coccinelle-1.0.0-rc19/0000755000175000017500000000000012250162456013357 5ustar eugeneugencoccinelle-1.0.0-rc19/Makefile.common0000644000175000017500000000164612247437436016326 0ustar eugeneugen# Some common definitions that factored out many reoccurring patterns # in the Makefiles of the project. This file is included at the bottom # so that its implicit rules take precedence over implicit rules in # the file that includes this one. # this is a "hack" so that we do not have to pass --native to ocamldep # and rebuild .depend when building the native version. Since we have # .ml files without .mli files, building the .cmo *and .cmx file could # cause the .cmi file to be build twice, which could cause trouble when # the .cmi file is read by other compilation steps (especially when # building in parallel). export BUILD_OPT ifeq ($(BUILD_OPT),yes) %.cmo: %.ml %.cmo: %.cmx @echo "skipped building $@ in optimizing mode: $< will be build instead." endif # If this variable is set, then 'make distclean' should not remove certain # generated files like the generated parsers, and documentation. export KEEP_GENERATED coccinelle-1.0.0-rc19/Makefile.config.in0000644000175000017500000000663312247437436016711 0ustar eugeneugen# autogenerated by configure # * for each library $1, add another entry in the same manner MAKELIBS=@MAKE_dynlink@ @MAKE_menhirLib@ @MAKE_pycaml@ @MAKE_pcre@ LNKLIBS=@MODULES_dynlink@ @MODULES_menhirLib@ @MODULES_pycaml@ @MODULES_pcre@ @MODULES_profiling@ OPTLNKLIBS=@MODULESOPT_dynlink@ @MODULESOPT_menhirLib@ @MODULESOPT_pycaml@ @MODULESOPT_pcre@ INCLIBS=@PATH_dynlink@ @PATH_menhirLib@ @PATH_pycaml@ @PATH_pcre@ FLAGSLIBS=@FLAGS_dynlink@ @FLAGS_menhirLib@ @FLAGS_pycaml@ @FLAGS_pcre@ OPTFLAGSLIBS=@OPTFLAGS_dynlink@ @OPTFLAGS_menhirLib@ @OPTFLAGS_pycaml@ @OPTFLAGS_pcre@ # * end of library variables # system packages inc libs SYSINCLIBS=@PATH_unix@ @PATH_bigarray@ @PATH_num@ @PATH_str@ @PATH_dynlink@ # camlp4 library location PATH_camlp4=@PATH_camlp4@ SHELL?=@SHELL@ PKG_CONFIG=@PKG_CONFIG@ INSTALL=@INSTALL@ TAR=@TAR@ PATCH=@PATCH@ ECHO=@ECHO@ PDFLATEX=@PDFLATEX@ PATCHELF=@PATCHELF@ # copy of the configure flags CONFIGURE_FLAGS=@CONFIGURE_FLAGS@ # differentiate between release and development builds here # (typically for improved performance) ifneq (@enable_release@, no) EXTRA_OCAML_FLAGS=-unsafe else # -dtypes is depricated and can be replaced with -annot for newer # versions of ocaml. EXTRA_OCAML_FLAGS=-g # -dtypes endif # note that variables are exported and thus cannot be used in # definitions of other variables. Use $(EXTRA_OCAML_FLAGS) for that. # Todo: since these definitions are now in Makefile.config.in, the # defaults can be removed from each individual Makefile in the # subdirectories. export OCAMLCFLAGS?=$(EXTRA_OCAML_FLAGS) export OPTFLAGS?=$(EXTRA_OCAML_FLAGS) # paths prefix=@prefix@ exec_prefix=@exec_prefix@ bindir=@bindir@ datarootdir=@datarootdir@ includedir=@includedir@ libdir=@libdir@ sysconfdir=@sysconfdir@ mandir=@mandir@ # C compiler export CC=@CC@ export CFLAGS=@CFLAGS@ export CPP=@CPP@ export CPPFLAGS=@CPPFLAGS@ # portable MKDIR_P MKDIR_P=@MKDIR_P@ # the default Make target TARGET_ALL=@MAKETARGET_ALL@ TARGET_SPATCH=@MAKETARGET_SPATCH@ PYTHON_CFLAGS=@PYTHON_CFLAGS@ PYTHON_LIBS=@PYTHON_LIBS@ export PYTHON_VERSION=@PYVER@ export PYTHON_VERSION_MAJOR=@PYVER_MAJOR@ PCRE_CFLAGS=@PCRE_CFLAGS@ PCRE_LIBS=@PCRE_LIBS@ export OCAMLFIND=@OCAMLFIND@ export OCAMLBUILD=@OCAMLBUILD@ export OCAMLC=@OCAMLC@ export OCAMLDEP=@OCAMLDEP@ export OCAMLDOC=@OCAMLDOC@ export OCAMLLEX=@OCAMLLEX@ export OCAMLYACC=@OCAMLYACC@ export OCAMLLIB=@OCAMLLIB@ export OCAMLMKLIB=@OCAMLMKLIB@ export OCAMLMKTOP=@OCAMLMKTOP@ export OCAMLOPT=@OCAMLOPT@ export CAMLP4=@CAMLP4@ export CAMLP4O=@CAMLP4O@ export MENHIR=@MENHIR@ export OCAMLVERSION=@OCAMLVERSION@ INSTALL_PROGRAM=$(INSTALL) -m 755 INSTALL_LIB=$(INSTALL) -m 755 INSTALL_DATA=$(INSTALL) -m 644 # Where to install the binary BINDIR=${bindir} # Where to install the man pages MANDIR=${mandir} # Where to install the lib LIBDIR=${libdir} # Where to install the configuration files SHAREDIR=@SHAREDIR@ BASH_COMPLETION_DIR=${sysconfdir}/bash_completion.d # selected libraries FEATURE_menhirLib=@FEATURE_menhirLib@ FEATURE_pycaml=@FEATURE_pycaml@ FEATURE_pcre=@FEATURE_pcre@ LOCALLIB_pycaml=@LOCALLIB_pycaml@ # Features FEATURE_PYTHON=@FEATURE_PYTHON@ FEATURE_OCAML=@FEATURE_OCAML@ NO_OCAMLFIND=@SUBSTITUTED_OCAMLFIND@ FEATURE_OCAMLBUILD=@FEATURE_OCAMLBUILD@ # Include paths PCREDIR=@PATH_pcre@ PYCAMLDIR=@PATH_pycaml@ MENHIRDIR=@PATH_menhirLib@ DYNLINKDIR=@PATH_dynlink@ # selected ocaml modules PYCOCCI_FILE=@PYCOCCI_FILE@ OCAMLCOCCI_FILE=@OCAMLCOCCI_FILE@ REGEXP_FILE=@REGEXP_FILE@ coccinelle-1.0.0-rc19/Makefile.am0000644000175000017500000000046012247437436015424 0ustar eugeneugen# This file is not the actual Makefile, as we do not use Automake for # our project. The purpose of this file is to instruct autoreconf # to include the setup directory. # # Note: ./configure generates the Makefile from Makefile.in, but # not from this Makefile.am. ACLOCAL_AMFLAGS = -I setup --install coccinelle-1.0.0-rc19/changes.txt0000644000175000017500000012540412247437436015547 0ustar eugeneugen-*- org -*- * upcoming/planned/todo ** Language: - Semantic patch for other languages - Support metavariables, virtual rules and virtual identifiers in initialize and finalize rules - Support for matching #ifdef, etc. - function-typed metavariables - virtual typedef, declarer name, iterator name - regexps for type metavariables - 'symbol' metadeclaration for C identifiers that are guaranteed not intended as meta variables. - allow mixing isomorpisms with normal rules ** Features: - New scripting languages - more than one SP on the command line - interpret #if, as is done for #ifdef ** Bugfix: - Add more information in documentation, man pages and wiki - typedefs from C code should not be used before their point of inference (saved_typedefs in cprogram_of_file) * 1.0.0 ** Language: - Addition of initializer list metavariables. Thanks to Michael Stefaniuc for noticing the need for them. - Allow multiple position variables per token - ++ can now be associated with - code - Allow /* */ comments as smpl comments, not only as + code - Add support for && (label addresses) - local idexpression metavariable no longer matches static local x - Consider using to be a comment in C++ code. Patch submitted by Jani Monoses. - Command line cocci - print_main etc for ocaml Coccilib - =~ not ~= is used to indicate a regular expression constraint on an identifier. And !~ for a nonmatch. - allow long double, short int, long int, and long long int in SmPL code. - gcc constructors allowed in SmPL. Thanks to Uwe Kleine-Koenig for pointing out the problem. - Allow ! to appear before () in depends. Thanks to SF Markus Elfring for noticing the problem. - Can add code containing #pragma or #line. - Multicharacter command-line options now begin with -- and contain - rather than _. - Allow multiple types of hidden metavariables, each preceded by @. Position variables can be attached to these. - Python code now receives a structure containing a list of matched elements for list metavariables. Thanks to Michael Stefaniuc for suggesting this features. - Python code now receives expressions and identifiers as ordinary strings, not as elements of specific structures. - Allow size_t as the type of an array index in smpl code. Reported by Mansour Moufid. - Allow renaming an expression as an identifier (@i) - Support const/volatile after *. Thanks to Lars-Peter Clausen for pointing out the problem. - Support variable declarations in the first element of a for loop header. - Support decimal type with the --ibm option - Support some matching on pragmas ** Features: - Preserve spacing before // comments when not at the beginning of a line - Adjusted parsing of endif to put it after jump code - Improve warning message when using -use_cache - More helpful initial value for exported variables in python - Support - on expression nests - Better handling of the case of a matched declaration that should only be replaced by other top level things. - Allow a semantic patch beginning and ending with braces to match the complete body of a function if the braces are not removed and if nothing is added before the first brace or after the last one. - Add -cache_prefix option, to specify where to put cached files. - Allow module_init(foo); to match module_init(foo) (or likewise for any declarer), when no transformation is specified on the semicolon. - Add Coccilib.exit() for ocaml code and cocci.exit() for python code, to abort the treatment of the current file. - Don't multiply print the same patch for the same file - Drop date in diff - Don't repeat smpl type warnings - -sp_file/-cocci_file are now optional. If not present an argument that ends in .cocci is assumed to be the name of the file containing the semantic patch. - Allow limiting the size of a named cache using -cache_limit - Cache name specified with -cache_prefix is extended according to the index (parallelism), if any. - Allow multi-character constants in C code and SmPL code. Thanks to Kamil Pilch for pointing out the problem. - Better parsing of K&R C functions. No longer convert all parameters to typedefs. - Implement newes as a hash table, for more efficiency on big sets of environments. - A local variable that is declared without a type is not considered to be a local variable. Actually, such a variable is probably really a macro that expends to a declaration, and this macro is not the variable name. - Allow iteration to make modifications when the modifications are done inplace. - -debug gives information about defined virtual rules and about virtual identifier bindings. - no more crashing on c++-like code without the c++ argument. - dependencies can have ! on () - Give ocaml code access to Flag and thus the current file name. - Slightly more efficient handling of lists. - Slightly better error message in the case of inconsistent paths - Improve limited size caching - Remove zero #ifdefs when everything else is removed - Mac OSX compatibility (tested on OSX Lion) - 'Make depend' is called automatically when starting from a cleaned source - Configure flag --enable-release makes 'make' build the optimized version of coccinelle if possible. - The installed 'bin/spatch' calls spatch.opt or spatch with default parameters for iso/headers/python. 'bin/spatch.opt' and 'bin/spatch.byte' - The bundled packages are now in the 'bundles' subdirectory and in the form of their original tarballs. These are extracted and used on-demand. - Compatibility with python 2 and python 3. Also, a small bug is fixed in the order of library includes that caused sometimes trouble when building the pycaml library. - Dropped the dependency on Perl in the Makefiles - The configure script uses pkg-config and ocaml findlib and provides many flags for tuning/overriding the build process (including the ocaml compiler and the C compiler and preprocessor). - Add line number directives to the .ml file generated from a .cocci file - Added 'make check' as an alternative to 'make test'. It can run after building spatch, checks whether some features work (python and ocaml scripts, regexes) if these features are enabled, and then launches the test suite with a 75% success rate requirement. It also does not ask for user input and can be used in autonomous builds. - Added an experimental --reverse flag to invert the semantic patch before application. Note that not all patches can be inverted, nor is it guaranteed that applying a patch followed by applying its inverse is an identity operation. - Cache prefix takes distribution index into account. - Add --defined and --undefined options allowing some code not to be touched. Suggested by Eric Leblond. - Dropped the need for the ocaml-extlib and ocaml-sexplib packages. - Changed the file format of the regression test results. Files in the old format are no longer readable by spatch. - Added a crude mechanism for integrating the results of external analyses with coccinelle, using positions to connect them together. This is an experimental feature. See demos/external_ana.{c,cocci,data}. - Try to do better pretty printing when array elements are individually replaced - Just fail quietly on attempt to remove a multi-variable declaration, allowing the semantic patch to continue. A warning message is printed. - Ignore unknown identifiers around known types. - Ignore --use-glimpse if multiple directories given - Added support for c++ namespace syntax in cocci files. - Improved c++ parsing - Addition of gcc min and max operators. Thanks to Holden Karau - Allow --use-idutils to take the name of the database as an optional argument. Thank to Wolfram Sang for the suggestion. - Allow some parameters of a function not to have names. - Improve indentation and newline introduction in pretty printer. Thanks to Nic Volanschi for the bug report. - Eliminate the reliance on grep in most cases for worth trying, to improve performance. Thanks to Johannes Berg for the suggestion. ** Bugfix: - Corrected parsing of script strings delimited by a single quote. Thanks to Eugeniy Meshcheryakov for reporting the problem. - Improved indentation of added ifdefs. - Allow added comments and #ifdefs to precede other added code. Thanks to Jani Monoses for noticing the problem. - Corrected failure to due missing ocamlfind. Thanks to Derek M. Jones for reporting the problem. - Allow fake nodes to be - in the allminus case, to drop tokens related to a function definition or forward declaration but before the first code mentioned in the semantic patch. - Drop __init etc when deleting a whole function. - Cause appropriate newlines to be preserved when multiple matches (trees) contain adjacent modifications derived from the same SmPL code. - check_meta takes into account fresh identifier seed information. - Types for worth-trying optimization should not be followed by space - Improved filtering of result of matching atomic patterns - Drop positions before creating function prototype rules - Adjust position of { introduced by adding multiple statements in a single-statement position - Drop newline after function call ( when all arguments on that line are eliminated - Accept removal of a single declaration, replaced by arbitrary, non-declaration code - smpl_spacing takes into account newlines, indentation - Improved prevention of transformations on toplevel { ... } from causing changes outside function boundaries; also outside ifs, whiles, etc. Changes are still allowed on { ... } present for other reasons. - Fix bug in include_match that caused everything to halt when all matches were discarded - Don't call Insert_plus on rules that cannot be evaluated due to failed dependencies. - Allow variable declaration right after a case in switch. - The top of a loop is also after the body of a loop, for ... in loop body - Do not anchor Str regexp at the beginning of the string to check - Type annotation for C code uses most recent env for typedefs when possible. Thanks to Andrea Canciani for pointing out the problem. - Pretty print pointer types without a trailing space. Thanks to Michael Stefaniuc for pointing out the problem. - Propagate dependencies further in get_constants2 - Make lexer more dos friendly - slightly better handling of long long - Strip constraints from metavariables in function prototype treatment before comparison, due to incomparability of pcre regexps. - Fixed obsolete regexp doc, thanks to Dmitry Osmakov - Improved x || ... || y to avoid double modification - Transparently allow \( \| and \) to be on lines beginning with -. The - has no effect. - Remove memory leak related to pr2_once management. Thanks to Robert Gomulka for helping to solve the problem. Don't use once hashtable if messages won't be printed anyway. - Change the type of subtraction mixing pointer and array to have int result. Thanks to Robert Gomulka for noticing the problem. - Fix interpretation of dependencies in the presence of virtual rules. Ignore constraints on inherited position metavariables in a rule that will be ignored. - Better support meta iterator and meta declarer tokens, and symid tokens. - Better indentation after added noindent. - Fixed length bug in the treatment of structures. - Allow inheriting declaration/field metavariables. - Don't drop spaces after parentheses in when no minus code present. Thanks to Terry Wilson for reporting the problem. - Keep inherited metavariables in asttomember (preprocessing for matching) - allminus for types, to allow removing const, not just matching it - improved pretty printing when something is added before a closed brace - Allow matching on nameless structs. Thanks to Ron Minnich for reporting the problem. - Pretty printing of const/volatile arrays in smpl code. - Don't allow just dropping an exp or type - Avoid removing #endif when surrounded by - code - Print some important error messages even with the --very-quiet flag. - Fixed parallel building in the Makefiles - Fixed the compilation of the "pure bytecode" version. If you use the bundled pycaml or ocaml-pcre, you'll need their stub libraries in your LD_LIBRARY_PATH. - For get_constants, virtuals should be false, not true - C parsing of top-level declarers with initializations. - Remove constraints in predicates in match result, to avoid PCRE equality problems - Enum assignment matching an enum value shouldn't cause a crash. Likewise, an identifier matching an initialized enum field shouldn't cause a crash. - Make when forall in an exists rule behave (more) like forall - Ocaml 4.00.0 compatibility fixes - Drop inlines, reduce parser code size - Bind const_vol in the right order in Ast0 visitor - use arg_expression for printing iterator arguments instead of expression, to get the right spacing. Thanks to Lars-Peter Clausen for the fix. - Better spacing for generated argument lists. Thanks to Lars-Peter Clausen for reporting the problem. - Collect all module interfaces for ocaml scripting in a single coccilib.cmi file, with the list of exposed internal modules in ocaml/exposed_modules.ml. This simplifies the installation of the ocaml version of coccilib, and allows us to specify which modules can be accessed by an ocaml script. The coccilib.cmi must either reside in $COCCI_DIR/ocaml/ or $COCCI_DIR/ocaml/coccilib/. - Ocamlbuild-based compilation of coccinelle (experimental). In a cleaned repository, use the configure option --enable-ocamlbuild to enable it. The Makefiles will then use ocamlbuild. - Ocamlscripts can access more of coccinelle: the file ocaml/exposed_modules.ml specifies which modules are accessible. - Use arg_expression to print macro arguments. Thanks to Lars-Peter Clausen for the fix. - Remove some trailing whitespace due to unindent or added if braces. Thanks to Eric LeBlond for reporting one of the problems. - Remove undesired newline after if header when body is a metavariable. Thanks to Eric LeBlond for reporting the problem. - Improve macro expansion to take into account variable numbers of arguments - Don't count macros or ifdefs in counting fields - Better counting of indent size when indent contains multiple tabs - Get the right annotation on trailing , that is after a nest. Requires avoiding double processing in transformation_c.ml - Fixed an issue where an 'Impossible' exception could be raised. - Fixed an issue where some identifiers were incorrectly interpreted as typedef. - allow __ at the beginning of a struct or union name - unparsing with precedence - Type metavariable should not match a case where there is no type in the C code. Thanks to SF Markus Elfring for pointing out the problem. - Allow an expression list metavariable to be attached to a parameter list metavariable, to allow using the parameter names as an argument list. Thanks to Michael Stefaniuc for pointing out the need for this feature. - register x; in C is considered to implicitly declare an int typed variable. A type metavariable that is part of a match of this declaration will get bound to int. But if the type metavariable furthermore is associated with a position metavariable, the match will fail, because the implicit int has no position. Thanks to Nic Volanschi for pointing out the problem. - Propagate parameter list variables from rules for function definitions to the generated rules for function prototypes. Thanks to Nic Volanschi for pointing out the problem. - Avoid introducing extra space when pretty printing. Thanks to Daniel Wagner for pointing out the problem. - Don't add extra space before semicolon, comma, or right paren when adding an __attribute__ - Identifiers promoted to typedefs should have positions - Allow disjunctions in removed nests - Only print a warning about multidecls if the pattern actually matches. - fixed --cache-limit to set --use-cache. Thanks to Tegawende Bissyande for finding the problem. - Drop matched pattern in idutils output. Thanks to Wolfram Sang for pointing out the problem. - Improve parsing of #defines that contain multiline comments. Thanks to Tegawende Bissyande for finding the problem. - Collect all types in get_constants when types mentioned on metavariables. Thanks to Michael Stefaniuc for the report. * 0.2.5 ** Language: - Make a very small attempt to parse C++ code, amounting to accepting identifiers containing ::, tilde, and template invocations. Use the option -c++. This is not likely to be very useful in practice. - Added metavariable metavariable type. - Add disjunctions on identifiers in some contexts - Pretend that & indicates a pointer in -c++ mode - Support for new and delete - Allow arrays in smpl parameter declarations. Thanks to Jesper Louis Andersen for pointing out the problem. - Field list metavariables - Add the ability to add __attributes__ (NB, no matching on attributes) - Slightly improved the error message for transformation on multiple variable declaration. Thanks to Jonathan Nieder for pointing out the problem. ** Features: - support transformations on variables (only) in declarations that declare multiple variables - allow #endif XXX in C code - relax_include_path now applied to non local includes too, in which case it tries to find a unique file with a suffix of the provided name. this is useful for directories that are intended to be symbolic links. - support matching and removing #undef - support for iteration in ocaml, requires use of -no_show_diff - calls to likely and unlikely propagate test expression status to their arguments - reuse typedefs and macros from complete parsing when reparsing the transformed code - better explanation when presenting glimpse tokens - optimization for an if branch that is just { ... } - spatch -control_flow_to_file file.c generates a file file.dot - include files with names ending in .cpp if -c++ option is given - removed use of the no longer supported sexplib function Conv.hashtbl_of_sexp - add information about which Fedora packages are needed ** Bugfix: - improved parsing of expressions to allow ... to the right of operators in more places - Fix check_config for Python 2.7 on Fedora 14 (Reported-by: Michael Stefaniuc) - Check for ocamlfind in configure (Reported-by: Paul E. McKenney) - Postpone use of ocamlfind at runtime to report fewer errors - Add support for Python 2.4 binding with the provided pycaml library - Allow '@' in script code. Thanks to Laurent Reveillere for noticing the problem. - Remove an optimization of x or true to true in asttoctl2 for the case where x may make a modification, eg the case of -thing ?-thing - Allow adding comments before a function. - Introduction of newlines in function arguments needs to take into account that the code added by SmPL can include newlines. Thanks to Thomas Gleixner for finding the problem. * 0.2.4 ** Language: - scripts now have names and can declare metavariables that are seen by SmPL as identifier metavariables, see demos/{python,ocaml}tococci.cocci - declaration (match variable declarations) and field (match structure field declarations) metavariables - matching of array initializations and of enum declarations ** Features: - compatibility with Python 2.7. Thanks to Richard W.M. Jones for pointing out the problem - python and ocaml string representations of parameter lists and expression lists - try simpler patterns on glimpse failure - graceful and immediate failure when a virtual rule is defined on the command line, but not in the rule - spatch returns -1 when a virtual rule is requested that is not supported - no transformation when using * with the option -no_show_diff - expanded +++ file name for match output - struct *^* and enum *^* metavariable types - allow an assignment to match a variable initialization, even if multiple variables are declared at the same time. - add the option -recursive_includes - added the option -use_idutils. The requires the previous use of the script idutils_index.sh ** Bugfix: - detect used after metavariables in simple statement metavariable match - allow inheriting position variables over rules that make transformations but depend on virtual rules that are not defined on the command line - treat top-level tokens in decl visitor. Thanks to Peter Tummeltshammer for noticing a resulting problem. - improve typing of the result of an assignment expression - eliminate some recursive calls in C code parsing to avoid stack overflows - better pretty printing of #define when the whole line is removed - better pretty printing of asm code containing "::[input]"r"(&coherence_data[i])" - allow pretty printing of C code with nameless bit fields - avoid adding an error message to standard output if ocamlfind is not found - struct/union/enum-typed metavariables with a metavariable type name - better management of whitespace between deleted lines. Thanks to Andriy Gapon for noticing the problem. - improved parsing recovery for badly parsed struct/enum typedefs - drop expanded tokens in sgrep output. Thanks to Andriy Gapon for noticing the problem. - constant strings have array type, not pointer type. Thanks to Vasiliy Kulikov for noticing the problem. - improve indentation when adding code after a function call with indented arguments. - return type of sizeof converted to unsigned long. Thanks to Vasiliy Kulikov for noticing the problem. - improve spacing when adding structure initializers. Thanks to Vasiliy Kulikov for noticing the problem. * 0.2.3 ** Language: - <= constraints relating an expression metavariable to one or more inherited expression metavariables that it should be a subexpression of - the -inplace and -outplace options have been renamed -in_place and -out_place. -in_place no longer makes a backup. A backup can be requested using the option -backup_suffix, eg -backup_suffix .bk - identifiers can be constrained to be different from an inherited identifier metavariable, or from a set containing both concrete identifiers and inherited identifier metavariables. - support for ocaml scripting - ast available in ocaml scripts ** Features: - drop inconsistent paths check when only one node was matched - allow #define id with no definition - attempt to add newlines in the generated code when function calls in the smpl cause passing column 80 - allow - in front of statement level nests, if everything inside the nest is also - - 'configure' looks for some system libraries: menhirLib, sexplib, pycaml. Not available libraries are replaced by a copy provided with the sources. - added static for a function goes just before what is specified in the semantic patch, not before any comments etc. - Add a new option, -ignore_unknown_options, to ease the integration of Coccinelle as a checker in a toolchain. - error in python code causes immediate abort of spatch - use the same algorithm for collecting grep tokens as for collecting glimpse tokens - Add scripts/spatch.bash_completion for automatic completion of common options under the bash shell. - Print rule name when a script rule crashes - Allow the declaration of an expression list or parameter list metavariable to specify the number of expressions or parameters, respectively. ** Bugfix: - drop inconsistent paths check when only one node was matched - better take into account virtual rules when selecting glimpse tokens - print diff when only a comment is added - the type of the C code !x should be int regardless of the type of x - allow python code at the beginning of an included file - better adjustment of whitespace when deleting adjacent lines. Thanks to Wolfram Sang for pointing out the problem. - allow metavariables to be inherited from included files - allow ? on goto - more graceful failure on finding a strange character in a macro parameter list - support Parameter metavariables - add space after the last comma in an added portion of an argument list - SmPL nameless struct should only match a nameless struct, not a nameless union. Thanks to Peter Tummeltshammer for pointing out the problem. - adjustments to storage don't modify inline as well - matching and transformation allowed on inline - allow removed field between two ... in structure initialization - allow removing an entire structure initialization - manage labels within do while 0 macros - added space after : in printing a conditional expression. Thanks to Josh Triplett for noticing the problem. - dropped trailing whitespace when code at the end of a line is deleted. Thanks to Josh Triplett for noticing the problem. - Fixed environment management when script rule uses cache. Thanks to Bissyande for finding the problem. - when false matches if with no else - ensure { ... } with whencode checks to the end of the function. Thanks to Rene Rydhof Hansen for finding the problem. * 0.2.2 ** Language: - Added ToTestExpression to iso language, see standard.iso for an explanation - Added depends on to initialize and finalize script code ** Features: - Update Emacs mode (cocci.el) to support 'virtual' rules and fix other keywords sush as 'depends on', 'using', 'disable' - better treatment of != 0 in isos, communtativity for ==/!= for all constants - allow adding // comments and blank lines (even after cocci + code) - Add support for multiple -I options ** Bugfix: - correct interaction between virtual rules and included .cocci files - improvement in treatment of ! in isos, to avoid duplicating + code - improvement in treatment of metavars as isos, to avoid duplicating + code between toplevel and variable instantiation - test expression of smpl conditional, etc no longer assumed to have type int - correct + line numbers in the patch produced when using * - iso constant metavariable matches an identifier whose name is all capital letters, eg NULL - allow / at the end of the name of a directory (-dir) or patch prefix (-patch) - dropped space in + code after the binding of a type metavariable that is a pointer type - better handling of . or .. in -dir name - allow keywords and metavariable names in identifier constraints (not sure keywords is very useful, though) - no lubtype on arguments of && and || in SmPL - allow unknown as type for array indices in SmPL - support matching of static annotation on functions that are both static and inline - support ENOTDIR error in Common.lfile_exists, to allow for the case where an include file is in a subdirectory that exists but is an ordinary file, not a directory. - better management of unbound position variables that appear in constraints - cause python parser to skip over // comments, hoping that // is not meaningful inside python - require + on every line of a multiline comment - correct calculation of line numbers when there is script code - always annotate arguments of && || and ! as test expressions in C code. * 0.2.1 ** Language: - Add virtual identifiers - Add coccilib.report and coccilib.trac Python modules - coccilib.org and coccilib.report are imported by default but not loaded in the current scope. ** Features: - Parse_error_msg now more helpful. New option -verbose_parsing for even more information. - Improve Python import handling. They are imported once during script initialization. ** Bugfix: - correct treatment of depends on with || for virtual rules * 0.2.0 ** Language: ** Features: - Remove duplicated code in disjunctions - Better error message when grep finds nothing relevant. Thanks to Joe Perches for the suggestion. - added -keep_comments option for the unparsing of the transformed code - Option "-version" now also gives information about built-in Python binding support. - slightly faster environment manipulation in pathological cases - hack added to accept well-formed #define after function header ** Bugfix: - Proper consideration of #define macro arguments in checking for the use of metavariables and in computing the line numbers of complex terms - Better parsing of included .cocci files - Put included .cocci files in the right order - Bind position variables only once for #include - Fix bug in include_match that caused everything to halt when all matches were discarded - Merge unlikely/likely iso rules under a iso rule named unlikely - Some fixes to coccicheck rules, thanks to Andrew Lunn - Support groups in regular expression, thanks to Michael Stefaniuc * 0.1.11 ** Language: - Meta-identifier/function and constant could be filtered from SmPL by regular expressions using the "~=" and "!~=" operators followed by an OCaml regular expression (see man Str) in double quote. - Virtual rules, which can be referenced in depends, and set and unset using the command-line options -D - ++ for multiple additions ** Features: - coccicheck: a framework to check a series of SmPL files on a project see scripts/coccicheck for more information ** Bugfix: - bind position variables to the correct starting position in the case of a complex statement such as an if or while. Thanks to Derek Jones for pointing out the problem. - checking for non mentioned case lines in switch should be unchecked. - space should be printed after sizeof when there are no parentheses around the argument. Thanks to Daniel Walker for pointing out the problem. - avoid introducing sharing in propagating ! over () in treatment of isos - save_excursion has to handle and rethrow exceptions - eliminate unnecessary consideration of CVS strings. Thanks to David Young for pointing out the problem. - completely new treatment of statement metavariables - better type checking for macro definitions - drop regression testing in -parse_c * 0.1.10 ** Language: - declarations allowed in switch, suggested by Derek M. Jones ** Features: - use interval timer for timeouts. Thanks to Derek M. Jones for the implementation. - more flexible env.sh, thanks to Derek Jones. - faster Python invocation - simplify unparsing in the sgrep case ** Bugfix: - for glimpse there is no point to create a pattern containing a numeric constant because glimpse doesn't index them - add spaces after commas in function calls and function headers - made python integration more like the ubuntu version http://patches.ubuntu.com/by-release/extracted/debian/c/coccinelle/0.1.5dbs-2/01-system-pycaml this fixes some memory management problems with None, True, and False - correct labels associated with a switch in the CFG so that a statement metavariable can match a switch. Thanks to Derek Jones for pointing out the problem. - keep switch pattern within switch body. Thanks to Derek Jones for pointing out the problem. - Allow expanded tokens to be stored in metavariables, as long as they are not removed. But this does currently allow them in + code, which will produce the expansion. Thanks to Ali-Erdem Ozcan for pointing out the problem. - improved adjustment of spacing when code removed at the beginning of a line * 0.1.9 ** Language: - allow fresh identifiers to be declared using ## such that the value mixes both strings and previously declared metavariables ** Features: - better handling of expanded code containing ##. Now compute the result. - more precise warning message for the "'\' outside define". Thanks to Nicholas Mc Guire for pointing out the problem. - more precise warning message related to ifdefization. Thanks to Derek Jones for pointing out the problem. - we don't create any more certain files in /tmp (they may be a cause of security problems). Thanks to Eugeniy Meshcheryakov for pointing out the problem. - More optimization for the case of just deleting a complete function. Allows this to happen without tracing through all the control-flow paths. Thanks to Francois Bissyande for pointing out the problem. - prevent code from being added to the beginning or end of a disjunction - more information about why a script is not applied when using -debug option - added -no_safe_expressions option - added -no_loops option. Ignores back edges derived from looping constructs. This is unsafe, but perhaps useful for bug finding, as it can be more efficient. - for semantic matches, allow "minus" on same code with multiple environments - better error message for mismatch of parenthesis in column 0 with normal parenthesis. Thanks to Derek Jones for pointing out the problem. - allow disjunctions on function return types. Thanks to Pierre Habouzit for pointing this out. ** Bugfix: - keep disjunction in the proper order for structure initialization fields - variables declared in different places should not seem to match each other - drop complaints about label metavariables not being used - drop test information from the type of an expression when the expression is bound to a metavariable - nests should not extend beyond the before and after code, even if the before and after code matches the nest code - nests should extend into conditionals that end in error exit - take into account metavariables on "else". Thanks to Derek Jones for pointing out the problem. - print single quotes on generated character constants - better typedef handling in the initialisation/affectation builtin isomorphism, cf -test init_affect_typedef - support disjunction of types on variable declaration - allow @ within strings in script code. ignore // comment lines in script code. - don't drop + code placed after the transformed code - drop spaces produced by removing code before semicolons - adjusted spacing within generated code - less verbose -sp. Thanks to Derek Jones for pointing out the problem. - accept multiple type names in a SmPL typedef declaration. * 0.1.8 ** Language: ** Features: - Metavariables now capture the cpp code contained within their definitions - When - fragments are separated by ... or nest boundaries in the semantic patch, but end up matching adjacent source code, the comments, cpp code and whitespace that are between them are not deleted. - better parsing of C: do expansion of macros only when needed when have actually a parse error and also leverage the definition of macros in the parsed file (or in a optional_standard.h file passed as a parameter). This should reduce the need for many hardcoded definitions in standard.h - new semantics for the -macro_file option, by default now expand macros only when necessary. To force use the -macro_file_builtins option instead. - a new -extract_macros command line action to help the parser. Works with the -macro_file option. e.g. $ ./spatch -extract_macros ~/linux > /tmp/alldefs.h $ ./spatch -macro_file /tmp/alldefs.h -sp_file foo.cocci -dir ~/linux - removed -D macro_file option, not consistent with what -D usually means - reattempt to be more efficient for statement metavariables that are just placeholders (ie, no modification, no reuse) - triples now returned from ctl in sorted order. The main key is the state. On the other hand, the state order does not always agree with the order of appearance in the code. - spatch is now less verbose on the things it does yet handle. Less confusing for new users. - slightly better error report. Thanks to Derek Jones for the suggestion. - added the options -linux_spacing and -smpl_spacing. -linux_spacing causes spatch to follow the spacing conventions of Linux, while -smpl_spacing causes spatch to follow the spacing in the semantic patch. -linux_spacing is the default. - more informative error reporting for the already tagged token case. Thanks to Erik Hovland for the suggestion. ** Bugfix: - better parsing of declare macro at toplevel and in structure. cf -text xfield - allowing back typedef names for fieldname - better printing of else in generated code - slightly better type inference for binary operators. - clear out declarer names and iterator names between SmPL files (for -testall) - better parsing and type checking of macro type aliases. Cf -test macro_int16. Thanks to Li Yingtong for pointing out the problem. - make insert_virtual_positions tail rec, avoid stack overflow pb. Thanks to Diego Liziero for pointing out the problem. - Better type inference for arithmetic binary operators Thanks to Li Yingtong for pointing out the problem. - Better type inference for constants Thanks to Li Yingtong for pointing out the problem. - move computing of adjacency information for semantic patches to after application of isomorphisms, because isomorphisms can introduce "..." - compute adjacency information for negated ... - record with each transformation site the set of indices of the witness trees that caused the transformation site to come about. Whitespace and comments between remove tokens associated with disjoint witness trees is not removed. - correct treatment of function pointer typed parameters in the SmPL ast0 visitor. - better parsing error message and error recovery when comments are not ended, when some macros have a weird body, and when some switch have a weird Body. Thanks to Derek Jones for pointing out the problem. - better detection and passing of "dangerous" ifdefs, cf -test double_switch. - dropped the separation of decls and body in Seq. This gives better positioning of the bindings of metavariables shared between them. Thanks to Erik Hovland for an example that shows the problem. ** Internals: - suppress warning in compiling ocamlsexp (warning caused by a new behavior of cpp used internally in processing files in ocamlsexp/) * 0.1.7 ** Language: - initialize and finalize script code, cf demos/initial_final.cocci ** Features: - -iso_limit option to limit the depth of isomorphism application - with the dir option, the include path is implicitly set to the "include" subdirectory of the specified directory, if the option -I is not used. - give a seed for the name of a fresh identifier - better handling of cpp "constructed" identifiers as in a##b, that in the futur will make it easier to match over those idents. cf tests/pb_parsing_macro.c. Thanks to Ali-Erdem Ozcan for pointing out the problem. A new "parsing hack hint" is also available: YACFE_IDENT_BUILDER, cf standard.h. ** Bugfix: - drop excessive "optimization" in ctl generation for while and for loops - allow . as the name of the directory - for type inference for an assignment, take the type of the right-hand side expression, not the type of the assigned variable - allow for with a declaration in the first header element, as in C++ (partial support) - allow for matching against variable declarations that include only storage, eg static, but no type at all. - allow for matching against types that contain both short/long and int - allow the type metavariable in the SmPL code "unsigned T" to match a T that is a type consisting of more than one word, eg long int. - -ifdef_to_if option made to process nested ifdefs (partial support) ** Internals: - improve and fix installation process (usable on BSD) - improve and fix testing process - apply patches from Eugeniy Meshcheryakov - reorganize the way we parse C identifiers, especially concatenated cpp identifiers as in a##b. This may lead to some regressions as we may not parse as much code as before. - removed popl/ and popl09/ and popl related stuff from official distrib. * 0.1.6 ** Language: - the ability to add comments ** Features: - grouping of generated rules with -hrule option - handling of special coccinelle comments /* {{coccinelle:skip_start}} */ and /* {{coccinelle:skip_end}} */ allowing to give more hints to the C parser. Thanks to Flavien@lebarbe.net for the idea. - the ability to print the values of more (but not all) kinds of metavariables from python - new vim SmPL mode. Thanks to Alexander Faroy. ** Bugfix: - consider the ident tokens also in the 2 lines before the error line for the 10-most-problematic-parsing-errors diagnostic. - SmPL parser allows cast as the argument of a pointer - SmPL type checker allows enum as an array index - Better generation of fresh metavariables names in hrule - no more warnings about things that should be metavariables when there is a disjunction in a function position - bugfix in parser, better error message. Thanks to Ali-Erdem OZCAN for the bug report. ** Internals: * 0.1.5 ** Language: - added initialiser metavariable - added sequences of designators in structures ** Features: - improved printing of the C code corresponding to metavariables - improved printing when code (eg declarations) is removed at the beginning of a block, and then is followed by a blank line - slightly less verbose error reporting in parsing_hacks ** Bugfix: - fixed some problems with parsing SmPL code where a nest appears after a | - better treatment of { }, form in macros wrt unparse_c - less quiet for -parse_c - improve parsing heuristics regarding macro statement ** Internals: * 0.1.4 ** Language: - long long added to SmPL ** Documentation: - add grammar reference and spatch command line options reference ** Features: - can match patterns of the form unsigned T or signed T, where T is a metavariable - dropped the sizeof_parens isomorphism, which was made redundant by the paren isomorphism - simple rule generation ** Bugfix: - trailing , ; and ) no longer left on a line by themselves - better treatment of error exit when the searched for code matches the error exit condition. - fix incorrect treatment of parentheses in test_exps that could allow + code to be added twice - don't ask whether iterator names and declarer names should be declared as metavariables. - slightly better support for expression list metavariables. - short and long allowed for array index types in SmPL - more restrictions on type inference for pointer arithmetic in SmPL - allow isomorphisms to apply when + code is anywhere within all - terms - changed order of printing const and volatile - allow eg ... <... in plus code - better formatting of generated if/while/etc. code - better parse error reporting when the problem is at the end of the file ** Internals: - isomorphisms don't apply under signed/unsigned, to prevent the creation of things like unsigned signed int. Need a better solution for this. * 0.1.3 ** Features: - help in building the configuration macro file. The -parse_c action now returns the 10 most frequent parsing errors. This give useful hints to extend standard.h. ** Bugfix: - positions no longer allowed on \(, \|, and \) - improved propagation of negation for isos in the presence of parens - convert Todos in flow graph construction to recoverable errors - fixed bug in treatment of when != true and when != false, to allow more than one of them per ... - improve parsing of typedef of function pointer. - improve typing. - parsing and typing support for old style C function declaration. - consider position variables as modifications when optimizing the translation into CTL of function definitions ** Internals: * 0.1.2 ** Bugfix: - better handling of ifdef on statements in control flow graph. - transform files even if they do not end in .c (thanks to Vegard Nossum) ** Internals: - merge code of yacfe * 0.1.1 ** Language: - support for initializer at toplevel, cf -test substruct * 0.1 ** first public release of the source code: ** Language: - embeded python scripting - position ** Features * beta ** first public release of the binary * alpha ** Features - lots of features ... look at coccinelle research papers and tutorials. coccinelle-1.0.0-rc19/python/0000755000175000017500000000000012247442646014710 5ustar eugeneugencoccinelle-1.0.0-rc19/python/python.mldylib0000644000175000017500000000002312247437436017603 0ustar eugeneugenPycocci Pycocci_auxcoccinelle-1.0.0-rc19/python/pycocci_aux.ml0000644000175000017500000000720012247442616017544 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pycocci_aux.ml" open Ast_c open Common let caller s f a = let str = ref ([] : string list) in let pr_elem info = str := (Ast_c.str_of_info info) :: !str in let pr_sp _ = () in f ~pr_elem ~pr_space:pr_sp a; String.concat s (List.rev !str) let call_pretty f a = caller " " f a let call_pretty0 f a = caller "" f a let exprrep = call_pretty Pretty_print_c.pp_expression_gen let commalistrep list_printer elem_printer comma_printer x = (call_pretty list_printer x, List.map (function x -> call_pretty elem_printer (comma_printer x) (* drop commas *)) x) let exprlistrep = commalistrep Pretty_print_c.pp_arg_list_gen Pretty_print_c.pp_arg_gen Ast_c.unwrap let paramlistrep = commalistrep Pretty_print_c.pp_param_list_gen Pretty_print_c.pp_param_gen Ast_c.unwrap let initlistrep = commalistrep Pretty_print_c.pp_init_list_gen Pretty_print_c.pp_init_gen Ast_c.unwrap let fieldlistrep = commalistrep Pretty_print_c.pp_field_list_gen Pretty_print_c.pp_field_gen (function x -> x) let stringrep = function Ast_c.MetaIdVal (s,_) -> s | Ast_c.MetaFuncVal s -> s | Ast_c.MetaLocalFuncVal s -> s | Ast_c.MetaExprVal (expr,_) -> exprrep expr | Ast_c.MetaExprListVal expr_list -> call_pretty Pretty_print_c.pp_arg_list_gen expr_list | Ast_c.MetaTypeVal typ -> call_pretty Pretty_print_c.pp_type_gen typ | Ast_c.MetaInitVal ini -> call_pretty Pretty_print_c.pp_init_gen ini | Ast_c.MetaInitListVal ini -> call_pretty Pretty_print_c.pp_init_list_gen ini | Ast_c.MetaDeclVal decl -> call_pretty Pretty_print_c.pp_decl_gen decl | Ast_c.MetaFieldVal field -> call_pretty Pretty_print_c.pp_field_gen field | Ast_c.MetaFieldListVal field -> call_pretty Pretty_print_c.pp_field_list_gen field | Ast_c.MetaStmtVal statement -> call_pretty Pretty_print_c.pp_statement_gen statement | Ast_c.MetaParamVal param -> call_pretty Pretty_print_c.pp_param_gen param | Ast_c.MetaParamListVal params -> call_pretty Pretty_print_c.pp_param_list_gen params | Ast_c.MetaFragListVal frags -> call_pretty0 Pretty_print_c.pp_string_fragment_list_gen frags | Ast_c.MetaFmtVal fmt -> call_pretty0 Pretty_print_c.pp_string_format_gen fmt | Ast_c.MetaListlenVal n -> string_of_int n | Ast_c.MetaPosVal (pos1, pos2) -> let print_pos = function Ast_cocci.Real x -> string_of_int x | Ast_cocci.Virt(x,off) -> Printf.sprintf "%d+%d" x off in Common.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2) | Ast_c.MetaPosValList positions -> "TODO: <>" coccinelle-1.0.0-rc19/python/pycocci.mli0000644000175000017500000000330112247442616017036 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pycocci.mli" val build_classes : Ast_cocci.meta_name list -> unit val construct_variables : (string * Ast_cocci.meta_name * Ast_cocci.metavar) list -> Ast_c.metavars_binding (*virts*) -> unit val construct_script_variables : Ast_cocci.meta_name list -> unit val pyrun_simplestring : string -> int val inc_match : bool ref val exited : bool ref val retrieve_script_variables : Ast_cocci.meta_name list -> string list exception Pycocciexception val set_coccifile : string -> unit val python_support : bool val initialised : bool ref val py_isinitialized : unit -> int val py_finalize : unit -> unit coccinelle-1.0.0-rc19/python/coccipython.cmxa0000644000175000017500000000502112247437536020104 0ustar eugeneugenCaml1999Z010 }(+Pycocci_aux@'Marshal0~ou [//$List0ARlxCtϠ$Oset0dC@Bn㠠&Printf0U% 9ihT%Objet0#)Y,HX/Ograph_extended0<{Qc)&Lexing0}V#MZR&'v$Setb0jkł&String0^iDs" %SetPt0Vٽ*]"*Regexp_str0Ȇ8~Nh%6~HHߠ+Ocollection0z}5v?Vs6 0&Buffer0@e/":|䠠.Pretty_print_c0e挚lbLK?#Str0IaA9jz&Common0^kɍ& _֓r%Ast_c0 K1; %疈'Token_c0zj&<I9钣&Regexp0ᖰ@(\$Unix0*STG Ŋ*Type_cocci0>.΂FqP⻠'Hashtbl02t uaV&Oassoc0 ?#ǫL^젠%Int320 vp -W#Obj0:33[ SVev#Arg0`˱;{u1*Pervasives0r:"%+Pycocci_aux0Ϯ* cUT~ʠ$Lazy0bF "cbD+Token_annot0"qQbĎÔE.Control_flow_c0Cpx#* u٠)Ast_cocci0M<ݿ] ק$Seti0]ŧwר#@&Common0?Ŕŵ,&Printf0zykt_&à*Pervasives0@QDb'EXWI.Pretty_print_c0Twv u $List0o= |Š&String0 %!t|7do%Ast_c0s['WZAP<@@DBC@BC@@@0=qkBBTxi(*No_pycocci@&Lexing0}V#MZR&'v+Pycocci_aux0Ϯ* cUT~ʠ+Token_annot0"qQbĎÔE&Common0^kɍ& _֓r&Buffer0@e/":|䠠*Pervasives0r:"%*Type_cocci0>.΂FqP⻠&String0^iDs" $Unix0*STG Ŋ&Regexp0ᖰ@(\#Map0\]nyZUg#Arg0`˱;{u1$List0ARlxCtϠ%Ast_c0 K1; %疈)Ast_cocci0M<ݿ] ק*Regexp_str0Ȇ8~Nh%6~HHߠD0 @-2iCoV.#Str0IaA9jz'Token_c0zj&<I9钣'Hashtbl02t uaV'Marshal0~ou [//$Lazy0bF "cbD@*Pervasives0@QDb'EXWI&String0 %!t|7do#Map0a-S@@DB@@@@0ɠ1se5b6Ơ('Pycocci@&Lexing0}V#MZR&'v+Pycocci_aux0Ϯ* cUT~ʠ+Token_annot0"qQbĎÔE&Common0^kɍ& _֓r&Buffer0@e/":|䠠*Pervasives0r:"%*Type_cocci0>.΂FqP⻠&String0^iDs" $Unix0*STG Ŋ&Regexp0ᖰ@(\#Map0\]nyZUg#Arg0`˱;{u1$List0ARlxCtϠ%Ast_c0 K1; %疈'Pycocci0iS>hUǠ*No_pycocci0 @-2iCoV.)Ast_cocci0M<ݿ] ק*Regexp_str0Ȇ8~Nh%6~HHߠ#Str0IaA9jz'Token_c0zj&<I9钣'Hashtbl02t uaV'Marshal0~ou [//$Lazy0bF "cbD@*No_pycocci0ɠ1se5b6@@@@@@0 Pk6Y3zUP@@@coccinelle-1.0.0-rc19/python/pycocci.ml.in0000644000175000017500000000003112247437436017273 0ustar eugeneugeninclude @PYCOCCI_MODULE@ coccinelle-1.0.0-rc19/python/no_pycocci.ml0000644000175000017500000000562712247442616017376 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./no_pycocci.ml" open Ast_c open Common open Pycocci_aux module StringMap = Map.Make (String) exception Pycocciexception let python_support = false let check_return_value v = failwith "no python" let check_int_return_value v = failwith "no python" let initialised = ref false let cocci_file_name = ref "" (* dealing with python modules loaded *) let get_module module_name = failwith "no python" let is_module_loaded module_name = failwith "no python" let load_module module_name = failwith "no python" (* end python module handling part *) (* initialisation routines *) let pycocci_init () = initialised := true (*let _ = pycocci_init ()*) (* end initialisation routines *) (* python interaction *) let split_fqn fqn = failwith "no python" let pycocci_get_class_type fqn = failwith "no python" let pycocci_instantiate_class fqn args = failwith "no python" (* end python interaction *) let inc_match = ref false let exited = ref false let include_match v = failwith "no python" let sp_exit _ = failwith "no python" let build_method (mname, camlfunc, args) pymodule classx classdict = failwith "no python" let build_class cname parent methods pymodule = failwith "no python" let has_environment_binding env name = failwith "no python" let get_cocci_file args = failwith "no python" let build_classes env = failwith "no python" let build_variable name value = failwith "no python" let contains_binding e (_,(r,m),_) = failwith "no python" let construct_variables mv e = failwith "no python" let construct_script_variables mv = failwith "no python" let retrieve_script_variables mv = failwith "no python" let set_coccifile cocci_file = cocci_file_name := cocci_file; () let pyrun_simplestring s = failwith "no python" let py_isinitialized () = failwith "no python" let py_finalize () = failwith "no python" coccinelle-1.0.0-rc19/python/pycocci_aux.mli0000644000175000017500000000271512247442616017723 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pycocci_aux.mli" val exprlistrep : Ast_c.argument Ast_c.wrap2 list -> string * string list val paramlistrep : Ast_c.parameterType Ast_c.wrap2 list -> string * string list val initlistrep : Ast_c.initialiser Ast_c.wrap2 list -> string * string list val fieldlistrep : Ast_c.field list -> string * string list val stringrep : Ast_c.metavar_binding_kind -> string coccinelle-1.0.0-rc19/python/coccipython.a0000644000175000017500000006336412247437536017412 0ustar eugeneugen! / 1386102622 0 0 0 1972 ` 8,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4ZZZZZZZcamlPycocci_aux__data_begincamlPycocci_aux__code_begincamlPycocci_auxcamlPycocci_aux__stringrep_1430camlPycocci_aux__fun_1474camlPycocci_aux__commalistrep_1419camlPycocci_aux__call_pretty0_1415camlPycocci_aux__call_pretty_1412camlPycocci_aux__caller_1404camlPycocci_aux__print_pos_1451camlPycocci_aux__pr_sp_1411camlPycocci_aux__pr_elem_1409camlPycocci_aux__fun_1471camlPycocci_aux__entrycamlPycocci_aux__code_endcamlPycocci_aux__data_endcamlPycocci_aux__frametablecamlNo_pycocci__data_begincamlNo_pycocci__code_begincamlNo_pycoccicamlNo_pycocci__py_finalize_1551camlNo_pycocci__py_isinitialized_1550camlNo_pycocci__pyrun_simplestring_1548camlNo_pycocci__set_coccifile_1546camlNo_pycocci__retrieve_script_variables_1544camlNo_pycocci__construct_script_variables_1542camlNo_pycocci__construct_variables_1539camlNo_pycocci__contains_binding_1535camlNo_pycocci__build_variable_1532camlNo_pycocci__build_classes_1530camlNo_pycocci__get_cocci_file_1528camlNo_pycocci__has_environment_binding_1525camlNo_pycocci__build_class_1520camlNo_pycocci__build_method_1513camlNo_pycocci__sp_exit_1512camlNo_pycocci__include_match_1510camlNo_pycocci__pycocci_instantiate_class_1505camlNo_pycocci__pycocci_get_class_type_1503camlNo_pycocci__split_fqn_1501camlNo_pycocci__pycocci_init_1500camlNo_pycocci__load_module_1498camlNo_pycocci__is_module_loaded_1496camlNo_pycocci__get_module_1494camlNo_pycocci__check_int_return_value_1490camlNo_pycocci__check_return_value_1488camlNo_pycocci__entrycamlNo_pycocci__code_endcamlNo_pycocci__data_endcamlNo_pycocci__frametablecamlPycocci__data_begincamlPycocci__code_begincamlPycoccicamlPycocci__entrycamlPycocci__code_endcamlPycocci__data_endcamlPycocci__frametablepycocci_aux.o/ 1386102622 1000 1000 100644 9216 ` ELF> @@ HH8HGHt HH8fH?IHL;8r/IwHFH>HCHHFH{HHff.HHH$H[H;HH$H@Hff.HHXHt*H$HHH$HXHHHHfff.HHD$HI0HL;8riIWH$HBHHBH@ HHH@HPHH$HHHHD$H@HHHHff.HHHHff.HH$Ht$I(HL;8rxIGH@HHH@HXHxHHD$H$H\$HIHL;8rIGH@HH\$HXHnffffff.HHHGHHcHHHHHX@HH;HHHH@HHHH@@HHHH@HHHHH@PHHHH@XHHHH@`HHHH@ HHHH@(HHHH@0HHHH@8HHHH@pHHHH@hHHH$HHHD$H$H@HD$H$HH\$H|$HHHHHfff.HHHHX(HHHX0HHHX8HHX0HH@H;HHC@HHHXHHHpHHHHHXHH@HHHHpHHHHHX@HH@HHHCHHpHHHHHXXHH@`HHCHHpHH=HHX(HH@0HHCHHHX HH(   pos(%s,%s) TODO: <> %d+%d       !`l  list.ml.symtab.strtab.shstrtab.rela.text.rela.data.bss.rodata.cst8.rela.rodata.note.GNU-stack @P +&h 1 6 H LC8" Pl l ` (  8`2xEXk~(@Xx 6Rbp(EDepe%AMgPcaml_negf_maskcaml_absf_maskcamlPycocci_aux__1camlPycocci_aux__2camlPycocci_aux__3camlPycocci_aux__4camlPycocci_aux__5camlPycocci_aux__6camlPycocci_aux__8camlPycocci_aux__12camlPycocci_aux__7camlPycocci_aux__9camlPycocci_aux__10camlPycocci_aux__11camlPycocci_aux__13camlPycocci_aux__data_begincamlPycocci_aux__code_begincamlPycocci_auxcamlPycocci_aux__stringrep_1430camlPycocci_aux__fun_1474caml_curry4camlPycocci_aux__commalistrep_1419caml_curry2camlPycocci_aux__call_pretty0_1415camlPycocci_aux__call_pretty_1412caml_curry3camlPycocci_aux__caller_1404camlPycocci_aux__print_pos_1451camlPycocci_aux__pr_sp_1411camlPycocci_aux__pr_elem_1409_GLOBAL_OFFSET_TABLE_caml_young_limitcaml_modifycaml_call_gccamlPycocci_aux__fun_1471camlPrintf__sprintf_1413caml_apply2camlPervasives__string_of_int_1130caml_apply3camlList__rev_append_1051camlString__concat_1066camlList__map_1062camlPretty_print_ccamlPycocci_aux__entrycamlAst_ccamlPycocci_aux__code_endcamlPycocci_aux__data_endcamlPycocci_aux__frametable& &N'_( * &B $X ]-p.(   & )0*8 &_(f(  1 1 1  1" 1: 1R 1j 1 1 1 1 1  *""/ W ^ i p {    1     3 1 1-   3 1' 10-7 B M 3[ 1f 1o-v    1 1-   +,/!!/G_w(+@,`x !"(#s4(c8.HXjptac   <$X(t,048<@DpHno_pycocci.o/ 1386102622 1000 1000 100644 11808 ` ELF> @@ H@H@H@H@H@HH@(HHfDH@H@H@H@H@H@H@H@H@H@H@H@H@H@H@HHH{0HHHffff.H@H@H@HHIGH@HHHHHPIGH@HHHHCHHCH=HH{H=HH{ HxHGHHH{(Hx HGHHHH{0H=HH{8H=HH{@H=HH{HH=HH{PH=HH{XH=HH{`H=HH{hHx0HGHHH{pHX@HCHHHXxHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH      No_pycocci.Pycocciexceptionno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno pythonno python.symtab.strtab.shstrtab.rela.text.rela.data.bss.rodata.cst8.note.GNU-stack @X +0&*H 1 6 C@ @ SXH : 1(C@UXgpy0P p 3FYl(@Xp*=P c8vPh!(4@GXZpm 2 X `#P @ 0 7  ]     " D a   p P @ A0 g   1<HZfcaml_negf_maskcaml_absf_maskcamlNo_pycocci__1camlNo_pycocci__2camlNo_pycocci__3camlNo_pycocci__4camlNo_pycocci__5camlNo_pycocci__6camlNo_pycocci__7camlNo_pycocci__8camlNo_pycocci__9camlNo_pycocci__10camlNo_pycocci__11camlNo_pycocci__12camlNo_pycocci__13camlNo_pycocci__14camlNo_pycocci__15camlNo_pycocci__16camlNo_pycocci__17camlNo_pycocci__18camlNo_pycocci__19camlNo_pycocci__20camlNo_pycocci__21camlNo_pycocci__22camlNo_pycocci__23camlNo_pycocci__25camlNo_pycocci__26camlNo_pycocci__24camlNo_pycocci__27camlNo_pycocci__28camlNo_pycocci__29camlNo_pycocci__30camlNo_pycocci__31camlNo_pycocci__32camlNo_pycocci__33camlNo_pycocci__34camlNo_pycocci__35camlNo_pycocci__36camlNo_pycocci__37camlNo_pycocci__38camlNo_pycocci__39camlNo_pycocci__40camlNo_pycocci__41camlNo_pycocci__42camlNo_pycocci__43camlNo_pycocci__44camlNo_pycocci__45camlNo_pycocci__46camlNo_pycocci__47camlNo_pycocci__48camlNo_pycocci__49camlNo_pycocci__50camlNo_pycocci__data_begincamlNo_pycocci__code_begincamlNo_pycoccicamlNo_pycocci__py_finalize_1551camlNo_pycocci__py_isinitialized_1550camlNo_pycocci__pyrun_simplestring_1548camlNo_pycocci__set_coccifile_1546camlNo_pycocci__retrieve_script_variables_1544camlNo_pycocci__construct_script_variables_1542caml_curry2camlNo_pycocci__construct_variables_1539camlNo_pycocci__contains_binding_1535camlNo_pycocci__build_variable_1532camlNo_pycocci__build_classes_1530camlNo_pycocci__get_cocci_file_1528camlNo_pycocci__has_environment_binding_1525caml_curry4camlNo_pycocci__build_class_1520camlNo_pycocci__build_method_1513camlNo_pycocci__sp_exit_1512camlNo_pycocci__include_match_1510camlNo_pycocci__pycocci_instantiate_class_1505camlNo_pycocci__pycocci_get_class_type_1503camlNo_pycocci__split_fqn_1501camlNo_pycocci__pycocci_init_1500camlNo_pycocci__load_module_1498camlNo_pycocci__is_module_loaded_1496camlNo_pycocci__get_module_1494camlNo_pycocci__check_int_return_value_1490camlNo_pycocci__check_return_value_1488_GLOBAL_OFFSET_TABLE_camlPervasives__failwith_1010caml_modifycamlNo_pycocci__entrycamlStringcaml_alloc1camlMap__fun_1920caml_allocNcamlNo_pycocci__code_endcamlNo_pycocci__data_endcamlNo_pycocci__frametable 8 7# 63 5C 4S <s 3 2 1 0 / . - , + * )# (3 'C &S %g <sZ $ # " \]^ <_ ! <% <4 ; <F M <k <  <  <  <  <  <  <  <   <( <F <Q X <f m <{  <  <  <  <  <  <  <  <# * <8 ? <M T <b i <w ~ <  <YY(Y8YHYxYYYYYYYYYYY(Y8YHYXYYYY=(>@?X@pABCDCECFGH0C@IPJ`KpJLMNCOPQR(S@TXUpVW pycocci.o/ 1386102622 1000 1000 100644 3112 ` ELF> @@ HH=HH_hH=HXH_8HHCHH=HXH_pH=HX H_xH=HX(H_PH=HX0HH=HX8HH=HX@HH=HXHHH=HXPHH=HXXHH=HX`HH=HXhHH=HXpH_ H=HXxH_(H=HHH=HHH=HHH=HHH=HHH=HHH=HHH=HHH=HHH=HH_H=HH_H=HH_0H=HH_@H=HH_H=HH_XHHHC`H.symtab.strtab.shstrtab.rela.text.data.bss.rodata.cst8.note.GNU-stack @M &,1 >N  87O[MnM caml_negf_maskcaml_absf_maskcamlPycocci__data_begincamlPycocci__code_begincamlPycoccicamlPycocci__entry_GLOBAL_OFFSET_TABLE_camlNo_pycoccicamlPycocci__code_endcamlPycocci__data_endcamlPycocci__frametable  ' 6 E T c u   & ; P e z         $ 6 coccinelle-1.0.0-rc19/python/coccilib/0000755000175000017500000000000012247437436016460 5ustar eugeneugencoccinelle-1.0.0-rc19/python/coccilib/org.py0000644000175000017500000000213412247437436017621 0ustar eugeneugendef build_link(p, msg, color) : return "[[view:%s::face=%s::linb=%s::colb=%s::cole=%s][%s]]" % (p.file,color,p.line,p.column,p.column_end,msg) def print_todo(p, msg="", color="ovl-face1") : if msg == "" : msg = "%s::%s" % (p.file,p.line) link = build_link(p, msg, color) print ("* TODO %s" % (link)) def print_link(p, msg="", color="ovl-face1") : if msg == "" : msg = "%s::%s" % (p.file,p.line) print (build_link(p, msg, color)) def print_safe_todo(p, msg="", color="ovl-face1") : msg_safe=msg.replace("[","@(").replace("]",")") print_todo(p, msg_safe, color) def print_safe_link(p, msg="", color="ovl-face1") : msg_safe=msg.replace("[","@(").replace("]",")") print_link(p, msg_safe, color) # # print_main, print_sec and print_secs # def print_main(msg, p, color="ovl-face1") : if msg == "" : oldmsgfmt = "%s::%s" % (p[0].file,p[0].line) else: oldmsgfmt = "%s %s::%s" % (msg,p[0].file,p[0].line) print_todo(p[0], oldmsgfmt, color) def print_sec(msg, p, color="ovl-face2") : print_link(p[0], msg, color) def print_secs(msg, ps, color="ovl-face2") : for i in ps: print_link (i, msg, color) coccinelle-1.0.0-rc19/python/coccilib/coccigui/0000755000175000017500000000000012247437436020245 5ustar eugeneugencoccinelle-1.0.0-rc19/python/coccilib/coccigui/vimcom.py0000644000175000017500000006505712247437436022126 0ustar eugeneugen# -*- coding: utf-8 -*- # vim:set shiftwidth=4 tabstop=4 expandtab textwidth=79: #Copyright (c) 2005 Ali Afshar aafshar@gmail.com #Permission is hereby granted, free of charge, to any person obtaining a copy #of this software and associated documentation files (the "Software"), to deal #in the Software without restriction, including without limitation the rights #to use, copy, modify, merge, publish, distribute, sublicense, and/or sell #copies of the Software, and to permit persons to whom the Software is #furnished to do so, subject to the following conditions: #The above copyright notice and this permission notice shall be included in #all copies or substantial portions of the Software. #THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE #AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, #OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE #SOFTWARE. """ A library to control vim -g using its X protocol interface (with gdk). ============ How it works ============ === General Communication === The Vim client/server protocol communicates by sending messages to and from an X communication window. The details are explained in the Vim source. Essentially, Vim understands two sorts of messages over this interface. ;asynchronous key sends : that are exactly equivalent to to the user of the remote Vim typing commands. ;synchronous expression evaluations : these are Vim expressions that are evaluated by the remote Vim, and an answer is replied with the result over the same protocol. Although the synchronous messages are called synchronous, the reply itself, in programming terms is entirely asynchronous, in that there is no way of knowing when a reply will be received, and one cannot block for it. Thus, this library allows you to make both of these calls to remote Vims. Synchronous expressions must provide a call back function that will be called when the message is replied to. === The Server List === (It has been an utter nightmare.) The primary problem is that GTK does not actually know accurately whether a window with a given window ID has been destroyed. This is how Vim does it (using the X libraries) after checking an attribute for registered Vim sessions with the X root window. This way each Vim doesn't need to unregister itself with the X root window on dying, it just assumes that any other client attempting to connect to it will know that the window has been destroyed. As mentioned, GTK totally fails to do what the X library does, and ascertain whether the window is alive. It succeeds sometimes, but not at others. The result is a GDK window that appears alive, and ready to communicate with, but which causes an uncatchable and fatal application error. Step in other potential methods of getting an accurate list of servers. Firstly, and most obviously, one can call the command 'vim --serverlist' on a simple system pipe and read the list off. This is entirely reliable, and effective, but the cost of forking a process and starting Vim each time is not fun, and effectively blocks. Another option is to force users to start Vim through Pida and keep an account of the child processes. This would work very effectively, but it restricts the user, and the entire system. The final, and current solution is to start Vim itself on a pseudoterminal as a hidden instance, and then communicate with that over the Vim protocol. The reason this can be reliably done, is that since the process is a child, it can be polled to check whether it is alive. This is performed each time the serverlist is requested, and if the hidden instance has been destroyed (eg by the user) a new one is spawned, thus preventing an attempt to communicate with an already-destroyed GDK window. The cost of this solution is that we spawn an extra Vim process. I believe that the added solidity it brings to the entire system is easily worth it, and it ensures that Pida can communicate with Vim it started and Vim it didn't start. """ # Gtk imports import gtk import gtk.gdk as gdk import gobject # System imports import os import pty import time import tempfile class poller(object): """ DEPRECATED: WE DO NOT USE THIS ANYMORE An instance of Vim on a pseudoterminal which can be reliably polled. This class is used to provide an instance of Vim which can be communicated with using the Vim client/server protocol, in order to retrieve an accurate and current server list, and also which can be polled accurately as to whether it is alive before communicating with it. This method is much cheaper in resources than running vim --serverlist each time, and much more accurate than using the root window's VimRegistry property, and also more accurate than using GDK methods for assessing whether a window is alive. """ def __init__(self): """ Constructor. Create a temporary and unique name for use as the servername, and initialise the instance variables. @param cb: An instance of the main application class. @type cb: pida.main.Application. """ # Prefacing with '__' means it will be ignored in the internal server # list. self.name = '__%s_PIDA_HIDDEN' % time.time() # Checked to evaluate False on starting. self.pid = None def start(self): """ Start the Vim instance if it is not already running. This command forks in a pseudoterminal, and starts Vim, if Vim is not already running. The pid is stored for later use. """ if not self.pid: # Get the console vim executable path #command = self.prop_main_registry.commands.vim.value() command = 'gvim' # Fork using pty.fork to prevent Vim taking the terminal sock = gtk.Socket() w = gtk.Window() w.realize() w.add(sock) xid = sock.get_id() pid, fd = pty.fork() if pid == 0: # Child, execute Vim with the correct servername argument os.execvp(command, ['gvim', '-f', '--servername', self.name, '--socketid', '%s' % xid]) #'-v']) # os.system('%s -v --servername %s' % (command, self.name)) else: # Parent, store the pid, and file descriptor for later. self.pid = pid self.childfd = fd #self.do_action('accountfork', self.pid) def is_alive(self): """ Check if the Vim instance is alive. This method uses os.waitpid, with no blocking to determine whether the process is still alive. If it is not, it sets the internal pid attribute to None, so that it may be restarted. @returns: alive @rtype alive: boolean """ if self.pid: try: # call os.waitpid, returns 0 if the pid is alive pid, sts = os.waitpid(self.pid, os.WNOHANG) except OSError: # might still be starting up return False if pid == self.pid: # has shut down self.pid = None return False else: # is still alive return True else: # Not started yet return False class communication_window(gtk.Window): """ A GTK window that can communicate with any number Vim instances. This is an actual GTK window (which it must be to accurately detect property events inside the GTK main loop) but has its GDK window correctly set to receive such events. This is notably the "Vim" property which must be present and set to a version string, in this case "6.0" is used. """ def __init__(self, cb): """ Constructor. The Window is instantiated, the properties are correctly set, the event mask is modified, and the instance variables are initialized. @param cb: An instance of the main Application class. @type cb: pida.main.Application. """ gtk.Window.__init__(self) self.cb = cb # Window needs to be realized to do anything useful with it. Realizing # does not show the window to the user, so we can use it, but not have # an ugly blank frame while it loads. self.realize() # The "Vim" property self.window.property_change("Vim", gdk.SELECTION_TYPE_STRING, 8, gdk.PROP_MODE_REPLACE, "6.0") # Set the correct event mask and connect the notify event self.add_events(gtk.gdk.PROPERTY_CHANGE_MASK) self.connect('property-notify-event', self.cb_notify) # The serial number used for sending synchronous messages self.serial = 1 # A dictionary of callbacks for synchronous messages. The key is the # serial number, and the value is a callable that will be called with # the result of the synchronous evaluation. self.callbacks = {} # A dictionary to store the working directories for each Vim so they # only have to be fetched once. self.server_cwds = {} # An instance of the root window, so it only has to be fetched once. dpy = gdk.display_get_default() if not dpy: raise Exception('Unable to get default display') screen = dpy.get_screen(0) self.root_window = screen.get_root_window() # fetch the serverlist to begin with to know when we are started self.oldservers = None self.keep_fetching_serverlist = True gobject.timeout_add(250, self.fetch_serverlist) def fetch_serverlist(self): """ Fetch the serverlist, and if it has changed, feed it to the client. The serverlist is requested asynchrnously, and passed the gotservers function as a callback. The gotservers function is then called with the server list, gets the appropriate working directory (if required) and feeds the new server list to the client if it has changed. """ def gotservers(serverlist): """ Called back on receiving the serverlist. Fetch working directories for new Vim instances, and feed the server list to the client if it has changed. """ for server in serverlist: # Check if we already have the working directory. if server not in self.server_cwds: # We don't, fetch it self.fetch_cwd(server) # Check if the server list has changed if serverlist != self.oldservers: self.oldservers = serverlist # A ew serverlist to feed to the client. self.feed_serverlist(serverlist) gotservers(self.get_rootwindow_serverlist()) # decide whether to keep fetching server list return self.keep_fetching_serverlist def stop_fetching_serverlist(self): self.keep_fetching_serverlist = False def get_rootwindow_serverlist(self): """ Get the X root window's version of the current Vim serverlist. On starting with the client-server feature, GVim or Vim with the --servername option registers its server name and X window id as part of the "VimRegistry" parameter on the X root window. This method extracts and parses that property, and returns the server list. Note: Vim does not actually unregister itself with the root window on dying, so the presence of a server in the root window list is no gurantee that it is alive. @return: servers @rtype servers: dict of ("server", "window id") key, value """ servers = {} # Read the property vimregistry = self.root_window.property_get("VimRegistry") # If it exists if vimregistry: # Get the list of servers by splitting with '\0' vimservers = vimregistry[-1].split('\0') # Parse each individual server and add to the results list for rawserver in vimservers: # Sometimes blank servers exist in the list if rawserver: # split the raw value for the name and id name_id = rawserver.split() # Set the value in the results dict, remembering to convert # the window id to a long int. servers[name_id[1]] = long(int(name_id[0], 16)) # return the list of resuts return servers def get_shell_serverlist(self): """ DEPRACATED: WE NEVER NEED A SERVERLIST (This is here for educative purposes) Get the server list by starting console Vim on a Pipe. This blocks, so we don't use it. It is one of the alternative methods of retrieving an accurate serverlist. It is slow, and expensive. """ vimcom = 'gvim' p = os.popen('%s --serverlist' % vimcom) servers = p.read() p.close() return servers.splitlines() def get_hidden_serverlist(self, callbackfunc): """ DEPRACATED: WE NEVER NEED A SERVERLIST (This is here for educative purposes) Get the serverlist from the hidden Vim instance and call the callback function with the results. This method checks first whther the Vim instance is alive, and then evaluates the serverlist() function remotely in it, with a local call back function which parses the result and calls the user-provided callback function. @param callbackfunc: The call back function to be called with the server list. @type callbackfunc: callable """ def cb(serverstring): """ Called back with the raw server list. Parse the lines and call the call back function, ignoring any instances starting with "__" which represent hidden instances. If the hidden Vim instance is not alive, it is restarted. """ servers = serverstring.splitlines() # Call the callback function callbackfunc([svr for svr in servers if not svr.startswith('__')]) # Check if the hidden Vim is alive. if self.vim_hidden.is_alive(): # It is alive, get the serverlist. self.send_expr(self.vim_hidden.name, 'serverlist()', cb) else: # It is not alive, restart it. self.vim_hidden.start() def get_server_wid(self, servername): """ Get the X Window id for a named Vim server. This function returns the id from the root window server list, if it exists, or None if it does not. @param servername: The name of the server @type servername: str @return: wid @rtype wid: long """ try: # get the window id from the root window wid = self.get_rootwindow_serverlist()[servername] except KeyError: # The server is not registered in the root window so return None wid = None # Return wid if it is not none, or None return wid and long(wid) or None def get_server_window(self, wid): """ Create and return a GDK window for a given window ID. This method simply calls gdk.window_foreign_new, which should return None if the window has been destroyed, but does not, in some cases. @param wid: The window ID. @type wid: long """ return gtk.gdk.window_foreign_new(wid) def feed_serverlist(self, serverlist): """ Feed the given list of servers to the client. This is achieved by calling the clients serverlist event. In Pida, this event is passed on to all the plugins. @param serverlist: The list of servers. @type serverlist: list """ # Call the event. #self.do_evt('serverlist', serverlist) self.cb.vim_new_serverlist(serverlist) def fetch_cwd(self, servername): """ Fetch the working directory for a named server and store the result. """ def gotcwd(cwd): """ Called back on receiving the working directory, store it for later use. """ self.server_cwds[servername] = cwd # Evaluate the expression with the gotcwd callback self.send_expr(servername, "getcwd()", gotcwd) def get_cwd(self, server): if server in self.server_cwds: return self.server_cwds[server] def abspath(self, servername, filename): """ Return the absolute path of a buffer name in the context of the named server. """ # Only alter non-absolute paths if not filename.startswith('/'): try: # Try to find the current working directory cwd = self.server_cwds[servername] except KeyError: # The working directory is not set # Use a sane default, and fetch it cwd = os.path.expanduser('~') self.fetch_cwd(servername) filename = os.path.join(cwd, filename) return filename def generate_message(self, server, cork, message, sourceid): """ Generate a message. """ # Increment the serial number used for synchronous messages if cork: self.serial = self.serial + 1 # Pick an arbitrary number where we recycle. if self.serial > 65530: self.serial = 1 # return the generated string return '\0%s\0-n %s\0-s %s\0-r %x %s\0' % (cork, server, message, sourceid, self.serial) def parse_message(self, message): """ Parse a received message and return the message atributes as a dictionary. """ messageattrs = {} for t in [s.split(' ') for s in message.split('\0')]: if t and len(t[0]): name = t[0] value = ' '.join(t[1:]) if name.startswith('-'): #attributes start with a '-', strip it and set the value name = name[1:] messageattrs[name] = value else: # Otherwise set the t attribute messageattrs['t'] = name return messageattrs def send_message(self, servername, message, asexpr, callback): wid = self.get_server_wid(servername) if wid: cork = (asexpr and 'c') or 'k' sw = self.get_server_window(wid) if sw and sw.property_get("Vim"): mp = self.generate_message(servername, cork, message, self.window.xid) sw.property_change("Comm", gdk.TARGET_STRING, 8, gdk.PROP_MODE_APPEND, mp) if asexpr and callback: self.callbacks['%s' % (self.serial)] = callback def send_expr(self, server, message, callback): self.send_message(server, message, True, callback) def send_keys(self, server, message): self.send_message(server, message, False, False) def send_esc(self, server): self.send_keys(server, '') def send_ret(self, server): self.send_keys(server, '') def send_ex(self, server, message): self.send_esc(server) self.send_keys(server, ':%s' % message) self.send_ret(server) def send_ex_via_tempfile(self, server, message): """For really long ugly messages""" tf, tp = tempfile.mkstemp() os.write(tf, '%s\n' % message) os.close(tf) self.load_script(server, tp) # delay removing the temporary file to make sure it is loaded gobject.timeout_add(6000, os.unlink, tp) def get_option(self, server, option, callbackfunc): self.send_expr(server, '&%s' % option, callbackfunc) def foreground(self, server): def cb(*args): pass self.send_expr(server, 'foreground()', cb) def change_buffer(self, server, filename): self.send_ex(server, "exe 'b!'.bufnr('%s')" % filename) def change_buffer_number(self, server, number): self.send_ex(server, "b!%s" % number) def close_buffer(self, server, buffername): self.send_ex(server, "exe 'confirm bw'.bufnr('%s')" % buffername) def close_current_buffer(self, server): self.send_ex(server, 'confirm bw') def change_cursor(self, server, x, y): self.send_message(server, 'cursor(%s, %s)' % (y, x), True, False) self.send_esc(server) def save_session(self, server, file_name): self.send_ex(server, 'mks %s' % file_name) def load_session(self, server, file_name): self.load_script(server, file_name) def escape_filename(self, name): for s in ['\\', '?', '*', ' ', "'", '"', '[', ' ', '$', '{', '}']: name = name.replace (s, '\\%s' % s) return name def open_file(self, server, name): self.send_ex(server, 'confirm e %s' % self.escape_filename(name)) def new_file(self, server): f, path = tempfile.mkstemp() self.open_file(server, path) return path def goto_line(self, server, linenumber): self.send_ex(server, '%s' % linenumber) self.send_esc(server) self.send_keys(server, 'zz') self.send_keys(server, 'zv') def revert(self, server): self.send_ex(server, 'e') def load_script(self, server, scriptpath): self.send_ex(server, 'so %s' % scriptpath) def preview_file(self, server, fn): self.send_ex(server, 'pc') self.send_ex(server, 'set nopreviewwindow') self.send_ex(server, 'pedit %s' % fn) def get_bufferlist(self, server): def cb(bl): if bl: l = [i.split(':') for i in bl.strip(';').split(';')] L = [] for n in l: if not n[0].startswith('E'): L.append([n[0], self.abspath(server, n[1])]) self.do_evt('bufferlist', L) #self.get_cwd(server) self.send_expr(server, 'Bufferlist()', cb) def get_current_buffer(self, server): def cb(bs): bn = bs.split(chr(5)) bn[1] = self.abspath(server, bn[1]) self.do_evt('bufferchange', *bn) #self.get_cwd(server) self.send_expr(server, "bufnr('%').'\\5'.bufname('%')", cb) def save(self, server): self.send_ex(server, 'w') def save_as(self, server, filename): print(filename) self.send_ex(server, 'saveas %s' % filename) def undo(self, server): self.send_esc(server) self.send_keys(server, 'u') def redo(self, server): self.send_esc(server) self.send_keys(server, '') def cut(self, server): self.send_keys(server, '"+x') def copy(self, server): self.send_keys(server, '"+y') def paste(self, server): self.send_esc(server) self.send_keys(server, 'p') def set_colorscheme(self, server, colorscheme): self.send_ex(server, 'colorscheme %s' % colorscheme) def set_menu_visible(self, server, visible): if visible: op = '+' else: op = '-' self.send_ex(server, 'set guioptions%s=m' % op) def quit(self, server): self.send_ex(server, 'q!') def define_sign(self, server, name, icon, linehl, text, texthl, direct=False): cmd = ('sign define %s icon=%s linehl=%s text=%s texthl=%s '% (name, icon, linehl, text, texthl)) if direct: self.send_ex(server, cmd) else: self.send_ex_via_tempfile(server, cmd) def undefine_sign(self, server, name): self.send_ex(server, 'sign undefine %s' % name) def show_sign(self, server, index, type, filename, line): self.send_ex(server, 'sign place %s line=%s name=%s file=%s' % (index + 1, line, type, filename)) def hide_sign(self, server, index, filename): self.send_ex(server, 'sign unplace %s' % (index + 1)) def get_cword(self, server, callback): self.send_esc(server) self.send_expr(server, 'expand("")', callback) def get_selection(self, server, callback): self.send_expr(server, 'getreg("*")', callback) def delete_cword(self, server): self.send_esc(server) self.send_keys(server, 'ciw') def insert_text(self, server, text): self.send_esc(server) self.send_keys(server, 'a') self.send_keys(server, text) def set_path(self, server, path): self.send_ex(server, 'cd %s' % path) def add_completion(self, server, s): self.send_expr(server, 'complete_add("%s")' % s, lambda *a: None) def finish_completion(self, server): self.send_keys(server, chr(3)) def cb_notify(self, *a): win, ev = a if hasattr(ev, 'atom'): if ev.atom == 'Comm': message = self.window.property_get('Comm', pdelete=True) if message: self.cb_reply(message[-1]) return True def cb_reply(self, data): mdict = self.parse_message(data) if mdict['t'] == 'r': if mdict['s'] in self.callbacks: self.callbacks[mdict['s']](mdict['r']) else: s = [t for t in data.split('\0') if t.startswith('-n')].pop()[3:] self.cb_reply_async(s) def cb_reply_async(self, data): if data.count(':'): server, data = data.split(':', 1) else: server = None sep = chr(4) if data.count(sep): evt, d = data.split(sep, 1) self.vim_event(server, evt, d) else: print('bad async reply', data) def vim_event(self, server, evt, d): funcname = 'vim_%s' % evt if hasattr(self.cb, funcname): getattr(self.cb, funcname)(server, *d.split(chr(4))) else: print('unhandled event', evt) VimCom = communication_window coccinelle-1.0.0-rc19/python/coccilib/coccigui/vimeditor.py0000644000175000017500000002310712247437436022624 0ustar eugeneugen# -*- coding: utf-8 -*- # vim:set shiftwidth=4 tabstop=4 expandtab textwidth=79: #Copyright (c) 2005-2006 The PIDA Project #Permission is hereby granted, free of charge, to any person obtaining a copy #of this software and associated documentation files (the "Software"), to deal #in the Software without restriction, including without limitation the rights #to use, copy, modify, merge, publish, distribute, sublicense, and/or sell #copies of the Software, and to permit persons to whom the Software is #furnished to do so, subject to the following conditions: #The above copyright notice and this permission notice shall be included in #all copies or substantial portions of the Software. #THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE #AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, #OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE #SOFTWARE. import os import gobject import pida.core.service as service from pida.core import errors defs = service.definitions types = service.types import vimcom class vim_editor(object): single_view = None class display(defs.optiongroup): class colour_scheme(defs.option): """The colour scheme to use in vim (Empty will be ignored).""" rtype = types.string default = '' class hide_vim_menu(defs.option): """Whether the vim menu will be hidden.""" rtype = types.boolean default = False def init(self): self.__servers = {} self.__documents = {} self.__old_shortcuts = {'n':{}, 'v':{}} self.__currentdocument = None self._create_initscript() self.__cw = vimcom.communication_window(self) self.__newdocs = {} def _create_initscript(self): script_path = os.path.join(self.boss.get_pida_home(), 'pida_vim_init.vim') if not os.path.exists(script_path): f = open(script_path, 'w') f.write(vimcom.VIMSCRIPT) f.close() def vim_init_server(self): self.__cw.load_script(self.server, os.path.join(self.boss.get_pida_home(), 'pida_vim_init.vim')) def stop_fetching_serverlist(self): self.__cw.keep_fetching_serverlist = False def get_server(self): raise NotImplementedError def vim_start(self): raise NotImplementedError def vim_new_serverlist(self, serverlist): raise NotImplementedError def cmd_start(self): self.vim_start() def cmd_revert(self): self.__cw.revert(self.server) def cmd_close(self, document): if document.unique_id in self.__newdocs: fn = self.__newdocs[document.unique_id] else: fn = document.filename self.__cw.close_buffer(self.server, fn) def cmd_edit(self, document): """Open and edit.""" if document is not self.__currentdocument: if (document.unique_id in self.__servers.setdefault(self.server, [])): if document.unique_id in self.__newdocs: fn = self.__newdocs[document.unique_id] else: fn = document.filename self.__cw.change_buffer(self.server, fn) self.__cw.foreground(self.server) else: found = False for server in self.__servers: serverdocs = self.__servers[server] if document.unique_id in serverdocs: self.__cw.change_buffer(server, document.filename) self.__cw.foreground(server) found = True break if not found: if document.filename is None: newname = self.__cw.new_file(self.server) self.__newdocs[document.unique_id] = newname else: self.__cw.open_file(self.server, document.filename) self.__servers[self.server].append(document.unique_id) self.__documents[document.unique_id] = document self.__currentdocument = document if self.single_view is not None: self.single_view.raise_page() if document.filename is None: title = 'New File' else: title = document.filename self.single_view.long_title = title def cmd_undo(self): self.__cw.undo(self.server) def cmd_redo(self): self.__cw.redo(self.server) def cmd_cut(self): self.__cw.cut(self.server) def cmd_copy(self): self.__cw.copy(self.server) def cmd_paste(self): self.__cw.paste(self.server) def cmd_save(self): self.__cw.save(self.server) def cmd_save_as(self, filename): del self.__newdocs[self.__currentdocument.unique_id] self.__cw.save_as(self.server, filename) def cmd_goto_line(self, linenumber): self.__cw.goto_line(self.server, linenumber + 1) def cmd_show_mark(self, index, filename, line): self.__cw.show_sign(self.server, index, filename, line) def cmd_hide_mark(self, index): pass def reset(self): colorscheme = self.opts.display__colour_scheme if colorscheme: self.__cw.set_colorscheme(self.server, colorscheme) if self.opts.display__hide_vim_menu: self.__cw.set_menu_visible(self.server, False) #self.__load_shortcuts() def open_file_line(self, filename, linenumber): if self.__currentfile != filename: self.open_file(filename) self.__bufferevents.append([self.goto_line, (linenumber, )]) else: self.goto_line(linenumber) def goto_line(self, linenumber): self.__cw.change_cursor(self.server, 1, linenumber) def vim_bufferchange(self, server, cwd, filename, bufnr): self.log.debug('vim buffer change "%s"', filename) if not filename or filename in '-MiniBufExplorer-': return if os.path.abspath(filename) != filename: filename = os.path.join(cwd, filename) if os.path.isdir(filename): if self.opts.behaviour__open_directories_in_pida: self.boss.call_command('filemanager', 'browse', directory=filename) self.__cw.close_buffer(self.server, filename) return if self.__currentdocument is None or filename != self.__currentdocument.filename: for uid, fn in self.__newdocs.iteritems(): if fn == filename: doc = self.__documents[uid] self.__current_doc_set(doc) return for doc in self.__documents.values(): if doc.filename == filename: self.__current_doc_set(doc) return self.boss.call_command('buffermanager', 'open_file', filename=filename) def __current_doc_set(self, doc): self.__currentdocument = doc self.boss.call_command('buffermanager', 'open_document', document=doc) def vim_bufferunload(self, server, filename, *args): self.log.debug('vim unloaded "%s"', filename) if filename != '': doc = None for uid, fn in self.__newdocs.iteritems(): if fn == filename: doc = self.__documents[uid] break if doc is None: for uid, document in self.__documents.iteritems(): if document.filename == filename: doc = document break if doc is not None: self.__servers[server].remove(doc.unique_id) del self.__documents[uid] self.__currentdocument = None self.boss.call_command('buffermanager', 'document_closed', document=doc, dorefresh=True) def vim_started(self, server): print('started') def vim_filesave(self, server, *args): self.boss.call_command('buffermanager', 'reset_current_document') def vim_globalkp(self, server, name): self.boss.command('keyboardshortcuts', 'keypress-by-name', kpname=name) def vim_shutdown(self, server, *args): #self.clean_after_shutdown(server) self.after_shutdown(server) def vim_set_breakpoint(self, server, line): self.boss.call_command('pythondebugger', 'set_breakpoint', filename=self.__currentdocument.filename, line=int(line)) def clean_after_shutdown(self, server): for docid in self.__servers.setdefault(server, []): doc = self.__documents[docid] del self.__documents[docid] self.boss.call_command('buffermanager', 'document_closed', document=doc) self.__servers[server] = [] self.__currentdocument = None def after_shutdown(self, server): pass def get_vim_window(self): return self.__cw vim_window= property(get_vim_window) def get_current_document(self): return self.__currentdocument current_document = property(get_current_document) def stop(self): self.__cw.quit(self.server) coccinelle-1.0.0-rc19/python/coccilib/coccigui/vim.py0000644000175000017500000002172112247437436021415 0ustar eugeneugen# -*- coding: utf-8 -*- # Copyright (c) 2007 The PIDA Project #Permission is hereby granted, free of charge, to any person obtaining a copy #of this software and associated documentation files (the "Software"), to deal #in the Software without restriction, including without limitation the rights #to use, copy, modify, merge, publish, distribute, sublicense, and/or sell #copies of the Software, and to permit persons to whom the Software is #furnished to do so, subject to the following conditions: #The above copyright notice and this permission notice shall be included in #all copies or substantial portions of the Software. #THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE #AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, #OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE #SOFTWARE. import os # PIDA Imports from pida.core.environment import get_data_path from pida.ui.views import PidaView from pida.utils.vim.vimembed import VimEmbedWidget from pida.utils.vim.vimcom import VimCom from pida.core.editors import EditorService, _ class VimView(PidaView): def create_ui(self): self._vim = VimEmbedWidget('gvim', self.svc.script_path) self.add_main_widget(self._vim) def run(self): return self._vim.run() def get_server_name(self): return self._vim.get_server_name() def grab_input_focus(self): self._vim.grab_input_focus() class VimCallback(object): def __init__(self, svc): self.svc = svc def vim_new_serverlist(self, servers): if self.svc.server in servers: self.svc.init_vim_server() def vim_bufferchange(self, server, cwd, file_name, bufnum): if server == self.svc.server: if file_name: if os.path.abspath(file_name) != file_name: file_name = os.path.join(cwd, file_name) if os.path.isdir(file_name): self.svc.boss.cmd('filemanager', 'browse', new_path=file_name) self.svc.boss.cmd('filemanager', 'present_view') self.svc.open_last() else: self.svc.boss.cmd('buffer', 'open_file', file_name=file_name) def vim_bufferunload(self, server, file_name): if server == self.svc.server: if file_name: self.svc.remove_file(file_name) self.svc.boss.get_service('buffer').cmd('close_file', file_name=file_name) def vim_filesave(self, server, file_name): if server == self.svc.server: self.svc.boss.cmd('buffer', 'current_file_saved') def vim_cursor_move(self, server, line_number): if server == self.svc.server: self.svc.set_current_line(int(line_number)) def vim_shutdown(self, server, args): if server == self.svc.server: self.svc.boss.stop(force=True) def vim_complete(self, server, temp_buffer_filename, offset): buffer = open(temp_buffer_filename).read() offset = int(offset) - 1 from rope.ide.codeassist import PythonCodeAssist from rope.base.project import Project p = Project(self.svc.boss.cmd('buffer', 'get_current').directory) c = PythonCodeAssist(p) co = c.assist(buffer, offset).completions print(co) for comp in co: self.svc._com.add_completion(server, comp.name) # do this a few times #self.svc._com.add_completion(server, 'banana') pass # Service class class Vim(EditorService): """Describe your Service Here""" ##### Vim Things def _create_initscript(self): self.script_path = get_data_path('pida_vim_init.vim') def init_vim_server(self): if self.started == False: self._com.stop_fetching_serverlist() self.started = True self._emit_editor_started() def _emit_editor_started(self): self.boss.get_service('editor').emit('started') def get_server_name(self): return self._view.get_server_name() server = property(get_server_name) def pre_start(self): """Start the editor""" self.started = False self._create_initscript() self._cb = VimCallback(self) self._com = VimCom(self._cb) self._view = VimView(self) self.boss.cmd('window', 'add_view', paned='Editor', view=self._view) self._documents = {} self._current = None self._sign_index = 0 self._signs = {} self._current_line = 1 success = self._view.run() if not success: err = _('There was a problem running the "gvim" ' 'executable. This is usually because it is not ' 'installed. Please check that you can run "gvim" ' 'from the command line.') self.error_dlg(err) raise RuntimeError(err) def open(self, document): """Open a document""" if document is not self._current: if document.unique_id in self._documents: fn = document.filename self._com.change_buffer(self.server, fn) self._com.foreground(self.server) else: self._com.open_file(self.server, document.filename) self._documents[document.unique_id] = document self._current = document def open_many(documents): """Open a few documents""" def open_last(self): self._com.change_buffer(self.server, '#') def close(self, document): if document.unique_id in self._documents: self._remove_document(document) self._com.close_buffer(self.server, document.filename) def remove_file(self, file_name): document = self._get_document_for_filename(file_name) if document is not None: self._remove_document(document) def _remove_document(self, document): del self._documents[document.unique_id] def _get_document_for_filename(self, file_name): for uid, doc in self._documents.iteritems(): if doc.filename == file_name: return doc def close_all(): """Close all the documents""" def save(self): """Save the current document""" self._com.save(self.server) def save_as(filename): """Save the current document as another filename""" def revert(): """Revert to the loaded version of the file""" def goto_line(self, line): """Goto a line""" self._com.goto_line(self.server, line) self.grab_focus() def cut(self): """Cut to the clipboard""" self._com.cut(self.server) def copy(self): """Copy to the clipboard""" self._com.copy(self.server) def paste(self): """Paste from the clipboard""" self._com.paste(self.server) def undo(self): self._com.undo(self.server) def redo(self): self._com.redo(self.server) def grab_focus(self): """Grab the focus""" self._view.grab_input_focus() def define_sign_type(self, name, icon, linehl, text, texthl): self._com.define_sign(self.server, name, icon, linehl, text, texthl) def undefine_sign_type(self, name): self._com.undefine_sign(self.server, name) def _add_sign(self, type, filename, line): self._sign_index += 1 self._signs[(filename, line, type)] = self._sign_index return self._sign_index def _del_sign(self, type, filename, line): return self._signs.pop((filename, line, type)) def show_sign(self, type, filename, line): index = self._add_sign(type, filename, line) self._com.show_sign(self.server, index, type, filename, line) def hide_sign(self, type, filename, line): try: index = self._del_sign(type, filename, line) self._com.hide_sign(self.server, index, filename) except KeyError: self.window.error_dlg(_('Tried to remove non-existent sign')) def set_current_line(self, line_number): self._current_line = line_number def get_current_line(self): return self._current_line def delete_current_word(self): self._com.delete_cword(self.server) def insert_text(self, text): self._com.insert_text(self.server, text) def call_with_current_word(self, callback): return self._com.get_cword(self.server, callback) def call_with_selection(self, callback): return self._com.get_selection(self.server, callback) def set_path(self, path): return self._com.set_path(self.server, path) # Required Service attribute for service loading Service = Vim # vim:set shiftwidth=4 tabstop=4 expandtab textwidth=79: coccinelle-1.0.0-rc19/python/coccilib/coccigui/pygui.gladep0000644000175000017500000000041712247437436022562 0ustar eugeneugen pygui pygui FALSE coccinelle-1.0.0-rc19/python/coccilib/coccigui/vimembed.py0000644000175000017500000001041412247437436022407 0ustar eugeneugen# -*- coding: utf-8 -*- # vim:set shiftwidth=4 tabstop=4 expandtab textwidth=79: #Copyright (c) 2005-2006 The PIDA Project #Permission is hereby granted, free of charge, to any person obtaining a copy #of this software and associated documentation files (the "Software"), to deal #in the Software without restriction, including without limitation the rights #to use, copy, modify, merge, publish, distribute, sublicense, and/or sell #copies of the Software, and to permit persons to whom the Software is #furnished to do so, subject to the following conditions: #The above copyright notice and this permission notice shall be included in #all copies or substantial portions of the Software. #THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR #IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, #FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE #AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER #LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, #OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE #SOFTWARE. ''' A library to embed vim in a gtk socket ''' import gtk import os import time import subprocess class vim_embed(object): HAS_CONTROL_BOX = False HAS_TITLE = False def init(self, command='gvim', args=[]): self.__servername = self.__generate_servername() self.pid = None self.args = args self.r_cb_plugged = None self.r_cb_unplugged = None self.__eb = None def __pack(self): socket = gtk.Socket() eb = gtk.EventBox() self.widget.pack_start(eb) eb.add_events(gtk.gdk.KEY_PRESS_MASK) eb.add(socket) self.show_all() self.__eb = eb return socket.get_id() def __generate_servername(self): return 'PIDA_EMBEDDED_%s' % time.time() def get_servername(self): return self.__servername servername = property(get_servername) def should_remove(self): self.service.remove_attempt() return False def run(self, command): self.command = command xid = self.__pack() args = self.args[:] # a copy args.extend(['--socketid', '%s' % xid]) if not xid: return if not self.pid: popen = subprocess.Popen([self.command, '--servername', self.servername, '--cmd', 'let PIDA_EMBEDDED=1'] + args, close_fds=True) self.pid = popen.pid self.show_all() def grab_input_focus(self): self.__eb.child_focus(gtk.DIR_TAB_FORWARD) class VimEmbedWidget(gtk.EventBox): def __init__(self, command, script_path, args=[]): gtk.EventBox.__init__(self) self._servername = self._generate_servername() self._command = command self._init_script = script_path self.pid = None self.args = args self.r_cb_plugged = None self.r_cb_unplugged = None self.__eb = None def _create_ui(self): socket = gtk.Socket() self.add_events(gtk.gdk.KEY_PRESS_MASK) self.add(socket) self.show_all() return socket.get_id() def _generate_servername(self): return 'PIDA_EMBEDDED_%s' % time.time() def get_server_name(self): return self._servername def should_remove(self): self.service.remove_attempt() return False def run(self): xid = self._create_ui() args = self.args[:] # a copy args.extend(['--socketid', '%s' % xid]) if not xid: return if not self.pid: try: popen = subprocess.Popen( [self._command, '--servername', self.get_server_name(), '--cmd', 'let PIDA_EMBEDDED=1', '-c', 'so %s' % self._init_script ] + args, close_fds=True ) self.pid = popen.pid except OSError: return False self.show_all() return True def grab_input_focus(self): self.child_focus(gtk.DIR_TAB_FORWARD) coccinelle-1.0.0-rc19/python/coccilib/coccigui/coccigui.py0000644000175000017500000001100512247437436022401 0ustar eugeneugenimport pygtk pygtk.require("2.0") import sys, gtk, gtk.glade, gobject, os, locale, gettext from pycoccimodel import * import vimembed, vimcom class VimCallback(object): def __init__(self, app): self.app = app def vim_new_serverlist(self, serverlist): self.app.vimcom.stop_fetching_serverlist() self.app.vimcom.open_file(self.app.vimsock.get_server_name(), '~/.vimrc') class pycocci(object): def __init__(self): self.local_path = os.path.realpath(os.path.dirname(sys.argv[0])) self.initialize_translation() self.gladefile = os.path.join(self.local_path, "coccilib/coccigui/pygui.glade") self.wTree = gtk.glade.XML(self.gladefile, "mainWindow") self.setup_tree_columns() self.wTree.signal_autoconnect(self) self.initialise_tree() self.main_window = self.wTree.get_widget("mainWindow") self.vimsock = vimembed.VimEmbedWidget('gvim', '~/.vimrc') self.vimsock.visible = True self.vbox1 = self.wTree.get_widget("vbox1") self.vbox1.pack_end(self.vimsock) self.setup_vim() def setup_vim(self): self.vimcb = VimCallback(self) self.vimcom = vimcom.VimCom(self.vimcb) self.vimsock.run() self.vimsock.connect('destroy', self.on_vimsock_destroy) def on_vimsock_destroy(self, widget): self.setup_vim() def initialise_tree(self): tree_type_list = [] self.__column_dict = {} self.bugTreeView = self.wTree.get_widget("bugView") self.bugTreeView.set_rules_hint(True) for c in self.__tree_columns: self.__column_dict[c.id] = c tree_type_list.append(c.type) if c.visible: column = gtk.TreeViewColumn(c.name, c.cellrenderer, text=c.pos) column.set_resizable(True) column.set_sort_column_id(c.pos) self.bugTreeView.append_column(column) self.bugTree = gtk.TreeStore(*tree_type_list) self.bugTreeView.set_model(self.bugTree) self.bugTreeView.connect('row-activated', self.row_activated) def row_activated(self, view, path, view_column): it = view.get_model().get_iter(path) obj, objtype, bugdesc, file, line, col = view.get_model().get(it, 0, 1, 2, 3, 4, 5) if file != '': server = self.vimsock.get_server_name() self.vimcom.open_file(server, file) if line != '': self.vimcom.send_ex(server, line) if col != '': self.vimcom.send_keys(server, col + '|') def setup_tree_columns(self): self.__tree_columns = [ pycoccicolumn(COL_OBJECT, gobject.TYPE_PYOBJECT, "object", 0), pycoccicolumn(COL_OBJECT, gobject.TYPE_INT, "object_type", 1), pycoccicolumn(COL_TITLE, gobject.TYPE_STRING, _("Bug type"), 2, True, gtk.CellRendererText()), pycoccicolumn(COL_FILE, gobject.TYPE_STRING, _("File"), 3, True, gtk.CellRendererText()), pycoccicolumn(COL_LINE, gobject.TYPE_STRING, _("Line"), 4, True, gtk.CellRendererText()), pycoccicolumn(COL_COLUMN, gobject.TYPE_STRING, _("Column"), 5, True, gtk.CellRendererText()) ] def initialize_translation(self): langs = [] lc, encoding = locale.getdefaultlocale() if lc: langs = [lc] language = os.environ.get('LANGUAGE', None) if language: langs += language.split(':') gettext.bindtextdomain('pycocci', self.local_path) gettext.textdomain('pycocci') self.lang = gettext.translation('pycocci', self.local_path, languages=langs, fallback = True) gettext.install('pycocci', self.local_path) def on_mainWindow_destroy(self, widget): gtk.main_quit() def add_result(self, cocci_file, l): root = self.bugTreeView.get_model().get_iter_root() it = None while root != None: c_cocci_file = self.bugTreeView.get_model().get(root, 2)[0] if c_cocci_file == cocci_file: it = root break root = self.bugTreeView.get_model().iter_next(root) if it == None: it = self.bugTree.insert_after(None, None, (None, 0, cocci_file, '', '', '')) description, file, line, col = l[0] mit = self.bugTree.append(it, (None, 1, description, file, line, col)) for i in xrange(1, len(l)): description, file, line, col = l[i] self.bugTree.append(mit, (None, 2, description, file, line, col)) #if __name__ == '__main__': # app = pycocci() # app.add_result('Test.cocci', [('Array identified: z', '/home/hstuart/thesis/py-cocci/tests/scripting/array/script4.c', '6', '7'), ('Array use: z', '/home/hstuart/thesis/py-cocci/tests/scripting/array/script4.c', '8', '3')]) # app.add_result('Test.cocci', [('Array identified: foo', '/home/hstuart/thesis/py-cocci/tests/scripting/array/script4.c', '12', '17')]) # gtk.main() coccinelle-1.0.0-rc19/python/coccilib/coccigui/pycoccimodel.py0000644000175000017500000000112712247437436023272 0ustar eugeneugenimport pygtk import gtk, gtk.glade COL_OBJECT = 0 COL_OBJECT_TYPE = 1 COL_TITLE = 2 COL_FILE = 3 COL_LINE = 4 COL_COLUMN = 5 class pycoccicolumn(object): def __init__(self, id, type, name, pos, visible=False, cellrenderer=None): self.id = id self.type = type self.name = name self.pos = pos self.visible = visible self.cellrenderer = cellrenderer self.colour = 0 def __str__(self): return "" % (self.id, self.type, self.name, self.pos, self.visible, self.cellrenderer) coccinelle-1.0.0-rc19/python/coccilib/coccigui/__init__.py0000644000175000017500000000003012247437436022347 0ustar eugeneugen# python infrastructure coccinelle-1.0.0-rc19/python/coccilib/coccigui/pygui.glade0000644000175000017500000001153112247437436022401 0ustar eugeneugen True pycocci GTK_WIN_POS_CENTER 1000 800 True True True _File True True gtk-new True True True gtk-open True True True gtk-save True True True gtk-save-as True True True True gtk-quit True True False False True True GTK_SHADOW_IN True True True 1 coccinelle-1.0.0-rc19/python/coccilib/coccigui/Makefile0000644000175000017500000000004312247437436021702 0ustar eugeneugenall: depend: clean: rm -f *.pyc coccinelle-1.0.0-rc19/python/coccilib/output.py0000644000175000017500000000560512247437436020400 0ustar eugeneugenfrom copy import deepcopy class Output: """In order to implement an output class for use with Coccinelle, one can inherit from this class and overload register_match with the same number of arguments. include_match will be overwritten by inheriting from your actual class, and thus if your class is a.b.C then Coccinelle will create a Python class "class Coccinelle(a.b.C)" that hooks include_match into the O'Caml internals. """ def include_match(self, b): pass def register_match(self, include, messages): pass def combine(self, meta_variable, locations): nmv = deepcopy(meta_variable) nloc = [deepcopy(loc) for loc in locations] nmv.location = nloc[0] nmv.locations = nloc return nmv def finalise(self): pass def print_main (self, *args): from coccilib.org import print_main print_main(*args) def print_sec (self, *args): from coccilib.org import print_sec print_sec(*args) def print_secs (self, *args): from coccilib.org import print_secs print_secs(*args) class Console(Output): def __init__(self): pass def register_match(self, include, messages): self.include_match(include) if include: for variable, message in messages: print("%s:%s:%s: %s - %s" % (variable.location.file, variable.location.line, variable.location.column, message, variable)) from threading import Thread class GtkRunner(Thread): def __init__(self): from threading import Lock Thread.__init__(self) self.lock = Lock() self.rows = [] def add_row(self, cocci, l): for i in xrange(0, len(l)): l[i] = (l[i][1], l[i][0].location.file, l[i][0].location.line, l[i][0].location.column) self.lock.acquire() try: self.rows.append((cocci, l)) finally: self.lock.release() def has_row(self): self.lock.acquire() try: return len(self.rows) > 0 finally: self.lock.release() def get_row(self): self.lock.acquire() try: return self.rows.pop(0) finally: self.lock.release() def update(self): import gobject while self.has_row(): cocci, l = self.get_row() self.gui.add_result(cocci, l) gobject.timeout_add(1000, self.update) def run(self): import gtk,gobject import coccilib.coccigui.coccigui self.gui = coccilib.coccigui.coccigui.pycocci() globals()['gtk_sock'] = self.gui gobject.timeout_add(1000, self.update) gtk.gdk.threads_init() gtk.gdk.threads_enter() gtk.main() gtk.gdk.threads_leave() globals().pop('gtk_thread') globals().pop('gtk_sock') class Gtk(Output): def check_availability(self): import time if not globals().has_key('gtk_sock'): t = GtkRunner() globals()['gtk_thread'] = t globals()['gtk_thread'].start() time.sleep(2) def register_match(self, include, messages): self.check_availability() self.include_match(include) if include: globals()['gtk_thread'].add_row(self.cocci_file, messages) def finalise(self): self.check_availability() globals()['gtk_thread'].join() coccinelle-1.0.0-rc19/python/coccilib/__init__.py0000644000175000017500000000003012247437436020562 0ustar eugeneugen# python infrastructure coccinelle-1.0.0-rc19/python/coccilib/elems.py0000644000175000017500000000151212247437436020136 0ustar eugeneugenclass Location: def __init__(self, file, current_element, line, column, line_end, column_end): self.file = file self.current_element = current_element self.line = line self.column = column self.line_end = line_end self.column_end = column_end class ElemBase: def __init__(self): pass # class Expression(ElemBase): # def __init__(self, expr): # ElemBase.__init__(self) # self.expr = expr # # def __str__(self): # return self.expr class TermList(ElemBase): def __init__(self, expr, elements): ElemBase.__init__(self) self.expr = expr self.elements = elements def __getitem__(self,n): return self.elements[n] def __str__(self): return self.expr # class Identifier(ElemBase): # def __init__(self, ident): # ElemBase.__init__(self) # self.ident = ident # # def __str__(self): # return self.ident coccinelle-1.0.0-rc19/python/coccilib/xml_firehose.py0000644000175000017500000002252112247437436021520 0ustar eugeneugen# Coccinelle output module to display Firehose XML import sys """ You need Firehose to use this module. You can get it at https://github.com/fedora-static-analysis/firehose or directly via Pypi: # pip install firehose In your semantic patches, import Firehose like this: coccilib.xml_firehose.import_firehose() """ def import_firehose(): """ inserts Firehose module into globals() It is required to proceed this way, as long as we can't use the classical approach (from firehose.model import Foo[...]), mainly because this module is imported by coccinelle whether or not it will be used by the semantic patch (and we don't want to display an error message to non-Firehose users. """ try: globals()['firehose'] = __import__('firehose.model') except ImportError: print "Error: Firehose is not installed or not in the Python path." class Analysis(object): """ An Analysis object wraps the work to keep tracks of results, and print the Firehose Analysis at the end. """ def __init__(self, use_env_variables=True, sut_type=None, sut_name=None, sut_version=None, sut_buildarch=None, generator_version="", root_path="", blank_if_no_results=False): """ Initializes an analysis and sets its useful variables Arguments: use_env_variables: if set to True, looks for the variables in bash environment, otherwise it uses the below parameters Do for example before calling spatch: export COCCI_SUT_TYPE="debian-source" export COCCI_SUT_NAME="package name" export COCCI_SUT_VERSION="package version" export COCCI_SUT_BUILARCH="pakage buildarch" export COCCI_GENERATOR_VERSION="1.0" export COCCI_ROOT_PATH="/path/to/project/" export COCCI_BLANK_IF_NO_RESULTS=1 sut_type: "debian-source", "debian-binary" or "source-rpm" sut_name: the name of the package or software being analysed sut_version: its version sut_builarch: its architecture (only for "debian-binary", "source-rpm") generator_version: the version of Coccinelle root_path: the prefix to remove from the files paths e.g. file = /path/to/project/path/to/file root_path = /path/to/project/ file becomes path/to/file blank_if_no_results: defaults to False. If set to True, doesn't print anything if the analysis has 0 result. """ if use_env_variables: import os self.sut_type = os.environ.get("COCCI_SUT_TYPE") or "" self.sut_name = os.environ.get("COCCI_SUT_NAME") or "" self.sut_version = os.environ.get("COCCI_SUT_VERSION") or "" self.sut_buildarch = os.environ.get("COCCI_SUT_BUILDARCH") or "" self.generator_version = os.environ.get( "COCCI_GENERATOR_VERSION") or "" self.root_path = os.environ.get("COCCI_ROOT_PATH") or "" self.blank_if_no_results = os.environ.get( "COCCI_BLANK_IF_NO_RESULTS") or False else: self.sut_type = sut_type self.sut_name = sut_name self.sut_version = sut_version self.sut_buildarch = sut_buildarch self.generator_version = generator_version self.root_path = root_path self.blank_if_no_results = blank_if_no_results self.results = [] def add_result(self, location, message, cwe=None, testid=None, notes=None, severity=None, customfields=None): """ Adds a result in the analysis Arguments: location: a coccinelle position (cocci.elems.Location) message: the message to display with """ self.results.append(self.__build_issue(location, message, cwe=cwe, testid=testid, notes=notes, severity=severity, customfields=customfields)) def __build_analysis(self, sut = None, file_ = None, stats = None, gen_name="coccinelle", gen_version=""): """Creates a new Analysis() object. Keyword arguments: sut -- software under test file_ -- stats -- gen_name -- the generator name, default 'coccinelle' gen_version -- the generator version """ generator = firehose.model.Generator(name=gen_name, version=gen_version) metadata = firehose.model.Metadata(generator, sut, file_, stats) analysis = firehose.model.Analysis(metadata, []) return analysis def __build_issue(self, location, message, cwe=None, testid=None, notes=None, severity=None, customfields=None): """Creates a new Issue() object. Arguments: location -- a coccinelle position (cocci.elems.Location) message -- Keyword arguments: cwe -- testid -- notes -- trace -- severity -- customfields -- """ location = self.__coccilocation_to_firehoselocation(location[0]) message = firehose.model.Message(message) if notes is not None: notes = firehose.model.Notes(notes) if customfields is not None: customfields = firehose.model.CustomFields(customfields) # TODO: trace -> how to pass a trace from spatch to xml_firehose trace = None issue = firehose.model.Issue(cwe, testid, location, message, notes, trace, severity=severity, customfields=customfields) return issue def __coccilocation_to_firehoselocation(self, cocciloc): """Converts a Coccinelle Location object to a Firehose one. The range attribute is used (single point not yet supported). Arguments: cocciloc -- coccilib.elems.Location instance """ # removes root_path from the file name filename = cocciloc.file if filename.startswith(self.root_path): filename = filename[len(self.root_path):] # removes the slash at begin of the filename if there's one: if filename.startswith("/"): filename = filename[1:] file_ = firehose.model.File(filename, "") function = firehose.model.Function(cocciloc.current_element) range_ = firehose.model.Range( firehose.model.Point(int(cocciloc.line), int(cocciloc.column)), firehose.model.Point(int(cocciloc.line_end), int(cocciloc.column_end)) ) return firehose.model.Location(file_, function, range_=range_) def print_analysis(self): """Displays the Firehose XML output of an issue. This function is intended to be called from a .cocci file. """ def _extract_version_release(long_version): """ extracts the version and the release from long_version # e.g. 1.5-2-4.2 -> 1.5-2 -- 4.2 """ sep = long_version.rfind("-") if sep == -1: version = long_version release = "" else: version = long_version[:sep] release = long_version[sep+1:] return version, release # if the analysis has 0 result and blank_if_no_results is True, # we don't print anything if not(self.results) and self.blank_if_no_results: sys.stdout.write("\n") return if self.sut_type == "source-rpm": self.sut_release = "" # TODO for RPM sut = firehose.model.SourceRpm(self.sut_name, self.sut_version, self.sut_release, self.sut_buildarch) elif self.sut_type == "debian-binary": self.sut_version, self.sut_release = _extract_version_release( self.sut_version) sut = firehose.model.DebianBinary( self.sut_name, self.sut_version, self.sut_release, self.sut_buildarch) elif self.sut_type == "debian-source": self.sut_version, self.sut_release = _extract_version_release( self.sut_version) sut = firehose.model.DebianSource( self.sut_name, self.sut_version, self.sut_release) else: sut = None sys.stderr.write("Warning: sut_type incorrect, should be " "debian-source, debian-binary or source-rpm\n") analysis = self.__build_analysis(sut=sut, gen_version=self.generator_version) analysis.results = self.results sys.stdout.write(str(analysis.to_xml_bytes())) sys.stdout.write("\n") coccinelle-1.0.0-rc19/python/coccilib/Makefile0000644000175000017500000000041612247437436020121 0ustar eugeneugenMAKESUBDIRS=coccigui ifneq ($(MAKECMDGOALS),distclean) include ../../Makefile.config endif all: all.opt: depend: clean: set -e; for i in $(MAKESUBDIRS); do $(MAKE) -C $$i clean; done rm -rf __pycache__ rm -f *.pyc distclean: clean include ../../Makefile.common coccinelle-1.0.0-rc19/python/coccilib/trac.py0000644000175000017500000000105512247437436017764 0ustar eugeneugenimport psycopg2 from datetime import date, datetime from trac.util.datefmt import to_timestamp, utc def add_ticket(self, dbinfo, summary, desc) : conn = psycopg2.connect(dbinfo) curs = conn.cursor() created = to_timestamp(datetime.now(utc)) curs.execute("INSERT INTO ticket \ (type,time,changetime,component,priority,owner,reporter,cc,version,milestone,status,summary,description, keywords) \ VALUES \ ('defect', %s, %s, 'other','major','somebody','Coccinelle','','next','','new','%s','%s', '')" % (created, created, summary, desc) ) conn.commit() coccinelle-1.0.0-rc19/python/coccilib/report.py0000644000175000017500000000024212247437436020343 0ustar eugeneugendef build_report(p, msg) : return "%s:%s:%s-%s: %s" % (p.file,p.line,p.column,p.column_end,msg) def print_report(p, msg="ERROR") : print(build_report(p, msg)) coccinelle-1.0.0-rc19/python/Makefile0000644000175000017500000001053612247442616016352 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ############################################################################# # Configuration section ############################################################################# ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif ############################################################################## # Variables ############################################################################## TARGET=coccipython OCAMLCFLAGS ?= -g OPTFLAGS ?= -g SOURCES= pycocci_aux.ml $(PYCOCCI_FILE) pycocci.ml INCLUDEDIRS_LOCAL = ../commons ../commons/ocamlextra ../globals \ ../parsing_c ../parsing_cocci INCLUDEDIRS = $(INCLUDEDIRS_LOCAL) $(PYCAMLDIR) SYSLIBS = str.cma unix.cma pycaml.cma LIBS=../commons/commons.cma ../globals/globals.cma ############################################################################## # Generic variables ############################################################################## INCLUDES=$(INCLUDEDIRS:%=-I %) $(INCLUDESEXTRA) INCLUDES_DEPEND=$(INCLUDEDIRS_LOCAL:%=-I %) $(INCLUDESEXTRA) ############################################################################## # Generic ocaml variables ############################################################################## # The Caml compilers. OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES_DEPEND) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) ############################################################################## # Top rules ############################################################################## EXEC=$(TARGET).byte LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) CTLEXEC=$(CTLTARGET) OBJS = $(SOURCES:.ml=.cmo) OPTOBJS = $(OBJS:.cmo=.cmx) CTLOBJS = $(CTLSOURCES:.ml=.cmo) CTLOPTOBJS = $(CTLOBJS:.cmo=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(LIB) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes ctl: $(CTLEXEC) $(LIB): $(OBJS) $(OCAMLC_CMD) -a -o $(LIB) $(OBJS) clean:: rm -f $(TARGET).cma $(TARGET).a $(TARGET).o $(TARGET).cmxa $(OPTLIB): $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $(OPTLIB) $(OPTOBJS) $(EXEC): $(OBJS) main.cmo $(LIBS) $(OCAMLC_CMD) -o $(EXEC) $(SYSLIBS) $(LIBS) $(OBJS) main.cmo $(CTLEXEC): $(CTLOBJS) $(LIBS) $(OCAMLC_CMD) -o $(CTLEXEC) $(SYSLIBS) $(LIBS) $(CTLOBJS) else all: cd .. && $(OCAMLBUILD) python/python.cma all.opt: cd .. && $(OCAMLBUILD) python/python.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif clean:: rm -f $(OPTLIB) $(LIB:.cma=.a) rm -f $(TARGET) rm -f $(TARGET).byte rm -f $(CTLTARGET) rm -f .depend rm -f coccipython.cmxa coccipython.a distclean:: $(MAKE) -C coccilib $@ rm -f pycocci.ml rm -f *.cm[ioxa] *.o *.annot ############################################################################## # Generic ocaml rules ############################################################################## .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< # clean rule for others files clean:: rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ #*# .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/python/yes_pycocci.ml0000644000175000017500000002701112247442616017551 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./yes_pycocci.ml" open Ast_c open Common open Pycaml open Pycocci_aux module StringMap = Map.Make (String) exception Pycocciexception let python_support = true (* ------------------------------------------------------------------- *) (* The following definitions are from http://patches.ubuntu.com/by-release/extracted/debian/c/coccinelle/0.1.5dbs-2/01-system-pycaml as well as _pycocci_setargs *) let _pycocci_none () = let builtins = pyeval_getbuiltins () in pyobject_getitem (builtins, pystring_fromstring "None") let _pycocci_true () = let builtins = pyeval_getbuiltins () in pyobject_getitem (builtins, pystring_fromstring "True") let _pycocci_false () = let builtins = pyeval_getbuiltins () in pyobject_getitem (builtins, pystring_fromstring "False") let _pycocci_tuple6 (a,b,c,d,e,f) = pytuple_fromarray ([|a; b; c; d; e; f|]) (* ------------------------------------------------------------------- *) let check_return_value msg v = if v =*= (pynull ()) then (pyerr_print (); Common.pr2 ("while " ^ msg ^ ":"); raise Pycocciexception) else () let check_int_return_value msg v = if v =|= -1 then (pyerr_print (); Common.pr2 ("while " ^ msg ^ ":"); raise Pycocciexception) else () let initialised = ref false let coccinelle_module = ref (_pycocci_none ()) let cocci_file_name = ref "" (* dealing with python modules loaded *) let module_map = ref (StringMap.add "__main__" (_pycocci_none ()) StringMap.empty) let get_module module_name = StringMap.find module_name (!module_map) let is_module_loaded module_name = try let _ = get_module module_name in true with Not_found -> false let load_module module_name = if not (is_module_loaded module_name) then (* let _ = Sys.command("python3 -c 'import " ^ module_name ^ "'") in *) let m = pyimport_importmodule module_name in check_return_value ("importing module " ^ module_name) m; (module_map := (StringMap.add module_name m (!module_map)); m) else get_module module_name (* end python module handling part *) (* python interaction *) let split_fqn fqn = let last_period = String.rindex fqn '.' in let module_name = String.sub fqn 0 last_period in let class_name = String.sub fqn (last_period + 1) (String.length fqn - last_period - 1) in (module_name, class_name) let pycocci_get_class_type fqn = let (module_name, class_name) = split_fqn fqn in let m = get_module module_name in let attr = pyobject_getattrstring(m, class_name) in check_return_value "obtaining a python class type" attr; attr let pycocci_instantiate_class fqn args = let class_type = pycocci_get_class_type fqn in let obj = pyeval_callobjectwithkeywords(class_type, args, pynull()) in check_return_value "instantiating a python class" obj; obj (* end python interaction *) let inc_match = ref true let exited = ref false let include_match v = let truth = pyobject_istrue (pytuple_getitem (v, 1)) in check_int_return_value "testing include_match" truth; inc_match := truth != 0; _pycocci_none () let sp_exit _ = exited := true; _pycocci_none () let build_method (mname, camlfunc, args) pymodule classx classdict = let cmx = pymethod_new(pywrap_closure camlfunc, args, classx) in let v = pydict_setitemstring(classdict, mname, cmx) in check_int_return_value ("building python method " ^ mname) v; () let build_class cname parent methods pymodule = let cd = pydict_new() in check_return_value "creating a new python dictionary" cd; let cx = pyclass_new(pytuple_fromsingle (pycocci_get_class_type parent), cd, pystring_fromstring cname) in check_return_value "creating a new python class" cx; List.iter (function meth -> build_method meth pymodule cx cd) methods; let v = pydict_setitemstring(pymodule_getdict pymodule, cname, cx) in check_int_return_value ("adding python class " ^ cname) v; (cd, cx) let the_environment = ref [] let has_environment_binding name = let a = pytuple_toarray name in let (rule, name) = (Array.get a 1, Array.get a 2) in let orule = pystring_asstring rule in let oname = pystring_asstring name in let e = List.exists (function (x,y) -> orule =*= x && oname =$= y) !the_environment in if e then _pycocci_true () else _pycocci_false () let pyoutputinstance = ref (_pycocci_none ()) let pyoutputdict = ref (_pycocci_none ()) let get_cocci_file args = pystring_fromstring (!cocci_file_name) (* initialisation routines *) let _pycocci_setargs argv0 = let argv = pysequence_list (pytuple_fromsingle (pystring_fromstring argv0)) in let sys_mod = load_module "sys" in pyobject_setattrstring (sys_mod, "argv", argv) let pycocci_init () = (* initialize *) if not !initialised then ( initialised := true; (* use python_path_base as default (overridable) dir for coccilib *) let python_path_base = Printf.sprintf "%s/coccinelle" (Unix.getenv "HOME") in let python_path = try Unix.getenv "PYTHONPATH" ^ ":" ^ python_path_base with Not_found -> python_path_base in Unix.putenv "PYTHONPATH" python_path; let _ = if not (py_isinitialized () != 0) then (if !Flag.show_misc then Common.pr2 "Initializing python\n%!"; py_initialize()) in (* set argv *) let argv0 = Sys.executable_name in let _ = _pycocci_setargs argv0 in coccinelle_module := (pymodule_new "coccinelle"); module_map := StringMap.add "coccinelle" !coccinelle_module !module_map; let _ = load_module "coccilib.elems" in let _ = load_module "coccilib.output" in let module_dictionary = pyimport_getmoduledict() in coccinelle_module := pymodule_new "coccinelle"; let mx = !coccinelle_module in let (cd, cx) = build_class "Cocci" (!Flag.pyoutput) [("exit", sp_exit, (pynull())); ("include_match", include_match, (pynull())); ("has_env_binding", has_environment_binding, (pynull()))] mx in pyoutputinstance := cx; pyoutputdict := cd; let v1 = pydict_setitemstring(module_dictionary, "coccinelle", mx) in check_int_return_value "adding coccinelle python module" v1; let mypystring = pystring_fromstring !cocci_file_name in let v2 = pydict_setitemstring(cd, "cocci_file", mypystring) in check_int_return_value "adding python field cocci_file" v2; ()) else () (*let _ = pycocci_init ()*) (* end initialisation routines *) let added_variables = ref [] let build_classes env = let _ = pycocci_init () in inc_match := true; exited := false; the_environment := env; let mx = !coccinelle_module in let dict = pymodule_getdict mx in List.iter (function "include_match" | "has_env_binding" | "exit" -> () | name -> let v = pydict_delitemstring(dict,name) in check_int_return_value ("removing " ^ name ^ " from python coccinelle module") v) !added_variables; added_variables := []; () let build_variable name value = let mx = !coccinelle_module in added_variables := name :: !added_variables; check_int_return_value ("build python variable " ^ name) (pydict_setitemstring(pymodule_getdict mx, name, value)) let get_variable name = let mx = !coccinelle_module in pystring_asstring (pyobject_str(pydict_getitemstring(pymodule_getdict mx, name))) let contains_binding e (_,(r,m),_) = try let _ = List.find (function ((re, rm), _) -> r =*= re && m =$= rm) e in true with Not_found -> false let construct_variables mv e = let find_binding (r,m) = try let elem = List.find (function ((re,rm),_) -> r =*= re && m =$= rm) e in Some elem with Not_found -> None in (* Only string in this representation, so no point let instantiate_Expression(x) = let str = pystring_fromstring (Pycocci_aux.exprrep x) in pycocci_instantiate_class "coccilib.elems.Expression" (pytuple_fromsingle (str)) in *) (* Only string in this representation, so no point let instantiate_Identifier(x) = let str = pystring_fromstring x in pycocci_instantiate_class "coccilib.elems.Identifier" (pytuple_fromsingle (str)) in *) let instantiate_term_list py printer lst = let (str,elements) = printer lst in let str = pystring_fromstring str in let elements = pytuple_fromarray (Array.of_list (List.map pystring_fromstring elements)) in let repr = pycocci_instantiate_class "coccilib.elems.TermList" (pytuple_fromarray (Array.of_list [str;elements])) in let _ = build_variable py repr in () in List.iter (function (py,(r,m),_) -> match find_binding (r,m) with None -> () (* | Some (_, Ast_c.MetaExprVal (expr,_)) -> let expr_repr = instantiate_Expression(expr) in let _ = build_variable py expr_repr in () *) (* | Some (_, Ast_c.MetaIdVal (id,_)) -> let id_repr = instantiate_Identifier(id) in let _ = build_variable py id_repr in () *) | Some (_, Ast_c.MetaExprListVal (exprlist)) -> instantiate_term_list py Pycocci_aux.exprlistrep exprlist | Some (_, Ast_c.MetaParamListVal (paramlist)) -> instantiate_term_list py Pycocci_aux.paramlistrep paramlist | Some (_, Ast_c.MetaInitListVal (initlist)) -> instantiate_term_list py Pycocci_aux.initlistrep initlist | Some (_, Ast_c.MetaFieldListVal (fieldlist)) -> instantiate_term_list py Pycocci_aux.fieldlistrep fieldlist | Some (_, Ast_c.MetaPosValList l) -> let locs = List.map (function (fname,current_element,(line,col),(line_end,col_end)) -> pycocci_instantiate_class "coccilib.elems.Location" (_pycocci_tuple6 (pystring_fromstring fname,pystring_fromstring current_element, pystring_fromstring (Printf.sprintf "%d" line), pystring_fromstring (Printf.sprintf "%d" col), pystring_fromstring (Printf.sprintf "%d" line_end), pystring_fromstring (Printf.sprintf "%d" col_end)))) l in let pylocs = pytuple_fromarray (Array.of_list locs) in let _ = build_variable py pylocs in () | Some (_,binding) -> let _ = build_variable py (pystring_fromstring (Pycocci_aux.stringrep binding)) in () ) mv; () let construct_script_variables mv = List.iter (function (_,py) -> let str = pystring_fromstring "initial value: consider using coccinelle.varname" in let _ = build_variable py str in ()) mv let retrieve_script_variables mv = List.map (function (_,py) -> get_variable py) mv let set_coccifile cocci_file = cocci_file_name := cocci_file; () let pyrun_simplestring s = let res = Pycaml.pyrun_simplestring s in check_int_return_value ("running simple python string: " ^ s) res; res let py_isinitialized () = Pycaml.py_isinitialized () let py_finalize () = Pycaml.py_finalize () coccinelle-1.0.0-rc19/python/python.mllib0000644000175000017500000000002312247437436017246 0ustar eugeneugenPycocci Pycocci_auxcoccinelle-1.0.0-rc19/editors/0000755000175000017500000000000012247437436015041 5ustar eugeneugencoccinelle-1.0.0-rc19/editors/emacs/0000755000175000017500000000000012247437436016131 5ustar eugeneugencoccinelle-1.0.0-rc19/editors/emacs/cocci-ediff.el0000644000175000017500000007445012247437436020620 0ustar eugeneugen;;; cocci-ediff.el --- ediff support for semantic patches ;; Copyright (C) 2006-2007 The Cocci Gang ;; Emacs Lisp Archive Entry ;; Author: Rene Rydhof Hansen ;; Padioleau Yoann (modifying the ediff layout) ;; Version: 0.1 ;; Keywords: coccinelle patch refactoring program transformation ;; URL: http://www.emn.fr/x-info/coccinelle/ ;;; Ediff and dired support ;; You must modify the variables `cocci-spatch-path', ;; `cocci-isofile-path', and `cocci-spatch-args' according to your setup. ;; Once it is installed you use it by loading a .cocci file (called the ;; SP), e.g., 'coccinelle/tests/rule17.cocci'. From the buffer containing ;; the SP you then press `C-cd' (or `M-x cocci-directory') and specify ;; the directory where your target C files are located, e.g., ;; 'coccinelle/tests/rule17/', pick one of the listed C files (place the ;; cursor on it) and press `E' (or `M-x cocci-ediff-merge'). This will ;; then run spatch and apply the SP to the chosen C file; when spatch ;; finishes Ediff will start in a merge session, displaying the original ;; C file, the spatch'ed file and the result of merging those two. You ;; can now use Ediff for merging as usual. When you quit Ediff you will ;; be asked whether or not to replace the original file with the result ;; of the merge. (require 'dired) (require 'dired-x) (require 'ediff) (require 'cocci-mode) ;-------------------------------------------------- ; Defaults ;-------------------------------------------------- (defvar cocci-spatch-path "~/coccinelle/spatch") (defvar cocci-isofile-path "~/coccinelle/standard.iso") (defvar cocci-spatch-args "-no_show_ctl_text -no_show_transinfo -no_parse_error_msg -no_show_misc") (defvar cocci-spatch-default-output "/tmp/output.c") (defvar cocci-save-merge-result nil "Determines if the result of merging files should be saved.") ;-------------------------------------------------- ; Key map for Dired under Cocci ;-------------------------------------------------- (defvar cocci-dired-mode-map (let ((map (make-sparse-keymap))) (define-key map "N" 'dired-next-marked-file) (define-key map "P" 'dired-prev-marked-file) (define-key map "c" 'cocci-dired-compile-makeok) (define-key map "\C-c" 'cocci-dired-compile-makeok) (define-key map "\C-r" 'cocci-dired-run-spatch) (define-key map "r" 'cocci-dired-compile-spatch) (define-key map "v" 'cocci-dired-view-file) (define-key map "V" 'cocci-dired-view-corresponding-file) (define-key map [(control return)] 'cocci-dired-view-corresponding-file) (define-key map "*c" 'cocci-dired-mark-c-files) (define-key map "*C" 'cocci-dired-mark-cocci-files) (define-key map "*o" 'cocci-dired-mark-ok-files) (define-key map "*r" 'cocci-dired-mark-expected-files) (define-key map "*f" 'cocci-dired-mark-failed-files) (define-key map "T" 'cocci-dired-toggle-terse-mode) (define-key map "E" 'cocci-ediff-merge) (define-key map "D" 'cocci-ediff-diff) map) "Keymap used for cocci bindings in `dired-mode'.") ;-------------------------------------------------- ; Internal Variables ;-------------------------------------------------- (defvar cocci-current-cocci nil "The current cocci-file") (defvar cocci-spatch-output nil "The buffer for spatch output") (defvar cocci-current-cocci-buffer nil "The current cocci-filebuffer") ;-------------------------------------------------- ; Misc helpers ;-------------------------------------------------- (defun get-spatch-output-buffer () (if (buffer-live-p cocci-spatch-output) cocci-spatch-output (setq cocci-spatch-output (generate-new-buffer "*Spatch Output*")))) ;-------------------------------------------------- ; Shell Commands ;-------------------------------------------------- (defun cocci-spatch-cmd (sp) "Assembles command line for spatch" (concat cocci-spatch-path " -iso_file " cocci-isofile-path ; " -compare_with_expected" " -cocci_file " sp " " cocci-spatch-args)) (defun cocci-makeok-cmd (sp) "Assembles command line for make ok" (concat "make " " ISOFILE=\"-iso_file " cocci-isofile-path "\"" " SP=" sp " ARGS=\"" cocci-spatch-args "\"")) ;-------------------------------------------------- ; Misc. ;-------------------------------------------------- (defun cocci-convert-ends (from to files) "Convert files (in files) from ending in from to ending to" (mapcar (lambda (f) (if (string-match (concat from "$") f) (replace-match to t t f) f)) files)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar cocci-ediff-windows) (defvar cocci-ediff-result) (defvar ediff-buffer-A) (defvar ediff-buffer-B) (defvar ediff-buffer-C) (defvar ediff-show-sp t) (defun cocci-merge-files (orig-file new-file &optional name-A name-B) "Invoke ediff to review application of SP and manually perform merge." (interactive) (let* ((found nil)) (save-excursion ;; Set-up (let ((config (current-window-configuration)) (ediff-default-variant 'default-B) (ediff-keep-variants t)) ;; Fire up ediff. (set-buffer (ediff-merge-files orig-file new-file)) ;; Ediff is now set up, and we are in the control buffer. ;; Do a few further adjustments and take precautions for exit. (make-local-variable 'cocci-ediff-orig) (setq cocci-ediff-orig orig-file) (make-local-variable 'cocci-ediff-windows) (setq cocci-ediff-windows config) ; (make-local-variable 'cocci-ediff-result) ; (setq cocci-ediff-result result-buffer) (make-local-variable 'ediff-quit-hook) (setq ediff-quit-hook (lambda () (let ((buffer-A ediff-buffer-A) (buffer-B ediff-buffer-B) (buffer-C ediff-buffer-C) ; (result cocci-ediff-result) (windows cocci-ediff-windows) (original cocci-ediff-orig)) (ediff-cleanup-mess) ; (ediff-janitor) ; (set-buffer result) ; (erase-buffer) ; (insert-buffer buffer-C) (kill-buffer buffer-A) (kill-buffer buffer-B) (when cocci-save-merge-result (switch-to-buffer buffer-C) (delete-other-windows) (ediff-write-merge-buffer-and-maybe-kill buffer-C original)) ; (kill-buffer buffer-C) (set-window-configuration windows) (message "Merge resolved; you may save the buffer")))) (message "Please resolve merge now; exit ediff when done") nil)))) ; pad's code ; merge between ediff-setup-windows-plain-compare and ; ediff-setup-windows-plain from 'ediff-wind.el' (defun cocci-ediff-setup-windows-plain (buf-A buf-B buf-C control-buffer) (ediff-with-current-buffer control-buffer (setq ediff-multiframe nil)) (ediff-destroy-control-frame control-buffer) (let ((window-min-height 1) split-window-function wind-width-or-height three-way-comparison wind-A-start wind-B-start wind-A wind-B wind-C) (ediff-with-current-buffer control-buffer (setq wind-A-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'A ediff-narrow-bounds)) wind-B-start (ediff-overlay-start (ediff-get-value-according-to-buffer-type 'B ediff-narrow-bounds)) ;; this lets us have local versions of ediff-split-window-function split-window-function ediff-split-window-function three-way-comparison ediff-3way-comparison-job)) (delete-other-windows) (split-window-vertically) (ediff-select-lowest-window) ;NEW (setq lowest-wind (selected-window)) (ediff-setup-control-buffer control-buffer) ;; go to the upper window and split it betw A, B, and possibly C (other-window 1) ;NEW (split-window-vertically) (setq this-wind (selected-window)) (other-window 1) (switch-to-buffer cocci-current-cocci-buffer) (select-window this-wind) (switch-to-buffer buf-A) (setq wind-A (selected-window)) (if three-way-comparison (setq wind-width-or-height (/ (if (eq split-window-function 'split-window-vertically) (window-height wind-A) (window-width wind-A)) 3))) ;; XEmacs used to have a lot of trouble with display ;; It did't set things right unless we told it to sit still ;; 19.12 seems ok. ;;(if ediff-xemacs-p (sit-for 0)) ; (funcall split-window-function wind-width-or-height) (split-window-horizontally) (if (eq (selected-window) wind-A) (other-window 1)) (switch-to-buffer buf-B) (setq wind-B (selected-window)) (if three-way-comparison (progn (funcall split-window-function) ; equally (if (eq (selected-window) wind-B) (other-window 1)) (switch-to-buffer buf-C) (setq wind-C (selected-window)))) (ediff-with-current-buffer control-buffer (setq ediff-window-A wind-A ediff-window-B wind-B ediff-window-C wind-C)) ;; It is unlikely that we will want to implement 3way window comparison. ;; So, only buffers A and B are used here. (if ediff-windows-job (progn (set-window-start wind-A wind-A-start) (set-window-start wind-B wind-B-start))) (ediff-select-lowest-window) (ediff-setup-control-buffer control-buffer) )) (defvar old-ediff-setup-function ediff-window-setup-function) ; pad's code, almost copy paste of rene's cocci-merge-files (defun cocci-diff-files (orig-file new-file &optional name-A name-B) "Invoke ediff to review application of SP and manually perform merge." (interactive) (let* ((found nil)) (save-excursion ;; Set-up (let ((config (current-window-configuration)) (ediff-default-variant 'default-B) (ediff-keep-variants t) ) ;; Fire up ediff. ;NEW, use ediff-files (setq ediff-window-setup-function 'cocci-ediff-setup-windows-plain) (set-buffer (ediff-files orig-file new-file)) ;; Ediff is now set up, and we are in the control buffer. ;; Do a few further adjustments and take precautions for exit. (make-local-variable 'cocci-ediff-orig) (setq cocci-ediff-orig orig-file) (make-local-variable 'cocci-ediff-windows) (setq cocci-ediff-windows config) ; (make-local-variable 'cocci-ediff-result) ; (setq cocci-ediff-result result-buffer) (make-local-variable 'ediff-quit-hook) (setq ediff-quit-hook (lambda () (let ((buffer-A ediff-buffer-A) (buffer-B ediff-buffer-B) (buffer-C ediff-buffer-C) ; (result cocci-ediff-result) (windows cocci-ediff-windows) (original cocci-ediff-orig)) (ediff-cleanup-mess) ; (ediff-janitor) ; (set-buffer result) ; (erase-buffer) ; (insert-buffer buffer-C) (kill-buffer buffer-A) (kill-buffer buffer-B) (setq ediff-window-setup-function old-ediff-setup-function) (when cocci-save-merge-result (switch-to-buffer buffer-C) (delete-other-windows) (ediff-write-merge-buffer-and-maybe-kill buffer-C original)) ; (kill-buffer buffer-C) (set-window-configuration windows) (message "Merge resolved; you may save the buffer")))) (message "Please resolve merge now; exit ediff when done") nil)))) ;---------------------------------------------------------------------- ; Executing "make" and "spatch" commands ;---------------------------------------------------------------------- (defun cocci-dired-compile-makeok (arg) "Compiles the marked files in cocci/dired mode. With prefix arg no file names are substituted (useful for Makefiles)." (interactive "P") (if arg (compile (read-from-minibuffer "Compile command: " (eval compile-command) nil nil '(compile-history . 1))) (let* ((file-list (cocci-convert-ends ".c" ".ok" (dired-get-marked-files t))) (command (dired-mark-read-string "Make targets %s with: " (cocci-makeok-cmd cocci-current-cocci) 'compile nil file-list))) (compile (concat command " " (mapconcat 'identity file-list " ")))))) (defun cocci-dired-compile-spatch (&optional arg) "Runs spatch on current file. Non-nil optional arg to specify command." (interactive "P") (if arg (compile (read-from-minibuffer "Command: " (eval compile-command) nil nil '(compile-history . 1))) (let ((file (dired-get-filename t)) (command (cocci-spatch-cmd cocci-current-cocci))) (compile (concat command " " file))))) (defun cocci-apply-spatch (file &optional sp-file out-buf) "Applies the current SP to FILE." (interactive) (let ((cmd (concat (cocci-spatch-cmd (or sp-file cocci-current-cocci))))) (shell-command (concat cmd " " file) out-buf))) (defun cocci-ediff-merge (&optional res-file) "Use EDiff to review and apply semantic patch." (interactive) (let ((file (dired-get-filename t)) (out-buf (get-spatch-output-buffer))) (message "Applying SP '%s' to file '%s'..." (file-name-nondirectory cocci-current-cocci) (file-name-nondirectory file)) (cocci-apply-spatch file cocci-current-cocci out-buf) (message "Applying SP '%s' to file '%s'... done." (file-name-nondirectory cocci-current-cocci) (file-name-nondirectory file)) ; (ediff-merge-files file (or res-file cocci-spatch-default-output)) (cocci-merge-files file (or res-file cocci-spatch-default-output)))) (defun cocci-ediff-diff (&optional res-file) "Use EDiff to review and apply semantic patch." (interactive) (let ((file (dired-get-filename t)) (out-buf (get-spatch-output-buffer))) (message "Applying SP '%s' to file '%s'..." (file-name-nondirectory cocci-current-cocci) (file-name-nondirectory file)) (cocci-apply-spatch file cocci-current-cocci out-buf) (message "Applying SP '%s' to file '%s'... done." (file-name-nondirectory cocci-current-cocci) (file-name-nondirectory file)) ; (ediff-merge-files file (or res-file cocci-spatch-default-output)) (cocci-diff-files file (or res-file cocci-spatch-default-output)))) (defun cocci-dired-view-file () "In cocci dired, visit the file or directory named on this line using diff-mode." (interactive) (let ((file-name (file-name-sans-versions (dired-get-filename) t)) ;; bind it so that the command works on directories too, ;; independent of the user's setting (find-file-run-dired t)) (if (file-exists-p file-name) (progn (find-file file-name) (diff-mode)) (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") (error "File no longer exists; type `g' to update Dired buffer"))))) (defun cocci-dired-view-corresponding-file () "In cocci dired, visit the file or directory named on this line using diff-mode." (interactive) (let* ((file-name (cocci-corresponding-file (file-name-sans-versions (dired-get-filename) t))) (find-file-run-dired t)) (if (file-exists-p file-name) (progn (find-file file-name) (diff-mode)) (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") (error "File no longer exists; type `g' to update Dired buffer"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun cocci-dired-run-spatch (&optional spfile) "In a dired buffer, runs spatch on marked files with source buffer as SP file" (interactive) (when (not spfile) (setq spfile cocci-current-cocci)) (dired-do-shell-command (concat (cocci-spatch-cmd spfile) " ?") current-prefix-arg (dired-get-marked-files t current-prefix-arg))) (defun cocci-dired-run-makeok (spfile) "In a dired buffer, runs 'make ok' on marked files with source buffer as SP file" (interactive) (let ((files (dired-get-marked-files t current-prefix-arg))) (dired-do-shell-command (concat (cocci-makeok-cmd spfile) " ?") current-prefix-arg (cocci-convert-ends ".c" ".ok" files)))) (defun cocci-run-makeok (spfile) "Run 'make ok' in current directory with source buffer as SP file" (interactive) (compile (cocci-makeok-cmd (buffer-file-name)))) ;-------------------------------------------------- ; Marking files in Dired under Cocci ;-------------------------------------------------- (defun cocci-dired-mark-c-files () (interactive) (dired-mark-extension ".c")) (defun cocci-dired-mark-cocci-files () (interactive) (dired-mark-extension ".cocci")) (defun cocci-dired-mark-ok-files () "Mark all .ok files. In terse mode mark all .c files that have a corresponding .ok file" (interactive) (if (not cocci-dired-terse-mode) (dired-mark-extension ".ok") (dired-mark-if (let ((f (dired-get-filename nil t))) (and f (file-exists-p (cocci-file f 'ok)) (not (file-directory-p f)))) "source file(s) with OK result file"))) (defun cocci-dired-mark-failed-files () "Mark all .failed files. In terse mode mark all .c files that have a corresponding .failed file" (interactive) (if (not cocci-dired-terse-mode) (dired-mark-extension ".failed") (dired-mark-if (let ((f (dired-get-filename nil t))) (and f (file-exists-p (cocci-file f 'fail)) (not (file-directory-p f)))) "source file(s) with FAILED result file"))) (defun cocci-dired-mark-expected-files () "Mark all .res files. In terse mode mark all .c files that have a corresponding .res file" (interactive) (if (not cocci-dired-terse-mode) (dired-mark-extension ".res") (dired-mark-if (let ((f (dired-get-filename nil t))) (and f (file-exists-p (cocci-file f 'expected)) (not (file-directory-p f)))) "source file(s) with EXPECTED result file"))) ;;; One shot - for counting in README's ;;; FIXME: remove (defun cocci-count-status () (interactive) (let (res) (save-excursion (beginning-of-buffer) (let ((ok (count-matches "\\[status\\] ok")) (sok (count-matches "\\[status\\] spatch-ok")) (fail (count-matches "\\[status\\] fail")) (wrong (count-matches "\\[status\\] wrong"))) (setq res (replace-regexp-in-string " occurrences" "" (concat "[ok: " ok "; spatch-ok: " sok "; fail: " fail "; wrong: " wrong "]"))))) (insert res))) ;---------------------------------------------------------------------- ; Cocci Dired - Adapted from VC Dired ;---------------------------------------------------------------------- (defvar cocci-dired-listing-switches "-al" "*Switches passed to `ls' for vc-dired. MUST contain the `l' option.") (defvar cocci-dired-terse-display t "*If non-nil, show only source (.c) files in Cocci Dired.") (defvar cocci-dired-recurse t "*If non-nil, show directory trees recursively in VC Dired.") (defvar cocci-directory-exclusion-list '("SCCS" "RCS" "CVS") "*List of directory names to be ignored when walking directory trees.") (defvar cocci-dired-switches) (defvar cocci-dired-terse-mode) (defvar cocci-dired-mode nil) (make-variable-buffer-local 'cocci-dired-mode) ;;; based on vc-dired-mode (define-derived-mode cocci-dired-mode dired-mode "Dired under Cocci" "The major mode used in Cocci directory buffers. It works like Dired, with the current Cocci state of each file being indicated in the place of the file's link count, owner, group and size. Subdirectories are also listed, and you may insert them into the buffer as desired, like in Dired." ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20. ;; We do it here because dired might not be loaded yet ;; when vc-dired-mode-map is initialized. (set-keymap-parent cocci-dired-mode-map dired-mode-map) (make-local-hook 'dired-after-readin-hook) (add-hook 'dired-after-readin-hook 'cocci-dired-hook nil t) ;; The following is slightly modified from dired.el, ;; because file lines look a bit different in vc-dired-mode. (set (make-local-variable 'dired-move-to-filename-regexp) (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") ;; In some locales, month abbreviations are as short as 2 letters, ;; and they can be followed by ".". (month (concat l l "+\\.?")) (s " ") (yyyy "[0-9][0-9][0-9][0-9]") (dd "[ 0-3][0-9]") (HH:MM "[ 0-2][0-9]:[0-5][0-9]") (seconds "[0-6][0-9]\\([.,][0-9]+\\)?") (zone "[-+][0-2][0-9][0-5][0-9]") (iso-mm-dd "[01][0-9]-[0-3][0-9]") (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?")) (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time "\\|" yyyy "-" iso-mm-dd "\\)")) (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)" s "+" "\\(" HH:MM "\\|" yyyy "\\)")) (western-comma (concat month s "+" dd "," s "+" yyyy)) ;; Japanese MS-Windows ls-lisp has one-digit months, and ;; omits the Kanji characters after month and day-of-month. (mm "[ 0-1]?[0-9]") (japanese (concat mm l "?" s dd l "?" s "+" "\\(" HH:MM "\\|" yyyy l "?" "\\)"))) ;; the .* below ensures that we find the last match on a line (concat ".*" s "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)" s "+"))) (and (boundp 'cocci-dired-switches) cocci-dired-switches (set (make-local-variable 'dired-actual-switches) cocci-dired-switches)) (set (make-local-variable 'cocci-dired-terse-mode) cocci-dired-terse-display) (setq cocci-dired-mode t)) (defun cocci-dired-toggle-terse-mode () "Toggle terse display in Cocci Dired." (interactive) (if (not cocci-dired-mode) nil (setq cocci-dired-terse-mode (not cocci-dired-terse-mode)) (if cocci-dired-terse-mode (cocci-dired-hook) (revert-buffer)))) (defun cocci-convert-file-ext (file ext) (concat (file-name-sans-extension file) ext)) (defvar cocci-file-types '((cocci . ".cocci") (source . ".c") (ok . ".ok") (fail . ".failed") (expected . ".res")) "Alist of file name extensions used by Cocci.") (defun cocci-file (file type) (let ((ext (cdr (assq type cocci-file-types)))) (if ext (cocci-convert-file-ext file ext) (error "cocci-file: requested unknown file type (%s)" type)))) (defun cocci-file-type (file) (car (rassoc (file-name-extension file t) cocci-file-types))) (defun cocci-result-type-p (type) (or (eq type 'ok) (eq type 'fail))) (defun cocci-corresponding-file (file) (let ((ftype (cocci-file-type file))) (cond ((or (eq ftype 'ok) (eq ftype 'fail)) (cocci-file file 'source)) ((eq ftype 'source) (let ((status (cocci-result-status file))) (cond ((eq status 'cocci-ok) (cocci-file file 'ok)) ((eq status 'cocci-fail) (cocci-file file 'fail)) (t (error "No corresponding result file for %s" file))))) (t (error "No corresponding file for %s" file))))) (defun cocci-result-status (file) "For a source file return the Coccinelle result status (if any)." (let ((ok (file-exists-p (cocci-file file 'ok))) (fail (file-exists-p (cocci-file file 'fail))) (res (file-exists-p (cocci-file file 'expected)))) (cond ((and ok fail) 'cocci-conflict) ; old .ok/.failed files lying around? (ok 'cocci-ok) ; found a .ok file (fail 'cocci-fail) ; found a .fail file (res 'cocci-update) ; found an expected result but no result (t 'cocci-unknown)))) ; file is not under cocci "control" (defun cocci-stale-result-file (file &optional src-file) (when (not src-file) (setq src-file (cocci-file file 'source))) (and (file-exists-p file) (or (file-newer-than-file-p cocci-current-cocci file) (file-newer-than-file-p src-file file)))) ;; Trying to abstract away from files (defun cocci-stale-result (file &optional result) "Determine if the result is stale." (let ((src-file (cocci-file file 'source))) (if result (cocci-stale-result-file (cocci-file file result) src-file) (or (cocci-stale-result-file (cocci-file file 'ok) src-file) (cocci-stale-result-file (cocci-file file 'fail) src-file))))) (defun cocci-dired-state-info (file) (cond ; a source (.c) file ((eq (cocci-file-type file) 'source) (let ((result) (status (cocci-result-status file))) (setq result (cond ((eq status 'cocci-ok) (if (cocci-stale-result file 'ok) "(ok?)" "(ok)")) ((eq status 'cocci-fail) (if (cocci-stale-result file 'fail) "(fail?)" "(fail)")) ((eq status 'cocci-conflict) "(ok/fail)") ((eq status 'cocci-update) "(update)") ((eq status 'cocci-unknown) "(unknown)") (t nil))) (substring (concat result " ") 0 10))) )) (defun cocci-dired-reformat-line (x) "Reformat a directory-listing line. Replace various columns with version control information. This code, like dired, assumes UNIX -l format." (beginning-of-line) (let ((pos (point)) limit perm date-and-file) (end-of-line) (setq limit (point)) (goto-char pos) (when (or (re-search-forward ;; owner and group "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)" limit t) (re-search-forward ;; only owner displayed "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)" limit t) (re-search-forward ;; OS/2 -l format, no links, owner, group "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)" limit t)) (setq perm (match-string 1) date-and-file (match-string 2)) (setq x (substring (concat x " ") 0 10)) (replace-match (concat perm x date-and-file))))) (defun cocci-dired-hook () "Reformat the listing according to version control. Called by dired after any portion of a cocci-dired buffer has been read in." (message "Getting status information... ") (let (subdir filename (buffer-read-only nil) cvs-dir) (goto-char (point-min)) (while (not (eobp)) (cond ;; subdir header line ((setq subdir (dired-get-subdir)) ;; if the backend supports it, get the state ;; of all files in this directory at once ; (let ((backend (vc-responsible-backend subdir))) ; (if (vc-find-backend-function backend 'dir-state) ; (vc-call-backend backend 'dir-state subdir))) (forward-line 1) ;; erase (but don't remove) the "total" line (delete-region (point) (line-end-position)) ;; Ugly hack to display the current cocci file. ;; Needed because of hardcoded dired regexps (when cocci-current-cocci (insert (concat (propertize " " 'display '((margin nil) " Current cocci file: ")) (propertize " " 'display `((margin nil) ,(file-name-nondirectory cocci-current-cocci)))))) (beginning-of-line) (forward-line 1)) ;; file line ((setq filename (dired-get-filename nil t)) (cond ;; subdir ((file-directory-p filename) (cond ((member (file-name-nondirectory filename) cocci-directory-exclusion-list) (let ((pos (point))) (dired-kill-tree filename) (goto-char pos) (dired-kill-line))) (cocci-dired-terse-mode ;; Don't show directories in terse mode. Don't use ;; dired-kill-line to remove it, because in recursive listings, ;; that would remove the directory contents as well. (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename)) (dired-kill-line)) (t (cocci-dired-reformat-line nil) (forward-line 1)))) ;; ordinary file ;; show only .c in terse mode ((or (and (eq (cocci-file-type filename) 'source) (equal (file-name-sans-versions filename) filename)) (not (and cocci-dired-terse-mode))) (cocci-dired-reformat-line (cocci-dired-state-info filename)) (forward-line 1)) (t (dired-kill-line)))) ;; any other line (t (forward-line 1)))) (cocci-dired-purge)) (message "Getting status information... done")) (defun cocci-dired-purge () "Remove empty subdirs." (let (subdir) (goto-char (point-min)) (while (setq subdir (dired-get-subdir)) (forward-line 2) (if (dired-get-filename nil t) (if (not (dired-next-subdir 1 t)) (goto-char (point-max))) (forward-line -2) (if (not (string= (dired-current-directory) default-directory)) (dired-do-kill-lines t "") ;; We cannot remove the top level directory. ;; Just make it look a little nicer. (forward-line 1) (kill-line) (if (not (dired-next-subdir 1 t)) (goto-char (point-max)))))) (goto-char (point-min)))) (defun cocci-dired-buffers-for-dir (dir) "Return a list of all cocci-dired buffers that currently display DIR." (let (result) ;; Check whether dired is loaded. (when (fboundp 'dired-buffers-for-dir) (mapcar (lambda (buffer) (with-current-buffer buffer (if cocci-dired-mode (setq result (append result (list buffer)))))) (dired-buffers-for-dir dir))) result)) (defun cocci-dired-resynch-file (file) "Update the entries for FILE in any Cocci Dired buffers that list it." (let ((buffers (cocci-dired-buffers-for-dir (file-name-directory file)))) (when buffers (mapcar (lambda (buffer) (with-current-buffer buffer (if (dired-goto-file file) ;; bind vc-dired-terse-mode to nil so that ;; files won't vanish when they are checked in (let ((cocci-dired-terse-mode nil)) (dired-do-redisplay 1))))) buffers)))) (defun cocci-directory (dir read-switches) "Create a buffer in Cocci Dired Mode for directory DIR. With prefix arg READ-SWITCHES, specify a value to override `dired-listing-switches' when generating the listing." (interactive "DDired under Cocci (directory): \nP") (let ((cocci-dired-switches (concat cocci-dired-listing-switches (if cocci-dired-recurse "R" "")))) (if read-switches (setq cocci-dired-switches (read-string "Dired listing switches: " cocci-dired-switches))) (require 'dired) (require 'dired-aux) (switch-to-buffer (dired-internal-noselect (expand-file-name (file-name-as-directory dir)) cocci-dired-switches 'cocci-dired-mode)))) ;-------------------------------------------------- ; Hook ;-------------------------------------------------- (define-key cocci-mode-map "\C-cd" 'cocci-directory) (add-hook 'cocci-mode-hook (lambda () (setq cocci-current-cocci (buffer-file-name)) (setq cocci-current-cocci-buffer (current-buffer)) (setq compile-command (cocci-makeok-cmd cocci-current-cocci)))) (provide 'cocci-ediff)coccinelle-1.0.0-rc19/editors/emacs/cocci.el0000644000175000017500000002572212247437436017543 0ustar eugeneugen;;; cocci.el --- a major mode for editing semantic patches ;; Copyright (C) 2010 Nicolas Palix ;; Copyright (C) 2006-2007 Yoann Padioleau ;; Please imagine a long and boring gnu-style copyright notice ;; appearing just here. ;; Emacs Lisp Archive Entry ;; Author: Padioleau Yoann , ;; Version: 0.2 ;; Keywords: coccinelle patch refactoring program transformation ;; URL: http://coccinelle.lip6.fr/ ;;; Usage ;; Copy this file in your ~/.emacs.d directory ;; ;; Add the following lines to your ~/.emacs or equivalent: ;; (load "~/.emacs.d/cocci.el") ;; (setq auto-mode-alist ;; (cons '("\\.cocci$" . cocci-mode) auto-mode-alist)) ;; (autoload 'cocci-mode "cocci" ;; "Major mode for editing cocci code." t) ;; ;; You can also use cocci-mode to edit the files containing the ;; isomorphisms with: ;; (setq auto-mode-alist ;; (cons '("\\.iso$" . cocci-mode) auto-mode-alist)) ;; ;;; History ;; 2010-04-02 Nico: Fix 'script' with 'depends on'. Add 'when forall', 'when any' ;; 2010-02-01 Nico: Add support for 'disable', 'using', scripting, 'virtual' rules ;; 2009-11-05 Nico: Cleanups, Change shortcut % to C-M-% (% is used in Python rule) ;; Some cleanups done by Rene Rydhof Hansen ;;; Utilities (defun join-sep (sep xs) (mapconcat 'identity xs sep)) ;;; Variables (defvar cocci-menu) ;; new (color) faces (defface cocci-number-face '((((background light)) (:foreground "black")) (((background dark)) (:foreground "yellow3"))) "Used for Cocci numbers") (defface cocci-punctuation-face '((((background light)) (:foreground "black")) (((background dark)) (:foreground "cyan"))) "Used for punctuation") (defface cocci-problem-face '((((background light)) (:background "deep pink")) (((background dark)) (:background "deep pink"))) "Highlighting potential problems") (defface cocci-special-face '((((background light)) (:foreground "blue")) (((background dark)) (:foreground "red"))) "") (defface cocci-rulename-face '((((background light)) (:foreground "DarkSlateGray")) (((background dark)) (:foreground "DarkSlateGray4"))) "Highlighting the rule names") (defface cocci-minus-face '((((background light)) (:foreground "red")) (((background dark)) (:foreground "SeaGreen3"))) "Highlighting lines to be removed") (defface cocci-plus-face '((((background light)) (:foreground "dark green")) (((background dark)) (:foreground "salmon"))) "Highlighting lines to be added") (defface cocci-match-face '((((background light)) (:foreground "violet red")) (((background dark)) (:foreground "purple"))) "Highlighting lines to be matched (sgrep)") (defface cocci-script-face '((((background light)) (:foreground "red")) (((background dark)) (:foreground "SeaGreen3"))) "Highlighting script language name") ;; can look in lexer_cocci.mll for new identifiers (defconst cocci-c-keywords-list '("if" "else" "while" "do" "for" "return" "sizeof" "struct" "union" "static" "extern" "const" "volatile" "break" "continue" "switch" "case" )) (defconst cocci-declaration-keywords-list '("identifier" "type" "parameter" "constant" "expression" "statement" "function" "local" "list" "fresh" "position" "idexpression" "context" "typedef" "declarer" "iterator" "pure" ;"error" "words" "char" "short" "int" "float" "double" "long" "void" "signed" "unsigned" )) (defconst cocci-iso-keywords-list '("Expression" "Statement" "Type" "Declaration" "TopLevel" "ArgExpression" )) (defconst c-preprocessor-directives-list '("define" "undef" "if" "ifdef" "elif" "else" "endif" "ifndef" "include" "error" "pragma" "file" "line" )) (setq cocci-font-lock-keywords `( ; For virtual rule declarations ("^[ \t]*\\(virtual\\)\\b\\(.*\\)" (1 'cocci-special-face) (2 'cocci-rulename-face) ) ; blink possible errors, when - or + is not in first column ("^[ \t]+[-+]" . 'cocci-problem-face) ; modifiers ("^\\??\\+.*" . 'cocci-plus-face) ("^\\??-.*" . 'cocci-minus-face) ("^\\*.*" . 'cocci-match-face) ;("^\\??\\+.*?//" . 'cocci-plus-face) ; ! \\+ ; --- +++ ; #cpp ("#\\(include\\) *\\(.*\\)" (1 'font-lock-builtin-face) (2 'font-lock-string-face) ) ; comments ("//.*" . 'font-lock-comment-face) ; strings ("\"[^\"]*\"" . 'font-lock-string-face) ; rule header ("@[ \t]*@" . 'cocci-special-face) ; this rule may seems redundant with the following one, but ; without it, @@ int x; @@ would color the int x with rulename-face. ; by using this rule, we color the @@ and so prevent the ; next rule to be applied (cf font-lock semantic when have not the ; OVERRIDE flag). ("\\(@\\)\\(.*\\)\\(@\\)" (1 'cocci-special-face) (2 'cocci-rulename-face) (3 'cocci-special-face) ) ("@.*\\b\\(extends\\|\\(depends[ \t]*on\\)\\)\\b.*@" (1 'cocci-special-face t)) ("@.*\\b\\(disable\\)\\b.*@" (1 'cocci-special-face t)) ("@.*\\b\\(using\\)\\b.*@" (1 'cocci-special-face t)) ("@.*\\b\\(initialize\\)[ \t]*:[ \t]*\\(.*\\)[ \t]*@" (1 'cocci-special-face t) (2 'cocci-script-face t) ) ("@.*\\b\\(script\\)[ \t]*:[ \t]*\\([^ ]*\\)[ \t]*.*@" (1 'cocci-special-face t) (2 'cocci-script-face t) ) ("@.*\\b\\(finalize\\)[ \t]*:[ \t]*\\(.*\\)[ \t]*@" (1 'cocci-special-face t) (2 'cocci-script-face t) ) ;old: does not work, not easy to handle the rule1, rule2, rule3 list. ; ("@[ \t]*\\(\\(\\w+\\)[ \t,]*\\)*[ \t]*@" ; ("\\(@\\)[ \t]*\\(\\w+\\)[ \t]*\\(@\\)" ; ("\\(@\\)[ \t]*\\(\\w+\\)[ \t]+\\(extends\\)[ \t]+\\(\\w+\\)[ \t]*\\(@\\)" ; ("\\(@\\)[ \t]*\\(\\w+\\)[ \t]+\\(depends\\)[ \t]+\\(on\\)[ \t]+\\(\\(\\w+\\)[ ,\t]*\\)+\\(@\\)" ; inherited variable, fontifying rulename (,(concat "^" "\\b\\(" (regexp-opt cocci-declaration-keywords-list) "\\)\\b" ".*?\\(\\w+\\)\\.") (2 'cocci-rulename-face)) ;rule1.T *a; ("^\\(\\w+\\)\\." (1 'cocci-rulename-face)) ; just for pad, metavariables in maj ("\\b[A-Z][0-9]?\\b" . font-lock-variable-name-face) ; todo: do also for other variable, do as in font-lock.el ; with font-lock-match-c-style-declaration-item-and-skip-to-next ; special cocci operators ("\\.\\.\\." . 'font-lock-keyword-face) ("^[()|]" . 'font-lock-keyword-face) ; escaped version of cocci operators ("\\\\[()|]" . 'font-lock-keyword-face) ("\\bwhen[ \t]+!=" . 'font-lock-keyword-face) ("\\bWHEN[ \t]+!=" . 'font-lock-keyword-face) ("\\bwhen[ \t]+=" . 'font-lock-keyword-face) ("\\bWHEN[ \t]+=" . 'font-lock-keyword-face) ("\\bwhen[ \t]+forall" . 'font-lock-keyword-face) ("\\bWHEN[ \t]+forall" . 'font-lock-keyword-face) ("\\bwhen[ \t]+any" . 'font-lock-keyword-face) ("\\bWHEN[ \t]+any" . 'font-lock-keyword-face) ; used in iso files ("<=>" . 'font-lock-keyword-face) ("=>" . 'font-lock-keyword-face) (,(concat "\\b\\(" (regexp-opt cocci-iso-keywords-list) "\\)\\b") . 'cocci-special-face) ("\\<[0-9]+\\>" . 'cocci-number-face) (,(join-sep "\\|" (list "(" ")" ";" "," "{" "}" "\\[" "\\]")) . 'cocci-punctuation-face) ; . -> * + etc ; c keywords (,(concat "\\b\\(" (regexp-opt cocci-c-keywords-list) "\\)\\b") . 'font-lock-keyword-face) ; cocci declaration keywords (,(concat "\\b\\(" (regexp-opt cocci-declaration-keywords-list) "\\)\\b") . 'font-lock-type-face) ; cpp directives (,(concat "^#[ \t]*\\(" (regexp-opt c-preprocessor-directives-list) "\\)\\>[ \t!]*\\(\\sw+\\)?") (1 'font-lock-builtin-face)) )) ; "Expressions to highlight in cocci-mode.") ;; define a mode-specific abbrev table for those who use such things (defvar cocci-mode-abbrev-table nil "Abbrev table used while in cocci mode.") (define-abbrev-table 'cocci-mode-abbrev-table nil) (defvar cocci-mode-map nil "Keymap used in `cocci-mode'.") (unless cocci-mode-map (setq cocci-mode-map (make-sparse-keymap)) (define-key cocci-mode-map [(meta control *)] 'switch-between-cocci-c) (define-key cocci-mode-map "%" 'cocci-replace-modifiers) ;(define-key cocci-mode-map "\C-c" 'compile) ) (defvar cocci-mode-syntax-table nil "Syntax table used while in cocci mode.") (unless cocci-mode-syntax-table (setq cocci-mode-syntax-table (make-syntax-table)) ; _ is part of a word. (modify-syntax-entry ?\_ "w" cocci-mode-syntax-table) ; change mode for ", bad interaction with font-lock (modify-syntax-entry ?\" "w" cocci-mode-syntax-table) ) ;;; Code ;; helper functions for the cocci programmer (defun cocci-replace-modifiers (beg end str) "TODO" (interactive (let ((str (read-string "New modifier string (+, -, space): " nil 'my-history))) (list (region-beginning) (region-end) str))) ;(interactive "rsNew modifier string (+, -, space): ") (replace-regexp "^[-+]?" str nil beg end) ) ;Used internally while developping coccinelle. ;Allow to switch between the corresponding SP and C file. ;todo: handle the _verxxx naming convention. (defun switch-between-cocci-c () (interactive) (let ((target (cond ((string-match ".c$" (buffer-name)) (replace-match ".cocci" t t (buffer-name))) ((string-match ".cocci$" (buffer-name)) (replace-match ".c" t t (buffer-name))) (t "none")))) (if (get-buffer target) (switch-to-buffer target) (find-file (read-file-name "file: " nil nil t target))))) (eval-after-load "cc-mode" '(progn (define-key c-mode-map [(meta control *)] 'switch-between-cocci-c)) ) (defvar cocci-mode-hook nil "Hook called by `cocci-mode'") ;;;###autoload (defun cocci-mode () "Major mode for editing cocci code. Special commands: \\{cocci-mode-map} Turning on cocci-mode runs the hook `cocci-mode-hook'." (interactive) (kill-all-local-variables) (make-local-variable 'font-lock-defaults) (make-local-variable 'comment-start) (make-local-variable 'comment-end) (make-local-variable 'compile-command) (use-local-map cocci-mode-map) (set-syntax-table cocci-mode-syntax-table) (setq mode-name "cocci" major-mode 'cocci-mode local-abbrev-table cocci-mode-abbrev-table font-lock-defaults '(cocci-font-lock-keywords) comment-start "//" comment-end "" ) (easy-menu-add cocci-menu) (run-hooks 'cocci-mode-hook) ) ;; Menu (easy-menu-define cocci-menu cocci-mode-map "Cocci menu" '("Cocci" ["Switch to corresponding C file" switch-between-cocci-c t] ["Replace modifiers" cocci-replace-modifiers t] )) ; put cursor before a parse error coccinelle message and it will ; open the corresponding file and go to corresponding line. (fset 'cocci-goto-next-error [?\C-s ?F ?i ?l ?e right right ?\C- ?\C-s ?" left ?\M-w ?\C-x ?\C-f S-insert return ?\C-\M-l C-right right C-S-right C-insert ?\C-\M-l ?\M-g S-insert return]) ;" ;; Provide (provide 'cocci-mode) ;;; cocci.el ends here coccinelle-1.0.0-rc19/editors/vim/0000755000175000017500000000000012247437436015634 5ustar eugeneugencoccinelle-1.0.0-rc19/editors/vim/README0000644000175000017500000000060012247437436016510 0ustar eugeneugenREADME for cocci-syntax ======================= Syntax highlighting for Coccinelle's cocci files for vim. Releases are available from http://dev.exherbo.org/~ahf/pub/software/releases/cocci-syntax/ and a Git repository is available at git://github.com/ahf/cocci-syntax.git Feel free to submit patches :) Alexander Færøy .. vim: set spell spelllang=en tw=80 : .. coccinelle-1.0.0-rc19/editors/vim/ftdetect/0000755000175000017500000000000012247437436017436 5ustar eugeneugencoccinelle-1.0.0-rc19/editors/vim/ftdetect/cocci.vim0000644000175000017500000000055712247437436021242 0ustar eugeneugen" Vim filetype detection file " Language: Cocci (SmPL) " Author: Alexander Færøy " Copyright: Copyright (c) 2009-2010 Alexander Færøy " License: You may redistribute this under the same terms as Vim itself. if &compatible || v:version < 603 finish endif au BufNewFile,BufRead *.cocci set filetype=cocci " vim: set et ts=4 : coccinelle-1.0.0-rc19/editors/vim/syntax/0000755000175000017500000000000012247437436017162 5ustar eugeneugencoccinelle-1.0.0-rc19/editors/vim/syntax/cocci.vim0000644000175000017500000000234012247437436020756 0ustar eugeneugen" Vim syntax file " Language: Cocci (SmPL) " Author: Alexander Færøy " Copyright: Copyright (c) 2009-2010 Alexander Færøy " License: You may redistribute this under the same terms as Vim itself. if &compatible || v:version < 603 || exists("b:current_syntax") finish endif " Keywords syn keyword CocciKeywords identifier type parameter constant expression contained syn keyword CocciKeywords statement function local list fresh position idexpression contained syn region CocciGroup matchgroup=CocciGroupDelim start="@[^@]*@" end="@@" contains=CocciKeywords syn match CocciLineRemoved "^-.*" syn match CocciLineAdded "^+.*" syn match CocciComment "//.*" syn case ignore syn match CocciOperator "\.\.\." syn match CocciOperator "when" syn case match " Errors syn match CocciError "^[ \t][+-].*" " Highlight! hi def link CocciLineRemoved Special hi def link CocciLineAdded Identifier hi def link CocciError Error hi def link CocciKeywords Keyword hi def link CocciGroupDelim PreProc hi def link CocciComment Comment hi def link CocciOperator Operator let b:current_syntax = "cocci" " vim: set et ts=4 : coccinelle-1.0.0-rc19/env.csh0000644000175000017500000000040412247437436014655 0ustar eugeneugenecho setting COCCINELLE_HOME setenv COCCINELLE_HOME `pwd` echo setting LD_LIBRARY_PATH setenv LD_LIBRARY_PATH $COCCINELLE_HOME:$LD_LIBRARY_PATH echo setting PYTHONPATH setenv PYTHONPATH $COCCINELLE_HOME/python:$PYTHONPATH setenv PATH $COCCINELLE_HOME:$PATH coccinelle-1.0.0-rc19/_tags0000644000175000017500000000660412247437436014416 0ustar eugeneugen# Compile all .ml files against some base libraries # (defined in the plugin as unix,str,nums and bigarray) <**/*.ml>: use_base # # Cocci sources and directories # : include : include : include : include : use_pcre : include : use_menhirLib, nowarn20 : include : include : include : include : include : include : use_pcre : include : thread, use_pycaml # some users have a symlink 'result' pointing to the outcome # of the build, which causes troubles with the hygiene check. : -traverse # # Subdirectories # : use_pcre : use_pcre : use_pcre : use_pcre : use_pcre, use_menhirLib : use_pcre : use_pcre, use_pycaml # # Bundled packages # # apriori remove the traverse tag from the bundle # directories to prevent them from being included. # The traverse tag will be added by the plugin for # the bundles that are included. : -traverse : use_pcre : thread, use_pycaml # Interaction between the bundles and the plugin. : use_pcre : use_pcre : use_pycaml : pp_pycaml, use_pycaml : pp_pycaml : for-pack(MenhirLib) # # Hygiene # # Some lexers and parsers are precompiled in the # source distribution to make some preprocessors # optional : not_hygienic : not_hygienic : not_hygienic : not_hygienic : not_hygienic : not_hygienic : precious : not_hygienic # # Applications # Main is the entry point of spatch. # # library dependencies of spatch. : thread, use_base, use_menhirLib, use_pcre, use_pycaml # some test tools in the subdirectories : use_base, use_pcre : use_base # Build tools/all.otarget for all tools, or # tools/all.opt.otarget for all tools with the native compiler. : use_base : use_base : use_base : use_base : use_base : use_base : use_base : use_base : use_base, use_pcre : use_base # # Documentation # : gen_man, use_menhirLib, use_pcre, use_pycaml : gen_html, use_menhirLib, use_pcre, use_pycaml coccinelle-1.0.0-rc19/bugs.txt0000644000175000017500000000017012247437436015067 0ustar eugeneugenSend a mail to cocci@systeme.lip6.fr, or julia.lawall@lip6.fr with [bug-cocci] as a prefix in the subject of your mail. coccinelle-1.0.0-rc19/env.sh0000644000175000017500000000271612247437436014522 0ustar eugeneugen# I put both stuff useful for the user and developer in this file. Could # separate and have a env-user.sh, env-compile.sh, env-developer.sh, # but it's not worth it. #!!!!You need to source me with "source env.sh" from the good directory!!!! # 14 Aug 2009 Try directory we were executed from if [ "$1" ] ; then DIR=$1 else DIR=`pwd` fi if [ ! -r $DIR/standard.iso ] then echo "standard.iso not found in '$DIR' trying `dirname $0`" DIR=`dirname $0` fi if [ ! -r $DIR/standard.iso ] then echo "standard.iso not found in '$DIR'. Give the coccinelle directory as the first argument. "; else ############################################################################## # Compile ############################################################################## ############################################################################## # Run ############################################################################## # To find the data/ files such as the default standard.h file. # Cf also globals/config.ml echo setting COCCINELLE_HOME=$DIR COCCINELLE_HOME=$DIR ; export COCCINELLE_HOME # To find pycaml dynamic library echo adding $COCCINELLE_HOME to LD_LIBRARY_PATH LD_LIBRARY_PATH=$COCCINELLE_HOME:$LD_LIBRARY_PATH ; export LD_LIBRARY_PATH # To find .py files like the one in python/coccib echo adding $COCCINELLE_HOME/python to PYTHONPATH PYTHONPATH=$COCCINELLE_HOME/python:$PYTHONPATH ; export PYTHONPATH fi export PATH=$COCCINELLE_HOME:$PATH coccinelle-1.0.0-rc19/scripts/0000755000175000017500000000000012247442646015056 5ustar eugeneugencoccinelle-1.0.0-rc19/scripts/extractor_README.pl0000755000175000017500000000511112247442616020441 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl use strict; my $ok = 0; #ok+spatch-ok my $wrong = 0; #Error, file level my $fail = 0; my $unknown = 0; my $nbfiles = 0; my $bugfix = 0; # site level ? my $wrongsites = 0; # Error, site level my $SP = ""; while(<>) { if(/\[status\]/) { $nbfiles++; } if(/\[status\]\s*(spatch-ok|ok)\b/) { $ok++; } if(/\[status\]\s*(wrong)\b/) { $wrong++; } if(/\[status\]\s*(fail)\b/) { $fail++; } if(/\[status\]\s*(UNKNOWN)\b/) { $unknown++; } if(/Cocci\s+file\s*:\s*(\w+.cocci)/) { $SP = $1; } } my $pourcentcorrect = ($ok * 100.0) / $nbfiles; print "----------------------------------------\n"; print "!!Total files = $nbfiles\n"; print " Correct number = $ok\n"; printf "!!Correct = %3.1f\%\n", $pourcentcorrect; print "!!Error = $wrong\n"; print "!!Bugfix (sites) = $bugfix\n"; my $sizeSP = `cat $SP | perl -p -e "s/\\/\\/.*//g;" | grep -v '^[ \t]*\$' | wc -l`; chomp $sizeSP; print "!!Size SP = $sizeSP\n"; my $gitinfo = `ls *.gitinfo`; chomp $gitinfo; print " gitinfo files = $gitinfo\n"; my $sizeP = `cat *.gitinfo | wc -l`; chomp $sizeP; print " Size P = $sizeP\n"; my $ratioSPvsP = ($sizeSP * 100.0) / $sizeP; printf "!!Ratio SP vs P = %3.1f\%\n", $ratioSPvsP; my $ratioPvsSP = $sizeP / $sizeSP; printf "!!Ratio SP vs P = %3.1f\n", $ratioPvsSP; my $totalstatus = $ok + $fail + $wrong + $unknown; print "----------------------------------------------------------------\n"; print "Sanity checks: nb files = $nbfiles, total status = $totalstatus\n"; print "NB UNKNOWNS = $unknown\n" if $unknown > 0; coccinelle-1.0.0-rc19/scripts/extractor.awk0000755000175000017500000000506112247437436017603 0ustar eugeneugen#!/usr/bin/awk -f # # Extracting time statistics from .failed/.ok files # BEGIN { no_of_files = 0; max_running_time = 0.0; max_running_file = ""; min_running_time = 100000.0; min_running_file = ""; sum_running_time = 0.0; min_file_size_lines = 0; max_file_size_lines = 0; tot_file_size_lines = 0; min_file_size_bytes = 0; max_file_size_bytes = 0; tot_file_size_bytes = 0; } /real[ \t]+[0-9]+m[0-9]+[.][0-9]+/{ # The file currently processed current_file = FILENAME; # Count the number of files no_of_files++; # Parse time field split($2,timearr,/[m.]/); current_time = timearr[1] * 60.0; # minutes current_time += timearr[2]; # seconds current_time += timearr[3] / 1000.0; # 1/1000th sec. # Print progress printf "%6.3fs (%s)\n", current_time, current_file; # Update total time sum_running_time += current_time; # Update max and min if(current_time > max_running_time) { max_running_time = current_time; max_running_file = current_file; } if(current_time < min_running_time) { min_running_time = current_time; min_running_file = current_file; } # Find corresponding .c file gsub(/.(ok|failed|spatch_ok|gave_up)$/,".c",current_file); # Update file sizes (in lines) ("wc -l " current_file) | getline; current_size_lines = $1; tot_file_size_lines += current_size_lines; if(current_size_lines > max_file_size_lines) { max_file_size_lines = current_size_lines; } if(current_size_lines < min_file_size_lines) { min_file_size_lines = current_size_lines; } # Update file sizes (in bytes) ("du " current_file) | getline; current_size_bytes = $1; tot_file_size_bytes += current_size_bytes; if(current_size_bytes > max_file_size_bytes) { max_file_size_lines = current_size_bytes; } if(current_size_bytes < min_file_size_bytes) { min_file_size_bytes = current_size_bytes; } } END { printf "!!No. of files : %6d\n", no_of_files; printf " Total # of lines: %6d\n", tot_file_size_lines; printf "!!Avg. # of lines : %9.2f\n", (tot_file_size_lines / no_of_files); printf " Total size (KB) : %6d\n", tot_file_size_bytes; printf " Avg. size (KB) : %9.2f\n", (tot_file_size_bytes / no_of_files); printf " Minimum time : %9.2fs (%s)\n", min_running_time, min_running_file; printf "!!Maximum time : %9.2fs (%s)\n", max_running_time, max_running_file; printf " Total time : %9.2fs\n", sum_running_time; printf "!!Average time : %9.2fs\n", (sum_running_time / no_of_files); } coccinelle-1.0.0-rc19/scripts/gather_failed.pl0000755000175000017500000000237712247442616020202 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl # usage: gather_failed.pl **/*.failed > /tmp/big.failed print "-*- mode: outline; -*-\n"; map { print "* FAILED FILE: $_\n"; print "\n"; system("cat $_"); } @ARGV; coccinelle-1.0.0-rc19/scripts/glimpseindex_cocci.sh0000755000175000017500000000010212247437436021237 0ustar eugeneugen#! /bin/sh find `pwd`/* -name "*.[ch]" | glimpseindex -o -H . -F coccinelle-1.0.0-rc19/scripts/spatch.bash_completion0000644000175000017500000000623212247437436021434 0ustar eugeneugen# Copyright: (C) 2010 Nicolas Palix, DIKU. GPLv2. # Copyright: (C) 2010 Julia Lawall, DIKU. GPLv2. # Copyright: (C) 2010 Gilles Muller, INRIA/LiP6. GPLv2. # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. # # http://coccinelle.lip6.fr/ # From bash completion of git: __gitcomp_1 __spatchcomp_1 () { local c IFS=' '$'\t'$'\n' for c in $1; do case "$c" in -*) printf %s$'\n' "$c " ;; */) printf %s$'\n' "$c" ;; *) printf %s$'\n' "$c " ;; esac done } have spatch && _spatch() { local cur prev xspec COMPREPLY=() cur=${COMP_WORDS[COMP_CWORD]} prev=${COMP_WORDS[COMP_CWORD-1]} _spatch_options="--parse-cocci --sp-file -I --dir --patch --iso-file --macro-file --macro-file-builtins --in-place --out-place -h --help --shorthelp --longhelp -o --ignore-unknown-options --use-glimpse --use-google --use-idutils --include-headers --no-includes --all-includes --local-includes --preprocess --quiet --very-quiet --debug --timeout --test" if [[ $COMP_CWORD -eq 1 ]]; then local IFS=$'\n' COMPREPLY=( $(compgen -W "$(__spatchcomp_1 "${_spatch_options}")" -- $cur) ) return 0 fi case "$prev" in --parse-cocci|--sp-file) xspec="!*.cocci" ;; --iso-file) xspec="!*.iso" ;; --macro-file|--macro-file-builtins) xspec="!*.h" ;; -I|--dir|--patch) xspec="" ;; *) xspec="!*.c" ;; esac if [[ "$xspec" == "" ]]; then COMPREPLY=( $( compgen -d -o nospace -S '/' -- "$cur" ) ) elif [[ "$cur" == -* ]]; then local IFS=$'\n' COMPREPLY=( $(compgen -W "$(__spatchcomp_1 "${_spatch_options}")" -- $cur) ) elif [[ "$xspec" == "!*.c" ]]; then COMPREPLY=( $( compgen -f -X "$xspec" -- "$cur" ) \ $( compgen -d -o nospace -S '/' -- "$cur" ) ) else COMPREPLY=( $( compgen -f -X "$xspec" -- "$cur" ) \ $( compgen -d -o nospace -S '/' -- "$cur" ) ) fi return 0 } complete -F _spatch -o bashdefault -o default -o nospace spatch \ || complete -F _spatch -o default -o nospace spatch complete -F _spatch -o bashdefault -o default -o nospace spatch.opt \ || complete -F _spatch -o default -o nospace spatch.opt # Local variables: # mode: shell-script # sh-basic-offset: 4 # indent-tabs-mode: nil # End: # ex: ts=4 sw=4 et filetype=sh coccinelle-1.0.0-rc19/scripts/idutils_index.sh0000755000175000017500000000006012247437436020256 0ustar eugeneugen#!/bin/sh mkid -i C --output .id-utils.index * coccinelle-1.0.0-rc19/scripts/stat_directories.pl0000755000175000017500000000416512247442616020770 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl #usage: # cd tests-big; # ~/coccinelle/scripts/stat_directories.pl bluetooth/* rules/* megas/* printf "%-20s %10s %10s %4s\n", "dir/", "failed" , "total", "%ok"; print "------------------------------------------------------\n"; $totalfailed = 0; $total = 0; foreach my $dir (@ARGV) { if(-e "$dir/") { my ($ok) = `find $dir -name "*.c.*ok" | wc -l`; # my ($ok) = `find $dir -name "*ok" | wc -l`; chomp $ok; my ($failed) = `find $dir -name "*.c.failed" | wc -l`; # my ($failed) = `find $dir -name "*failed" | wc -l`; chomp $failed; $totalfailed += $failed; my $sum = $failed + $ok; $total += $sum; if ($sum == 0) { print "$dir/ have 0 sum\n"; } else { my $pourcent = ($ok * 100.0) / ($sum); printf "%-20s %10d %10d %5.1f%%\n", "$dir/", $failed, $sum, $pourcent; } } } my $pourcent = (($total - $totalfailed) * 100.0) / ($total); print "------------------------------------------------------\n"; printf "total failed = %10d / %10d % 3.1f%%\n", $totalfailed, $total, $pourcent; coccinelle-1.0.0-rc19/scripts/extract_examples.pl0000755000175000017500000000301212247442616020757 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl #usage: ./extract_examples.pl ~/week-end/working-documents/examples.tex my $ex = 0; my $are_in = 0; while(<>) { if(/\\section{/) { $ex++; open TMP, ">$ex.cocci" or die "$!"; } if(/begin{verbatim}/) { $are_in = 1; #old: open TMP, ">$ex.cocci" or die "$!"; } elsif(/end{verbatim}/) { $are_in = 0; #old: $ex++; } else { if($are_in) { print TMP "$_"; } } } coccinelle-1.0.0-rc19/scripts/stat_directories_complete.pl0000755000175000017500000000313012247442616022647 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl #usage: if(@ARGV < 1) { die "usage: stat_directories_complete.pl [M|C|B]";} my $kind = "$ARGV[0]"; my $subdirs = `make subdirs`; #my $subdirs = "rule9"; #my $subdirs = "rule1"; chomp $subdirs; @subdirs = split /\s+/, $subdirs; my $i = 0; foreach my $dir (@subdirs) { if(-e "$dir/") { #print "RULE: $dir\n"; my ($s) = `cd $dir; ~/coccinelle/scripts/stat_directory_complete.pl | grep $kind:`; chomp $s; $i++; #print "M$i.$s\n"; $s =~ s/$kind:/$kind$i./; print "$s\n"; } } coccinelle-1.0.0-rc19/scripts/coccicheck/0000755000175000017500000000000012247437436017135 5ustar eugeneugencoccinelle-1.0.0-rc19/scripts/coccicheck/README0000644000175000017500000000301612247437436020015 0ustar eugeneugen Coccicheck version 0.2.4 -*- Usage -*- 1) ./configure mode This will setup some default directories. Check in Makefile if they suit you! mode is either org or diff, depending on whether you want the output in Emacs org mode, or in diff format where - indicates not something to remove but an item of interest. NB: The project directory must currently be an absolute path. On bash, you can overwrite the default flags on the command line: SPFLAGS="-I my_include -timeout 30" ./configure mode 2) make update This will create the `results` directory. It will contain all the files needed to apply the SmPL files to your project. 3) make [-jX] (where X is the number of cores to use) This will apply all the SmPL files found in the `cocci` directory to your project (as previously defined). When it's done, you will get some "out" and "log" files in the `results` directory. "out" files will contain the output generated by the SmPL files, and the "log" files will contain the execution trace of spatch. If you edit/add some SmPL files in `cocci` directory, you can use `make checkcocci` to parse them and see if there is any error. Once the results are computed, you can either: - run `make viewres` to view all the bug reports - run `make viewlog` to view the complete execution trace - run `make viewfilteredlog` to only view unlikely errors of the trace Note that this filter will remove some error messages about timeout, parsing ... Check Makefile to see the exact list. coccinelle-1.0.0-rc19/scripts/coccicheck/configure0000755000175000017500000000541212247437436021046 0ustar eugeneugen#!/bin/bash MODE=$1 PROJECT=$2 if [ "$MODE" == "" -o "$PROJECT" == "" ]; then echo -e "\n\tUsage: $0 mode path\n" echo -e "\tmode\torg or diff according to your needs" echo -e "\tpath\tyour project path\n" exit 1 fi SPATCHVER=`spatch -version 2>&1 | sed "s|spatch version \([^ ]*\) .*|\1|"` WITHPYTHON=`spatch -version 2>&1 | sed "s|spatch version \([^ ]*\) with Python support|yes|"` WITHPYTHON=`echo $WITHPYTHON | sed "s|spatch version \([^ ]*\) without Python support||"` echo "Using spatch version $SPATCHVER" #TODO: Add version check if [ "$WITHPYTHON" ] ; then echo "Your version has been build with Python support" else echo "Your version has no Python support" if [ "org" == "$MODE" ] ; then echo "org mode requires Python support." exit 1 fi fi echo echo "Using PREFIX="${PREFIX:=`pwd`} echo "Using PROJECT="${PROJECT:=$PREFIX/project} echo "Using COCCI="${COCCI:=$PREFIX/cocci} echo "Using RESULTS="${RESULTS:=$PREFIX/results} if [ "`which glimpse`" ]; then FLAGS=${SPFLAGS:="-timeout 60 -use_glimpse"} else FLAGS=${SPFLAGS:="-timeout 60"} fi SPFLAGS="$FLAGS -D $MODE" echo "Using SPFLAGS="$SPFLAGS echo -e "\nFor efficiency, run \`/scripts/glimpseindex_cocci.sh\`" echo -e "in $PROJECT" echo -e "NB: glimpse is available at http://webglimpse.net/ but it is not under the GPL.\n" cat > Makefile < /dev/null ; done clean: find \$(RESULTS) -name "*.out" -delete find \$(RESULTS) -name "*.log" -delete distclean: rm -rf \$(RESULTS) maintclean: distclean rm Makefile depend: update EOF coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/0000755000175000017500000000000012247437436020215 5ustar eugeneugencoccinelle-1.0.0-rc19/scripts/coccicheck/cocci/find_unsigned.cocci0000644000175000017500000000072612247437436024040 0ustar eugeneugen// A variable that is declared as unsigned should not be tested to be less than // zero. // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/find_unsigned.html // Options: -all_includes virtual org,diff @u@ type T; unsigned T i; position p; @@ i@p < 0 @script:python depends on org@ p << u.p; @@ cocci.print_main("",p) @depends on diff@ expression i; position u.p; @@ *i@p coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/unused.cocci0000644000175000017500000000116612247437436022526 0ustar eugeneugen// A variable is only initialized to a constant and is never used otherwise // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/unused.html // Options: virtual org,diff @e@ identifier i; position p; type T; @@ extern T i@p; @v forall@ type T; identifier i; constant C; position p1 != e.p; position p2; @@ T i@p1; <+... when != i i@p2 = C; ...+> @script:python depends on org@ p1 << v.p1; p2 << v.p2; @@ cocci.print_main("",p1) cocci.print_secs("",p2) @depends on diff exists@ identifier i; position v.p1, v.p2; @@ *i@p1 ... *i@p2 coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/malloc.cocci0000644000175000017500000000144512247437436022472 0ustar eugeneugen// // malloc 7 // // virtual diff, org @r exists@ local idexpression x; statement S; expression E; identifier f,l; position p1,p2,p3; expression *ptr != NULL; @@ ( if ((x@p1 = malloc(...)) == NULL) S | x@p1 = malloc(...); ... if (x == NULL) S ) <... when != x when != if (...) { <+...x...+> } ( goto@p3 l; | x->f = E ) ...> ( return \(0\|<+...x...+>\|ptr\); | return@p2 ...; ) @script:python depends on org@ p1 << r.p1; p2 << r.p2; p3 << r.p3; @@ cocci.print_main("",p1) cocci.print_secs("", p2) cocci.print_secs("goto", p3) cocci.include_match(False) @script:python depends on org@ p1 << r.p1; p2 << r.p2; @@ cocci.print_main("",p1) cocci.print_secs("", p2) @with_goto depends on diff@ expression x; identifier l; position r.p1, r.p2, r.p3; @@ *x@p1 <... *goto@p3 l; ...> *return@p2 ...; coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/kmalloc7.cocci0000644000175000017500000000152312247437436022731 0ustar eugeneugen// // kmalloc 7 // // virtual org,diff @r exists@ local idexpression x; statement S; expression E; identifier f,l; position p1,p2,p3; expression *ptr != NULL; @@ ( if ((x@p1 = \(kmalloc\|kzalloc\|kcalloc\)(...)) == NULL) S | x@p1 = \(kmalloc\|kzalloc\|kcalloc\)(...); ... if (x == NULL) S ) <... when != x when != if (...) { <+...x...+> } ( goto@p3 l; | x->f = E ) ...> ( return \(0\|<+...x...+>\|ptr\); | return@p2 ...; ) @script:python depends on org@ p1 << r.p1; p2 << r.p2; p3 << r.p3; @@ cocci.print_main("",p1) cocci.print_secs("", p2) cocci.print_secs("goto", p3) cocci.include_match(False) @script:python depends on org@ p1 << r.p1; p2 << r.p2; @@ cocci.print_main("",p1) cocci.print_secs("", p2) @with_goto depends on diff@ expression x; identifier l; position r.p1, r.p2, r.p3; @@ *x@p1 <... *goto@p3 l; ...> *return@p2 ...; coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/noderef2.cocci0000644000175000017500000000075412247437436022731 0ustar eugeneugen// // sizeof argument must be return the size of the // data, no the size of the pointer to it. // virtual org, patch, diff @ depends on patch && !org && !diff@ type T; T *x; expression E; @@ memset(x, E, sizeof( + * x)) @ depends on !patch && !org && diff@ type T; T *x; expression E; @@ *memset(x, E, sizeof(x)) @r depends on !patch && org && !diff@ type T; T *x; expression E; position p; @@ memset(x, E, sizeof(x@p)) @script:python@ x << r.x; p << r.p; @@ cocci.print_main(x, p)coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/noderef.cocci0000644000175000017500000000076612247437436022652 0ustar eugeneugen// // sizeof argument must be return the size of the // data, no the size of the pointer to it. // virtual org, patch, diff @ depends on patch && !org && !diff expression@ expression *x; @@ x = <+... -sizeof(x) +sizeof(*x) ...+> @ depends on !patch && !org && diff expression@ expression *x; @@ x = <+... *sizeof(x) ...+> @r depends on !patch && org && !diff expression @ expression *x; position p; @@ x = <+... sizeof(x@p) ...+> @script:python@ x << r.x; p << r.p; @@ cocci.print_main(x, p)coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/isnull.cocci0000644000175000017500000000125012247437436022523 0ustar eugeneugen// Dereference of an expression that has been checked to be NULL // // Confidence: Moderate // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/isnull.html // Options: virtual org,diff @r exists@ expression E, E1; identifier f; statement S1,S2,S3; position p; iterator iter; @@ if (E == NULL) { ... when != if (E == NULL && ...) S1 else S2 when != if (E == NULL || ...) S1 else S2 when != iter(E,...) S1 when != E = E1 E@p->f ... when any return ...; } else S3 @script:python depends on org@ p << r.p; @@ cocci.print_main("",p) @depends on diff@ expression E; position r.p; @@ * E@p coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/notand.h0000644000175000017500000005603212247437436021657 0ustar eugeneugen// **************************************************************************** // Prelude, this file is used with -macro_file_builtins option of the C parser // **************************************************************************** /* This file contains: * - macros found in <.h> * - macros found in ".h" * but where we cannot detect that it will be a "bad macro" * - hints, cf below. * * A "bad macro" is a macro using free variables or when expanded * that influence the control-flow of the code. In those cases it * is preferable to expand the macro so that the coccinelle engine * has a more accurate representation of what is going on. * * * * * old: this file was also containing what is below but now we * try to expand on demand the macro found in the c file, so those cases * are not needed any more: * - macros found in .c; macros that cannot be parsed. * In the future should be autodetected * (not so easy to do same for macros in .h cos require to access .h file) * - macros found in .c; macros correctly parsed * but where we cannot detect that it will be a "bad macro" * * Some of those macros could be deleted and the C code rewritten because * they are "bad" macros. * * todo? perhaps better if could enable/disable some of those expansions * as different software may use conflicting macros. * * * can maybe have a look in sparse/lib.c to see a list of default #define * handled builtin apparently by gcc. */ // **************************************************************************** // Hints // **************************************************************************** /* Cooperation with parsing_hack.ml: some body of macros in this file, such * as MACROSTATEMENT, are considered as magic strings. * I can't just expand those macros into some 'whatever();' because I need * to generate a TMacroStmt for solving some ambiguities in the grammar * for the toplevel stuff I think. * Right now a set of special strings are used as "hints" to the parser * to help it parse code. Those hints are specified in parsing_hack.ml: * * - YACFE_ITERATOR * - YACFE_DECLARATOR * - YACFE_STRING * - YACFE_STATEMENT, or MACROSTATEMENT * - YACFE_ATTRIBUTE * - YACFE_IDENT_BUILDER */ // **************************************************************************** // Test macros // **************************************************************************** // #define FOO(a, OP, b) a OP b // #define FOO(a,b) fn(a,b) #define FOO_METH_TEST(a) YACFE_IDENT_BUILDER //#define FOO YACFE_DECLARATOR // **************************************************************************** // Generic macros // **************************************************************************** // **************************************************************************** // Yacc macros // **************************************************************************** #define YY_PROTO(x) x #define yyconst const // **************************************************************************** // GNU Hello macros // **************************************************************************** #define __getopt_argv_const const // **************************************************************************** // Gcc (as in the source of gcc code) macros // **************************************************************************** // **************************************************************************** // Linux macros // **************************************************************************** // ---------------------------------------------------------------------------- // Attributes. could perhaps generalize via "__.*" // ---------------------------------------------------------------------------- #define __init #define __exit #define __user #define __iomem #define __initdata #define __exitdata #define __devinit #define __devexit #define __devinitdata #define __cpuinit #define __cpuinitdata #define __init_or_module #define __initdata_or_module #define __pminit #define __pminitdata #define __cacheline_aligned #define ____cacheline_aligned #define __cacheline_aligned_in_smp #define ____cacheline_aligned_in_smp #define ____cacheline_internodealigned_in_smp #define __ALIGNED__ #define __3xp_aligned #define __pmac #define __force #define __nocast #define __read_mostly #define __must_check // pb #define __unused #define __maybe_unused #define __attribute_used__ #define __attribute_pure__ #define __attribute_const__ // #define _attribute__const __attribute__((const)) #define __always_inline #define __xipram // in the other part of the kernel, in arch/, mm/, etc #define __sched #define __initmv #define __exception #define __cpuexit #define __kprobes #define __meminit #define __meminitdata #define __nosavedata #define __kernel #define __nomods_init #define __apicdebuginit #define __ipc_init #define __modinit #define __lockfunc #define __weak #define __tlb_handler_align #define __lock_aligned #define __force_data #define __nongprelbss #define __nongpreldata #define __noreturn #define __section_jiffies #define __vsyscall_fn #define __section_vgetcpu_mode #define __section_vsyscall_gtod_data // in header files #define __bitwise #define __bitwise__ #define __deprecated // last found #define __init_refok // maybe only in old kernel #define __openfirmware #define __extension__ #define __thread #define __used #define __pure #define __ref #define __refdata #define __uses_jump_to_uncached // last last #define __net_init #define __net_exit #define __net_initdata #define __paginginit // in mm // ---------------------------------------------------------------------------- // String macros // ---------------------------------------------------------------------------- /* string macro. normally handle quite well by mu lalr(k), but * sometimes not enough, if have for instance the XX YY case, could * be considered as a declaration with XX being a typedef, so would * Have ambiguity. So at least by adding this special case, we can * catch more correct string-macro, no more a XX YY but now a good * "XX" YY * * cf include/linux/kernel.h * * For stringification I need to have at least a witness, a string, * and sometimes have just printk(KERN_WARNING MYSTR) and it could * be transformed in a typedef later, so better to at least * transform in string already the string-macro we know. * * Perhaps better to apply also as soon as possible the * correct macro-annotation tagging (__init & co) to be able to * filter them as soon as possible so that they will not polluate * our pattern-matching that come later. */ #define KERN_EMERG "KERN_EMERG" #define KERN_ALERT "KERN_ALERT" #define KERN_CRIT "KERN_CRIT" #define KERN_ERR "KERN_ERR" #define KERN_WARNING "KERN_WARNING" #define KERN_NOTICE "KERN_NOTICE" #define KERN_INFO "KERN_INFO" #define KERN_DEBUG "KERN_DEBUG" /* EX_TABLE & co. * * Replaced by a string. We can't put everything as comment * because it can be part of an expression where we wait for * something, where we wait for a string. So at least we * must keep the EX_TABLE token and transform it as a string. * * normally not needed if have good stringification of macro * but those macros are sometimes used multiple times * as in EX_TABLE(0b) EX_TABLE(1b) and we don't detect * it well yet. */ // TODO don't use x :( #define EX_TABLE(x) "TOTO" #define ASM_EXCEPTIONTABLE_ENTRY(x) "TOTO" #define DCACHE_CLEAR(x) "TOTO" #define PPC405_ERR77(x) "TOTO" // ---------------------------------------------------------------------------- // Alias keywords // ---------------------------------------------------------------------------- // pb, false positive, can also be a #define cst and use as 'case CONST:' //#define CONST const #define STATIC static #define _static static #define noinline #define __CS4231_INLINE__ inline #define CCIO_INLINE inline #define SBA_INLINE inline #define STATIC_INLINE static inline #define __EXTERN_INLINE extern inline #define AGPEXTERN extern #define PNMI_STATIC static #define RLMT_STATIC static #define SISINITSTATIC static #define SCTP_STATIC static #define BUGLVL if #define IFDEBUG if #define TRACE_EXIT return #define notrace #define noinline_for_stack // in fs #define debug_noinline // in net // ---------------------------------------------------------------------------- // linkage // ---------------------------------------------------------------------------- #define fastcall #define asmlinkage #define far #define SK_FAR // pb //#define near // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- #define INITSECTION #define NORET_TYPE #define compat_init_data #define DIVA_EXIT_FUNCTION #define DIVA_INIT_FUNCTION #define ACPI_SYSTEM_XFACE #define ASC_INITDATA #define in2000__INITDATA #define PACKED #define WPMINFO #define CPMINFO #define PMINFO #define ACPI_INTERNAL_VAR_XFACE #define SISIOMEMTYPE #define ACPI_STATE_COMMON #define ACPI_PARSE_COMMON #define ACPI_COMMON_DEBUG_MEM_HEADER #define nabi_no_regargs #define ATTRIB_NORET #define ATTRIBUTE_UNUSED #define BTEXT #define BTDATA #define PAGE_ALIGNED #define EARLY_INIT_SECTION_ATTR // pb //#define INIT #define IDI_CALL_ENTITY_T #define IDI_CALL_LINK_T /* cf gcc-linux.h * A trick to suppress uninitialized variable warning without generating any * code */ #define uninitialized_var(x) x = x // as in u16 uninitialized_var(ioboard_type); /* GCC be quiet */ // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- #define __releases(x) #define __acquires(x) #define __declspec(x) #define __page_aligned(x) #define __vsyscall(x) // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- //conflict with a macro of firefox //#define FASTCALL(x) x #define PARAMS(x) x // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // include/asm-arm/mach/arch.h // #define MACHINE_START(x) struct foo { x } #define MACHINE_START(_type,_name) \ static const struct machine_desc __mach_desc_##_type \ /* __used*/ \ __attribute__((__section__(".arch.info.init"))) = { \ .nr = MACH_TYPE_##_type, \ .name = _name, #define MACHINE_END \ }; // include/asm-powerpc/machdep.h #define define_machine(name) \ extern struct machdep_calls mach_##name; \ EXPORT_SYMBOL(mach_##name); \ struct machdep_calls mach_##name /*__machine_desc*/ = // ---------------------------------------------------------------------------- // Declare like macros (in structure def), or tricky Declare macros // ---------------------------------------------------------------------------- // include/asm-i386/pci.h // the DECLARE are detected by parsing_hack but not when they are // inside a struct def. #define DECLARE_PCI_UNMAP_ADDR(ADDR_NAME) #define DECLARE_PCI_UNMAP_LEN(LEN_NAME) // defined in drivers/infiniband/hw/mthca/mthca_doorbell.h #define MTHCA_DECLARE_DOORBELL_LOCK(doorbell_lock) // include/linux/types.h //#define BITS_TO_LONGS(bits) \ // (((bits)+BITS_PER_LONG-1)/BITS_PER_LONG) #define DECLARE_BITMAP(name,bits) \ /*unsigned*/ long name[BITS_TO_LONGS(bits)] // include/asm-i386/percpu.h // interesting macro where we see the need of __typeof__(type) with // for example DECLARE_PER_CPU(char[256], iucv_dbf_txt_buf); #define DEFINE_PER_CPU(type, name) \ __attribute__((__section__(".data.percpu"))) __typeof__(type) per_cpu__##name #define DECLARE_PER_CPU(type, name) extern __typeof__(type) per_cpu__##name // include/linux/kobject.h #define decl_subsys(_name,_type,_uevent_ops) \ struct subsystem _name##_subsys = { \ .kset = { \ .kobj = { .name = __stringify(_name) }, \ .ktype = _type, \ .uevent_ops =_uevent_ops, \ } \ } // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // pb: if use this macro then we will not transform the argument of CS_CHECK // in some rules. //#define CS_CHECK(fn, ret) \ // do { last_fn = (fn); if ((last_ret = (ret)) != 0) goto cs_failed; } while (0) // bt2/hci_bcsp.c #define BCSP_CRC_INIT(x) x = 0xffff // sound/oss/cs46xx_wrapper-24.h #define CS_OWNER .owner = #define CS_THIS_MODULE THIS_MODULE, // sound/sparc/dbri.c // "bad macro", have a ',' at the end #define CS4215_SINGLE(xname, entry, shift, mask, invert) \ { .iface = SNDRV_CTL_ELEM_IFACE_MIXER, .name = xname, \ .info = snd_cs4215_info_single, \ .get = snd_cs4215_get_single, .put = snd_cs4215_put_single, \ .private_value = entry | (shift << 8) | (mask << 16) | (invert << 24) }, // drivers/media/video/sn9c102/sn9c102_sensor.h //#define sn9c102_write_const_regs(sn9c102_device, data...) \ // ({ const static u8 _valreg[][2] = {data}; \ // sn9c102_write_regs(sn9c102_device, _valreg, ARRAY_SIZE(_valreg)); }) // drivers/s390/cio/qdio.h #define SYNC_MEMORY if (unlikely(q->siga_sync)) qdio_siga_sync_q(q) #define SYNC_MEMORY_ALL if (unlikely(q->siga_sync)) \ qdio_siga_sync(q,~0U,~0U) #define SYNC_MEMORY_ALL_OUTB if (unlikely(q->siga_sync)) \ qdio_siga_sync(q,~0U,0) // drivers/scsi/g_NCR5380.c #define ANDP , // drivers/scsi/ncr53c8xx.c // generate lots of errors because error en cascade car dans l'initialiseur // il y'a des '}' dans la premiere colonne #define PREFETCH_FLUSH SCR_CALL, PADDRH (wait_dma), // drivers/net/e100.c // pbs false positive, defined in another manner in some files //#define X(a,b) a,b // net/ipv4/netfilter/ip_conntrack_helper_h323_asn1.c // also used in other.c that don't do any include :( // but locally redefined in drivers/net/bnx2.c :( with a // #define FNAME 0x8 #define FNAME(name) name, // drivers/net/tulip/de4x5.c #define DESC_ALIGN // in .h #define MPI_POINTER * // mega4/soc.c mega4/socal.c // cause false typedef inference if let soc_printk #define soc_printk printk #define socal_printk printk // ---------------------------------------------------------------------------- // Initializer array macros // ---------------------------------------------------------------------------- // drivers/net/wireless/bcm43xx/bcm43xx_wx.c // defined in similar way multiple times, in the same file and in another one #define WX(ioctl) [(ioctl) - SIOCSIWCOMMIT] // #define WX(x) [(x)-SIOCIWFIRST] // drivers/net/wireless/ipw2200.c #define IW_IOCTL(x) [(x)-SIOCSIWCOMMIT] // drivers/net/wireless/zd1211rw/zd_netdev.c #define PRIV_OFFSET(x) [(x)-SIOCIWFIRSTPRIV] // drivers/net/wireless/zd1211rw/zd_rf.h #define RF_CHANNEL(ch) [(ch)-1] // drivers/net/wireless/zd1211rw/zd_rf_uw2453.c #define RF_CHANPAIR(a,b) [CHAN_TO_PAIRIDX(a)] // drivers/net/wireless/arlan-proc.c // incomplete macro, the real macro is quite complex and use other macros #define ARLAN_SYSCTL_TABLE_TOTAL(x) // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // drivers/net/cxgb3/t3_hw.c #define VPD_ENTRY(name, len) \ u8 name##_kword[2]; u8 name##_len; u8 name##_data[len] // #define rtrc(i) {} // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // drivers/video/nvidia/nv_type.h // use: SetBitField(h_blank_e, 5: 5, 7:7) //#define BITMASK(t,b) (((unsigned)(1U << (((t)-(b)+1)))-1) << (b)) //#define MASKEXPAND(mask) BITMASK(1?mask,0?mask) //#define SetBF(mask,value) ((value) << (0?mask)) //#define GetBF(var,mask) (((unsigned)((var) & MASKEXPAND(mask))) >> (0?mask) ) //#define SetBitField(value,from,to) SetBF(to, GetBF(value,from)) //#define SetBit(n) (1<<(n)) //#define Set8Bits(value) ((value)&0xff) // drivers/video/sis/init.c // use: GETBITSTR((SiS_Pr->CVTotal -2), 10:10, 0:0) //#define BITMASK(h,l) (((unsigned)(1U << ((h)-(l)+1))-1)<<(l)) //#define GENMASK(mask) BITMASK(1?mask,0?mask) //#define GETBITS(var,mask) (((var) & GENMASK(mask)) >> (0?mask)) //#define GETBITSTR(val,from,to) ((GETBITS(val,from)) << (0?to)) // fs/afs/internal.h #define ASSERTCMP(X, OP, Y) \ do { \ if (unlikely(!((X) OP (Y)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu " /*#OP*/ " %lu is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ printk(KERN_ERR "0x%lx " /*#OP*/ " 0x%lx is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ BUG(); \ } \ } while(0) #define ASSERTIFCMP(C, X, OP, Y) \ do { \ if (unlikely((C) && !((X) OP (Y)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu " /*#OP*/ " %lu is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ printk(KERN_ERR "0x%lx " /*#OP*/ " 0x%lx is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ BUG(); \ } \ } while(0) #define ASSERTRANGE(L, OP1, N, OP2, H) \ do { \ if (unlikely(!((L) OP1 (N)) || !((N) OP2 (H)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu "/*#OP1*/" %lu "/*#OP2*/" %lu is false\n", \ (unsigned long)(L), (unsigned long)(N), \ (unsigned long)(H)); \ printk(KERN_ERR "0x%lx "/*#OP1*/" 0x%lx "/*#OP2*/" 0x%lx is false\n", \ (unsigned long)(L), (unsigned long)(N), \ (unsigned long)(H)); \ BUG(); \ } \ } while(0) // loop, macro without ';', single macro. ex: DEBUG() // TODO should find the definition because we don't use 'x' and so // may lose code sites with coccinelle. If expand correctly, will // still don't transform correctly but at least will detect the place. #define ASSERT(x) MACROSTATEMENT #define IRDA_ASSERT(x) MACROSTATEMENT #define CHECK_NULL(x) MACROSTATEMENT //#define DEBUG(x) MACROSTATEMENT #define DEBUG0(x) MACROSTATEMENT #define DEBUG1(x) MACROSTATEMENT #define DEBUG2(x) MACROSTATEMENT #define DEBUG3(x) MACROSTATEMENT #define DBG(x) MACROSTATEMENT #define DEB(x) MACROSTATEMENT #define PARSEDEBUG(x) MACROSTATEMENT #define DEBC(x) MACROSTATEMENT #define DBG_TRC(x) MACROSTATEMENT #define DBG_ERR(x) MACROSTATEMENT #define DBG_FTL(x) MACROSTATEMENT #define DBGINFO(x) MACROSTATEMENT #define DFLOW(x) MACROSTATEMENT #define DFLIP(x) MACROSTATEMENT #define DLOG_INT_TRIG(x) MACROSTATEMENT #define D3(x) MACROSTATEMENT #define D1(x) MACROSTATEMENT #define DB(x) MACROSTATEMENT #define DCBDEBUG(x) MACROSTATEMENT #define SCSI_LOG_MLQUEUE(x) MACROSTATEMENT #define PLND(x) MACROSTATEMENT #define FCALND(x) MACROSTATEMENT #define FCALD(x) MACROSTATEMENT #define DEBUGRECURSION(x) MACROSTATEMENT #define DEBUGPIO(x) MACROSTATEMENT #define VDEB(x) MACROSTATEMENT #define READ_UNLOCK_IRQRESTORE(x) MACROSTATEMENT #define TRACE_CATCH(x) MACROSTATEMENT #define PDBGG(x) MACROSTATEMENT #define IF_ABR(x) MACROSTATEMENT #define IF_EVENT(x) MACROSTATEMENT #define IF_ERR(x) MACROSTATEMENT #define IF_CBR(x) MACROSTATEMENT #define IF_INIT(x) MACROSTATEMENT #define IF_RX(x) MACROSTATEMENT #define SOD(x) MACROSTATEMENT #define KDBG(x) MACROSTATEMENT #define IRDA_ASSERT_LABEL(x) MACROSTATEMENT // ---------------------------------------------------------------------------- // Difficult foreach // ---------------------------------------------------------------------------- // include/linux/sched.h #define while_each_thread(g, t) \ while ((t = next_thread(t)) != g) // net/decnet/dn_fib.c #define for_fib_info() { struct dn_fib_info *fi;\ for(fi = dn_fib_info_list; fi; fi = fi->fib_next) #define endfor_fib_info() } #define for_nexthops(fi) { int nhsel; const struct dn_fib_nh *nh;\ for(nhsel = 0, nh = (fi)->fib_nh; nhsel < (fi)->fib_nhs; nh++, nhsel++) #define change_nexthops(fi) { int nhsel; struct dn_fib_nh *nh;\ for(nhsel = 0, nh = (struct dn_fib_nh *)((fi)->fib_nh); nhsel < (fi)->fib_nhs; nh++, nhsel++) #define endfor_nexthops(fi) } // ---------------------------------------------------------------------------- // Macros around function prototype // ---------------------------------------------------------------------------- // net/sched/em_meta.c #define META_COLLECTOR(FUNC) static void meta_##FUNC(struct sk_buff *skb, \ struct tcf_pkt_info *info, struct meta_value *v, \ struct meta_obj *dst, int *err) #define GDTH_INITFUNC(x,y) x y #define ASC_INITFUNC(x,y) x y // ---------------------------------------------------------------------------- // If-like macros // ---------------------------------------------------------------------------- // include/linux/lockd/debug.h // include/linux/nfs_fs.h // include/linux/nfsd/debug.h // include/linux/sunrpc/debug.h //#define ifdebug(flag) if (unlikely(nlm_debug & NLMDBG_##flag)) #define ifdebug(flag) if (0) // ---------------------------------------------------------------------------- //#define __PROM_O32 // ---------------------------------------------------------------------------- // for tests-big/ macros, may be obsolete now cos fixed in latest kernel // ---------------------------------------------------------------------------- // rule10 //#define ACPI_MODULE_NAME(x) // **************************************************************************** // Httpd (apache) macros // **************************************************************************** #define AP_DECLARE(x) x #define PROXY_DECLARE(x) x #define CACHE_DECLARE(x) x #define DBD_DECLARE_NONSTD(x) x #define DAV_DECLARE(x) x #define APU_DECLARE(x) x #define APU_DECLARE_NONSTD(x) x #define APR_DECLARE(x) x #define AP_CORE_DECLARE(x) x #define AP_DECLARE_NONSTD(x) x #define AP_CORE_DECLARE_NONSTD(x) x #define APR_OPTIONAL_FN_TYPE(x) x #define DAV_DECLARE_NONSTD(x) x #define APR_DECLARE_NONSTD(x) x #define APU_DECLARE_DATA #define APR_THREAD_FUNC #define AP_DECLARE_DATA #define PROXY_DECLARE_DATA #define AP_MODULE_DECLARE_DATA #define APR_DECLARE_DATA #define APR_INLINE inline #define EXPORT static #define REGISTER register #define MODSSL_D2I_SSL_SESSION_CONST const #define MODSSL_D2I_X509_CONST const #define MODSSL_D2I_PrivateKey_CONST const #define MODSSL_D2I_SSL_SESSION_CONST const #define STACK_OF(X509_NAME) X509_NAME #define MODSSL_PCHAR_CAST (pchar) #define WINAPI //#define CALLBACK // generate false positive in Linux #define APIENTRY #define __declspec(x) #define __stdcall //#define module struct xxx #define APR_POOL_IMPLEMENT_ACCESSOR(shm) #define ADD_SUITE(suite) suite; // **************************************************************************** // CISCO vpn client macros // **************************************************************************** // #define NOREGPARM // #define IN // #define OUT // #define OPTIONAL #define likely(x) (x) #define unlikely(x) (x) coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/notnull.cocci0000644000175000017500000000253612247437436022720 0ustar eugeneugen// This detects NULL tests that can only be reached when the value is known // not to be NULL // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/notnull.html // Options: virtual org,diff @r exists@ local idexpression x; expression E; position p1,p2; @@ if (x@p1 == NULL || ...) { ... when forall return ...; } ... when != \(x=E\|x--\|x++\|--x\|++x\|x-=E\|x+=E\|x|=E\|x&=E\) when != &x ( x@p2 == NULL | x@p2 != NULL ) // another path to the test that is not through p1? @s exists@ local idexpression r.x; position r.p1,r.p2; @@ ... when != x@p1 ( x@p2 == NULL | x@p2 != NULL ) // another path to the test from p1? @t exists@ local idexpression x; position r.p1,r.p2; @@ if (x@p1 == NULL || ...) { ... x@p2 ... when any return ...; } // another path to the test containing an assignment? @u exists@ local idexpression x; expression E; position r.p1,r.p2; @@ if (x@p1 == NULL || ...) { ... when forall return ...; } ... \(x=E\|x--\|x++\|--x\|++x\|x-=E\|x+=E\|x|=E\|x&=E\|&x\) ... when != x@p1 when any ( x@p2 == NULL | x@p2 != NULL ) @script:python depends on !s && !t && !u && org @ p1 << r.p1; p2 << r.p2; @@ cocci.print_main("",p2) cocci.print_secs("",p1) @depends on !s && !t && !u && diff@ position r.p1, r.p2; expression x; @@ *x@p1 ... *x@p2 coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/notand.cocci0000644000175000017500000000073212247437436022504 0ustar eugeneugen// !x&y combines boolean negation with bitwise and // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/notand.html // Options: -macro_file_builtins ../cocci/notand.h virtual org,diff @r@ expression E; constant C; position p; @@ ( !E & !C | !@p E & C ) @script:python depends on org@ p << r.p; @@ cocci.print_main("",p) @depends on diff@ expression E; position r.p; @@ * !@p E coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/open.cocci0000644000175000017500000000151512247437436022162 0ustar eugeneugen// // open.cocci (based on kmalloc 7) // // virtual diff,org @r exists@ local idexpression x; statement S; expression E; identifier f,l; position p1,p2,p3; expression *ptr != NULL; @@ ( if ((x@p1 = \(open\|fopen\)(...)) == NULL) S | x@p1 = \(open\|fopen\)(...); ... if (x == NULL) S ) <... when != x when != if (...) { <+...x...+> } ( goto@p3 l; | x->f = E ) ...> ( return \(0\|<+...x...+>\|ptr\); | return@p2 ...; ) @script:python depends on org@ p1 << r.p1; p2 << r.p2; p3 << r.p3; @@ cocci.print_main("",p1) cocci.print_secs("", p2) cocci.print_secs("goto", p3) cocci.include_match(False) @script:python depends on org@ p1 << r.p1; p2 << r.p2; @@ cocci.print_main("",p1) cocci.print_secs("", p2) @with_goto depends on diff@ expression x; identifier l; position r.p1, r.p2, r.p3; @@ *x@p1 <... *goto@p3 l; ...> *return@p2 ...; coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/null_ref.cocci0000644000175000017500000000223112247437436023023 0ustar eugeneugen// Find cases where a pointer is dereferenced and then compared to NULL // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/null_ref.html // Options: virtual org,diff @match exists@ expression x, E,E1; identifier fld; position p1,p2; @@ ( x = E; ... when != \(x = E1\|&x\) x@p2 == NULL ... when any | x = E ... when != \(x = E1\|&x\) x@p2 == NULL ... when any | x != NULL && (<+...x->fld...+>) | x == NULL || (<+...x->fld...+>) | x != NULL ? (<+...x->fld...+>) : E | &x->fld | x@p1->fld ... when != \(x = E\|&x\) x@p2 == NULL ... when any ) @other_match exists@ expression match.x, E1, E2; position match.p1,match.p2; @@ ( x = E1 | &x ) ... when != \(x = E2\|&x\) when != x@p1 x@p2 @other_match1 exists@ expression match.x, E2; position match.p1,match.p2; @@ ... when != \(x = E2\|&x\) when != x@p1 x@p2 @ script:python depends on !other_match && !other_match1 && org@ p1 << match.p1; p2 << match.p2; @@ cocci.print_main(p1) cocci.print_secs("NULL test",p2) @depends on !other_match && !other_match1 && diff@ position match.p1, match.p2; expression x; @@ *x@p1 ... *x@p2 coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/empty.cocci.model0000644000175000017500000000002512247437436023451 0ustar eugeneugen@@@@ -NicolasPalix() coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/kc.cocci0000644000175000017500000000102412247437436021611 0ustar eugeneugen// // Use kzalloc rather than kcalloc(1,...) // // Confidence: // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://coccinelle.lip6.fr/ // Options: virtual org,patch,diff @depends on patch && !org && !diff@ @@ - kcalloc(1, + kzalloc( ...) @depends on !patch && !org && diff@ position p; @@ *kcalloc@p(1,...) @r depends on !patch && org && !diff@ position p; @@ kcalloc@p(1,...) @script:python depends on org@ p << r.p; @@ msg="%s:%s" % (p[0].file, p[0].line) cocci.print_main(msg, p) coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/kzmem.cocci0000644000175000017500000000137112247437436022344 0ustar eugeneugen// Remove useless call to memset for zeroing memory // after a kzalloc call. // // Confidence: // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://coccinelle.lip6.fr/ // Options: virtual org,patch,diff @depends on patch && !org && !diff@ expression x; statement S; @@ x = kzalloc(...); if (x == NULL) S ... when != x -memset(x,0,...); @depends on !patch && !org && diff@ expression x; statement S; @@ x = kzalloc(...); if (x == NULL) S ... when != x *memset(x,0,...); @r depends on !patch && org && !diff@ expression x; statement S; position p; @@ x = kzalloc(...); if (x == NULL) S ... when != x memset@p(x,0,...); @script:python depends on org@ p << r.p; @@ msg="%s:%s" % (p[0].file, p[0].line) cocci.print_main(msg, p) coccinelle-1.0.0-rc19/scripts/coccicheck/cocci/badzero.cocci0000644000175000017500000000071212247437436022645 0ustar eugeneugen// A pointer should not be compared to zero // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://coccinelle.lip6.fr/rules/badzero.html // Options: virtual org,diff @r disable is_zero,isnt_zero @ expression *E; position p; @@ ( E@p == 0 | E@p != 0 | 0 == E@p | 0 != E@p ) @script:python depends on org@ p << r.p; @@ cocci.print_main("",p) @depends on diff@ position r.p; expression E; @@ *E@p coccinelle-1.0.0-rc19/scripts/coccicheck/bin/0000755000175000017500000000000012247437436017705 5ustar eugeneugencoccinelle-1.0.0-rc19/scripts/coccicheck/bin/update_result_tree0000755000175000017500000000402412247437436023532 0ustar eugeneugen#!/bin/bash echo "Using PREFIX="${PREFIX:=$1} echo "Using PROJECT="${PROJECT:=$2} echo "Using COCCI="${COCCI:=$3} echo "Using RESULTS="${RESULTS:=$4} echo "Using SPFLAGS="${SPFLAGS:=$5} if [ "`which spatch.opt`" ] ; then SPATCH=spatch.opt else SPATCH=spatch fi echo "Using $SPATCH" #echo "Using PREFIX="${PREFIX:=`pwd`} #echo "Using COCCI="${COCCI:=$PREFIX/cocci} #echo "Using PROJECT="${PROJECT:=$PREFIX/project} #echo "Using RESULTS="${RESULTS:=$PREFIX/results} SMPL=`find $COCCI -mindepth 1 -type f -name "*.cocci"| sed "s|$COCCI/||g"` PRJNAME=`basename $PROJECT` echo "Processing project \"$PRJNAME\"" mkdir -p $RESULTS/ for s in $SMPL;do f=`basename $s .cocci` # Produce bug report for a particular version and a particular bug pattern echo "#!/bin/bash" > $RESULTS/$f.sh echo "" >> $RESULTS/$f.sh echo "FLAGS=\"`grep -E \"// +Options *:\" $COCCI/$s | cut -f2 -d\":\"`\"" >> $RESULTS/$f.sh echo "INC?=$PROJECT/include" >> $RESULTS/$f.sh echo "echo \"Applying $COCCI/$s with: '\$FLAGS'\"" >> $RESULTS/$f.sh echo "nice -19 $SPATCH $SPFLAGS \$FLAGS -I \$INC -cocci_file $COCCI/$s -dir $PROJECT/ $FLAGS \\" >> $RESULTS/$f.sh echo "> $f.out \\" >> $RESULTS/$f.sh echo "2> $f.log" >> $RESULTS/$f.sh echo "echo \"$f.out completed\"" >> $RESULTS/$f.sh chmod u+x $RESULTS/$f.sh done # s in $SMPL ############################################# # Fill the Makefile ############################################# # Generation of a Makefile per project echo -e ".SUFFIXES: .out .sh\n" > $RESULTS/Makefile echo -e "all: out\n" >> $RESULTS/Makefile echo -e ".sh.out:" >> $RESULTS/Makefile echo -e "\t-@./\$<\n" >> $RESULTS/Makefile ALL_SMPL=`echo -n "out:"` for s in $SMPL;do f=`basename $s .cocci` # echo "$f.out:" >> $RESULTS/Makefile # echo " -./$f.sh" >> $RESULTS/Makefile ALL_SMPL="$ALL_SMPL $f.out" done # s echo "$ALL_SMPL" >> $RESULTS/Makefile ############################################# # Cleanup dead links find -L $RESULTS -type l -delete # Cleanup empty dir. find results/ -depth -type d -empty -delete coccinelle-1.0.0-rc19/scripts/stat_directory_complete.pl0000755000175000017500000002505012247442616022344 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl use strict; use diagnostics; #use Data::Dumper; #use Date::Manip qw(ParseDate UnixDate); #sudo apt-get install libdate-manip-perl #use Date::Calc qw(Delta_Days); #sudo apt-get install libdate-calc-perl #------------------------------------------------------------------------------ # Helpers #------------------------------------------------------------------------------ my $debug = 0; sub pr2 { print STDERR "@_\n"; } sub pr { print "@_\n"; } sub mylog { print STDERR "@_\n" if $debug; } sub plural { my ($n) = @_; $n > 1 ? "s" : ""; } #------------------------------------------------------------------------------ # Globals #------------------------------------------------------------------------------ my $ok = 0; my $so = 0; #spatch ok my $fa = 0; #failed my $gu = 0; #gave up my $nbfiles = 0; my $maxtime = 0; #my $mintime = 0; my $sumtime = 0; my $sumlinefiles = 0; my $errors = 0; my $sumlineP = 0; #whole git my $sumlineP2 = 0; my $sumlinePchange = 0; my $spfile = ""; my $ruleno = "??"; my $sizeSP = 0; my $cedescr = ""; my $numauthors = 0; my $duration = 0; # in days my @cfiles = (); #------------------------------------------------------------------------------ # SP #------------------------------------------------------------------------------ $spfile = `make sp_file`; chomp $spfile; if($spfile =~ /(rule|mega|bt)(\d+)\.cocci/) { $ruleno = "$2"; } #------------------------------------------------------------------------------ # CE #------------------------------------------------------------------------------ #$cedescr = `make ce_descr`; #chomp $cedescr; #print STDERR (Dumper($cedescr)); open TMP, "Makefile" or die "no Makefile file ?"; while() { if(/^(CE)?DESCRIPTION=["'](.*)["']/) { $cedescr = $2; } } #$cedescr =~ s/\\/\\\\/g; #$cedescr =~ s/ /\\f/g; #$cedescr =~ s/\t/\\t/g; #------------------------------------------------------------------------------ # List c files #------------------------------------------------------------------------------ my $files = `make source_files`; chomp $files; @cfiles = split /\s+/, $files; $nbfiles = scalar(@cfiles); #------------------------------------------------------------------------------ # Size files (lines) #------------------------------------------------------------------------------ map { my ($linefile) = `wc -l $_`; chomp $linefile; die "wierd wc output" unless $linefile =~ /^(\d+) /; $sumlinefiles += $1; mylog "filesize $_ $1"; } @cfiles; #------------------------------------------------------------------------------ # Size SP #------------------------------------------------------------------------------ $sizeSP = `cat $spfile | perl -p -e "s/\\/\\/.*//g;" | grep -v '^[ \t]*\$' | wc -l`; chomp $sizeSP; #------------------------------------------------------------------------------ # Bugs #------------------------------------------------------------------------------ if(!(-e "README")) { pr2 "no README file ?"; } else { open TMP, "README" or die "no README file ?"; while() { if (/\[bug\]/ || /status\]\s*bug/ || /status\]\s*BUG/ ) { # can also look for [semibug] but it's often related to [corrected_c] kind of pbs #|| /status\]\s*semi-bug/ #pr2 "OLD BUG FORMAT: $_"; $errors++ } } } #------------------------------------------------------------------------------ # Size P (total) #------------------------------------------------------------------------------ if(-e "gitinfo") { ($sumlineP) = `cat gitinfo |wc -l`; chomp $sumlineP; } else { pr2 "no GIT INFO?"; } #------------------------------------------------------------------------------ # Number of authors and duration #------------------------------------------------------------------------------ if(-e "gitinfo") { open TMP, "gitinfo" or die "no gitinfo file ?"; #for authors my $h = {}; #for duration my @mindate = (); my @maxdate = (); my $nodateyet = 1; while() { #can also do: egrep "^Author" gitinfo | sort | uniq | wc -l if (/^Author: (.*)/) { $h->{$1}++; } # if(/^Date: (.*) ([-+]\d+)?/) { # my $date = ParseDate($1); # if (!$date) { die "bad date" } # else { # my ($year, $month, $day) = UnixDate($date, "%Y", "%m", "%d"); # my @current = ($year, $month, $day); # if($nodateyet) { # @mindate = @current; # @maxdate = @current; # $nodateyet = 0; # } else { # my $diff1 = Delta_Days(@mindate, @current); # if($diff1 < 0) { @mindate = @current; } # my $diff2 = Delta_Days(@current, @maxdate); # if($diff2 < 0) { @maxdate = @current; } # # #pr2 "$diff1, $diff2"; # } # } # } } # my $diff = Delta_Days(@mindate, @maxdate); # if($diff == 1 || $diff == 0) { # $duration = "1 day"; # } # elsif($diff < 31) { # $duration = "$diff days"; # } # elsif($diff > 365) { # my $years = int($diff / 365); # my $s = plural($years); # $duration = "$years year$s"; # } # elsif($diff > 31) { # my $months = int($diff / 31); # my $s = plural($months); # $duration = "$months month$s"; # } # else { die "impossible"; } $duration = "xxx months"; $numauthors = scalar(keys %{$h}); } else { pr2 "no GIT INFO?"; } #------------------------------------------------------------------------------ # Size P (only change for .c in drivers/ or sounds/ (the test files)) #------------------------------------------------------------------------------ foreach my $c (@cfiles) { die "wierd: $c, with $spfile" unless ($c =~ /(.*)\.c$/); my $base = $1; my $bef = "$base.c"; my $aft = "$base.res"; if(-e "corrected_$base.res") { $aft = "corrected_$base.res"; mylog "found corrected"; } my $onlychange = 0; open TMP, "diff -u -b -B $bef $aft |"; my $count = 0; while() { $count++; if (/^\+[^+]/) { $onlychange++; } if (/^\-[^-]/) { $onlychange++; } } $sumlinePchange += $onlychange; $sumlineP2 += $count; } #------------------------------------------------------------------------------ # Time #------------------------------------------------------------------------------ foreach my $c (@cfiles) { die "" unless ($c =~ /(.*)\.c$/); my $base = $1; my $diagnosefile = ""; mylog "$base"; if(-e "$base.c.ok") { $ok++; $diagnosefile = "$base.c.ok"; } if(-e "$base.c.failed") { $fa++; $diagnosefile = "$base.c.failed"; } if(-e "$base.c.spatch_ok") { $so++; $diagnosefile = "$base.c.spatch_ok"; } if(-e "$base.c.gave_up") { $gu++; $diagnosefile = "$base.c.gave_up"; } open TMP, $diagnosefile or die "no diagnose $base: $diagnosefile"; my $found = 0; my $time = 0; while() { # before -test_okfailed # if (/real[ \t]+([0-9])+m([0-9]+)[.]([0-9]+)/) { # $found++; # # $time = $1 * 60.0; # minutes # $time += $2; # seconds # $time += $3 / 1000.0; # 1/1000th sec. # # pr2 (sprintf "%4.1fs\n", $time); # printf "I: %15s & %4.1fs\n", $c, $time; # # } if (/time: (.*)/) { $found++; $time = $1; mylog (sprintf "%4.1fs\n", $time); printf "I: %15s & %4.1fs\n", $c, $time; } } die "not found time information in $diagnosefile" unless $found == 1; $sumtime += $time; $maxtime = $time if $time > $maxtime; } #------------------------------------------------------------------------------ # Computations #------------------------------------------------------------------------------ my $correct = $ok + $so; my $pourcentcorrect = ($correct * 100.0) / $nbfiles; my $avglines = $sumlinefiles / $nbfiles; my $avgtime = $sumtime / $nbfiles; my $ratioPvsSP = $sumlineP / $sizeSP; my $ratioPvsSP2 = $sumlineP2 / $sizeSP; #------------------------------------------------------------------------------ # Results #------------------------------------------------------------------------------ pr "SP = $spfile"; mylog "FILES = \n"; map { mylog "\t$_"; } @cfiles; pr "----------------------------------------"; pr "!!Total files = $nbfiles"; printf "!!AvgLine = %.1fl\n", $avglines; #pr " Correct number = $correct"; printf "!!Correct = %.1f%s\n", $pourcentcorrect, "%"; pr "!!Human errors = $errors"; pr "!!Size SP = $sizeSP"; pr "!!Size P = $sumlineP"; pr "!!Size P (change only) = $sumlinePchange"; printf "!!Ratio P/SP = %3.1f\n", $ratioPvsSP; printf "!!RunTime = %.1fs\n", $sumtime; printf "!!MaxTime = %.1fs\n", $maxtime; printf "!!AvgTime = %.1fs\n", $avgtime; my $totalstatus = $ok + $fa + $so + $gu; mylog "----------------------------------------------------------------"; mylog "Sanity checks: nb files vs total status: $nbfiles =? $totalstatus"; printf "L: %20s (r%3s) & %5.1f%% & %5dfi & %2de & %6.1fx & %6.1fs \n", $cedescr, $ruleno, $pourcentcorrect, $nbfiles, $errors, $ratioPvsSP, $sumtime; # Mega, Complex, Bluetooth printf "M: %60s & %5d & %6d (%d) & %2d & %s & %2d & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $numauthors, $duration, $errors, $sizeSP, $ratioPvsSP, $avgtime, $maxtime, $pourcentcorrect, $spfile; printf "C: %60s & %5d & %6d (%d) & %2d & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $errors, $sizeSP, $ratioPvsSP, $avgtime, $maxtime, $pourcentcorrect, $spfile; printf "B: %60s & %5d & %5d (%d) & %3d & %6.0fx & %6.1fs (%.1fs) & %5.0f\\%% \\\\\\hline%% SP: %s \n", $cedescr, $nbfiles, $sumlineP, $sumlinePchange, $sizeSP, $ratioPvsSP, $avgtime, $maxtime, $pourcentcorrect, $spfile; coccinelle-1.0.0-rc19/scripts/readme.pl0000755000175000017500000000467712247442616016666 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl # # ARGV: 0 = replacement text, 1 = file w. list of files # $debug = 0; $retain = 1; # 1 = retain old status #---------------------------------------------------------------------- $header = 0; # 0 = not seen header yet; 1 = seen beginning; 2 = seen end $currentfile = ""; $currentstatus = ""; $oldstatus = ""; @files = (); # Get replacement text $replace = shift; # Get files of interest open(FILES,shift); @files = ; close(FILES); # Remove file name suffixes foreach $_ (@files) { s/^([^.]+)\..+$/\1/; chop; print "--> added [$_]\n" if $debug; } # Process std. input while(<>) { # Find an ignore header if(/^-+$/) { $header = $header + 1; } # if($header > 1) { # Filename if(/^([0-9a-zA-Z_-]+)\.c\s*$/) { $currentfile = $1; $currentstatus = ""; print "--> currentfile: [$currentfile]\n" if $debug; } # Status code if(/^(\s+\*\s+)\[status\]([ \t\f]*)(\S*)$/) { $currentstatus = $3; print "--> $currentfile [$currentstatus]\n" if $debug; if(grep {/^$currentfile$/} @files) { s/^(\s+\*\s+\[status\])[ \t\f]*(.*)$/\1 $replace/; print "==>" if $debug; if($retain && ($currentstatus ne "")) { $oldstatus = " * [old-status] $currentstatus\n"; } } $currentfile =""; } } # print "$_"; if($oldstatus ne "") { print $oldstatus; $oldstatus = ""; } } coccinelle-1.0.0-rc19/scripts/genversion.sh0000755000175000017500000000045612247437436017602 0ustar eugeneugen#! /bin/sh # fallback date (in RFC format) VERSION=`date "+%a, %d %b %Y %H:%M:%S %z"` # use the date information from git, if git is present if test -d ".git" && which git &>/dev/null; then VERSION=`git log -1 --date-order --date=rfc --pretty="format:%cd"` fi echo "let version_date = \"$VERSION\"" coccinelle-1.0.0-rc19/scripts/extract_c_and_res.pl0000755000175000017500000001536412247442616021073 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #!/usr/bin/perl -w use strict; sub pr2 { print "$_[0]\n"; } sub mylog { print @_;} # to be launched from the git directory die "usage: $0 commithashafter [commithashbefore]" if(@ARGV <= 0 || @ARGV >= 3); # update: now I also extract the headers files, the one # that were modified in the commit and the one that are # locally used and that may contain useful type information # for spatch. # update: now I also extract some include/linux/header.h files, the # one having the same name of one of the driver. my $target_dir = "/tmp/extract_c_and_res/$ARGV[0]"; `mkdir -p $target_dir`; my $old_dir = "/tmp/extract_c_and_res/$ARGV[0]_old"; `mkdir -p $old_dir`; my $new_dir = "/tmp/extract_c_and_res/$ARGV[0]_new"; `mkdir -p $new_dir`; my $commit_new = $ARGV[0]; my $commit_old = $ARGV[1] || "$commit_new^"; # default parent my $gitfile = "$target_dir/$commit_new.gitinfo"; my $makefile = "$target_dir/Makefile"; `git show $commit_new > $gitfile `; # processing the patch my @files = (); my $files = {}; my @driverheaders_in_include = (); open FILE, "$gitfile" or die "$!"; while() { # allow other dir ? # fs|mm there is drivers under arch/ too if(/^diff --git a\/((drivers|sound)\/.*?\.[ch]) b/){ mylog " $1\n"; push @files, $1; $files->{$1} = 1; } elsif(/^diff --git a\/(include\/.*?\.h) b/) { mylog "potential header driver $1\n"; push @driverheaders_in_include, $1; } elsif(/^diff --git a\//) { mylog " not driver:$_"; } elsif(/^diff/) { die "PB: strange diff line: $_"; } } # extracting the .c and .h of the patch my $counter=0; # to be able to later find the corresponding local included header file my $kerneldir_of_file = {}; my @finalcfiles = (); my $finalcfiles = {}; foreach my $f (@files) { my ($base) = `basename $f`; chomp $base; my $res = $base; if($base =~ /\.c$/) { $res =~ s/\.c$/.res/; } if($base =~ /\.h$/) { $res =~ s/\.h$/.h.res/; } pr2 "processing: $f $base $res"; if(-e "$target_dir/$base") { $counter++; $base = "${counter}_$base"; $res = "${counter}_$res"; pr2 "try transform one file because already exist: $base"; if($base =~ /\.h$/) { die "PB: Two header files share the same name: $base."; } } die "PB: one of the file already exist: $base" if (-e "$target_dir/$base"); `git cat-file blob $commit_old:$f > $target_dir/$base`; `git cat-file blob $commit_new:$f > $target_dir/$res`; `git cat-file blob $commit_old:$f > $old_dir/$base`; `git cat-file blob $commit_new:$f > $new_dir/$base`; $kerneldir_of_file->{$base} = `dirname $f`; chomp $kerneldir_of_file->{$base}; push @finalcfiles, $base; $finalcfiles->{$base} = 1; } # generate Makefile open MAKE, ">$makefile" or die "$!"; print MAKE "CEDESCRIPTION=\"\"\n"; print MAKE "SP=foo.cocci\n"; print MAKE "SOURCES = "; my $last = shift @finalcfiles; foreach my $f (@finalcfiles) { print MAKE "$f \\\n\t"; } print MAKE "$last\n"; print MAKE " TOP=../.. include \$(TOP)/generic_makefile "; # process potential driver headers of include/ foreach my $f (@driverheaders_in_include) { my $base = `basename $f`; chomp $base; if($base =~ /.h$/) { $base =~ s/.h$/.c/; } else { die "PB: internal error"; } # julia want all .h that were in the patch, not just the headers # of our heuristic. Hence the comment. # pr2 "$f $base"; # if(defined($finalcfiles->{$base})) { { # pr2 "found header of driver in include/: $f of $base"; my $dir = `dirname $f`; chomp $dir; `mkdir -p $target_dir/$dir`; `git cat-file blob $commit_old:$f > $target_dir/$f`; `git cat-file blob $commit_new:$f > $target_dir/$f.res`; `mkdir -p $old_dir/$dir`; `mkdir -p $new_dir/$dir`; `git cat-file blob $commit_old:$f > $old_dir/$f`; `git cat-file blob $commit_new:$f > $new_dir/$f`; } } # compute other linux headers not in the patch my @linuxheaders = `cd $target_dir; grep -E \"#include +\<[^>]*\>\" *.c *.h`; foreach my $line (@linuxheaders) { chomp $line; #pr2 ($line); if($line =~ /^(.*)?:#include *\<([^>]*)\>/) { my ($_file, $f) = ($1, $2); my $base = `basename $f`; chomp $base; if($base =~ /.h$/) { $base =~ s/.h$/.c/; } else { die "PB: internal error"; } if(defined($finalcfiles->{$base}) && ! -e "$target_dir/include/$f") { pr2 "found header of driver in include/: $f of $base"; my $dir = `dirname $f`; chomp $dir; `mkdir -p $target_dir/include/$dir`; `git cat-file blob $commit_old:include/$f > $target_dir/include/$f`; } } else { pr2 "pb regexp: $line"; } } # compute other local headers not in the patch my @headers = `cd $target_dir; grep -E \"#include +\\".*\\"\" *.c *.h`; my $hfiles = {}; foreach my $line (@headers) { chomp $line; #pr2 ($line); if($line =~ /^(.*)?:#include *"(.*)"/) { my ($file, $header) = ($1, $2); my $dir = $kerneldir_of_file->{$file}; my $fullheader = "$dir/$header"; #pr2 ($fullheader); if($files->{$fullheader}) { pr2 "INFO: $fullheader was already in commit"; } else { $hfiles->{$fullheader} = 1; } } else { pr2 "pb regexp: $line"; } } foreach my $h (keys %{$hfiles}) { my ($base) = `basename $h`; chomp $base; pr2 "processing additionnal header file: $h $base"; if(-e "$target_dir/$base") { pr2 "-------------------------------------"; pr2 "PB: local header (not modified in the git) $base already exists"; pr2 "BUT I CONTINUE, but may have more .failed in the end"; pr2 "-------------------------------------"; } else { `git cat-file blob $commit_old:$h > $target_dir/$base`; } } coccinelle-1.0.0-rc19/scripts/spatch.sh.in0000644000175000017500000000253712247437436017311 0ustar eugeneugen#! /bin/sh -e # generic wrapper script to invoke 'spatch' or 'spatch.opt' # it sets the python variables (if relevant) # and COCCINELLE_HOME SHAREDIR="@prefix@/share/coccinelle" LIBDIR="@prefix@/lib" if test ! -d "$SHAREDIR"; then SHAREDIR="$(pwd)" fi COCCINELLE_HOME="${COCCINELLE_HOME:=$SHAREDIR}" #echo setting COCCINELLE_HOME=${COCCINELLE_HOME:=$SHAREDIR} if [ ! -d "${COCCINELLE_HOME}" ]; then echo "\$COCCINELLE_HOME is not a directory: ${COCCINELLE_HOME}" 1>&2 fi if [ ! -r "${COCCINELLE_HOME}/standard.iso" ] ; then echo "There is no standard.iso in ${COCCINELLE_HOME}." 1>&2 echo -n "Are you sure you run a properly installed version of spatch ?\n" 1>&2 else export COCCINELLE_HOME export LD_LIBRARY_PATH="${LIBDIR}:$LD_LIBRARY_PATH:${SHAREDIR}:${COCCINELLE_HOME}" export PYTHONPATH="${COCCINELLE_HOME}/python:$PYTHONPATH" # echo setting LD_LIBRARY_PATH="$LD_LIBRARY_PATH" # echo setting PYTHONPATH="$PYTHONPATH" fi extension="${0##*.}" if [ "x$extension" = "xopt" ]; then TOOL="spatch.opt" elif [ "x$extension" = "xbyte" ]; then TOOL="spatch" else # autodetect if [ -f "${COCCINELLE_HOME}/spatch.opt" ]; then TOOL="spatch.opt" elif [ -f "${COCCINELLE_HOME}/spatch" ]; then TOOL="spatch" else echo "No 'spatch' nor 'spatch.opt' found in ${COCCINELLE_HOME}" 1>&2 exit 1 fi fi exec "${COCCINELLE_HOME}/${TOOL}" "$@" coccinelle-1.0.0-rc19/myocamlbuild.ml0000644000175000017500000002357012247442641016404 0ustar eugeneugen# 2 "myocamlbuild.ml.in" (* * This file is a plugin that provides the needed customization of * calls to the ocaml compiler needed for components of coccinelle. * The classification of particular components is done by tags, which * are specified in the _tags file. * * This file is also a compromise: some aspects of coccocinelle's * build process are somehwat complicated due to packaging some * bundled software, having no requirement on ocamlfind, etc. * We therefore let 'configure' find out the configuration and * paths to tools and libraries, and this plugin is transformed * by that configuration to customize ocamlbuild accordingly. *) (* Some useful commandline arguments to ocamlbuild are: * -yaccflag -v verbose ocamlyacc and menhir output * -classic-display see the individual build steps * -j 0 parallel building * -tag "-custom" pure bytecode building * -tag "-dtypes" no type annotation generation *) (* Configuration of this build plugin *) let ocamlc_path = "/usr/bin/ocamlc.opt" let ocamlopt_path = "/usr/bin/ocamlopt.opt" let ocamldep_path = "/usr/bin/ocamldep" let ocamldoc_path = "/usr/bin/ocamldoc" let ocamlyacc_path = "/usr/bin/ocamlyacc" let ocamllex_path = "/usr/bin/ocamllex.opt" let ocamlmklib_path = "/usr/bin/ocamlmklib" let ocamlmktop_path = "/usr/bin/ocamlmktop" let camlp4o_path = "/usr/bin/camlp4o" let menhir_path = "/usr/bin/menhir" let pycaml_path = "" let pcre_path = "" let menhirLib_path = "/usr/lib/ocaml/menhirLib" let dynlink_path = "/usr/lib/ocaml" let pcre_cflags = "" let pcre_ldflags = "" let python_cflags = "" let python_ldflags = "" let python_major_version = "" let profiling_modules = "" (* The plugin code starts here. *) open Ocamlbuild_plugin open Command (* Removes double separators and single dots from * a path. It does not resolve symlinks or turn * relative paths in absolute paths. *) let rec normalize_path path = let parent = Pathname.dirname path in if Pathname.equal path "/" || Pathname.equal parent "/" || Pathname.equal parent path then path else let name = Pathname.basename path in if Pathname.equal name "." then normalize_path parent else normalize_path parent / name (* Makes path relative and implicit, if it is a child of the * current directory. Relative paths are a must when dealing * with the build directory. * Todo: find out if there is a library function for * exactly this purpose. *) let relative_path path = let current = normalize_path Pathname.pwd in let target = normalize_path path in if Pathname.is_prefix current target then let len_current = String.length current in let len_target = String.length target in if len_current == len_target then "." else let len_tail = len_target - len_current - 1 in let ind_tail = len_current + 1 in String.sub target ind_tail len_tail else target let add_flags flag_ref flags = flag_ref := List.append flags !flag_ref let mk_use_tag name = "use_" ^ name (* Sets up a tag for compiling c and library files against * an external c library. *) let setup_clib name compile_flags link_flags = let tag = mk_use_tag name in flag [tag; "c"; "compile"] (S[A "-ccopt"; A compile_flags]); flag [tag; "c"; "ocamlmklib"] (S[A "-ldopt"; A link_flags]); flag [tag; "ocaml"; "link"] (S[A "-ccopt"; A compile_flags]); flag [tag; "ocaml"; "link"] (S[A "-ccopt"; A link_flags]) (* Sets up a tag for declaring a dependency on a stubs library, * and linking it in. The dependency includes both a .a archive * and a .so dll. *) let setup_stubs name stubs_dir = let tag = mk_use_tag name in let path_a = Printf.sprintf "%s/lib%s_stubs.a" stubs_dir name in if not (Pathname.exists path_a) then dep [tag; "link"; "ocaml"] [path_a]; let stubs_arg = Printf.sprintf "-l%s_stubs" name in flag [tag; "ocaml"; "link"; "byte"] (S[A "-I"; P stubs_dir; A "-dllib"; A stubs_arg; A "-cclib"; A stubs_arg]); flag [tag; "ocaml"; "link"; "native"] (S[A "-I"; P stubs_dir; A "-cclib"; A stubs_arg]); flag [tag; "ocaml"; "doc"] (S[A "-I"; P stubs_dir]) (* The use of bundled software is simply the * inclusion of the appropriate source directory. * The build system can find automatically how to * deal with the bundled sources. *) let setup_bundle rootdir = tag_file rootdir ["include"; "traverse"] (* Sets up a tag that adds the given module directory and module * as additional argument to ocaml when it processes a * file with that tag. * Todo: it may be beneficial to add a dependency on the target * module. *) let setup_module name modname rootdir = let tag = mk_use_tag name in let link_args isNative = S [A "-I"; P rootdir; A (modname isNative) ] in let compile_args = S [A "-I"; P rootdir] in flag [tag; "ocaml"; "compile"] compile_args; flag [tag; "ocaml"; "byte"; "link"; "program"] (link_args false); flag [tag; "ocaml"; "native"; "link"; "program"] (link_args true); flag [tag; "ocaml"; "doc"] (S[A "-I"; P rootdir]) (* Sets up the use of either a bundled source package or precompiled module. *) let setup_package name modname rootdir = let exists_path isNative = Pathname.exists (rootdir / modname isNative) in let is_binary = exists_path false || exists_path true in if is_binary then setup_module name modname rootdir else setup_bundle rootdir (* Most files depend on these standard modules, hence we setup a * single tag for them. * This setup routine should be called before the others to ensure * that these modules appear first on the ocaml commandlines. *) let setup_basic_libs use_dynlink = ocaml_lib ~extern:true ~tag_name:"use_base" "unix"; ocaml_lib ~extern:true ~tag_name:"use_base" "str"; ocaml_lib ~extern:true ~tag_name:"use_base" "nums"; ocaml_lib ~extern:true ~tag_name:"use_base" "bigarray"; if use_dynlink then ocaml_lib ~extern:true ~tag_name:"use_base" "dynlink"; () (* The menhir package provides individual object files * instead of an archive. *) let setup_menhirLib () = let menhirLib_dir = relative_path menhirLib_path in let modname isNative = match isNative with true -> "menhirLib.cmx" | false -> "menhirLib.cmo" in setup_package "menhirLib" modname menhirLib_dir (* Pycaml is a stubs library with some conditional * code that depends on the python version. We * additionally introduce a tag pp_pycaml which * runs the appropriate preprocessors. *) let setup_pycaml () = let pycaml_dir = relative_path pycaml_path in let modname isNative = match isNative with true -> "pycaml.cmxa" | false -> "pycaml.cma" in setup_package "pycaml" modname pycaml_dir; setup_stubs "pycaml" pycaml_dir; setup_clib "pycaml" python_cflags python_ldflags; let macrodef = Printf.sprintf "-D PYMAJOR%s" python_major_version in flag ["pp_pycaml"; "c"; "compile"] (S[A "-ccopt"; A macrodef]); let camlp4cmd = Printf.sprintf "%s -parser Camlp4MacroParser -D PYMAJOR%s" camlp4o_path python_major_version in flag ["pp_pycaml"; "ocaml"; "pp"] (Sh camlp4cmd) (* Pcre is a standard stub library. *) let setup_pcre () = let pcre_dir = relative_path pcre_path in let modname isNative = match isNative with true -> "pcre.cmxa" | false -> "pcre.cma" in setup_package "pcre" modname pcre_dir; setup_stubs "pcre" pcre_dir; setup_clib "pcre" pcre_cflags pcre_ldflags (* Some utility code on strings and paths. *) let any_non_space str = let have_non_space = ref false in String.iter begin fun c -> match c with ' ' -> () | '\t' -> () | _ -> have_non_space := true end str; !have_non_space let not_empty str = String.length str > 0 && any_non_space str let is_path_configured path = not_empty path && Pathname.exists path (* Note: the setup of the modules is done before the hygiene phase * in order to benefit from additional "include" tags that may be * given to directories. *) let _ = dispatch begin function | Before_options -> Options.hygiene := true; Options.sanitize := true; Options.make_links := false; Options.catch_errors := true; Options.use_menhir := true; let menhir_wrapper = Printf.sprintf "%s/setup/wrapper-menhir.sh" Pathname.pwd in Options.ocamlc := Sh ocamlc_path; Options.ocamlopt := Sh ocamlopt_path; Options.ocamldep := Sh ocamldep_path; Options.ocamldoc := Sh ocamldoc_path; Options.ocamlyacc := S[P menhir_wrapper; P ocamlyacc_path; P menhir_path]; Options.ocamllex := Sh ocamllex_path; Options.ocamlmklib := Sh ocamlmklib_path; Options.ocamlmktop := Sh ocamlmktop_path; () | Before_hygiene -> let use_dynlink = is_path_configured dynlink_path in setup_basic_libs use_dynlink; if is_path_configured menhirLib_path then setup_menhirLib (); if is_path_configured pcre_path then setup_pcre (); if is_path_configured pycaml_path then setup_pycaml (); () | After_rules -> (* produces a slightly faster native version *) (* flag ["ocaml"; "compile"; "native"] (A "-unsafe"); *) (* adds debugging info (including exception backtraces) *) flag ["ocaml"; "compile"] (A "-g"); (* flags to parameterize ocamldoc to produce web pages *) flag ["gen_html"; "ocaml"; "doc"] (S [A "-colorize-code"; A "-short-functors"; A "-all-params"]); flag ["gen_man"; "ocaml"; "doc"] (S [A "-man"; A "-man-mini"]); (* when profiling, link with profiling.cmo *) if not_empty profiling_modules then flag ["ocaml"; "link"; "byte"] (S [A profiling_modules]); (* the warning about unused function arguments are disabled * for files with this tag. *) flag ["nowarn20"; "ocaml"; "compile"] (S [A "-w"; A "-20"]); (* adds the custom option, unless 'nocustom' is given as a tag *) if not (Tags.mem "nocustom" (tags_of_pathname "myocamlbuild.ml")) then flag ["ocaml"; "link"; "byte"] (A "-custom"); () | _ -> () end coccinelle-1.0.0-rc19/flag_cocci.ml0000644000175000017500000000447312247442614015775 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_cocci.ml" (* the inputs *) let show_c = ref false let show_cocci = ref false (* the output *) let show_diff = ref true let force_diff = ref false (*show diff even if thhere are only space changes*) (* the derived inputs *) let show_flow = ref false let show_before_fixed_flow = ref false let show_ctl_tex = ref false let show_ctl_text = ref false let inline_let_ctl = ref false let show_mcodekind_in_ctl = ref false (* the "underived" outputs *) let show_binding_in_out = ref false let show_dependencies = ref false let verbose_cocci = ref true let windows = ref false let popl = ref false let ifdef_to_if = ref true(*false*) type include_options = I_UNSPECIFIED | I_NO_INCLUDES | I_NORMAL_INCLUDES | I_ALL_INCLUDES | I_REALLY_ALL_INCLUDES let include_options = ref I_UNSPECIFIED let include_path = ref ([] : string list) (* if true then when have a #include "../../xx.h", we look also for xx.h in * current directory. This is because of how works extract_c_and_res *) let relax_include_path = ref false let extra_includes = ref ([] : string list) let timeout = ref (None : int option) let selected_only = ref false (* just print files that would be treated *) let use_saved_typedefs = ref true (* hack! *) coccinelle-1.0.0-rc19/extra/0000755000175000017500000000000012247442646014512 5ustar eugeneugencoccinelle-1.0.0-rc19/extra/classic_patch.ml0000644000175000017500000000132612247437436017647 0ustar eugeneugenopen Common type patch = patchitem list and patchitem = File of filename * string (* header line *) * string list let parse_patch filename = let xs = Common.cat filename in let xxs = Common.split_list_regexp "^diff" xs in xxs +> List.map (fun (s, body) -> if s =~ "^diff --git a/\\([^ ]*\\) b/\\([^ ]*\\)" then begin let (a,b) = matched2 s in assert(a =$= b); File (a, s, body) end else failwith ("wrong line in git diff:" ^ s) ) let unparse_patch xs outfile = Common.with_open_outfile outfile (fun (pr_no_nl, _chan) -> let pr s = pr_no_nl (s ^ "\n") in xs +> List.iter (function (File (file, header, body)) -> pr header; body +> List.iter pr; ) ) coccinelle-1.0.0-rc19/extra/extra.mldylib0000644000175000017500000000004112247437436017207 0ustar eugeneugenClassic_patch Kbuild Maintainers coccinelle-1.0.0-rc19/extra/maintainers.ml0000644000175000017500000000621712247437436017365 0ustar eugeneugenopen Common type subsystem_info = subsystem list and subsystem = Subsystem of (dir * maintainers) * (dir * maintainers) list (* subdirs *) and dir = string and maintainers = string list let mk_inverted_index_subsystem xs = let h = Hashtbl.create 101 in xs +> List.iter (function (Subsystem ((leader, emails), dirs)) -> Hashtbl.add h leader leader; dirs +> List.iter (fun (subdir, emails) -> Hashtbl.add h subdir leader )); h let subsystem_to_assoc xs = xs +> List.map (function (Subsystem ((s, emails), ys)) -> s, (emails, ys)) let subsystem_to_hash xs = xs +> subsystem_to_assoc +> Common.hash_of_list let all_dirs_from_subsystem_info xs = xs +> List.map (function (Subsystem ((s, emails), dirs)) -> s::(List.map fst dirs) ) +> Common.union_all let unparse_subsystem_info xs filename = Common.with_open_outfile filename (fun (pr_no_nl,chan) -> let pr s = pr_no_nl (s ^ "\n") in xs +> List.iter (function Subsystem ((s, emails), ys) -> pr (sprintf "%-40s : %s" s (Common.join " ," emails)); ys +> List.iter (fun (s, emails) -> pr (sprintf " %-40s : %s" s (Common.join " ," emails)); ); pr ""; ) ) let parse_subsystem_info filename = let xs = cat filename in let xs = xs +> List.map (Str.global_replace (Str.regexp "#.*") "" ) in let xs = xs +> List.filter (fun s -> not (s =~ "^[ \t]*$")) in (* split by header of section *) let xs = xs +> Common.split_list_regexp "^[^ ]" in xs +> List.map (fun (s, xs) -> assert (s =~ "^\\([^ ]+\\) *: *\\(.*\\)"); let (dir, email) = matched2 s in let emails = Common.split "[ ,]+" email in let group = xs +> List.map (fun s -> assert (s =~ "^[ ]+\\([^ ]+\\) *: *\\(.*\\)"); let (dir, email) = matched2 s in let emails = Common.split "[ ,]+" email in (dir, emails) ) in Subsystem ((dir, emails), group) ) let generate_naive_subsystem_info dirs = let dirs' = dirs +> List.map (fun s -> Common.split "/" s, s ) in let rec aux_dirs xs = match xs with | [] -> [] | (dir_elems,s)::xs -> let cond, base = if List.length dir_elems >= 2 then let base = Common.take 2 dir_elems in (fun dir_elems' -> List.length dir_elems' >= 2 && Common.take 2 dir_elems' =*= base), base else (fun dir_elems' -> dir_elems' =*= dir_elems), dir_elems in let (yes, no) = xs +> Common.partition_either (fun (dir_elems', x) -> if cond dir_elems' then Left (x, []) else Right (dir_elems', x) ) in (Subsystem ((s, [""]), yes))::aux_dirs no in aux_dirs dirs' (* old: dirs +> List.map (fun s -> Subsystem (s, "", [])) *) (* a = current info file, in general manually extended; b = generated one *) let check_up_to_date a b = let set1 = all_dirs_from_subsystem_info a in let set2 = all_dirs_from_subsystem_info b in (set1 $-$ set2) +> List.iter (fun s -> pr2 ("old directory disappeared: " ^ s) ); (set2 $-$ set1) +> List.iter (fun s -> pr2 ("new directory appeared: " ^ s) ) coccinelle-1.0.0-rc19/extra/kbuild.ml0000644000175000017500000001501512247437436016321 0ustar eugeneugenopen Common type kbuild_info = directory list and directory = Directory of string (*dirname*) * group list and group = Group of filename list let directories_to_assoc xs = xs +> List.map (function (Directory (s, ys)) -> s, ys) let directories_to_hash xs = xs +> directories_to_assoc +> Common.hash_of_list let files_of_groups xs = xs +> List.map (function Group ys -> ys) +> Common.union_all let adjust_dirs dirs = dirs +> Common.map_filter (fun s -> match s with | s when s =~ "^\\.$" -> None | s when s =~ "^\\./\\.git" -> None | s when s =~ "^\\./\\.tmp_versions" -> None | s when s =~ "^\\./include/config/" -> None | s when s =~ "^\\./usr/include" -> None | s when s =~ "^\\./\\(.*\\)" -> Some (matched1 s) | s -> Some s ) let unparse_kbuild_info xs filename = Common.with_open_outfile filename (fun (pr_no_nl,chan) -> let pr s = pr_no_nl (s ^ "\n") in xs +> List.iter (function Directory (s, ys) -> pr s; ys +> List.iter (function Group zs -> pr (" " ^ (join " " zs)); ); pr ""; ) ) let parse_kbuild_info filename = let xs = cat filename in let xs = xs +> List.map (Str.global_replace (Str.regexp "#.*") "" ) in let xs = xs +> List.filter (fun s -> not (s =~ "^[ \t]*$")) in (* split by header of section *) let xs = xs +> Common.split_list_regexp "^[^ ]" in xs +> List.map (fun (s, xs) -> let groups = xs +> List.map (fun s -> assert (s =~ "^[ ]+\\(.*\\)"); let files = matched1 s in let cfiles = Common.split " +" files in Group cfiles ) in Directory (s, groups) ) let generate_naive_kbuild_info dirs = dirs +> List.map (fun s -> let files = Common.readdir_to_file_list s in let files_ext = files +> List.map Common.dbe_of_filename_safe in let cfiles = files_ext +> Common.map_filter (function | Left (d,base, "c") -> if base =~ ".*\\.mod$" then None else Some base | _ -> None ) in let ys = cfiles +> List.map (fun c -> Group [c ^ ".c"]) in Directory (s, ys) ) let generate_kbuild_info_from_depcocci dirs outfile = Common.with_open_outfile outfile (fun (pr_no_nl, chan) -> dirs +> List.iter (fun s -> pr_no_nl (s ^ "\n"); let depcocci = Common.cat (Filename.concat s "depcocci.dep") in depcocci +> List.iter (fun s -> pr_no_nl (s ^ "\n")); pr_no_nl "\n"; ) ) (* dirs +> List.map (fun s -> let groups = depcocci +> List.map (fun s -> Group (Common.split " +" s)) in Directory (s, groups) ) *) type makefile = { obj_dirs : string stack ref; obj_config: (string list) stack ref; obj_objs: (string * (string list)) stack ref; } let empty_makefile () = failwith "empty_makefile" let parse_makefile file = let xs = Common.cat file in let s = Common.unlines xs in let s = Str.global_replace (Str.regexp "\\\\\n") "" s in let xs = Common.lines_with_nl s in let xs = xs +> List.map (Str.global_replace (Str.regexp "#.*") "" ) in let xs = xs +> List.filter (fun s -> not (s =~ "^[ \t]*$")) in let _m = empty_makefile () in xs +> List.iter (fun s -> match s with | s when s =~ "obj-\\$(CONFIG_.*)[ \t]*[\\+:]=\\(.*/\\)" -> pr2_no_nl ("DIR: " ^ s) | s when s =~ "obj-y[ \t]*\\+=\\(.*/\\)" -> pr2_no_nl ("DIR: " ^ s) | s when s =~ "obj-\\$(CONFIG_.*)[ \t]*[\\+:]=\\(.*\\)" -> let s = matched1 s in let objs = Common.split "[ \t]+" s in assert(List.for_all (fun s -> thd3 (Common.dbe_of_filename s) =$= "o") objs); pr2 ("OBJS: " ^ (join "|" objs)) | s when s =~ "[a-zA-Z0-9_]+-objs[ \t]*[\\+:]=\\(.*\\)" -> let s = matched1 s in let objs = Common.split "[ \t]+" s in pr2 ("OBJSMODULE: " ^ (join "|" objs)) | s -> pr2_no_nl ("OTHER: " ^ s) ) let generate_less_naive_kbuild_info dirs = dirs +> List.map (fun s -> let files = Common.readdir_to_file_list s in let files_ext = files +> List.map Common.dbe_of_filename_safe in let cfiles = files_ext +> Common.map_filter (function | Left (d,base, "c") -> if base =~ ".*\\.mod$" then None else Some base | _ -> None ) in match cfiles with | [] -> Directory (s, []) | _::_ -> if Common.lfile_exists (Filename.concat s "Makefile") then let _res = parse_makefile (Filename.concat s "Makefile") in let ys = cfiles +> List.map (fun c -> Group [c ^ ".c"]) in Directory (s, ys) else failwith ("no Makefile found in: " ^ s) ) (* a = current info file, in general manually extended; b = generated one *) let check_up_to_date a b = let das = directories_to_assoc a in let dbs = directories_to_assoc b in let all_dirs = (das +> List.map fst) $+$ (dbs +> List.map fst) in all_dirs +> List.iter (fun dir -> match optionise (fun () -> List.assoc dir das), optionise (fun () -> List.assoc dir dbs) with | None, None -> raise (Impossible 57) | None, Some gbs -> pr2 ("new directory appeared:" ^ dir) | Some gas, None -> pr2 ("old directory disappeared:" ^ dir) | Some gas, Some gbs -> let afiles = files_of_groups gas in let bfiles = files_of_groups gbs in let all_files = afiles $+$ bfiles in all_files +> List.iter (fun file -> match List.mem file afiles, List.mem file bfiles with | false, false -> raise (Impossible 58) | false, true -> pr2 ("new file appeared:" ^ file ^ " in " ^ dir) | true, false -> pr2 ("old file disappeared:" ^ file ^ " in " ^ dir) | true, true -> () ) ) let files_in_dirs dirs kbuild_info = dirs +> List.map (fun dir -> let dir = Common.chop_dirsymbol dir in (* could use assoc, but we accept "parasite" prefix *) let gooddirs = kbuild_info +> Common.map_filter (function (Directory (s, groups)) -> if dir =~ ("\\(.*\\)" ^ s ^ "$") then let prefix = matched1 dir in Some (prefix, s, groups) else None ) in (match gooddirs with | [prefix, dir, groups] -> groups +> List.map (function (Group xs) -> Group (xs +> List.map (fun s -> Filename.concat (prefix ^ dir) s)) ) | [] -> pr2 ("can't find kbuild info for directory :" ^ dir); [] | x::y::ys -> pr2 ("too much kbuild info candidate for directory :" ^ dir); [] ) ) +> List.concat coccinelle-1.0.0-rc19/extra/Makefile0000644000175000017500000000366712247437436016167 0ustar eugeneugenifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=extra SOURCES = classic_patch.ml kbuild.ml maintainers.ml SYSLIBS = str.cma unix.cma LIBS=../commons/commons.cma ../parsing_c/parsing_c.cma ../globals/globals.cma INCLUDES= -I ../commons -I ../globals -I ../parsing_cocci -I ../parsing_c #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLCFLAGS ?= -g OPTFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDESDEP) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SOURCES:.ml=.cmo) OPTOBJS = $(SOURCES:.ml=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).byte: $(OBJS) $(LIBS) $(OCAMLC_CMD) -o $(TARGET).byte $(SYSLIBS) $(LIBS) $(OBJS) $(TARGET).opt: $(OPTOBJS) $(LIBS:.cma=.cmxa) $(OCAMLOPT_CMD) -o $(TARGET).opt $(SYSLIBS:.cma=.cmxa) $(LIBS:.cma=.cmxa) $(OPTOBJS) $(TARGET).cma: $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) $(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa) $(OCAMLOPT_CMD) -a -o $(TARGET).cmxa $(OPTOBJS) $(TARGET).top: $(OBJS) $(LIBS) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) clean:: rm -f $(TARGET).byte $(TARGET).opt rm -f $(TARGET).top else all: cd .. && $(OCAMLBUILD) extra/extra.cma all.opt: cd .. && $(OCAMLBUILD) extra/extra.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< .ml.mldepend: $(OCAMLC_CMD) -i $< clean:: rm -f .depend rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# distclean: clean .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/extra/classic_patch.mli0000644000175000017500000000037012247437436020016 0ustar eugeneugenopen Common (* used by tools/split_patch *) type patch = patchitem list and patchitem = File of filename * string (* header line *) * string list val parse_patch : filename -> patch val unparse_patch : patch -> filename (* outfile *) -> unit coccinelle-1.0.0-rc19/extra/extra.mllib0000644000175000017500000000004112247437436016652 0ustar eugeneugenClassic_patch Kbuild Maintainers coccinelle-1.0.0-rc19/extra/maintainers.mli0000644000175000017500000000141112247437436017525 0ustar eugeneugenopen Common (* used my tools/meta_files and tools/split_patch *) (* correspond usually to a kernel_dirs.meta *) type subsystem_info = subsystem list and subsystem = Subsystem of (dir * maintainers) * (dir * maintainers) list (* subdirs *) and dir = string and maintainers = string list val mk_inverted_index_subsystem : subsystem_info -> (dir,dir) Hashtbl.t val subsystem_to_hash : subsystem_info -> (dir, (maintainers * (dir * maintainers) list)) Hashtbl.t val unparse_subsystem_info : subsystem_info -> filename (*outfile*) -> unit val parse_subsystem_info : filename -> subsystem_info val generate_naive_subsystem_info : string list -> subsystem_info val check_up_to_date : subsystem_info -> subsystem_info -> unit coccinelle-1.0.0-rc19/extra/kbuild.mli0000644000175000017500000000160212247437436016467 0ustar eugeneugenopen Common (* used my tools/meta_files *) (* correspond usually to a kernel_files.meta *) type kbuild_info = directory list and directory = Directory of string (*dirname*) * group list and group = Group of filename list val unparse_kbuild_info : kbuild_info -> filename (*outfile*) -> unit val parse_kbuild_info : filename -> kbuild_info val generate_naive_kbuild_info : string list -> kbuild_info val generate_less_naive_kbuild_info : string list -> kbuild_info val generate_kbuild_info_from_depcocci : string list -> filename (*out*) -> unit val check_up_to_date : kbuild_info -> kbuild_info -> unit (* get the relevant groups from dirs given a kbuild_info *) val files_in_dirs : string list (* dirs *) -> kbuild_info -> group list (* remove the .git directory, wrong include, from the list of directories * passed in parameter *) val adjust_dirs : string list -> string list coccinelle-1.0.0-rc19/globals/0000755000175000017500000000000012247442646015012 5ustar eugeneugencoccinelle-1.0.0-rc19/globals/config.ml.in0000644000175000017500000000043312247437436017217 0ustar eugeneugenlet version = "@COCCI_VERSION@" let path = try (Sys.getenv "COCCINELLE_HOME") with Not_found->"@prefix@/share/coccinelle" let std_iso = ref (Filename.concat path "standard.iso") let std_h = ref (Filename.concat path "standard.h") let dynlink_is_native = @DYNLINK_IS_NATIVE@ coccinelle-1.0.0-rc19/globals/flag.ml0000644000175000017500000000450012247442615016250 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag.ml" let sgrep_mode2 = ref false let show_misc = ref true let show_transinfo = ref false let show_trying = ref false let track_iso_usage = ref false let worth_trying_opt = ref true type scanner = IdUtils | Glimpse | CocciGrep | NoScanner let scanner = ref NoScanner let pyoutput = ref "coccilib.output.Console" let ocamlc = ref Commands.ocamlc_cmd let ocamlopt = ref Commands.ocamlopt_cmd let ocamldep = ref Commands.ocamldep_cmd let ocamlfind = ref Commands.ocamlfind_cmd (*"Some" value is the path with respect to which the patch should be created*) let patch = ref (None : string option) let make_hrule = ref (None : string (*dir*) option) let hrule_per_file = ref true (* if false, then a rule per function *) let currentfile = ref (None : string option) let current_element = ref "" let dir = ref "" let defined_virtual_rules = ref ([] : string list) let defined_virtual_env = ref ([] : (string*string) list) let set_defined_virtual_rules s = match Str.split (Str.regexp "=") s with [name;vl] -> defined_virtual_env := (name,vl) :: !defined_virtual_env | _ -> defined_virtual_rules := s :: !defined_virtual_rules let c_plus_plus = ref false let ibm = ref false (* was in main *) let include_headers = ref false coccinelle-1.0.0-rc19/globals/regexp.ml.in0000644000175000017500000000003012247437436017235 0ustar eugeneugeninclude @REGEXP_MODULE@ coccinelle-1.0.0-rc19/globals/iteration.mli0000644000175000017500000000413012247442615017505 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iteration.mli" type init_info = (string (* language *) * string (* rule name *)) * string list (* defined virtual rules *) val initialization_stack : init_info list ref (* ----------------------------------------------------------------------- *) val base_file_list : string list ref val parsed_virtual_rules : string list ref val parsed_virtual_identifiers : string list ref (* ----------------------------------------------------------------------- *) type pending_info = string list (* files to treat *) * string list * (* defined virtual rules *) (string * string) list (* virtual identifiers *) val add_pending_instance : (* input is like pending_info, but with an extra option on files *) (string list option * string list * (string * string) list) -> unit val get_pending_instance : unit -> pending_info option (* ----------------------------------------------------------------------- *) val check_virtual_rule : string -> unit val check_virtual_ident : string -> unit coccinelle-1.0.0-rc19/globals/globals.mllib0000644000175000017500000000003512247437436017455 0ustar eugeneugenConfig Flag Iteration Regexp coccinelle-1.0.0-rc19/globals/iteration.ml0000644000175000017500000000634412247442615017345 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iteration.ml" type init_info = (string (* language *) * string (* rule name *)) * string list (* defined virtual rules *) let initialization_stack = ref ([] : init_info list) (* ----------------------------------------------------------------------- *) let base_file_list = ref ([] : string list) let parsed_virtual_rules = ref ([] : string list) let parsed_virtual_identifiers = ref ([] : string list) (* ----------------------------------------------------------------------- *) type pending_info = string list (* files to treat *) * string list * (* defined virtual rules *) (string * string) list (* virtual identifiers *) let pending_instances_file = ref ([] : pending_info list) let pending_instances_dir = ref ([] : pending_info list) let add_pending_instance (files,a,b) = match files with None -> pending_instances_dir := (!base_file_list,a,b) :: !pending_instances_dir | Some f -> (* if one specifies a file, it is assumed to be the current one *) (* put at the end of the list of information about this file *) let rec loop = function [] -> [(f,a,b)] | ((f1,a1,b1) as front)::rest -> if f = f1 then front :: (loop rest) else (f,a,b) :: front :: rest in pending_instances_file := loop !pending_instances_file let get_pending_instance _ = (if (List.length !pending_instances_file) > 0 or (List.length !pending_instances_dir) > 0 then Common.pr2 (Printf.sprintf "%d pending new file instances\n%d pending original file instances\n" (List.length !pending_instances_file) (List.length !pending_instances_dir))); match !pending_instances_file with [] -> (match !pending_instances_dir with [] -> None | x::xs -> pending_instances_dir := xs; Some x) | x::xs -> pending_instances_file := xs; Some x (* ----------------------------------------------------------------------- *) let check_virtual_rule r = if not (List.mem r !parsed_virtual_rules) then failwith ("unknown virtual rule "^r) let check_virtual_ident i = if not (List.mem i !parsed_virtual_identifiers) then failwith ("unknown virtual rule "^i) coccinelle-1.0.0-rc19/globals/Makefile0000644000175000017500000000620512247442615016451 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif ############################################################################## # Variables ############################################################################## TARGET=globals OCAMLCFLAGS ?= -g OPTFLAGS ?= -g SRC=config.ml flag.ml iteration.ml $(REGEXP_FILE) regexp.ml LIBS= INCLUDEDIRS= ../commons $(PCREDIR) ############################################################################## # Generic variables ############################################################################## INCLUDES=$(INCLUDEDIRS:%=-I %) OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS= $(SRC:.ml=.cmo) OPTOBJS= $(SRC:.ml=.cmx) ############################################################################## # Top rules ############################################################################## ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).cma: $(LIBS) $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) $(TARGET).cmxa: $(LIBS:.cma=.cmxa) $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $(TARGET).cmxa $(OPTOBJS) else all: cd .. && $(OCAMLBUILD) globals/globals.cma all.opt: cd .. && $(OCAMLBUILD) globals/globals.cmxa clean: cd .. && $(OCAMLBUILD) -clean endif ############################################################################## # Developer rules ############################################################################## .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< .ml.mldepend: $(OCAMLC_CMD) -i $< clean: rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# rm -f .depend distclean: clean .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/globals/globals.mldylib0000644000175000017500000000003512247437436020012 0ustar eugeneugenConfig Flag Iteration Regexp coccinelle-1.0.0-rc19/globals/regexp_pcre.ml0000644000175000017500000000300712247442615017643 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./regexp_pcre.ml" type regexp = Pcre of Pcre.regexp | Str of Str.regexp let pcre_support = ref true let regexp string = if !pcre_support then Pcre (Pcre.regexp string) else Str (Str.regexp string) let string_match regexp string = match regexp with Pcre regexp -> Pcre.pmatch ~rex:regexp string | Str regexp -> try ignore(Str.search_forward regexp string 0); true with _ -> false coccinelle-1.0.0-rc19/globals/regexp_str.ml0000644000175000017500000000247212247442615017527 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./regexp_str.ml" type regexp = Str.regexp let pcre_support = ref false let regexp string = Str.regexp string let string_match regexp string = try Str.search_forward regexp string 0 >= 0 with _ -> false coccinelle-1.0.0-rc19/empty.h0000644000175000017500000000000012247437436014665 0ustar eugeneugencoccinelle-1.0.0-rc19/ctl/0000755000175000017500000000000012247442646014151 5ustar eugeneugencoccinelle-1.0.0-rc19/ctl/ast_ctl.ml0000644000175000017500000001030512247442614016126 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast_ctl.ml" (* ---------------------------------------------------------------------- *) (* Types *) (* ---------------------------------------------------------------------- *) type strict = STRICT | NONSTRICT type keep_binding = bool (* true = put in witness tree *) (* CTL parameterised on basic predicates and metavar's*) type ('pred,'mvar,'anno) generic_ctl = | False | True | Pred of 'pred | Not of (('pred,'mvar,'anno) generic_ctl) | Exists of keep_binding * 'mvar * (('pred,'mvar,'anno) generic_ctl) | And of strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | AndAny of direction * strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | HackForStmt of direction * strict * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Or of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Implies of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | AF of direction * strict * (('pred,'mvar,'anno) generic_ctl) | AX of direction * strict * (('pred,'mvar,'anno) generic_ctl) | AG of direction * strict * (('pred,'mvar,'anno) generic_ctl) | AW of direction * strict * (* versions with exists v *) (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | AU of direction * strict * (* versions with exists v *) (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | EF of direction * (('pred,'mvar,'anno) generic_ctl) | EX of direction * (('pred,'mvar,'anno) generic_ctl) | EG of direction * (('pred,'mvar,'anno) generic_ctl) | EU of direction * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Let of string * (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | LetR of direction * string * (* evals phi1 wrt reachable states *) (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Ref of string | SeqOr of (('pred,'mvar,'anno) generic_ctl) * (('pred,'mvar,'anno) generic_ctl) | Uncheck of (('pred,'mvar,'anno) generic_ctl) | InnerAnd of (('pred,'mvar,'anno) generic_ctl) | XX of (('pred,'mvar,'anno) generic_ctl) (* fake, used in asttoctl *) and direction = FORWARD (* the normal way *) | BACKWARD (* toward the start *) let unwrap (ctl,_) = ctl let rewrap (_,model) ctl = (ctl,model) let get_line (_,l) = l (* NOTE: No explicit representation of the bottom subst., i.e., FALSE *) type ('mvar,'value) generic_subst = | Subst of 'mvar * 'value | NegSubst of 'mvar * 'value type ('mvar,'value) generic_substitution = ('mvar,'value) generic_subst list type ('state,'subst,'anno) generic_witnesstree = Wit of 'state * 'subst * 'anno * ('state,'subst,'anno) generic_witnesstree list | NegWit of ('state,'subst,'anno) generic_witnesstree (* ---------------------------------------------------------------------- *) type 'a modif = Modif of 'a | UnModif of 'a | Control (* ---------------------------------------------------------------------- *) coccinelle-1.0.0-rc19/ctl/flag_ctl.ml0000644000175000017500000000300312247442614016245 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_ctl.ml" (* option -verbose_ctl_engine *) let verbose_ctl_engine = ref false (* cheap partial matches using assttomember *) let verbose_match = ref false let partial_match = ref false let poswits_only = ref false let loop_in_src_code = ref false let bench = ref 0 let steps = ref (None : int option) let graphical_trace = ref false let gt_without_label = ref false let checking_reachability = ref false coccinelle-1.0.0-rc19/ctl/wrapper_ctl.mli0000644000175000017500000000600212247442614017167 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./wrapper_ctl.mli" type info = int type ('pred, 'mvar) wrapped_ctl = ('pred * 'mvar Ast_ctl.modif, 'mvar, info) Ast_ctl.generic_ctl type ('a, 'b) wrapped_binding = ClassicVal of 'a | PredVal of 'b Ast_ctl.modif type ('pred,'state,'mvar,'value) labelfunc = 'pred -> ('state * ('pred * ('mvar, 'value) Ast_ctl.generic_substitution)) list module CTL_ENGINE_BIS : functor (SUB : Ctl_engine.SUBST) -> functor (G : Ctl_engine.GRAPH) -> functor(P : Ctl_engine.PREDICATE) -> sig type predicate = P.t module WRAPPER_ENV : sig type mvar = SUB.mvar type value = (SUB.value, predicate) wrapped_binding end module WRAPPER_PRED : sig type t = P.t * SUB.mvar Ast_ctl.modif end module WRAPPER_ENGINE : sig type substitution = (WRAPPER_ENV.mvar, WRAPPER_ENV.value) Ast_ctl.generic_subst list type ('a, 'b) witness = (G.node, substitution, ('a, WRAPPER_ENV.mvar, 'b) Ast_ctl.generic_ctl list) Ast_ctl.generic_witnesstree type ('a, 'b) triples = (G.node * substitution * ('a, 'b) witness list) list end val satbis_noclean : G.cfg * (predicate, G.node, WRAPPER_ENV.mvar, SUB.value) labelfunc * G.node list -> ((WRAPPER_PRED.t, WRAPPER_ENV.mvar, int) Ast_ctl.generic_ctl * (WRAPPER_PRED.t list list)) -> (WRAPPER_PRED.t, 'a) WRAPPER_ENGINE.triples val satbis : G.cfg * (predicate,G.node,SUB.mvar,SUB.value) labelfunc * G.node list -> ((predicate,SUB.mvar) wrapped_ctl * (WRAPPER_PRED.t list list)) -> (WRAPPER_ENV.mvar list * (SUB.mvar * SUB.value) list) -> ((WRAPPER_PRED.t, 'a) WRAPPER_ENGINE.triples * ((G.node * (SUB.mvar * SUB.value) list * predicate) list list * bool * (WRAPPER_ENV.mvar * SUB.value) list list)) val print_bench : unit -> unit end coccinelle-1.0.0-rc19/ctl/ctl_engine.mli0000644000175000017500000000560012247442614016757 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctl_engine.mli" open Ast_ctl module type SUBST = sig type value type mvar val eq_mvar : mvar -> mvar -> bool val eq_val : value -> value -> bool val merge_val : value -> value -> value val print_mvar : mvar -> unit val print_value : value -> unit end module type GRAPH = sig type node type cfg val predecessors: cfg -> node -> node list val successors: cfg -> node -> node list val extract_is_loop : cfg -> node -> bool val print_node : node -> unit val size : cfg -> int val print_graph : cfg -> string option -> (node * string) list -> (node * string) list -> string -> unit end module OGRAPHEXT_GRAPH : sig type node = int type cfg = (string, unit) Ograph_extended.ograph_mutable val predecessors : < predecessors : 'a -> < tolist : ('b * 'c) list; .. >; .. > -> 'a -> 'b list val print_node : node -> unit end module type PREDICATE = sig type t val print_predicate : t -> unit end module CTL_ENGINE : functor (SUB : SUBST) -> functor (G : GRAPH) -> functor (P : PREDICATE) -> sig type substitution = (SUB.mvar, SUB.value) Ast_ctl.generic_subst list type ('pred,'anno) witness = (G.node, substitution, ('pred, SUB.mvar, 'anno) Ast_ctl.generic_ctl list) Ast_ctl.generic_witnesstree type ('pred,'anno) triples = (G.node * substitution * ('pred,'anno) witness list) list val sat : G.cfg * (P.t -> (P.t,'anno) triples) * G.node list -> (P.t, SUB.mvar, 'c) Ast_ctl.generic_ctl -> (P.t list list (* optional and required things *)) -> (P.t,'anno) triples val print_bench : unit -> unit end val get_graph_files : unit -> string list val get_graph_comp_files : string -> string list coccinelle-1.0.0-rc19/ctl/ctl.mllib0000644000175000017500000000007112247437436015753 0ustar eugeneugenAst_ctl Ctl_engine Flag_ctl Pretty_print_ctl Wrapper_ctl coccinelle-1.0.0-rc19/ctl/wrapper_ctl.ml0000644000175000017500000002150612247442614017024 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./wrapper_ctl.ml" (* ********************************************************************** * * Wrapping for FUNCTORS and MODULES * * * $Id$ * * **********************************************************************) type info = int type ('pred, 'mvar) wrapped_ctl = ('pred * 'mvar Ast_ctl.modif, 'mvar, info) Ast_ctl.generic_ctl type ('value, 'pred) wrapped_binding = | ClassicVal of 'value | PredVal of 'pred Ast_ctl.modif type ('pred,'state,'mvar,'value) labelfunc = 'pred -> ('state * ('pred * ('mvar, 'value) Ast_ctl.generic_substitution)) list (* pad: what is 'wit ? *) type ('pred,'state,'mvar,'value,'wit) wrapped_labelfunc = ('pred * 'mvar Ast_ctl.modif) -> ('state * ('mvar,('value,'pred) wrapped_binding) Ast_ctl.generic_substitution * 'wit ) list (* ********************************************************************** *) (* Module type: CTL_ENGINE_BIS (wrapper for CTL_ENGINE) *) (* ********************************************************************** *) (* This module must convert the labelling function passed as parameter, by using convert_label. Then create a SUBST2 module handling the wrapped_binding. Then it can instantiates the generic CTL_ENGINE module. Call sat. And then process the witness tree to remove all that is not revelevant for the transformation phase. *) module CTL_ENGINE_BIS = functor (SUB : Ctl_engine.SUBST) -> functor (G : Ctl_engine.GRAPH) -> functor(P : Ctl_engine.PREDICATE) -> struct exception TODO_CTL of string (* implementation still not quite done so... *) exception NEVER_CTL of string (* Some things should never happen *) module A = Ast_ctl type predicate = P.t module WRAPPER_ENV = struct type mvar = SUB.mvar type value = (SUB.value,predicate) wrapped_binding let eq_mvar = SUB.eq_mvar let eq_val wv1 wv2 = match (wv1,wv2) with | (ClassicVal(v1),ClassicVal(v2)) -> SUB.eq_val v1 v2 | (PredVal(v1),PredVal(v2)) -> v1 = v2 (* FIX ME: ok? *) | _ -> false let merge_val wv1 wv2 = match (wv1,wv2) with | (ClassicVal(v1),ClassicVal(v2)) -> ClassicVal(SUB.merge_val v1 v2) | _ -> wv1 (* FIX ME: ok? *) let print_mvar x = SUB.print_mvar x let print_value x = match x with ClassicVal v -> SUB.print_value v | PredVal(A.Modif v) -> P.print_predicate v | PredVal(A.UnModif v) -> P.print_predicate v | PredVal(A.Control) -> Format.print_string "no value" end module WRAPPER_PRED = struct type t = P.t * SUB.mvar Ast_ctl.modif let print_predicate (pred, modif) = begin P.print_predicate pred; (match modif with Ast_ctl.Modif x | Ast_ctl.UnModif x -> Format.print_string " with " | Ast_ctl.Control -> ()) end end (* Instantiate a wrapped version of CTL_ENGINE *) module WRAPPER_ENGINE = Ctl_engine.CTL_ENGINE (WRAPPER_ENV) (G) (WRAPPER_PRED) (* Wrap a label function *) let (wrap_label: ('pred,'state,'mvar,'value) labelfunc -> ('pred,'state,'mvar,'value,'wit) wrapped_labelfunc) = fun oldlabelfunc -> fun (p, predvar) -> let penv p' = match predvar with | A.Modif(x) -> [A.Subst(x,PredVal(A.Modif(p')))] | A.UnModif(x) -> [A.Subst(x,PredVal(A.UnModif(p')))] | A.Control -> [] in let conv_sub sub = match sub with | A.Subst(x,v) -> A.Subst(x,ClassicVal(v)) | A.NegSubst(x,v) -> A.NegSubst(x,ClassicVal(v)) in let conv_trip (s,(p',env)) = (s,penv p' @ (List.map conv_sub env),[](*pad: ?*)) in List.map conv_trip (oldlabelfunc p) (* ---------------------------------------------------------------- *) (* FIX ME: what about negative witnesses and negative substitutions *) let unwrap_wits modifonly wits = let mkth th = Common.map_filter (function A.Subst(x,ClassicVal(v)) -> Some (x,v) | _ -> None) th in let rec loop neg acc = function A.Wit(st,[A.Subst(x,PredVal(A.Modif(v)))],anno,wit) -> (match wit with [] -> [(st,acc,v)] | _ -> raise (NEVER_CTL "predvar tree should have no children")) | A.Wit(st,[A.Subst(x,PredVal(A.UnModif(v)))],anno,wit) when not modifonly or !Flag.track_iso_usage -> (match wit with [] -> [(st,acc,v)] | _ -> raise (NEVER_CTL "predvar tree should have no children")) | A.Wit(st,th,anno,wit) -> List.concat (List.map (loop neg ((mkth th) @ acc)) wit) | A.NegWit(_) -> [] (* why not failure? *) in List.concat (List.map (function wit -> loop false [] wit) wits) ;; (* (* a match can return many trees, but within each tree, there has to be at most one value for each variable that is in the used_after list *) let collect_used_after used_after envs = let print_var var = SUB.print_mvar var; Format.print_flush() in List.concat (List.map (function used_after_var -> let vl = List.fold_left (function rest -> function env -> try let vl = List.assoc used_after_var env in match rest with None -> Some vl | Some old_vl when SUB.eq_val vl old_vl -> rest | Some old_vl -> print_var used_after_var; Format.print_newline(); SUB.print_value old_vl; Format.print_newline(); SUB.print_value vl; Format.print_newline(); failwith "incompatible values" with Not_found -> rest) None envs in match vl with None -> [] | Some vl -> [(used_after_var, vl)]) used_after) *) (* a match can return many trees, but within each tree, there has to be at most one value for each variable that is in the used_after list *) (* actually, this should always be the case, because these variables should be quantified at the top level. so the more complicated definition above should not be needed. *) let collect_used_after used_after envs = List.concat (List.map (function used_after_var -> let vl = List.fold_left (function rest -> function env -> try let vl = List.assoc used_after_var env in if List.exists (function x -> SUB.eq_val x vl) rest then rest else vl::rest with Not_found -> rest) [] envs in List.map (function x -> (used_after_var, x)) vl) used_after) (* ----------------------------------------------------- *) (* The wrapper for sat from the CTL_ENGINE *) let satbis_noclean (grp,lab,states) (phi,reqopt) : ('pred,'anno) WRAPPER_ENGINE.triples = WRAPPER_ENGINE.sat (grp,wrap_label lab,states) phi reqopt (* Returns the "cleaned up" result from satbis_noclean *) let (satbis : G.cfg * (predicate,G.node,SUB.mvar,SUB.value) labelfunc * G.node list -> ((predicate,SUB.mvar) wrapped_ctl * (WRAPPER_PRED.t list list)) -> (WRAPPER_ENV.mvar list * (SUB.mvar * SUB.value) list) -> ((WRAPPER_PRED.t, 'a) WRAPPER_ENGINE.triples * ((G.node * (SUB.mvar * SUB.value) list * predicate) list list * bool * (WRAPPER_ENV.mvar * SUB.value) list list))) = fun m phi (used_after, binding) -> let noclean = satbis_noclean m phi in let witness_trees = List.map (fun (_,_,w) -> w) noclean in let res = List.map (unwrap_wits true) witness_trees in let new_bindings = List.map (function bindings_per_witness_tree -> (List.map (function (_,env,_) -> env) bindings_per_witness_tree)) (List.map (unwrap_wits false) witness_trees) in (noclean, (res,not(noclean = []), (* throw in the old binding. By construction it doesn't conflict with any of the new things, and it is useful if there are no new things. *) (List.map (collect_used_after used_after) new_bindings))) let print_bench _ = WRAPPER_ENGINE.print_bench() (* END OF MODULE: CTL_ENGINE_BIS *) end coccinelle-1.0.0-rc19/ctl/pretty_print_ctl.mli0000644000175000017500000000237512247442614020263 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_ctl.mli" val pp_ctl: ('pred -> unit) * ('mvar -> unit) -> bool (* inline_let_def *) -> ('pred, 'mvar, 'info) Ast_ctl.generic_ctl -> unit coccinelle-1.0.0-rc19/ctl/pretty_print_ctl.ml0000644000175000017500000001326412247442614020111 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_ctl.ml" open Common open Format open Ast_ctl (* todo?: a txt_to_latex, that use Format to compute the good space but * then generate latex to better output. *) let char_and = "&" let char_and_any = "&+" let char_hack = "&h+" let char_or = "v" let char_seqor = "|" let char_not = "!" let char_back = "^" (* let char_and = "/\\" let char_or = "\\/" let char_not = "-|" *) (* need introduce the Val constructor, or use -rectype. *) type ('a,'b,'c) environment = (string, ('a,'b,'c) binding_val) Common.assoc and ('a, 'b, 'c) binding_val = Val of ('a,'b,'c) generic_ctl * ('a,'b,'c) environment let rec (pp_ctl: ('pred -> unit) * ('mvar -> unit) -> bool -> ('pred, 'mvar, 'info) generic_ctl -> unit) = fun (pp_pred, pp_mvar) inline_let_def ctl -> let rec pp_aux env = function False -> pp "False" | True -> pp "True" | Pred(p) -> pp_pred p | Not(phi) -> pp char_not; Common.pp_do_in_box (fun () -> pp_aux env phi) | Exists(keep,v,phi) -> pp "("; if keep then pp ("Ex ") else pp ("Ex_ "); pp_mvar v; pp " . "; print_cut(); Common.pp_do_in_box (fun () -> pp_aux env phi); pp ")"; | AndAny(dir,s,phi1,phi2) -> pp_2args env (char_and_any^(pp_dirc dir)^(pp_sc s)) phi1 phi2; | HackForStmt(dir,s,phi1,phi2) -> pp_2args env (char_hack^(pp_dirc dir)^(pp_sc s)) phi1 phi2; | And(s,phi1,phi2) -> pp_2args env (char_and^(pp_sc s)) phi1 phi2; | Or(phi1,phi2) -> pp_2args env char_or phi1 phi2; | SeqOr(phi1,phi2) -> pp_2args env char_seqor phi1 phi2; | Implies(phi1,phi2) -> pp_2args env "=>" phi1 phi2; | AF(dir,s,phi1) -> pp "AF"; pp_dir dir; pp_s s; pp_arg_paren env phi1; | AX(dir,s,phi1) -> pp "AX"; pp_dir dir; pp_s s; pp_arg_paren env phi1; | AG(dir,s,phi1) -> pp "AG"; pp_dir dir; pp_s s; pp_arg_paren env phi1; | EF(dir,phi1) -> pp "EF"; pp_dir dir; pp_arg_paren env phi1; | EX(dir,phi1) -> pp "EX"; pp_dir dir; pp_arg_paren env phi1; | EG(dir,phi1) -> pp "EG"; pp_dir dir; pp_arg_paren env phi1; | AW(dir,s,phi1,phi2) -> pp "A"; pp_dir dir; pp_s s; pp "["; pp_2args_bis env "W" phi1 phi2; pp "]" | AU(dir,s,phi1,phi2) -> pp "A"; pp_dir dir; pp_s s; pp "["; pp_2args_bis env "U" phi1 phi2; pp "]" | EU(dir,phi1,phi2) -> pp "E"; pp_dir dir; pp "["; pp_2args_bis env "U" phi1 phi2; pp "]" | Let (x,phi1,phi2) -> let env' = (x, (Val (phi1,env)))::env in if not inline_let_def then begin pp ("Let"^" "^x); pp " = "; print_cut(); Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space (); pp "in"; print_space (); end; pp_do_in_zero_box (fun () -> pp_aux env' phi2); | LetR (dir,x,phi1,phi2) -> let env' = (x, (Val (phi1,env)))::env in if not inline_let_def then begin pp ("LetR"^" "^x); pp_dir dir; pp " = "; print_cut(); Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space (); pp "in"; print_space (); end; pp_do_in_zero_box (fun () -> pp_aux env' phi2); | Ref(s) -> if inline_let_def then let Val (phi1,env') = List.assoc s env in pp_aux env' phi1 else (* pp "Ref("; *) pp s (* pp ")" *) | Uncheck(phi1) -> pp "Uncheck"; pp_arg_paren env phi1 | InnerAnd(phi1) -> pp "InnerAnd"; pp_arg_paren env phi1 | XX _ -> failwith "should be removed" and pp_dir = function FORWARD -> () | BACKWARD -> pp char_back and pp_dirc = function FORWARD -> "" | BACKWARD -> char_back and pp_s = function STRICT -> if !Flag_ctl.partial_match then pp "," else () | NONSTRICT -> () and pp_sc = function STRICT -> "," | NONSTRICT -> "" and pp_2args env sym phi1 phi2 = begin pp "("; Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space(); pp sym; print_space (); Common.pp_do_in_box (fun () -> pp_aux env phi2); pp ")"; end and pp_2args_bis env sym phi1 phi2 = begin Common.pp_do_in_box (fun () -> pp_aux env phi1); print_space(); pp sym; print_space(); Common.pp_do_in_box (fun () -> pp_aux env phi2); end and pp_arg_paren env phi = Common.pp_do_in_box (fun () -> pp "("; pp_aux env phi; pp ")"; ) in Common.pp_do_in_box (fun () -> pp_aux [] ctl;) coccinelle-1.0.0-rc19/ctl/test_ctl.ml0000644000175000017500000002415012247442614016321 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./test_ctl.ml" (* ********************************************************************** *) (* Module: EXAMPLE_ENGINE (instance of CTL_ENGINE) *) (* ********************************************************************** *) (* Simple env.: meta.vars and values are strings *) module SIMPLE_ENV = struct type value = string;; type mvar = string;; let eq_mvar x x' = x = x';; let eq_val v v' = v = v';; let merge_val v v' = v;; end ;; (* Simple predicates *) module WRAPPER_PRED = struct type predicate = string end module EXAMPLE_ENGINE = Wrapper_ctl.CTL_ENGINE_BIS (SIMPLE_ENV) (Ctl_engine.OGRAPHEXT_GRAPH) (WRAPPER_PRED) let top_wit = [] (* ******************************************************************** *) (* *) (* EXAMPLES *) (* *) (* ******************************************************************** *) (* For convenience in the examples *) (* FIX ME: remove *) open Ctl_engine.OGRAPHEXT_GRAPH;; open EXAMPLE_ENGINE;; open Ast_ctl;; (* ---------------------------------------------------------------------- *) (* Helpers *) (* ---------------------------------------------------------------------- *) (* FIX ME: move to ENGINE module *) let (-->) x v = Subst (x,v);; (* FIX ME: move to ENGINE module *) let (-/->) x v = NegSubst(x,v);; let mkgraph nodes edges = let g = ref (new Ograph_extended.ograph_extended) in let addn (n,x) = (* let (g',i) = (!g)#add_node x in *) (* now I need to force the nodei of a node, because of the state(vx) predicates hence add_node -> add_nodei *) let (g', i) = !g#add_nodei n x in assert (i = n); g := g'; (n,i) in let adde anodes (n1,n2,x) = let g' = (!g)#add_arc ((List.assoc n1 anodes,List.assoc n2 anodes),x) in g := g'; () in let add_nodes = List.map addn nodes in let _add_edges = List.map (adde add_nodes) edges in !g ;; (* CTL parameterised on basic predicates and metavar's*) type ('pred,'mvar) old_gen_ctl = | False_ | True_ | Pred_ of 'pred | Not_ of ('pred,'mvar) old_gen_ctl | Exists_ of 'mvar * ('pred,'mvar) old_gen_ctl (* !!! *) | And_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | Or_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | Implies_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | AF_ of ('pred,'mvar) old_gen_ctl | AX_ of ('pred,'mvar) old_gen_ctl | AG_ of ('pred,'mvar) old_gen_ctl | AU_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | EF_ of ('pred,'mvar) old_gen_ctl | EX_ of ('pred,'mvar) old_gen_ctl | EG_ of ('pred,'mvar) old_gen_ctl | EU_ of ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | Let_ of string * ('pred,'mvar) old_gen_ctl * ('pred,'mvar) old_gen_ctl | Ref_ of string let rec mkanno phi0 = let anno phi = (phi,None) in match phi0 with | False_ -> anno False | True_ -> anno True | Pred_(p) -> anno (Pred(p)) | Not_(phi) -> anno (Not(mkanno phi)) | Exists_(v,phi) -> anno (Exists(v,mkanno phi)) | And_(phi1,phi2) -> anno (And(mkanno phi1,mkanno phi2)) | Or_(phi1,phi2) -> anno (Or(mkanno phi1,mkanno phi2)) | Implies_(phi1,phi2) -> anno (Implies(mkanno phi1,mkanno phi2)) | AF_(phi1) -> anno (AF(mkanno phi1)) | AX_(phi1) -> anno (AX(mkanno phi1)) | AG_(phi1) -> anno (AG(mkanno phi1)) | AU_(phi1,phi2) -> anno (AU(mkanno phi1,mkanno phi2)) | EF_(phi1) -> anno (EF(mkanno phi1)) | EX_(phi1) -> anno (EX(mkanno phi1)) | EG_(phi1) -> anno (EG(mkanno phi1)) | EU_(phi1,phi2) -> anno (EU(mkanno phi1,mkanno phi2)) | Let_ (x,phi1,phi2) -> anno (Let(x,mkanno phi1,mkanno phi2)) | Ref_(s) -> anno (Ref(s)) (* ******************************************************************** *) (* Example 1 *) (* CTL: f(x) /\ AF(Ey.g(y)) *) (* ******************************************************************** *) let ex1lab s = match s with | "f(x)" -> [(0,["x" --> "1"]); (1,["x" --> "2"])] | "g(y)" -> [(3,["y" --> "1"]); (4,["y" --> "2"])] | "f(1)" -> [(0,[])] | "f(2)" -> [(1,[])] | "g(1)" -> [(3,[])] | "g(2)" -> [(4,[])] | _ -> [] ;; let ex1graph = let nodes = [(0,"f(1)");(1,"f(2)");(2,"< >");(3,"g(1)");(4,"g(2)");(5,"")] in let edges = [(0,2); (1,2); (2,3); (2,4); (3,5); (4,5); (5,5)] in mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges) ;; let ex1states = List.map fst (ex1graph#nodes)#tolist;; let ex1model = (ex1graph,ex1lab,ex1states);; let ex1model_wrapped = (ex1graph,wrap_label ex1lab,ex1states);; let ex1s0 = Exists_("v0",Pred_ ("f(x)",UnModif "v0"));; let ex1s1 = Exists_("v1",Pred_ ("g(y)",Modif "v1"));; let ex1s2 = Exists_("y",ex1s1);; let ex1s3 = AF_(ex1s2);; let ex1s4 = And_(ex1s0,ex1s3);; let ex1s3a = AX_(ex1s2);; let ex1s4a = AX_(AX_(ex1s2));; let ex1s5a = And_(ex1s0,ex1s4a);; let ex1s0b = Pred_ ("g(y)", Modif "v0");; let ex1s1b = Exists_ ("v0",ex1s0b);; let ex1s2b = Exists_ ("y",ex1s1b);; let ex1s3b = AF_(ex1s2b);; let ex1s4b = AX_(ex1s3b);; let ex1s5b = Pred_ ("f(x)", UnModif "v3");; let ex1s6b = Exists_ ("v3", ex1s5b);; let ex1s7b = Exists_ ("x", ex1s6b);; let ex1s8b = And_(ex1s7b,ex1s4b);; let ex1s7c = And_(ex1s6b,ex1s4b);; let ex1s8c = Exists_("x",ex1s7c);; let ex1phi1 = ex1s4;; let ex1phi2 = ex1s5a;; let ex1phi3 = And_ (Exists_ ("x", (Exists_ ("v3", Pred_ ("f(x)", UnModif "v3")))), AX_ (AF_ (Exists_ ("y", (* change this to Y and have strange behaviour *) (Exists_ ("v0", Pred_ ("g(y)", Modif "v0") ))))));; let ex1phi4 = Exists_ ("x", And_ ( (Exists_ ("v3", Pred_ ("f(x)", UnModif "v3"))), AX_ (AF_ (Exists_ ("y", (* change this to Y and have strange behaviour *) (Exists_ ("v0", Pred_ ("g(y)", Modif "v0") )))))));; let ex1phi5 = AU_(True_,Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))));; let ex1phi6 = AU_( Not_(Exists_("x",Exists_("v1",Pred_("f(x)",UnModif "v1")))), Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))) );; (* use with ex1nc *) let ex1phi7 = AU_( Not_(Or_(Pred_("f(1)",Control),Pred_("f(2)",Control))), Exists_("y", Exists_("v0",Pred_("g(y)",Modif "v0"))) );; let ex1 phi = satbis ex1model (mkanno phi);; let ex1nc phi = satbis_noclean ex1model (mkanno phi);; (* ******************************************************************** *) (* Example 2 *) (* ******************************************************************** *) let ex2lab s = match s with | "p" -> [0,[]] | "{" -> [(1,[]); (2,[])] | "}" -> [(3,[]); (4,[])] | "paren(v)" -> [(1,["v" --> "1"]); (2,["v" --> "2"]); (3,["v" --> "2"]); (4,["v" --> "1"])] | _ -> [] ;; let ex2graph = let nodes = [(0,"p");(1,"{");(2,"{");(3,"}");(4,"}");(5,"")] in let edges = [(0,1); (1,2); (2,3); (3,4); (4,5); (5,5)] in mkgraph nodes (List.map (fun (x,y) -> (x,y,())) edges) ;; let ex2states = List.map fst (ex2graph#nodes)#tolist;; let ex2model = (ex2graph,ex2lab,ex2states);; let ex2model_wrapped = (ex2graph,wrap_label ex2lab,ex2states);; let ex2s0 = Pred_("p",Control);; let ex2s1 = Pred_("{",Control);; let ex2s2 = Pred_("paren(v)",Control);; let ex2s3 = And_(ex2s1,ex2s2);; let ex2s4 = Pred_("}",Control);; let ex2s5 = Pred_("paren(v)",Control);; let ex2s6 = And_(ex2s4,ex2s5);; let ex2s7 = AF_(ex2s6);; let ex2s8 = And_(ex2s3,ex2s7);; let ex2s9 = Exists_("v",ex2s8);; let ex2s10 = AX_(ex2s9);; let ex2s11 = And_(ex2s0,ex2s10);; let ex2phi1 = ex2s11;; let ex2 phi = satbis_noclean ex2model (mkanno phi) (* +--- s11:& ---+ | | s0:p s10:AX | s9:exists v | +---------- s8:& --------+ | | +-- s3:& --+ s7:AF | | | s1:"{" s2:paren(v) +-- s6:& -+ | | s4:"}" s5:paren(v) s0 : p : (0,_,_) s1 : "{" : (1,_,_); (2,_,_) s2 : paren(v) : (1,v=1,_); (2,v=2,_); (3,v=2,_); (4,v=1,_) s3 : "{" & paren(v) : (1,v=1,_); (2,v=2,_) s4 : "}" : (3,_,_); (4,_,_) s5 : paren(v) : (1,v=1,_); (2,v=2,_); (3,v=2,_); (4,v=1,_) s6 : "}" & paren(v) : (3,v=2,_); (4,v=1,_) s7 : AF(...) : (0;1;2;3,v=2,_); (0;1;2;3;4,v=1,_) s8 : (...&...) & AF(...) : (1,v=1,_); (2,v=2,_) s9 : exists ... : (1,_,(1,v=1)); (2,_,(2,v=2)) s10 : AX(...) : (0,_,(1,v=1)); (1,_,(2,v=2)) s11 : p & AX(...) : (0,_,(1,v=1)) *) coccinelle-1.0.0-rc19/ctl/ctl_engine.ml0000644000175000017500000023457212247442614016622 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctl_engine.ml" (*external c_counter : unit -> int = "c_counter"*) let timeout = 800 (* Optimize triples_conj by first extracting the intersection of the two sets, which can certainly be in the intersection *) let pTRIPLES_CONJ_OPT = ref true (* For complement, make NegState for the negation of a single state *) let pTRIPLES_COMPLEMENT_OPT = ref true (* For complement, do something special for the case where the environment and witnesses are empty *) let pTRIPLES_COMPLEMENT_SIMPLE_OPT = ref true (* "Double negate" the arguments of the path operators *) let pDOUBLE_NEGATE_OPT = ref true (* Only do pre_forall/pre_exists on new elements in fixpoint iteration *) let pNEW_INFO_OPT = ref true (* Filter the result of the label function to drop entries that aren't compatible with any of the available environments *) let pREQUIRED_ENV_OPT = ref true (* Memoize the raw result of the label function *) let pSATLABEL_MEMO_OPT = ref true (* Filter results according to the required states *) let pREQUIRED_STATES_OPT = ref true (* Drop negative witnesses at Uncheck *) let pUNCHECK_OPT = ref true let pANY_NEG_OPT = ref true let pLazyOpt = ref true (* Nico: This stack is use for graphical traces *) let graph_stack = ref ([] : string list) let graph_hash = (Hashtbl.create 101) (* let pTRIPLES_CONJ_OPT = ref false let pTRIPLES_COMPLEMENT_OPT = ref false let pTRIPLES_COMPLEMENT_SIMPLE_OPT = ref false let pDOUBLE_NEGATE_OPT = ref false let pNEW_INFO_OPT = ref false let pREQUIRED_ENV_OPT = ref false let pSATLABEL_MEMO_OPT = ref false let pREQUIRED_STATES_OPT = ref false let pUNCHECK_OPT = ref false let pANY_NEG_OPT = ref false let pLazyOpt = ref false *) let step_count = ref 0 exception Steps let inc_step _ = if not (!step_count = 0) then begin step_count := !step_count - 1; if !step_count = 0 then raise Steps end let inc cell = cell := !cell + 1 let satEU_calls = ref 0 let satAW_calls = ref 0 let satAU_calls = ref 0 let satEF_calls = ref 0 let satAF_calls = ref 0 let satEG_calls = ref 0 let satAG_calls = ref 0 let triples = ref 0 let ctr = ref 0 let new_let _ = let c = !ctr in ctr := c + 1; Printf.sprintf "_fresh_r_%d" c (* ********************************************************************** * * Implementation of a Witness Tree model checking engine for CTL-FVex * * * **********************************************************************) (* ********************************************************************** *) (* Module: SUBST (substitutions: meta. vars and values) *) (* ********************************************************************** *) module type SUBST = sig type value type mvar val eq_mvar: mvar -> mvar -> bool val eq_val: value -> value -> bool val merge_val: value -> value -> value val print_mvar : mvar -> unit val print_value : value -> unit end ;; (* ********************************************************************** *) (* Module: GRAPH (control flow graphs / model) *) (* ********************************************************************** *) module type GRAPH = sig type node type cfg val predecessors: cfg -> node -> node list val successors: cfg -> node -> node list val extract_is_loop : cfg -> node -> bool val print_node : node -> unit val size : cfg -> int val print_graph : cfg -> string option -> (node * string) list -> (node * string) list -> string -> unit end ;; module OGRAPHEXT_GRAPH = struct type node = int;; type cfg = (string,unit) Ograph_extended.ograph_mutable;; let predecessors cfg n = List.map fst ((cfg#predecessors n)#tolist);; let print_node i = Format.print_string (Common.i_to_s i) end ;; (* ********************************************************************** *) (* Module: PREDICATE (predicates for CTL formulae) *) (* ********************************************************************** *) module type PREDICATE = sig type t val print_predicate : t -> unit end (* ********************************************************************** *) (* ---------------------------------------------------------------------- *) (* Misc. useful generic functions *) (* ---------------------------------------------------------------------- *) let get_graph_files () = !graph_stack let get_graph_comp_files outfile = Hashtbl.find_all graph_hash outfile let head = List.hd let tail l = match l with [] -> [] | (x::xs) -> xs ;; let foldl = List.fold_left;; let foldl1 f xs = foldl f (head xs) (tail xs) type 'a esc = ESC of 'a | CONT of 'a let foldr = List.fold_right;; let concat = List.concat;; let map = List.map;; let filter = List.filter;; let partition = List.partition;; let concatmap f l = List.concat (List.map f l);; let maybe f g opt = match opt with | None -> g | Some x -> f x ;; let some_map f opts = map (maybe (fun x -> Some (f x)) None) opts let some_tolist_alt opts = concatmap (maybe (fun x -> [x]) []) opts let rec some_tolist opts = match opts with | [] -> [] | (Some x)::rest -> x::(some_tolist rest) | _::rest -> some_tolist rest ;; let rec groupBy eq l = match l with [] -> [] | (x::xs) -> let (xs1,xs2) = partition (fun x' -> eq x x') xs in (x::xs1)::(groupBy eq xs2) ;; let group l = groupBy (=) l;; let rec memBy eq x l = match l with [] -> false | (y::ys) -> if (eq x y) then true else (memBy eq x ys) ;; let rec nubBy eq ls = match ls with [] -> [] | (x::xs) when (memBy eq x xs) -> nubBy eq xs | (x::xs) -> x::(nubBy eq xs) ;; let rec nub ls = match ls with [] -> [] | (x::xs) when (List.mem x xs) -> nub xs | (x::xs) -> x::(nub xs) ;; let state_compare (s1,_,_) (s2,_,_) = compare s1 s2 let setifyBy eq xs = nubBy eq xs;; let setify xs = nub xs;; let inner_setify xs = List.sort compare (nub xs);; let unionBy compare eq xs = function [] -> xs | ys -> let rec loop = function [] -> ys | x::xs -> if memBy eq x ys then loop xs else x::(loop xs) in List.sort compare (loop xs) ;; let union xs ys = unionBy state_compare (=) xs ys;; let setdiff xs ys = filter (fun x -> not (List.mem x ys)) xs;; let subseteqBy eq xs ys = List.for_all (fun x -> memBy eq x ys) xs;; let subseteq xs ys = List.for_all (fun x -> List.mem x ys) xs;; let supseteq xs ys = subseteq ys xs let setequalBy eq xs ys = (subseteqBy eq xs ys) & (subseteqBy eq ys xs);; let setequal xs ys = (subseteq xs ys) & (subseteq ys xs);; (* Fix point calculation *) let rec fix eq f x = let x' = f x in if (eq x' x) then x' else fix eq f x' ;; (* Fix point calculation on set-valued functions *) let setfix f x = (fix subseteq f x) (*if new is a subset of old, stop*) let setgfix f x = (fix supseteq f x) (*if new is a supset of old, stop*) let get_states l = nub (List.map (function (s,_,_) -> s) l) (* ********************************************************************** *) (* Module: CTL_ENGINE *) (* ********************************************************************** *) module CTL_ENGINE = functor (SUB : SUBST) -> functor (G : GRAPH) -> functor (P : PREDICATE) -> struct module A = Ast_ctl type substitution = (SUB.mvar, SUB.value) Ast_ctl.generic_substitution type ('pred,'anno) witness = (G.node, substitution, ('pred, SUB.mvar, 'anno) Ast_ctl.generic_ctl list) Ast_ctl.generic_witnesstree type ('pred,'anno) triples = (G.node * substitution * ('pred,'anno) witness list) list (* ---------------------------------------------------------------------- *) (* Pretty printing functions *) (* ---------------------------------------------------------------------- *) let (print_generic_substitution : substitution -> unit) = fun substxs -> let print_generic_subst = function A.Subst (mvar, v) -> SUB.print_mvar mvar; Format.print_string " --> "; SUB.print_value v | A.NegSubst (mvar, v) -> SUB.print_mvar mvar; Format.print_string " -/-> "; SUB.print_value v in Format.print_string "["; Common.print_between (fun () -> Format.print_string ";" ) print_generic_subst substxs; Format.print_string "]" let rec (print_generic_witness: ('pred, 'anno) witness -> unit) = function | A.Wit (state, subst, anno, childrens) -> Format.print_string "wit "; G.print_node state; print_generic_substitution subst; (match childrens with [] -> Format.print_string "{}" | _ -> Format.force_newline(); Format.print_string " "; Format.open_box 0; print_generic_witnesstree childrens; Format.close_box()) | A.NegWit(wit) -> Format.print_string "!"; print_generic_witness wit and (print_generic_witnesstree: ('pred,'anno) witness list -> unit) = fun witnesstree -> Format.open_box 1; Format.print_string "{"; Common.print_between (fun () -> Format.print_string ";"; Format.force_newline() ) print_generic_witness witnesstree; Format.print_string "}"; Format.close_box() and print_generic_triple (node,subst,tree) = G.print_node node; print_generic_substitution subst; print_generic_witnesstree tree and (print_generic_algo : ('pred,'anno) triples -> unit) = fun xs -> Format.print_string "<"; Common.print_between (fun () -> Format.print_string ";"; Format.force_newline()) print_generic_triple xs; Format.print_string ">" ;; let print_state (str : string) (l : ('pred,'anno) triples) = Printf.printf "%s\n" str; List.iter (function x -> print_generic_triple x; Format.print_newline(); flush stdout) (List.sort compare l); Printf.printf "\n" let print_required_states = function None -> Printf.printf "no required states\n" | Some states -> Printf.printf "required states: "; List.iter (function x -> G.print_node x; Format.print_string " "; Format.print_flush()) states; Printf.printf "\n" let mkstates states = function None -> states | Some states -> states let print_graph grp required_states res str = function A.Exists (keep,v,phi) -> () | phi -> if !Flag_ctl.graphical_trace && not !Flag_ctl.checking_reachability then match phi with | A.Exists (keep,v,phi) -> () | _ -> let label = Printf.sprintf "%s%s" (String.escaped (Common.format_to_string (function _ -> Pretty_print_ctl.pp_ctl (P.print_predicate, SUB.print_mvar) false phi))) str in let file = (match !Flag.currentfile with None -> "graphical_trace" | Some f -> f ) in (if not (List.mem file !graph_stack) then graph_stack := file :: !graph_stack); let filename = Filename.temp_file (file^":") ".dot" in Hashtbl.add graph_hash file filename; G.print_graph grp (if !Flag_ctl.gt_without_label then None else (Some label)) (match required_states with None -> [] | Some required_states -> (List.map (function s -> (s,"blue")) required_states)) (List.map (function (s,_,_) -> (s,"\"#FF8080\"")) res) filename let print_graph_c grp required_states res ctr phi = let str = "iter: "^(string_of_int !ctr) in print_graph grp required_states res str phi (* ---------------------------------------------------------------------- *) (* *) (* ---------------------------------------------------------------------- *) (* ************************* *) (* Substitutions *) (* ************************* *) let dom_sub sub = match sub with | A.Subst(x,_) -> x | A.NegSubst(x,_) -> x ;; let ran_sub sub = match sub with | A.Subst(_,x) -> x | A.NegSubst(_,x) -> x ;; let eq_subBy eqx eqv sub sub' = match (sub,sub') with | (A.Subst(x,v),A.Subst(x',v')) -> (eqx x x') && (eqv v v') | (A.NegSubst(x,v),A.NegSubst(x',v')) -> (eqx x x') && (eqv v v') | _ -> false ;; (* NOTE: functor *) let eq_sub sub sub' = eq_subBy SUB.eq_mvar SUB.eq_val sub sub' let eq_subst th th' = setequalBy eq_sub th th';; let merge_subBy eqx (===) (>+<) sub sub' = (* variable part is guaranteed to be the same *) match (sub,sub') with (A.Subst (x,v),A.Subst (x',v')) -> if (v === v') then Some [A.Subst(x, v >+< v')] else None | (A.NegSubst(x,v),A.Subst(x',v')) -> if (not (v === v')) then Some [A.Subst(x',v')] else None | (A.Subst(x,v),A.NegSubst(x',v')) -> if (not (v === v')) then Some [A.Subst(x,v)] else None | (A.NegSubst(x,v),A.NegSubst(x',v')) -> if (v === v') then let merged = v >+< v' in if merged = v && merged = v' then Some [A.NegSubst(x,v >+< v')] else (* positions are compatible, but not identical. keep apart. *) Some [A.NegSubst(x,v);A.NegSubst(x',v')] else Some [A.NegSubst(x,v);A.NegSubst(x',v')] ;; (* NOTE: functor *) (* How could we accomadate subterm constraints here??? *) let merge_sub sub sub' = merge_subBy SUB.eq_mvar SUB.eq_val SUB.merge_val sub sub' let clean_substBy eq cmp theta = List.sort cmp (nubBy eq theta);; (* NOTE: we sort by using the generic "compare" on (meta-)variable * names; we could also require a definition of compare for meta-variables * or substitutions but that seems like overkill for sorting *) let clean_subst theta = let res = clean_substBy eq_sub (fun s s' -> let res = compare (dom_sub s) (dom_sub s') in if res = 0 then match (s,s') with (A.Subst(_,_),A.NegSubst(_,_)) -> -1 | (A.NegSubst(_,_),A.Subst(_,_)) -> 1 | _ -> compare (ran_sub s) (ran_sub s') else res) theta in let rec loop = function [] -> [] | (A.Subst(x,v)::A.NegSubst(y,v')::rest) when SUB.eq_mvar x y -> loop (A.Subst(x,v)::rest) | x::xs -> x::(loop xs) in loop res let top_subst = [];; (* Always TRUE subst. *) (* Split a theta in two parts: one with (only) "x" and one without *) (* NOTE: functor *) let split_subst theta x = partition (fun sub -> SUB.eq_mvar (dom_sub sub) x) theta;; exception SUBST_MISMATCH let conj_subst theta theta' = match (theta,theta') with | ([],_) -> Some theta' | (_,[]) -> Some theta | _ -> let rec classify = function [] -> [] | [x] -> [(dom_sub x,[x])] | x::xs -> (match classify xs with ((nm,y)::ys) as res -> if dom_sub x = nm then (nm,x::y)::ys else (dom_sub x,[x])::res | _ -> failwith "not possible") in let merge_all theta theta' = foldl (function rest -> function sub -> foldl (function rest -> function sub' -> match (merge_sub sub sub') with Some subs -> subs @ rest | _ -> raise SUBST_MISMATCH) rest theta') [] theta in let rec loop = function ([],ctheta') -> List.concat (List.map (function (_,ths) -> ths) ctheta') | (ctheta,[]) -> List.concat (List.map (function (_,ths) -> ths) ctheta) | ((x,ths)::xs,(y,ths')::ys) -> (match compare x y with 0 -> (merge_all ths ths') @ loop (xs,ys) | -1 -> ths @ loop (xs,((y,ths')::ys)) | 1 -> ths' @ loop (((x,ths)::xs),ys) | _ -> failwith "not possible") in try Some (clean_subst(loop (classify theta, classify theta'))) with SUBST_MISMATCH -> None ;; (* theta' must be a subset of theta *) let conj_subst_none theta theta' = match (theta,theta') with | (_,[]) -> Some theta | ([],_) -> None | _ -> let rec classify = function [] -> [] | [x] -> [(dom_sub x,[x])] | x::xs -> (match classify xs with ((nm,y)::ys) as res -> if dom_sub x = nm then (nm,x::y)::ys else (dom_sub x,[x])::res | _ -> failwith "not possible") in let merge_all theta theta' = foldl (function rest -> function sub -> foldl (function rest -> function sub' -> match (merge_sub sub sub') with Some subs -> subs @ rest | _ -> raise SUBST_MISMATCH) rest theta') [] theta in let rec loop = function (ctheta,[]) -> List.concat (List.map (function (_,ths) -> ths) ctheta) | ([],ctheta') -> raise SUBST_MISMATCH | ((x,ths)::xs,(y,ths')::ys) -> (match compare x y with 0 -> (merge_all ths ths') @ loop (xs,ys) | -1 -> ths @ loop (xs,((y,ths')::ys)) | 1 -> raise SUBST_MISMATCH | _ -> failwith "not possible") in try Some (clean_subst(loop (classify theta, classify theta'))) with SUBST_MISMATCH -> None ;; let negate_sub sub = match sub with | A.Subst(x,v) -> A.NegSubst (x,v) | A.NegSubst(x,v) -> A.Subst(x,v) ;; (* Turn a (big) theta into a list of (small) thetas *) let negate_subst theta = (map (fun sub -> [negate_sub sub]) theta);; (* ************************* *) (* Witnesses *) (* ************************* *) (* Always TRUE witness *) let top_wit = ([] : (('pred, 'anno) witness list));; let eq_wit wit wit' = wit = wit';; let union_wit wit wit' = (*List.sort compare (wit' @ wit) for popl*) let res = unionBy compare (=) wit wit' in let anynegwit = (* if any is neg, then all are *) List.exists (function A.NegWit _ -> true | A.Wit _ -> false) in if anynegwit res then List.filter (function A.NegWit _ -> true | A.Wit _ -> false) res else res let negate_wit wit = A.NegWit wit (* match wit with | A.Wit(s,th,anno,ws) -> A.NegWitWit(s,th,anno,ws) | A.NegWitWit(s,th,anno,ws) -> A.Wit(s,th,anno,ws)*) ;; let negate_wits wits = List.sort compare (map (fun wit -> [negate_wit wit]) wits);; let unwitify trips = let anynegwit = (* if any is neg, then all are *) List.exists (function A.NegWit _ -> true | A.Wit _ -> false) in setify (List.fold_left (function prev -> function (s,th,wit) -> if anynegwit wit then prev else (s,th,top_wit)::prev) [] trips) (* ************************* *) (* Triples *) (* ************************* *) (* Triples are equal when the constituents are equal *) let eq_trip (s,th,wit) (s',th',wit') = (s = s') && (eq_wit wit wit') && (eq_subst th th');; let triples_top states = map (fun s -> (s,top_subst,top_wit)) states;; let normalize trips = List.map (function (st,th,wit) -> (st,List.sort compare th,List.sort compare wit)) trips (* conj opt doesn't work ((1,[],{{x=3}}) v (1,[],{{x=4}})) & (1,[],{{x=4}}) = (1,[],{{x=3},{x=4}}), not (1,[],{{x=4}}) *) let triples_conj trips trips' = let (trips,shared,trips') = if false && !pTRIPLES_CONJ_OPT (* see comment above *) then let (shared,trips) = List.partition (function t -> List.mem t trips') trips in let trips' = List.filter (function t -> not(List.mem t shared)) trips' in (trips,shared,trips') else (trips,[],trips') in foldl (* returns a set - setify inlined *) (function rest -> function (s1,th1,wit1) -> foldl (function rest -> function (s2,th2,wit2) -> if (s1 = s2) then (match (conj_subst th1 th2) with Some th -> let t = (s1,th,union_wit wit1 wit2) in if List.mem t rest then rest else t::rest | _ -> rest) else rest) rest trips') shared trips ;; (* ignore the state in the right argument. always pretend it is the same as the left one *) (* env on right has to be a subset of env on left *) let triples_conj_none trips trips' = let (trips,shared,trips') = if false && !pTRIPLES_CONJ_OPT (* see comment above *) then let (shared,trips) = List.partition (function t -> List.mem t trips') trips in let trips' = List.filter (function t -> not(List.mem t shared)) trips' in (trips,shared,trips') else (trips,[],trips') in foldl (* returns a set - setify inlined *) (function rest -> function (s1,th1,wit1) -> foldl (function rest -> function (s2,th2,wit2) -> match (conj_subst_none th1 th2) with Some th -> let t = (s1,th,union_wit wit1 wit2) in if List.mem t rest then rest else t::rest | _ -> rest) rest trips') shared trips ;; exception AW let triples_conj_AW trips trips' = let (trips,shared,trips') = if false && !pTRIPLES_CONJ_OPT then let (shared,trips) = List.partition (function t -> List.mem t trips') trips in let trips' = List.filter (function t -> not(List.mem t shared)) trips' in (trips,shared,trips') else (trips,[],trips') in foldl (* returns a set - setify inlined *) (function rest -> function (s1,th1,wit1) -> foldl (function rest -> function (s2,th2,wit2) -> if (s1 = s2) then (match (conj_subst th1 th2) with Some th -> let t = (s1,th,union_wit wit1 wit2) in if List.mem t rest then rest else t::rest | _ -> raise AW) else rest) rest trips') shared trips ;; (* *************************** *) (* NEGATION (NegState style) *) (* *************************** *) (* Constructive negation at the state level *) type ('a) state = PosState of 'a | NegState of 'a list ;; let compatible_states = function (PosState s1, PosState s2) -> if s1 = s2 then Some (PosState s1) else None | (PosState s1, NegState s2) -> if List.mem s1 s2 then None else Some (PosState s1) | (NegState s1, PosState s2) -> if List.mem s2 s1 then None else Some (PosState s2) | (NegState s1, NegState s2) -> Some (NegState (s1 @ s2)) ;; (* Conjunction on triples with "special states" *) let triples_state_conj trips trips' = let (trips,shared,trips') = if !pTRIPLES_CONJ_OPT then let (shared,trips) = List.partition (function t -> List.mem t trips') trips in let trips' = List.filter (function t -> not(List.mem t shared)) trips' in (trips,shared,trips') else (trips,[],trips') in foldl (function rest -> function (s1,th1,wit1) -> foldl (function rest -> function (s2,th2,wit2) -> match compatible_states(s1,s2) with Some s -> (match (conj_subst th1 th2) with Some th -> let t = (s,th,union_wit wit1 wit2) in if List.mem t rest then rest else t::rest | _ -> rest) | _ -> rest) rest trips') shared trips ;; let triple_negate (s,th,wits) = let negstates = (NegState [s],top_subst,top_wit) in let negths = map (fun th -> (PosState s,th,top_wit)) (negate_subst th) in let negwits = map (fun nwit -> (PosState s,th,nwit)) (negate_wits wits) in negstates :: (negths @ negwits) (* all different *) (* FIX ME: it is not necessary to do full conjunction *) let triples_complement states (trips : ('pred, 'anno) triples) = if !pTRIPLES_COMPLEMENT_OPT then (let cleanup (s,th,wit) = match s with PosState s' -> [(s',th,wit)] | NegState ss -> assert (th=top_subst); assert (wit=top_wit); map (fun st -> (st,top_subst,top_wit)) (setdiff states ss) in let (simple,complex) = if !pTRIPLES_COMPLEMENT_SIMPLE_OPT then let (simple,complex) = List.partition (function (s,[],[]) -> true | _ -> false) trips in let simple = [(NegState(List.map (function (s,_,_) -> s) simple), top_subst,top_wit)] in (simple,complex) else ([(NegState [],top_subst,top_wit)],trips) in let rec compl trips = match trips with [] -> simple | (t::ts) -> triples_state_conj (triple_negate t) (compl ts) in let compld = (compl complex) in let compld = concatmap cleanup compld in compld) else let negstates (st,th,wits) = map (function st -> (st,top_subst,top_wit)) (setdiff states [st]) in let negths (st,th,wits) = map (function th -> (st,th,top_wit)) (negate_subst th) in let negwits (st,th,wits) = map (function nwit -> (st,th,nwit)) (negate_wits wits) in match trips with [] -> map (function st -> (st,top_subst,top_wit)) states | x::xs -> setify (foldl (function prev -> function cur -> triples_conj (negstates cur @ negths cur @ negwits cur) prev) (negstates x @ negths x @ negwits x) xs) ;; let triple_negate (s,th,wits) = let negths = map (fun th -> (s,th,top_wit)) (negate_subst th) in let negwits = map (fun nwit -> (s,th,nwit)) (negate_wits wits) in ([s], negths @ negwits) (* all different *) let print_compl_state str (n,p) = Printf.printf "%s neg: " str; List.iter (function x -> G.print_node x; Format.print_flush(); Printf.printf " ") n; Printf.printf "\n"; print_state "pos" p let triples_complement states (trips : ('pred, 'anno) triples) = if trips = [] then map (function st -> (st,top_subst,top_wit)) states else let cleanup (neg,pos) = let keep_pos = List.filter (function (s,_,_) -> List.mem s neg) pos in (map (fun st -> (st,top_subst,top_wit)) (setdiff states neg)) @ keep_pos in let trips = List.sort state_compare trips in let all_negated = List.map triple_negate trips in let merge_one (neg1,pos1) (neg2,pos2) = let (pos1conj,pos1keep) = List.partition (function (s,_,_) -> List.mem s neg2) pos1 in let (pos2conj,pos2keep) = List.partition (function (s,_,_) -> List.mem s neg1) pos2 in (Common.union_set neg1 neg2, (triples_conj pos1conj pos2conj) @ pos1keep @ pos2keep) in let rec inner_loop = function x1::x2::rest -> (merge_one x1 x2) :: (inner_loop rest) | l -> l in let rec outer_loop = function [x] -> x | l -> outer_loop (inner_loop l) in cleanup (outer_loop all_negated) (* ********************************** *) (* END OF NEGATION (NegState style) *) (* ********************************** *) (* now this is always true, so we could get rid of it *) let something_dropped = ref true let triples_union trips trips' = (*unionBy compare eq_trip trips trips';;*) (* returns -1 is t1 > t2, 1 if t2 >= t1, and 0 otherwise *) (* The following does not work. Suppose we have ([x->3],{A}) and ([],{A,B}). Then, the following says that since the first is a more restrictive environment and has fewer witnesses, then it should be dropped. But having fewer witnesses is not necessarily less informative than having more, because fewer witnesses can mean the absence of the witness-causing thing. So the fewer witnesses have to be kept around. subseteq changed to = to make it hopefully work *) if !pNEW_INFO_OPT then begin something_dropped := false; if trips = trips' then (something_dropped := true; trips) else let subsumes (s1,th1,wit1) (s2,th2,wit2) = if s1 = s2 then (match conj_subst th1 th2 with Some conj -> if conj = th1 then if (*subseteq*) wit1 = wit2 then 1 else 0 else if conj = th2 then if (*subseteq*) wit2 = wit1 then (-1) else 0 else 0 | None -> 0) else 0 in let rec first_loop second = function [] -> second | x::xs -> first_loop (second_loop x second) xs and second_loop x = function [] -> [x] | (y::ys) as all -> match subsumes x y with 1 -> something_dropped := true; all | (-1) -> second_loop x ys | _ -> y::(second_loop x ys) in first_loop trips trips' end else unionBy compare eq_trip trips trips' let triples_witness x unchecked not_keep trips = let anyneg = (* if any is neg, then all are *) List.exists (function A.NegSubst _ -> true | A.Subst _ -> false) in let anynegwit = (* if any is neg, then all are *) List.exists (function A.NegWit _ -> true | A.Wit _ -> false) in let allnegwit = (* if any is neg, then all are *) List.for_all (function A.NegWit _ -> true | A.Wit _ -> false) in let negtopos = List.map (function A.NegWit w -> w | A.Wit _ -> failwith "bad wit")in let res = List.fold_left (function prev -> function (s,th,wit) as t -> let (th_x,newth) = split_subst th x in match th_x with [] -> (* one consider whether if not not_keep is true, then we should fail. but it could be that the variable is a used_after and then it is the later rule that should fail and not this one *) if not not_keep && !Flag_ctl.verbose_ctl_engine then (SUB.print_mvar x; Format.print_flush(); print_state ": empty witness from" [t]); t::prev | l when anyneg l && !pANY_NEG_OPT -> prev (* see tests/nestseq for how neg bindings can come up even without eg partial matches (* negated substitution only allowed with negwits. just dropped *) if anynegwit wit && allnegwit wit (* nonempty negwit list *) then prev else (print_generic_substitution l; Format.print_newline(); failwith"unexpected negative binding with positive witnesses")*) | _ -> let new_triple = if unchecked or not_keep then (s,newth,wit) else if anynegwit wit && allnegwit wit then (s,newth,[A.NegWit(A.Wit(s,th_x,[],negtopos wit))]) else (s,newth,[A.Wit(s,th_x,[],wit)]) in new_triple::prev) [] trips in if unchecked || !Flag_ctl.partial_match (* the only way to have a NegWit *) then setify res else List.rev res ;; (* ---------------------------------------------------------------------- *) (* SAT - Model Checking Algorithm for CTL-FVex *) (* *) (* TODO: Implement _all_ operators (directly) *) (* ---------------------------------------------------------------------- *) (* ************************************* *) (* The SAT algorithm and special helpers *) (* ************************************* *) let rec pre_exist dir (grp,_,_) y reqst = let check s = match reqst with None -> true | Some reqst -> List.mem s reqst in let exp (s,th,wit) = concatmap (fun s' -> if check s' then [(s',th,wit)] else []) (match dir with A.FORWARD -> G.predecessors grp s | A.BACKWARD -> G.successors grp s) in setify (concatmap exp y) ;; exception Empty let pre_forall dir (grp,_,states) y all reqst = let check s = match reqst with None -> true | Some reqst -> List.mem s reqst in let pred = match dir with A.FORWARD -> G.predecessors | A.BACKWARD -> G.successors in let succ = match dir with A.FORWARD -> G.successors | A.BACKWARD -> G.predecessors in let neighbors = List.map (function p -> (p,succ grp p)) (setify (concatmap (function (s,_,_) -> List.filter check (pred grp s)) y)) in (* would a hash table be more efficient? *) let all = List.sort state_compare all in let rec up_nodes child s = function [] -> [] | (s1,th,wit)::xs -> (match compare s1 child with -1 -> up_nodes child s xs | 0 -> (s,th,wit)::(up_nodes child s xs) | _ -> []) in let neighbor_triples = List.fold_left (function rest -> function (s,children) -> try (List.map (function child -> match up_nodes child s all with [] -> raise Empty | l -> l) children) :: rest with Empty -> rest) [] neighbors in match neighbor_triples with [] -> [] | _ -> (*normalize*) (foldl1 (@) (List.map (foldl1 triples_conj) neighbor_triples)) let pre_forall_AW dir (grp,_,states) y all reqst = let check s = match reqst with None -> true | Some reqst -> List.mem s reqst in let pred = match dir with A.FORWARD -> G.predecessors | A.BACKWARD -> G.successors in let succ = match dir with A.FORWARD -> G.successors | A.BACKWARD -> G.predecessors in let neighbors = List.map (function p -> (p,succ grp p)) (setify (concatmap (function (s,_,_) -> List.filter check (pred grp s)) y)) in (* would a hash table be more efficient? *) let all = List.sort state_compare all in let rec up_nodes child s = function [] -> [] | (s1,th,wit)::xs -> (match compare s1 child with -1 -> up_nodes child s xs | 0 -> (s,th,wit)::(up_nodes child s xs) | _ -> []) in let neighbor_triples = List.fold_left (function rest -> function (s,children) -> (List.map (function child -> match up_nodes child s all with [] -> raise AW | l -> l) children) :: rest) [] neighbors in match neighbor_triples with [] -> [] | _ -> foldl1 (@) (List.map (foldl1 triples_conj_AW) neighbor_triples) (* drop_negwits will call setify *) let satEX dir m s reqst = pre_exist dir m s reqst;; let satAX dir m s reqst = pre_forall dir m s s reqst ;; (* E[phi1 U phi2] == phi2 \/ (phi1 /\ EXE[phi1 U phi2]) *) let satEU dir ((_,_,states) as m) s1 s2 reqst print_graph = (*Printf.printf "EU\n"; let ctr = ref 0 in*) inc satEU_calls; if s1 = [] then s2 else (*let ctr = ref 0 in*) if !pNEW_INFO_OPT then let rec f y new_info = inc_step(); match new_info with [] -> y | new_info -> (*ctr := !ctr + 1; print_graph y ctr;*) let first = triples_conj s1 (pre_exist dir m new_info reqst) in let res = triples_union first y in let new_info = setdiff res y in (*Printf.printf "iter %d res %d new_info %d\n" !ctr (List.length res) (List.length new_info); print_state "res" res; print_state "new_info" new_info; flush stdout;*) f res new_info in f s2 s2 else let f y = inc_step(); (*ctr := !ctr + 1; print_graph y ctr;*) let pre = pre_exist dir m y reqst in triples_union s2 (triples_conj s1 pre) in setfix f s2 ;; (* EF phi == E[true U phi] *) let satEF dir m s2 reqst = inc satEF_calls; (*let ctr = ref 0 in*) if !pNEW_INFO_OPT then let rec f y new_info = inc_step(); match new_info with [] -> y | new_info -> (*ctr := !ctr + 1; print_state (Printf.sprintf "iteration %d\n" !ctr) y;*) let first = pre_exist dir m new_info reqst in let res = triples_union first y in let new_info = setdiff res y in (*Printf.printf "EF %s iter %d res %d new_info %d\n" (if dir = A.BACKWARD then "reachable" else "real ef") !ctr (List.length res) (List.length new_info); print_state "new info" new_info; flush stdout;*) f res new_info in f s2 s2 else let f y = inc_step(); let pre = pre_exist dir m y reqst in triples_union s2 pre in setfix f s2 type ('pred,'anno) auok = AUok of ('pred,'anno) triples | AUfailed of ('pred,'anno) triples (* A[phi1 U phi2] == phi2 \/ (phi1 /\ AXA[phi1 U phi2]) *) let satAU dir ((cfg,_,states) as m) s1 s2 reqst print_graph = let ctr = ref 0 in inc satAU_calls; if s1 = [] then AUok s2 else (*let ctr = ref 0 in*) let pre_forall = if !Flag_ctl.loop_in_src_code then pre_forall_AW else pre_forall in if !pNEW_INFO_OPT then let rec f y newinfo = inc_step(); match newinfo with [] -> AUok y | new_info -> ctr := !ctr + 1; (*print_state (Printf.sprintf "iteration %d\n" !ctr) y; flush stdout;*) print_graph y ctr; let pre = try Some (pre_forall dir m new_info y reqst) with AW -> None in match pre with None -> AUfailed y | Some pre -> match triples_conj s1 pre with [] -> AUok y | first -> (*print_state "s1" s1; print_state "pre" pre; print_state "first" first;*) let res = triples_union first y in let new_info = if not !something_dropped then first else setdiff res y in (*Printf.printf "iter %d res %d new_info %d\n" !ctr (List.length res) (List.length new_info); flush stdout;*) f res new_info in f s2 s2 else if !Flag_ctl.loop_in_src_code then AUfailed s2 else (*let setfix = fix (function s1 -> function s2 -> let s1 = List.map (function (s,th,w) -> (s,th,nub w)) s1 in let s2 = List.map (function (s,th,w) -> (s,th,nub w)) s2 in subseteq s1 s2) in for popl *) let f y = inc_step(); ctr := !ctr + 1; print_graph y ctr; let pre = pre_forall dir m y y reqst in triples_union s2 (triples_conj s1 pre) in AUok (setfix f s2) ;; (* reqst could be the states of s1 *) (* let lstates = mkstates states reqst in let initial_removed = triples_complement lstates (triples_union s1 s2) in let initial_base = triples_conj s1 (triples_complement lstates s2) in let rec loop base removed = let new_removed = triples_conj base (pre_exist dir m removed reqst) in let new_base = triples_conj base (triples_complement lstates new_removed) in if supseteq new_base base then triples_union base s2 else loop new_base new_removed in loop initial_base initial_removed *) let satAW dir ((grp,_,states) as m) s1 s2 reqst = inc satAW_calls; if s1 = [] then s2 else (* This works extremely badly when the region is small and the end of the region is very ambiguous, eg free(x) ... x see free.c if !pNEW_INFO_OPT then let get_states l = setify(List.map (function (s,_,_) -> s) l) in let ostates = Common.union_set (get_states s1) (get_states s2) in let succ = (match dir with A.FORWARD -> G.successors grp | A.BACKWARD -> G.predecessors grp) in let states = List.fold_left Common.union_set ostates (List.map succ ostates) in let negphi = triples_complement states s1 in let negpsi = triples_complement states s2 in triples_complement ostates (satEU dir m negpsi (triples_conj negphi negpsi) (Some ostates)) else *) (*let ctr = ref 0 in*) let f y = inc_step(); (*ctr := !ctr + 1; Printf.printf "iter %d y %d\n" !ctr (List.length y); print_state "y" y; flush stdout;*) let pre = pre_forall dir m y y reqst in (*print_state "pre" pre;*) let conj = triples_conj s1 pre in (* or triples_conj_AW *) triples_union s2 conj in let drop_wits = List.map (function (s,e,_) -> (s,e,[])) in (* drop wits on s1 represents that we don't want any witnesses from the case that infinitely loops, only from the case that gets out of the loop. s1 is like a guard. To see the problem, consider an example where both s1 and s2 match some code after the loop. we only want the witness from s2. *) setgfix f (triples_union (nub(drop_wits s1)) s2) ;; let satAF dir m s reqst = inc satAF_calls; if !pNEW_INFO_OPT then let rec f y newinfo = inc_step(); match newinfo with [] -> y | new_info -> let first = pre_forall dir m new_info y reqst in let res = triples_union first y in let new_info = setdiff res y in f res new_info in f s s else let f y = inc_step(); let pre = pre_forall dir m y y reqst in triples_union s pre in setfix f s let satAG dir ((_,_,states) as m) s reqst = inc satAG_calls; let f y = inc_step(); let pre = pre_forall dir m y y reqst in triples_conj y pre in setgfix f s let satEG dir ((_,_,states) as m) s reqst = inc satEG_calls; let f y = inc_step(); let pre = pre_exist dir m y reqst in triples_conj y pre in setgfix f s (* **************************************************************** *) (* Inner And - a way of dealing with multiple matches within a node *) (* **************************************************************** *) (* applied to the result of matching a node. collect witnesses when the states and environments are the same *) (* not a good idea, poses problem for unparsing, because don't realize that adjacent things come from different matches, leading to loss of newlines etc. exple struct I { ... - int x; + int y; ...} *) let inner_and trips = trips (* let rec loop = function [] -> ([],[]) | (s,th,w)::trips -> let (cur,acc) = loop trips in (match cur with (s',_,_)::_ when s = s' -> let rec loop' = function [] -> [(s,th,w)] | ((_,th',w') as t')::ts' -> (match conj_subst th th' with Some th'' -> (s,th'',union_wit w w')::ts' | None -> t'::(loop' ts')) in (loop' cur,acc) | _ -> ([(s,th,w)],cur@acc)) in let (cur,acc) = loop (List.sort state_compare trips) (* is this sort needed? *) in cur@acc *) (* *************** *) (* Partial matches *) (* *************** *) let filter_conj states unwanted partial_matches = let x = triples_conj (triples_complement states (unwitify unwanted)) partial_matches in triples_conj (unwitify x) (triples_complement states x) let strict_triples_conj strict states trips trips' = let res = triples_conj trips trips' in if !Flag_ctl.partial_match && strict = A.STRICT then let fail_left = filter_conj states trips trips' in let fail_right = filter_conj states trips' trips in let ors = triples_union fail_left fail_right in triples_union res ors else res let strict_triples_conj_none strict states trips trips' = let res = triples_conj_none trips trips' in if !Flag_ctl.partial_match && strict = A.STRICT then let fail_left = filter_conj states trips trips' in let fail_right = filter_conj states trips' trips in let ors = triples_union fail_left fail_right in triples_union res ors else res let left_strict_triples_conj strict states trips trips' = let res = triples_conj trips trips' in if !Flag_ctl.partial_match && strict = A.STRICT then let fail_left = filter_conj states trips trips' in triples_union res fail_left else res let strict_A1 strict op failop dir ((_,_,states) as m) trips required_states = let res = op dir m trips required_states in if !Flag_ctl.partial_match && strict = A.STRICT then let states = mkstates states required_states in let fail = filter_conj states res (failop dir m trips required_states) in triples_union res fail else res let strict_A2 strict op failop dir ((_,_,states) as m) trips trips' required_states = let res = op dir m trips trips' required_states in if !Flag_ctl.partial_match && strict = A.STRICT then let states = mkstates states required_states in let fail = filter_conj states res (failop dir m trips' required_states) in triples_union res fail else res let strict_A2au strict op failop dir ((_,_,states) as m) trips trips' required_states print_graph = match op dir m trips trips' required_states print_graph with AUok res -> if !Flag_ctl.partial_match && strict = A.STRICT then let states = mkstates states required_states in let fail = filter_conj states res (failop dir m trips' required_states) in AUok (triples_union res fail) else AUok res | AUfailed res -> AUfailed res (* ********************* *) (* Environment functions *) (* ********************* *) let drop_wits required_states s phi = match required_states with None -> s | Some states -> List.filter (function (s,_,_) -> List.mem s states) s let print_required required = List.iter (function l -> Format.print_string "{"; List.iter (function reqd -> print_generic_substitution reqd; Format.print_newline()) l; Format.print_string "}"; Format.print_newline()) required exception Too_long let extend_required trips required = if !Flag_ctl.partial_match then required else if !pREQUIRED_ENV_OPT then (* make it a set *) let envs = List.fold_left (function rest -> function (_,t,_) -> if List.mem t rest then rest else t::rest) [] trips in let envs = if List.mem [] envs then [] else envs in match (envs,required) with ([],_) -> required | (envs,hd::tl) -> (try let hdln = List.length hd + 5 (* let it grow a little bit *) in let (_,merged) = let add x (ln,y) = if List.mem x y then (ln,y) else if ln + 1 > hdln then raise Too_long else (ln+1,x::y) in foldl (function rest -> function t -> foldl (function rest -> function r -> match conj_subst t r with None -> rest | Some th -> add th rest) rest hd) (0,[]) envs in merged :: tl with Too_long -> envs :: required) | (envs,_) -> envs :: required else required let drop_required v required = if !pREQUIRED_ENV_OPT then let res = inner_setify (List.map (function l -> inner_setify (List.map (List.filter (function sub -> not(dom_sub sub = v))) l)) required) in (* check whether an entry has become useless *) List.filter (function l -> not (List.exists (function x -> x = []) l)) res else required (* no idea how to write this function ... *) let memo_label = (Hashtbl.create(50) : (P.t, (G.node * substitution) list) Hashtbl.t) let satLabel label required p = let triples = if !pSATLABEL_MEMO_OPT then try let states_subs = Hashtbl.find memo_label p in List.map (function (st,th) -> (st,th,[])) states_subs with Not_found -> let triples = setify(label p) in Hashtbl.add memo_label p (List.map (function (st,th,_) -> (st,th)) triples); triples else setify(label p) in (* normalize first; conj_subst relies on sorting *) let ntriples = normalize triples in if !pREQUIRED_ENV_OPT then foldl (function rest -> function ((s,th,_) as t) -> if List.for_all (List.exists (function th' -> not(conj_subst th th' = None))) required then t::rest else rest) [] ntriples else ntriples let get_required_states l = if !pREQUIRED_STATES_OPT && not !Flag_ctl.partial_match then Some(inner_setify (List.map (function (s,_,_) -> s) l)) else None let get_children_required_states dir (grp,_,_) required_states = if !pREQUIRED_STATES_OPT && not !Flag_ctl.partial_match then match required_states with None -> None | Some states -> let fn = match dir with A.FORWARD -> G.successors | A.BACKWARD -> G.predecessors in Some (inner_setify (List.concat (List.map (fn grp) states))) else None let reachable_table = (Hashtbl.create(50) : (G.node * A.direction, G.node list) Hashtbl.t) (* like satEF, but specialized for get_reachable *) let reachsatEF dir (grp,_,_) s2 = let dirop = match dir with A.FORWARD -> G.successors | A.BACKWARD -> G.predecessors in let union = unionBy compare (=) in let rec f y = function [] -> y | new_info -> let (pre_collected,new_info) = List.partition (function Common.Left x -> true | _ -> false) (List.map (function x -> try Common.Left (Hashtbl.find reachable_table (x,dir)) with Not_found -> Common.Right x) new_info) in let y = List.fold_left (function rest -> function Common.Left x -> union x rest | _ -> failwith "not possible") y pre_collected in let new_info = List.map (function Common.Right x -> x | _ -> failwith "not possible") new_info in let first = inner_setify (concatmap (dirop grp) new_info) in let new_info = setdiff first y in let res = new_info @ y in f res new_info in List.rev(f s2 s2) (* put root first *) let get_reachable dir m required_states = match required_states with None -> None | Some states -> Some (List.fold_left (function rest -> function cur -> if List.mem cur rest then rest else Common.union_set (try Hashtbl.find reachable_table (cur,dir) with Not_found -> let states = reachsatEF dir m [cur] in Hashtbl.add reachable_table (cur,dir) states; states) rest) [] states) let ctr = ref 0 let new_var _ = let c = !ctr in ctr := !ctr + 1; Printf.sprintf "_c%d" c (* **************************** *) (* End of environment functions *) (* **************************** *) type ('code,'value) cell = Frozen of 'code | Thawed of 'value let rec satloop unchecked required required_states ((grp,label,states) as m) phi env = let rec loop unchecked required required_states phi = let res = match phi with A.False -> [] | A.True -> triples_top states | A.Pred(p) -> satLabel label required p | A.Uncheck(phi1) -> let unchecked = if !pUNCHECK_OPT then true else false in loop unchecked required required_states phi1 | A.Not(phi) -> let phires = loop unchecked required required_states phi in (*let phires = List.map (function (s,th,w) -> (s,th,[])) phires in*) triples_complement (mkstates states required_states) phires | A.Or(phi1,phi2) -> triples_union (loop unchecked required required_states phi1) (loop unchecked required required_states phi2) | A.SeqOr(phi1,phi2) -> let res1 = loop unchecked required required_states phi1 in let res2 = loop unchecked required required_states phi2 in let res1neg = unwitify res1 in let pm = !Flag_ctl.partial_match in (match (pm,res1,res2) with (false,res1,[]) -> res1 | (false,[],res2) -> res2 | _ -> triples_union res1 (triples_conj (triples_complement (mkstates states required_states) res1neg) res2)) | A.And(strict,phi1,phi2) -> (* phi1 is considered to be more likely to be [], because of the definition of asttoctl. Could use heuristics such as the size of the term *) let pm = !Flag_ctl.partial_match in (match (pm,loop unchecked required required_states phi1) with (false,[]) when !pLazyOpt -> [] | (_,phi1res) -> let new_required = extend_required phi1res required in let new_required_states = get_required_states phi1res in (match (pm,loop unchecked new_required new_required_states phi2) with (false,[]) when !pLazyOpt -> [] | (_,phi2res) -> strict_triples_conj strict (mkstates states required_states) phi1res phi2res)) | A.AndAny(dir,strict,phi1,phi2) -> (* phi2 can appear anywhere that is reachable *) let pm = !Flag_ctl.partial_match in (match (pm,loop unchecked required required_states phi1) with (false,[]) -> [] | (_,phi1res) -> let new_required = extend_required phi1res required in let new_required_states = get_required_states phi1res in let new_required_states = get_reachable dir m new_required_states in (match (pm,loop unchecked new_required new_required_states phi2) with (false,[]) -> phi1res | (_,phi2res) -> (match phi1res with [] -> (* !Flag_ctl.partial_match must be true *) if phi2res = [] then [] else let s = mkstates states required_states in List.fold_left (function a -> function b -> strict_triples_conj strict s a [b]) [List.hd phi2res] (List.tl phi2res) | [(state,_,_)] -> let phi2res = List.map (function (s,e,w) -> [(state,e,w)]) phi2res in let s = mkstates states required_states in List.fold_left (function a -> function b -> strict_triples_conj strict s a b) phi1res phi2res | _ -> failwith "only one result allowed for the left arg of AndAny"))) | A.HackForStmt(dir,strict,phi1,phi2) -> (* phi2 can appear anywhere that is reachable *) let pm = !Flag_ctl.partial_match in (match (pm,loop unchecked required required_states phi1) with (false,[]) -> [] | (_,phi1res) -> let new_required = extend_required phi1res required in let new_required_states = get_required_states phi1res in let new_required_states = get_reachable dir m new_required_states in (match (pm,loop unchecked new_required new_required_states phi2) with (false,[]) -> phi1res | (_,phi2res) -> (* if there is more than one state, something about the environment has to ensure that the right triples of phi2 get associated with the triples of phi1. the asttoctl2 has to ensure that that is the case. these should thus be structural properties. env of phi2 has to be a proper subset of env of phi1 to ensure all end up being consistent. no new triples should be generated. strict_triples_conj_none takes care of this. *) let s = mkstates states required_states in List.fold_left (function acc -> function (st,th,_) as phi2_elem -> let inverse = triples_complement [st] [(st,th,[])] in strict_triples_conj_none strict s acc (phi2_elem::inverse)) phi1res phi2res)) | A.InnerAnd(phi) -> inner_and(loop unchecked required required_states phi) | A.EX(dir,phi) -> let new_required_states = get_children_required_states dir m required_states in satEX dir m (loop unchecked required new_required_states phi) required_states | A.AX(dir,strict,phi) -> let new_required_states = get_children_required_states dir m required_states in let res = loop unchecked required new_required_states phi in strict_A1 strict satAX satEX dir m res required_states | A.EF(dir,phi) -> let new_required_states = get_reachable dir m required_states in satEF dir m (loop unchecked required new_required_states phi) new_required_states | A.AF(dir,strict,phi) -> if !Flag_ctl.loop_in_src_code then loop unchecked required required_states (A.AU(dir,strict,A.True,phi)) else let new_required_states = get_reachable dir m required_states in let res = loop unchecked required new_required_states phi in strict_A1 strict satAF satEF dir m res new_required_states | A.EG(dir,phi) -> let new_required_states = get_reachable dir m required_states in satEG dir m (loop unchecked required new_required_states phi) new_required_states | A.AG(dir,strict,phi) -> let new_required_states = get_reachable dir m required_states in let res = loop unchecked required new_required_states phi in strict_A1 strict satAG satEF dir m res new_required_states | A.EU(dir,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match loop unchecked required new_required_states phi2 with [] when !pLazyOpt -> [] | s2 -> let new_required = extend_required s2 required in let s1 = loop unchecked new_required new_required_states phi1 in satEU dir m s1 s2 new_required_states (fun y ctr -> print_graph_c grp new_required_states y ctr phi)) | A.AW(dir,strict,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match loop unchecked required new_required_states phi2 with [] when !pLazyOpt -> [] | s2 -> let new_required = extend_required s2 required in let s1 = loop unchecked new_required new_required_states phi1 in strict_A2 strict satAW satEF dir m s1 s2 new_required_states) | A.AU(dir,strict,phi1,phi2) -> (*Printf.printf "using AU\n"; flush stdout;*) let new_required_states = get_reachable dir m required_states in (match loop unchecked required new_required_states phi2 with [] when !pLazyOpt -> [] | s2 -> let new_required = extend_required s2 required in let s1 = loop unchecked new_required new_required_states phi1 in let res = strict_A2au strict satAU satEF dir m s1 s2 new_required_states (fun y ctr -> print_graph_c grp new_required_states y ctr phi) in match res with AUok res -> res | AUfailed tmp_res -> (* found a loop, have to try AW *) (* the formula is A[E[phi1 U phi2] & phi1 W phi2] the and is nonstrict *) (* tmp_res is bigger than s2, so perhaps closer to s1 *) (*Printf.printf "using AW\n"; flush stdout;*) let s1 = triples_conj (satEU dir m s1 tmp_res new_required_states (* no graph, for the moment *) (fun y str -> ())) s1 in strict_A2 strict satAW satEF dir m s1 s2 new_required_states ) | A.Implies(phi1,phi2) -> loop unchecked required required_states (A.Or(A.Not phi1,phi2)) | A.Exists (keep,v,phi) -> let new_required = drop_required v required in triples_witness v unchecked (not keep) (loop unchecked new_required required_states phi) | A.Let(v,phi1,phi2) -> (* should only be used when the properties unchecked, required, and required_states are known to be the same or at least compatible between all the uses. this is not checked. *) let res = loop unchecked required required_states phi1 in satloop unchecked required required_states m phi2 ((v,res) :: env) | A.LetR(dir,v,phi1,phi2) -> (* should only be used when the properties unchecked, required, and required_states are known to be the same or at least compatible between all the uses. this is not checked. *) (* doesn't seem to be used any more *) let new_required_states = get_reachable dir m required_states in let res = loop unchecked required new_required_states phi1 in satloop unchecked required required_states m phi2 ((v,res) :: env) | A.Ref(v) -> let res = List.assoc v env in if unchecked then List.map (function (s,th,_) -> (s,th,[])) res else res | A.XX(phi) -> failwith "should have been removed" in if !Flag_ctl.bench > 0 then triples := !triples + (List.length res); let res = drop_wits required_states res phi (* ) *) in print_graph grp required_states res "" phi; res in loop unchecked required required_states phi ;; (* SAT with tracking *) let output str = Printf.printf "%s\n" str let rec sat_verbose_loop unchecked required required_states annot maxlvl lvl ((_,label,states) as m) phi env = let anno res children = (annot lvl phi res children,res) in let satv unchecked required required_states phi0 env = sat_verbose_loop unchecked required required_states annot maxlvl (lvl+1) m phi0 env in if (lvl > maxlvl) && (maxlvl > -1) then anno (satloop unchecked required required_states m phi env) [] else let (child,res) = match phi with A.False -> anno [] [] | A.True -> anno (triples_top states) [] | A.Pred(p) -> output "label"; anno (satLabel label required p) [] | A.Uncheck(phi1) -> let unchecked = if !pUNCHECK_OPT then true else false in let (child1,res1) = satv unchecked required required_states phi1 env in output "uncheck"; anno res1 [child1] | A.Not(phi1) -> let (child,res) = satv unchecked required required_states phi1 env in output "not"; anno (triples_complement (mkstates states required_states) res) [child] | A.Or(phi1,phi2) -> let (child1,res1) = satv unchecked required required_states phi1 env in let (child2,res2) = satv unchecked required required_states phi2 env in output "or"; anno (triples_union res1 res2) [child1; child2] | A.SeqOr(phi1,phi2) -> let (child1,res1) = satv unchecked required required_states phi1 env in let (child2,res2) = satv unchecked required required_states phi2 env in let res1neg = List.map (function (s,th,_) -> (s,th,[])) res1 in output "seqor"; let pm = !Flag_ctl.partial_match in (match (pm,res1,res2) with (false,res1,[]) -> anno res1 [child1; child2] | (false,[],res2) -> anno res2 [child1; child2] | _ -> anno (triples_union res1 (triples_conj (triples_complement (mkstates states required_states) res1neg) res2)) [child1; child2]) | A.And(strict,phi1,phi2) -> let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> output "and"; anno [] [child1] | (_,(child1,res1)) -> let new_required = extend_required res1 required in let new_required_states = get_required_states res1 in (match (pm,satv unchecked new_required new_required_states phi2 env) with (false,(child2,[])) -> output "and"; anno [] [child1;child2] | (_,(child2,res2)) -> output "and"; let res = strict_triples_conj strict (mkstates states required_states) res1 res2 in anno res [child1; child2])) | A.AndAny(dir,strict,phi1,phi2) -> let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> output "and"; anno [] [child1] | (_,(child1,res1)) -> let new_required = extend_required res1 required in let new_required_states = get_required_states res1 in let new_required_states = get_reachable dir m new_required_states in (match (pm,satv unchecked new_required new_required_states phi2 env) with (false,(child2,[])) -> output "andany"; anno res1 [child1;child2] | (_,(child2,res2)) -> (match res1 with [] -> (* !Flag_ctl.partial_match must be true *) if res2 = [] then anno [] [child1; child2] else let res = let s = mkstates states required_states in List.fold_left (function a -> function b -> strict_triples_conj strict s a [b]) [List.hd res2] (List.tl res2) in anno res [child1; child2] | [(state,_,_)] -> let res2 = List.map (function (s,e,w) -> [(state,e,w)]) res2 in output "andany"; let res = let s = mkstates states required_states in List.fold_left (function a -> function b -> strict_triples_conj strict s a b) res1 res2 in anno res [child1; child2] | _ -> failwith "only one result allowed for the left arg of AndAny"))) | A.HackForStmt(dir,strict,phi1,phi2) -> let pm = !Flag_ctl.partial_match in (match (pm,satv unchecked required required_states phi1 env) with (false,(child1,[])) -> output "and"; anno [] [child1] | (_,(child1,res1)) -> let new_required = extend_required res1 required in let new_required_states = get_required_states res1 in let new_required_states = get_reachable dir m new_required_states in (match (pm,satv unchecked new_required new_required_states phi2 env) with (false,(child2,[])) -> output "andany"; anno res1 [child1;child2] | (_,(child2,res2)) -> let res = let s = mkstates states required_states in List.fold_left (function acc -> function (st,th,_) as phi2_elem -> let inverse = triples_complement [st] [(st,th,[])] in strict_triples_conj_none strict s acc (phi2_elem::inverse)) res1 res2 in anno res [child1; child2])) | A.InnerAnd(phi1) -> let (child1,res1) = satv unchecked required required_states phi1 env in output "uncheck"; anno (inner_and res1) [child1] | A.EX(dir,phi1) -> let new_required_states = get_children_required_states dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "EX"; anno (satEX dir m res required_states) [child] | A.AX(dir,strict,phi1) -> let new_required_states = get_children_required_states dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "AX"; let res = strict_A1 strict satAX satEX dir m res required_states in anno res [child] | A.EF(dir,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "EF"; anno (satEF dir m res new_required_states) [child] | A.AF(dir,strict,phi1) -> if !Flag_ctl.loop_in_src_code then satv unchecked required required_states (A.AU(dir,strict,A.True,phi1)) env else (let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "AF"; let res = strict_A1 strict satAF satEF dir m res new_required_states in anno res [child]) | A.EG(dir,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "EG"; anno (satEG dir m res new_required_states) [child] | A.AG(dir,strict,phi1) -> let new_required_states = get_reachable dir m required_states in let (child,res) = satv unchecked required new_required_states phi1 env in output "AG"; let res = strict_A1 strict satAG satEF dir m res new_required_states in anno res [child] | A.EU(dir,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with (child2,[]) -> output "EU"; anno [] [child2] | (child2,res2) -> let new_required = extend_required res2 required in let (child1,res1) = satv unchecked new_required new_required_states phi1 env in output "EU"; anno (satEU dir m res1 res2 new_required_states (fun y str -> ())) [child1; child2]) | A.AW(dir,strict,phi1,phi2) -> failwith "should not be used" (* let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with (child2,[]) -> output (Printf.sprintf "AW %b" unchecked); anno [] [child2] | (child2,res2) -> let new_required = extend_required res2 required in let (child1,res1) = satv unchecked new_required new_required_states phi1 env in output (Printf.sprintf "AW %b" unchecked); let res = strict_A2 strict satAW satEF dir m res1 res2 new_required_states in anno res [child1; child2]) *) | A.AU(dir,strict,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in (match satv unchecked required new_required_states phi2 env with (child2,[]) -> output "AU"; anno [] [child2] | (child2,s2) -> let new_required = extend_required s2 required in let (child1,s1) = satv unchecked new_required new_required_states phi1 env in output "AU"; let res = strict_A2au strict satAU satEF dir m s1 s2 new_required_states (fun y str -> ()) in (match res with AUok res -> anno res [child1; child2] | AUfailed tmp_res -> (* found a loop, have to try AW *) (* the formula is A[E[phi1 U phi2] & phi1 W phi2] the and is nonstrict *) (* tmp_res is bigger than s2, so perhaps closer to s1 *) output "AW"; let s1 = triples_conj (satEU dir m s1 tmp_res new_required_states (* no graph, for the moment *) (fun y str -> ())) s1 in let res = strict_A2 strict satAW satEF dir m s1 s2 new_required_states in anno res [child1; child2])) | A.Implies(phi1,phi2) -> satv unchecked required required_states (A.Or(A.Not phi1,phi2)) env | A.Exists (keep,v,phi1) -> let new_required = drop_required v required in let (child,res) = satv unchecked new_required required_states phi1 env in output "exists"; anno (triples_witness v unchecked (not keep) res) [child] | A.Let(v,phi1,phi2) -> let (child1,res1) = satv unchecked required required_states phi1 env in let (child2,res2) = satv unchecked required required_states phi2 ((v,res1) :: env) in anno res2 [child1;child2] | A.LetR(dir,v,phi1,phi2) -> let new_required_states = get_reachable dir m required_states in let (child1,res1) = satv unchecked required new_required_states phi1 env in let (child2,res2) = satv unchecked required required_states phi2 ((v,res1) :: env) in anno res2 [child1;child2] | A.Ref(v) -> output "Ref"; let res = List.assoc v env in let res = if unchecked then List.map (function (s,th,_) -> (s,th,[])) res else res in anno res [] | A.XX(phi) -> failwith "should have been removed" in let res1 = drop_wits required_states res phi in if not(res1 = res) then begin print_required_states required_states; print_state "after drop_wits" res1 end; (child,res1) ;; let sat_verbose annotate maxlvl lvl m phi = sat_verbose_loop false [] None annotate maxlvl lvl m phi [] (* Type for annotations collected in a tree *) type ('a) witAnnoTree = WitAnno of ('a * ('a witAnnoTree) list);; let sat_annotree annotate m phi = let tree_anno l phi res chld = WitAnno(annotate l phi res,chld) in sat_verbose_loop false [] None tree_anno (-1) 0 m phi [] ;; (* let sat m phi = satloop m phi [] ;; *) let simpleanno l phi res = let pp s = Format.print_string ("\n" ^ s ^ "\n------------------------------\n"); print_generic_algo (List.sort compare res); Format.print_string "\n------------------------------\n\n" in let pp_dir = function A.FORWARD -> () | A.BACKWARD -> pp "^" in match phi with | A.False -> pp "False" | A.True -> pp "True" | A.Pred(p) -> pp ("Pred" ^ (Dumper.dump p)) | A.Not(phi) -> pp "Not" | A.Exists(_,v,phi) -> pp ("Exists " ^ (Dumper.dump(v))) | A.And(_,phi1,phi2) -> pp "And" | A.AndAny(dir,_,phi1,phi2) -> pp "AndAny" | A.HackForStmt(dir,_,phi1,phi2) -> pp "HackForStmt" | A.Or(phi1,phi2) -> pp "Or" | A.SeqOr(phi1,phi2) -> pp "SeqOr" | A.Implies(phi1,phi2) -> pp "Implies" | A.AF(dir,_,phi1) -> pp "AF"; pp_dir dir | A.AX(dir,_,phi1) -> pp "AX"; pp_dir dir | A.AG(dir,_,phi1) -> pp "AG"; pp_dir dir | A.AW(dir,_,phi1,phi2)-> pp "AW"; pp_dir dir | A.AU(dir,_,phi1,phi2)-> pp "AU"; pp_dir dir | A.EF(dir,phi1) -> pp "EF"; pp_dir dir | A.EX(dir,phi1) -> pp "EX"; pp_dir dir | A.EG(dir,phi1) -> pp "EG"; pp_dir dir | A.EU(dir,phi1,phi2) -> pp "EU"; pp_dir dir | A.Let (x,phi1,phi2) -> pp ("Let"^" "^x) | A.LetR (dir,x,phi1,phi2) -> pp ("LetR"^" "^x); pp_dir dir | A.Ref(s) -> pp ("Ref("^s^")") | A.Uncheck(s) -> pp "Uncheck" | A.InnerAnd(s) -> pp "InnerAnd" | A.XX(phi1) -> pp "XX" ;; (* pad: Rene, you can now use the module pretty_print_ctl.ml to print a ctl formula more accurately if you want. Use the print_xxx provided in the different module to call Pretty_print_ctl.pp_ctl. *) let simpleanno2 l phi res = begin Pretty_print_ctl.pp_ctl (P.print_predicate, SUB.print_mvar) false phi; Format.print_newline (); Format.print_string "----------------------------------------------------"; Format.print_newline (); print_generic_algo (List.sort compare res); Format.print_newline (); Format.print_string "----------------------------------------------------"; Format.print_newline (); Format.print_newline (); end (* ---------------------------------------------------------------------- *) (* Benchmarking *) (* ---------------------------------------------------------------------- *) type optentry = bool ref * string type options = {label : optentry; unch : optentry; conj : optentry; compl1 : optentry; compl2 : optentry; newinfo : optentry; reqenv : optentry; reqstates : optentry} let options = {label = (pSATLABEL_MEMO_OPT,"satlabel_memo_opt"); unch = (pUNCHECK_OPT,"uncheck_opt"); conj = (pTRIPLES_CONJ_OPT,"triples_conj_opt"); compl1 = (pTRIPLES_COMPLEMENT_OPT,"triples_complement_opt"); compl2 = (pTRIPLES_COMPLEMENT_SIMPLE_OPT,"triples_complement_simple_opt"); newinfo = (pNEW_INFO_OPT,"new_info_opt"); reqenv = (pREQUIRED_ENV_OPT,"required_env_opt"); reqstates = (pREQUIRED_STATES_OPT,"required_states_opt")} let baseline = [("none ",[]); ("label ",[options.label]); ("unch ",[options.unch]); ("unch and label ",[options.label;options.unch])] let conjneg = [("conj ", [options.conj]); ("compl1 ", [options.compl1]); ("compl12 ", [options.compl1;options.compl2]); ("conj/compl12 ", [options.conj;options.compl1;options.compl2]); ("conj unch satl ", [options.conj;options.unch;options.label]); (* ("compl1 unch satl ", [options.compl1;options.unch;options.label]); ("compl12 unch satl ", [options.compl1;options.compl2;options.unch;options.label]); *) ("conj/compl12 unch satl ", [options.conj;options.compl1;options.compl2;options.unch;options.label])] let path = [("newinfo ", [options.newinfo]); ("newinfo unch satl ", [options.newinfo;options.unch;options.label])] let required = [("reqenv ", [options.reqenv]); ("reqstates ", [options.reqstates]); ("reqenv/states ", [options.reqenv;options.reqstates]); (* ("reqenv unch satl ", [options.reqenv;options.unch;options.label]); ("reqstates unch satl ", [options.reqstates;options.unch;options.label]);*) ("reqenv/states unch satl ", [options.reqenv;options.reqstates;options.unch;options.label])] let all_options = [options.label;options.unch;options.conj;options.compl1;options.compl2; options.newinfo;options.reqenv;options.reqstates] let all = [("all ",all_options)] let all_options_but_path = [options.label;options.unch;options.conj;options.compl1;options.compl2; options.reqenv;options.reqstates] let all_but_path = ("all but path ",all_options_but_path) let counters = [(satAW_calls, "satAW", ref 0); (satAU_calls, "satAU", ref 0); (satEF_calls, "satEF", ref 0); (satAF_calls, "satAF", ref 0); (satEG_calls, "satEG", ref 0); (satAG_calls, "satAG", ref 0); (satEU_calls, "satEU", ref 0)] let perms = map (function (opt,x) -> (opt,x,ref 0.0,ref 0, List.map (function _ -> (ref 0, ref 0, ref 0)) counters)) [List.hd all;all_but_path] (*(all@baseline@conjneg@path@required)*) exception Out let rec iter fn = function 1 -> fn() | n -> let _ = fn() in (Hashtbl.clear reachable_table; Hashtbl.clear memo_label; triples := 0; iter fn (n-1)) let copy_to_stderr fl = let i = open_in fl in let rec loop _ = Printf.fprintf stderr "%s\n" (input_line i); loop() in try loop() with _ -> (); close_in i let bench_sat (_,_,states) fn = List.iter (function (opt,_) -> opt := false) all_options; let answers = concatmap (function (name,options,time,trips,counter_info) -> let iterct = !Flag_ctl.bench in if !time > float_of_int timeout then time := -100.0; if not (!time = -100.0) then begin Hashtbl.clear reachable_table; Hashtbl.clear memo_label; List.iter (function (opt,_) -> opt := true) options; List.iter (function (calls,_,save_calls) -> save_calls := !calls) counters; triples := 0; let res = let bef = Sys.time() in try Common.timeout_function timeout (fun () -> let bef = Sys.time() in let res = iter fn iterct in let aft = Sys.time() in time := !time +. (aft -. bef); trips := !trips + !triples; List.iter2 (function (calls,_,save_calls) -> function (current_calls,current_cfg,current_max_cfg) -> current_calls := !current_calls + (!calls - !save_calls); if (!calls - !save_calls) > 0 then (let st = List.length states in current_cfg := !current_cfg + st; if st > !current_max_cfg then current_max_cfg := st)) counters counter_info; [res]) with Common.Timeout -> begin let aft = Sys.time() in time := -100.0; Printf.fprintf stderr "Timeout at %f on: %s\n" (aft -. bef) name; [] end in List.iter (function (opt,_) -> opt := false) options; res end else []) perms in Printf.fprintf stderr "\n"; match answers with [] -> [] | res::rest -> (if not(List.for_all (function x -> x = res) rest) then (List.iter (print_state "a state") answers; Printf.printf "something doesn't work\n"); res) let print_bench _ = let iterct = !Flag_ctl.bench in if iterct > 0 then (List.iter (function (name,options,time,trips,counter_info) -> Printf.fprintf stderr "%s Numbers: %f %d " name (!time /. (float_of_int iterct)) !trips; List.iter (function (calls,cfg,max_cfg) -> Printf.fprintf stderr "%d %d %d " (!calls / iterct) !cfg !max_cfg) counter_info; Printf.fprintf stderr "\n") perms) (* ---------------------------------------------------------------------- *) (* preprocessing: ignore irrelevant functions *) let preprocess (cfg,_,_) label = function [] -> true (* no information, try everything *) | l -> let sz = G.size cfg in let verbose_output pred = function [] -> Printf.printf "did not find:\n"; P.print_predicate pred; Format.print_newline() | _ -> Printf.printf "found:\n"; P.print_predicate pred; Format.print_newline(); Printf.printf "but it was not enough\n" in let get_any verbose x = let res = try Hashtbl.find memo_label x with Not_found -> (let triples = label x in let filtered = List.map (function (st,th,_) -> (st,th)) triples in Hashtbl.add memo_label x filtered; filtered) in if verbose then verbose_output x res; not([] = res) in let get_all l = (* don't bother testing when there are more patterns than nodes *) if List.length l > sz-2 then false else List.for_all (get_any false) l in if List.exists get_all l then true else (if !Flag_ctl.verbose_match then List.iter (List.iter (function x -> let _ = get_any true x in ())) l; false) let filter_partial_matches trips = if !Flag_ctl.partial_match then let anynegwit = (* if any is neg, then all are *) List.exists (function A.NegWit _ -> true | A.Wit _ -> false) in let (bad,good) = List.partition (function (s,th,wit) -> anynegwit wit) trips in (match bad with [] -> () | _ -> print_state "partial matches" bad; Format.print_newline()); good else trips (* ---------------------------------------------------------------------- *) (* Main entry point for engine *) let sat m phi reqopt = try (match !Flag_ctl.steps with None -> step_count := 0 | Some x -> step_count := x); Hashtbl.clear reachable_table; Hashtbl.clear memo_label; let (x,label,states) = m in if (!Flag_ctl.bench > 0) or (preprocess m label reqopt) then ((* to drop when Yoann initialized this flag *) if List.exists (G.extract_is_loop x) states then Flag_ctl.loop_in_src_code := true; let m = (x,label,List.sort compare states) in let res = if(!Flag_ctl.verbose_ctl_engine) then let fn _ = snd (sat_annotree simpleanno2 m phi) in if !Flag_ctl.bench > 0 then bench_sat m fn else fn() else let fn _ = satloop false [] None m phi [] in if !Flag_ctl.bench > 0 then bench_sat m fn else Common.profile_code "ctl" (fun _ -> fn()) in let res = filter_partial_matches res in (* Printf.printf "steps: start %d, stop %d\n" (match !Flag_ctl.steps with Some x -> x | _ -> 0) !step_count; Printf.printf "triples: %d\n" !triples; print_state "final result" res; *) List.sort compare res) else (if !Flag_ctl.verbose_ctl_engine then Common.pr2 "missing something required"; []) with Steps -> [] (* ********************************************************************** *) (* End of Module: CTL_ENGINE *) (* ********************************************************************** *) end ;; coccinelle-1.0.0-rc19/ctl/double_negate_ml0000644000175000017500000000346512247437436017372 0ustar eugeneugen(* optimizes triples that have complementary environments and the same witnesses *) let double_negate trips = let y = List.sort (function (s,_,wit) -> function (s',_,wit') -> compare (s,wit) (s',wit')) trips in let rec classify = function [] -> [] | ((s,th,wit) as x)::rest -> (match classify rest with [] -> [[x]] | (((s',th',wit')::_) as x1)::rest -> if (s,wit) = (s',wit') then (x::x1)::rest else [x]::(x1::rest) | _ -> failwith "not possible") in let y = List.map (function (((s,_,wit)::_) as all) -> ((s,wit),List.map (function (_,th,_) -> th) all) | _ -> failwith "not possible") (classify y) in let cnf rest_th th = List.fold_left (function rest -> function sub1 -> List.fold_left (function rest -> function subs -> if memBy eq_sub (negate_sub sub1) subs then rest else if memBy eq_sub sub1 subs then subs::rest else (sub1::subs)::rest) rest rest_th) [] th in let dnf rest_th th = List.fold_left (function rest -> function sub1 -> List.fold_left (function rest -> function subs -> match conj_subst [sub1] subs with None -> rest | Some th -> th::rest) rest rest_th) [] th in let res = List.sort compare (List.fold_left (function rest -> function ((s,wit),[th]) -> (s,th,wit)::rest | ((s,wit),ths) -> match ths with [] -> failwith "not possible" | (th::ths) -> let (cnf : substitution list) = List.fold_left cnf (List.map (function x -> [x]) th) ths in match cnf with [] -> (s,[],wit)::rest | th::ths -> let res = setify (List.fold_left dnf (List.map (function x -> [x]) th) ths) in (List.map (function th -> (s,th,wit)) res) @ rest) [] y) in res coccinelle-1.0.0-rc19/ctl/ctl.mldylib0000644000175000017500000000007112247437436016310 0ustar eugeneugenAst_ctl Ctl_engine Flag_ctl Pretty_print_ctl Wrapper_ctl coccinelle-1.0.0-rc19/ctl/Makefile0000644000175000017500000000554612247442614015616 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=ctl SRC=flag_ctl.ml ast_ctl.ml pretty_print_ctl.ml ctl_engine.ml wrapper_ctl.ml SYSLIBS=str.cma unix.cma LIBS=../commons/commons.cma ../globals/globals.cma INCLUDES=-I ../commons -I ../commons/ocamlextra -I ../globals #The Caml compilers. #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLCFLAGS ?= -g OPTFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(LIB) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes $(TARGET).top: $(LIB) test_ctl.cmo $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) test_ctl.cmo $(LIB): $(OBJS) $(OCAMLC_CMD) -a -o $(LIB) $(OBJS) $(OPTLIB): $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $(OPTLIB) $(OPTOBJS) clean:: rm -f $(LIB) $(OPTLIB) $(LIB:.cma=.a) $(TARGET).top else all: cd .. && $(OCAMLBUILD) ctl/ctl.cma all.opt: cd .. && $(OCAMLBUILD) ctl/ctl.cmxa clean:: cd .. && $(OCAMLBUILD) -clean rm -f test_ctl test_ctl: cd .. && $(OCAMLBUILD) ctl/test_ctl.byte cp ../_build/ctl/test_ctl.byte test_ctl endif .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< # clean rule for other files clean:: rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ #*# rm -f .depend distclean: clean .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/docs/0000755000175000017500000000000012247442646014317 5ustar eugeneugencoccinelle-1.0.0-rc19/docs/spatch.1.in0000644000175000017500000003264212247437436016300 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH SPATCH 1 "aug 02, 2012" .\" see http://www.fnal.gov/docs/products/ups/ReferenceManual/html/manpages.html .\" see http://www.linuxjournal.com/article/1158 .\" see http://www.schweikhardt.net/man_page_howto.html .\" groff -Tascii -man ./spatch.1 | more .\" .\" Some roff macros, for reference: .\" .nh disable hyphenation .\" .hy enable hyphenation .\" .ad l left justify .\" .ad b justify to both left and right margins .\" .nf disable filling .\" .fi enable filling .\" .br insert line break .\" .sp insert n+1 empty lines .\" for manpage-specific macros, see man(7) .\" .\" TeX users may be more comfortable with the \fB\fP and .\" \fI\fP escape sequences to invode bold face and italics, .\" respectively. Also \fR for roman. .\" pad: src: deputy man page .SH NAME spatch \- apply a semantic patch file to a set of C files .SH SYNOPSIS .B spatch .B -sp_file .I .I .B [-o .I .B ] .B [-iso_file .I .B ] .B [ .I options .B ] .\" .SH DESCRIPTION \fBspatch\fP is a program matching and transformation tool for C. The programmer describes the code to match and the transformation to perform as a semantic patch, which looks like a standard patch, but can transform multiple files at any number of code sites. .PP Further information about spatch is available at \fBhttp://coccinelle.lip6.fr/\fP. .SH OPTIONS Here is a summary of the most commonly used options: .TP .B -sp_file \fI\fP the semantic patch file .TP .B -dir \fI\fP process all files in directory recursively .TP .B -iso_file \fI\fP (default=@SHAREDIR@/standard.iso) .TP .B -macro_file \fI\fP (default=@SHAREDIR@/standard.h) .TP .B -debug print some information to help debug the matching process .TP .B -all_includes causes all available include files to be used .TP .B -no_includes causes not even local include files to be used .TP .B -I \fI\fP the directory containing the include files .TP .B -include_headers process header files independently .TP .B -use_glimpse works with -dir, use information generated by glimpseindex .TP .B -o \fI\fP the output file. If none is specified, a patch is generated on the standard output .TP .B -in_place do the modification on the file directly .TP .B -out_place store modifications in a .cocci_res file .TP .B -version show the version of spatch .TP .B -date show the date on which spatch was compiled .TP .B -shorthelp see short list of options .TP .B -longhelp see all the available options in different categories .TP .B \-help, \-\-help show summary of options. .SH EXAMPLES ./spatch -sp_file foo.cocci foo.c Apply the semantic patch foo.cocci to the C file foo.c. The semantic patch is applied modulo a set of isomorphisms contained in standard.iso (standard.iso is by default located in @SHAREDIR@/standard.iso). A patch showing the effect of the application, if any, will be generated on the standard output. ./spatch -sp_file foo.cocci foo.c -o /tmp/newfoo.c The same as the above, except that a modified version of foo.c is stored in /tmp/newfoo.c. It is also possible to apply spatch to all of the C files in a directory: ./spatch -cocci_file foo.cocci -dir foodir If the semantic patch is not working as expected, the option -debug shows selection of information about the application of a semantic patch to a file or directory. .SH MORE OPTIONS .IP "MAIN OPTIONS" .TP \fB\-\-sp\-file\fR the semantic patch file .TP \fB\-o\fR the output file .TP \fB\-\-in\-place\fR do the modification on the file directly .TP \fB\-\-backup\-suffix\fR suffix to use when making a backup for inplace .TP \fB\-\-out\-place\fR store modifications in a .cocci_res file .TP \fB\-\-reverse\fR invert the semantic patch before applying it .TP \fB\-U\fR set number of diff context lines .TP \fB\-\-partial\-match\fR report partial matches of the SP on the C file .TP \fB\-\-iso\-file\fR (default=/usr/local/share/coccinelle/standard.iso) .TP \fB\-\-macro\-file\fR .TP \fB\-\-macro\-file\-builtins\fR (default=/usr/local/share/coccinelle/standard.h) .TP \fB\-\-recursive\-includes\fR causes all available include files, both those included in the C file(s) and those included in header files, to be used .TP \fB\-\-all\-includes\fR causes all available include files included in the C file(s) to be used .TP \fB\-\-no\-includes\fR causes not even local include files to be used .TP \fB\-\-local\-includes\fR causes local include files to be used .TP \fB\-\-ignore\-unknown\-options\fR For integration in a toolchain (must be set before the first unknown option) .TP \fB\-\-include\-headers\fR process header files independently .TP \fB\-I\fR containing the header files (optional) .TP \fB\-\-preprocess\fR run the C preprocessor before applying the semantic match .TP \fB\-c\fR gcc/cpp compatibility mode .TP \fB\-\-dir\fR process all files in directory recursively .TP \fB\-\-use\-glimpse\fR works with \fB\-dir\fR, use info generated by glimpseindex .TP \fB\-\-use\-google\fR find relevant files using google code search .TP \fB\-\-use\-idutils\fR find relevant files using id\-utils .TP \fB\-\-patch\fR path name with respect to which a patch should be created .IP "" for a file in the current directory .TP \fB\-\-kbuild\-info\fR improve \fB\-dir\fR by grouping related c files .TP \fB\-\-pyoutput\fR Sets output routine: Standard values: .TP \fB\-\-version\fR guess what .TP \fB\-\-date\fR guess what .TP \fB\-\-shorthelp\fR see short list of options .TP \fB\-\-longhelp\fR see all the available options in different categories .PP .IP "ALIASES AND OBSOLETE OPTIONS" .TP \fB\-\-sp\fR command line semantic patch .TP \fB\-\-iso\fR short option of \fB\-\-iso\-file\fR .TP \fB\-\-cocci\-file\fR the semantic patch file .PP .IP "MOST USEFUL SHOW OPTIONS" .HP \fB\-\-show\-diff\fR .HP \fB\-\-no\-show\-diff\fR .TP \fB\-\-force\-diffshow\fR diff even if only spacing changes .HP \fB\-\-show\-flow\fR .HP \fB\-\-ctl\-inline\-let\fR .HP \fB\-\-ctl\-show\-mcodekind\fR .HP \fB\-\-show\-bindings\fR .HP \fB\-\-show\-transinfo\fR .HP \fB\-\-show\-misc\fR .TP \fB\-\-show\-trying\fR show the name of each function being processed .TP \fB\-\-show\-dependencies\fR show the dependencies related to each rule .PP .IP "VERBOSE SUBSYSTEMS OPTIONS" .HP \fB\-\-verbose\-ctl\-engine\fR .HP \fB\-\-verbose\-match\fR .HP \fB\-\-verbose\-engine\fR .TP \fB\-\-graphical\-trace\fR generate a pdf file representing the matching process .TP \fB\-\-gt\-without\-label\fR remove graph label (requires option \fB\-graphical\-trace\fR) .HP \fB\-\-parse\-error\-msg\fR .HP \fB\-\-verbose\-parsing\fR .HP \fB\-\-type\-error\-msg\fR .PP .IP "OTHER SHOW OPTIONS" .HP \fB\-\-show\-c\fR .HP \fB\-\-show\-cocci\fR .HP \fB\-\-show\-before\-fixed\-flow\fR .HP \fB\-\-show\-ctl\-tex\fR .HP \fB\-\-show\-ctl\-text\fR .HP \fB\-\-show\-SP\fR .PP .IP "DEBUG C PARSING/UNPARSING" .HP \fB\-\-debug\-cpp\fR .HP \fB\-\-debug\-lexer\fR .HP \fB\-\-debug\-etdt\fR .HP \fB\-\-debug\-typedef\fR .TP \fB\-\-filter\-msg\fR filter some cpp message when the macro is a "known" cpp construct .HP \fB\-\-filter\-define\-error\fR .TP \fB\-\-filter\-msg\-define\-error\fR filter the error msg .HP \fB\-\-filter\-passed\-level\fR .HP \fB\-\-debug\-unparsing\fR .PP .IP "SHORTCUT FOR ENABLING/DISABLING A SET OF DEBUGGING OPTIONS AT ONCE" .HP \fB\-\-quiet\fR .HP \fB\-\-very\-quiet\fR .HP \fB\-\-debug\fR .HP \fB\-\-pad\fR .PP .IP "BENCH OPTIONS" .TP \fB\-\-profile\fR gather timing information about the main coccinelle functions .TP \fB\-\-bench\fR for profiling the CTL engine .TP \fB\-\-timeout\fR timeout in seconds .TP \fB\-\-steps\fR max number of model checking steps per code unit .TP \fB\-\-iso\-limit\fR max depth of iso application .TP \fB\-\-no\-iso\-limit\fR disable limit on max depth of iso application .TP \fB\-\-track\-iso\fR gather information about isomorphism usage .TP \fB\-\-disable\-iso\fR disable a specific isomorphism .TP \fB\-\-profile\-iso\fR gather information about the cost of isomorphism usage .PP .IP "CHANGE OF ALGORITHM OPTIONS" .TP \fB\-\-keep\-comments\fR keep comments around removed code .HP \fB\-\-loop\fR .TP \fB\-\-no\-loops\fR drop all back edges derived from looping constructs \- unsafe .TP \fB\-\-no\-gotos\fR drop all jumps derived from gotos \- unsafe .TP \fB\-\-no\-saved\-typedefs\fR drop all inferred typedefs from one parse of some code to the next .TP \fB\-\-ocaml\-regexps\fR use OCaml Str regular expressions for constraints .HP \fB\-\-l1\fR .TP \fB\-\-ifdef\-to\-if\fR convert ifdef to if (experimental) .TP \fB\-\-no\-ifdef\-to\-if\fR convert ifdef to if (experimental) .HP \fB\-\-disable\-multi\-pass\fR .HP \fB\-\-noif0\-passing\fR .HP \fB\-\-defined\fR .HP \fB\-\-undefined\fR .HP \fB\-\-noadd\-typedef\-root\fR .TP \fB\-\-disallow\-nested\-exps\fR disallow an expresion pattern from matching a term and its subterm .HP \fB\-\-disable\-worth\-trying\-opt\fR .HP \fB\-\-only\-return\-is\-error\-exitif\fR this flag is not set, then break and continue are also error exits .TP \fB\-\-allow\-inconsistent\-paths\fR if this flag is set don't check for inconsistent paths; dangerous .TP \fB\-\-no\-safe\-expressions\fR make an expression disjunction not prioritise the topmost disjunct .TP \fB\-\-int\-bits\fR the number of bits in an unsigned int .TP \fB\-\-long\-bits\fR the number of bits in an unsigned long .TP \fB\-\-linux\-spacing\fR spacing of + code follows the conventions of Linux .TP \fB\-\-smpl\-spacing\fR spacing of + code follows the semantic patch .TP \fB\-D\fR indicate that a virtual rule should be considered to be matched .TP \fB\-\-c\fR++ make a small attempt to parse C++ files .PP .IP "MISC OPTIONS" .TP \fB\-\-debugger\fR option to set if launch spatch in ocamldebug .TP \fB\-\-disable\-once\fR to print more messages .TP \fB\-\-show\-trace\-profile\fR show trace .HP \fB\-\-save\-tmp\-files\fR .PP .IP "CONCURRENCY" .TP \fB\-\-index\fR the processor to use for this run of spatch .TP \fB\-\-max\fR the number of processors available .TP \fB\-\-mod\-distrib\fR use mod to distribute files among the processors .PP .IP "PAD OPTIONS" .TP \fB\-\-use\-cache\fR use .ast_raw pre\-parsed cached C file .TP \fB\-\-cache\-prefix\fR directory of cached ASTs, sets \fB\-use\-cache\fR .TP \fB\-\-cache\-limit\fR maximum number of cached ASTs, sets \fB\-use\-cache\fR .PP .IP "TEST MODE AND TEST OPTIONS (WORKS WITH TESTS/ OR .OK FILES)" The test options don't work with the \fB\-\-sp\-file\fR and so on. .TP \fB\-\-test\fR launch spatch on tests/file.[c,cocci] .TP \fB\-\-testall\fR launch spatch on all files in tests/ having a .res .TP \fB\-\-test\-okfailed\fR generates .{ok,failed,spatch_ok} files using .res files .TP \fB\-\-test\-regression\-okfailed\fR process the .{ok,failed,spatch_ok} files in current dir .TP \fB\-\-compare\-with\-expected\fR use also file.res .TP \fB\-\-expected\-score\-file\fR which score file to compare with in \fB\-testall\fR .TP \fB\-\-no\-update\-score\-file\fR do not update the score file when \fB\-testall\fR succeeds .HP \fB\-\-relax\-include\-path\fR .PP .IP "ACTION MODE" The action options don't work with the \fB\-\-sp\-file\fR and so on. It's for the other (internal) uses of the spatch program. .TP \fB\-\-tokens\-c\fR .TP \fB\-\-parse\-c\fR .TP \fB\-\-parse\-h\fR .TP \fB\-\-parse\-ch\fR .TP \fB\-\-parse\-i\fR .TP \fB\-\-parse\fR .TP \fB\-\-show\-flow\fR .TP \fB\-\-control\-flow\fR .TP \fB\-\-control\-flow\-to\-file\fR .TP \fB\-\-test\-cfg\-ifdef\fR .TP \fB\-\-parse\-unparse\fR .TP \fB\-\-type\-c\fR .TP \fB\-\-compare\-c\fR .TP \fB\-\-comment\-annotater\-c\fR .HP \fB\-\-compare\-c\-hardcoded\fR .TP \fB\-\-test\-attributes\fR .TP \fB\-\-test\-cpp\fR .TP \fB\-\-extract\-macros\fR .TP \fB\-\-extract\-macros\-select\fR .TP \fB\-\-xxx\fR <> .TP \fB\-\-parse\-cocci\fR .TP \fB\-\-compare\-c\fR .SH FILES .I @SHAREDIR@/standard.iso .RS This file contains the default set of isomorphisms. .RE .I @SHAREDIR@/standard.h .RS This file contains the default set of macro hints. .SH ENVIRONMENT .IP COCCINELLE_HOME The path to the Coccinelle share directory. Default is .I @SHAREDIR@ .SH REFERENCES Y. Padioleau, J.L. Lawall, R.R Hansen, G. Muller "Documenting and Automating Collateral Evolutions in Linux Device Driver" .I EuroSys 2008, Glasgow, Scotland (April 2008) pp. 247-260. .SH AUTHOR \fBspatch\fP was written by Julia Lawall , Yoann Padioleau , Rene Rydhof Hansen and Henrik Stuart . .PP This manual page was written by Yoann Padioleau and Julia Lawall . .SH REPORTING BUGS Send a mail to .SH COPYRIGHT Copyright 2010, 2011, University of Copenhagen DIKU and INRIA. Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen. spatch is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, according to version 2 of the License. .SH SEE ALSO \fIpatch\fP(1), \fIdiff\fP(1) coccinelle-1.0.0-rc19/docs/developer.txt0000644000175000017500000000423412247437436017051 0ustar eugeneugen-*- org -*- * How to install coccinelle ------------------------------ ** CVS export CVS_RSH=ssh export CVSROOT=:ext:topps.diku.dk:/var/cvs/cocci You must be a member of the cocci group on the topps.diku.dk machine. Then cvs checkout coccinelle. ** Dependencies See install.txt ** Tools OCaml, Emacs. ** Compile make depend make * How to use coccinelle ------------------------------ ** Test ** Tutorial I have put demos/examples. ** spatch, sgrep ** Emacs coccinelle mode See emacs/cocci.el for instructions. ** Manual See docs/manual.tex * How to extend coccinelle ------------------------------ Send us a semantic patch :) * Documentation on coccinelle internals ---------------------------------------- - look at the papers from the coccinelle website: http://www.emn.fr/x-info/coccinelle - look in docs from cvs checkout working-documents - look at the code :) ** Software architecture See docs/graph-module-dependencies.ps ** coccinelle/ organization See authors.txt * Being a coccinelle developer ------------------------------ ** Conventions/advices Do not use the 'open' OCaml module instruction. Qualify, like in 'Cocci.full_engine x'. Have a makefile in each directory with a clean:, depend:, and possibly all: and all.opt: targets. * How to contribute to Linux ------------------------------ ** How to use git ** How to use spatch ** How to prepare a patch for Linus * Tools ------------------------------ ** Emacs ** debugging: ocamldebug, the ocaml replay debugger ** profiling: gprof (but can also use the -profile option of spatch) ** CVS tricks *** To remove : cvs release -d *** To update the code and allow the checkout of new directories but pruning empty (obsolete but still there because CVS sux) directories: cvs update -d -P *** To see what has changed since 2 days cvs diff -u -D "2 days ago" *** To create a new CVS module: mkdir nameofdir; cd nameofdir; cvs import -m"your commit message" yoyo start cd ..; rm -rf nameofdir; cvs checkout nameofdir yoyo is a dummy name * Coders ------------------------------ See authors.txt coccinelle-1.0.0-rc19/docs/manual/0000755000175000017500000000000012250162456015564 5ustar eugeneugencoccinelle-1.0.0-rc19/docs/manual/macros_grammar.tex0000644000175000017500000000302512247437436021311 0ustar eugeneugen% Definition of a grammar (BNF style) package for Latex and Hevea \ifhevea % Definition for Hevea (HTML generation) \def\T#1{{\sf{#1}}} \def\NTS#1{{\maroon #1\/}} \def\KW#1{{\blue #1}} \def\gramor{{\black $|$}} \def\grameq{{\black \quad::=\quad}} \def\lparen{{\black (}} \def\rparen{{\black )}} \def\lbracket{{\black [}} \def\rbracket{{\black ]}} \def\plus{{\black +}} \def\questionmark{{\black ?}} \def\etoile{{\black *}} \else % Definition for LaTeX \def\T#1{{\textsf{\small{#1}}}} \def\NTS#1{{\it #1\/}} \def\KW#1{{\mtt{#1}}} %\def\gramor{$\vert$} \def\gramor{$\mid$} \def\grameq{\,\,\,::=\,\,\,\,\,} \def\lparen{(} \def\rparen{)} \def\lbracket{$[$} \def\rbracket{$]$} \def\plus{+} \def\questionmark{?} \def\etoile{*} \fi \def\NT#1{\hyperlink{#1}{\NTS{#1}}} \def\group#1{{\rm\lparen}#1{\rm\rparen}} \def\range#1#2{#1{..}#2} \def\any#1{#1$^{\etoile}$} \def\some#1{#1$^{\plus}$} \def\ANY#1{\any{{\rm\lparen}#1{\rm\rparen}}} \def\SOME#1{\some{{\rm\lparen}#1{\rm\rparen}}} \def\OR{\gramor\ } \iflanguagestyle % Option notation : [ xxx ] versus (xxx)^? \def\opt#1{#1$^{\questionmark}$} \def\OPT#1{\opt{{\rm\lparen}#1{\rm\rparen}}} \else \def\opt#1{{\lbracket}#1{\rbracket}} \def\OPT#1{\opt{#1}} \fi \newenvironment{grammar}{\begin{center}\begin{tabular}{l@{}c@{}l}}{\end{tabular}\end{center}} \def\RULE#1\CASE#2{\NTS{#1} & \grameq & \KW{#2} \\} \def\CASE#1{& \gramor & \KW{#1} \\} \newcommand{\rt}[1]{\hypertarget{#1}{#1}} \newcommand{\bs}{\textbackslash} \def\lb{\char123} \def\rb{\char125} \def\lt{\tt\char60} \def\gt{\tt\char62} \def\caret{\tt\^{}} coccinelle-1.0.0-rc19/docs/manual/tips.tex0000644000175000017500000000224512247437436017301 0ustar eugeneugen \section{Tips and Tricks} \subsection{How to remove useless parentheses?} If you want to rewrite any access to a pointer value by a function call, you may use the following semantic patch. \begin{lstlisting}[language=Cocci] @-- a = *b @++ a = readb(b) \end{lstlisting} However, if for some reason your code looks like \verb|bar = *(foo)|, you will end up with \verb|bar = readb((foo))| as the extra parentheses around \texttt{foo} are capture by the metavariable \texttt{b}. In order to generate better output code, you can use the following semantic patch instead. \begin{lstlisting}[language=Cocci] @-- a = *(b) @++ a = readb(b) \end{lstlisting} \noindent And rely on your standard.iso isomorphism file which should contain: \begin{lstlisting}[language=Cocci] Expression @ paren @ expression E; @@ (E) => E \end{lstlisting} Coccinelle will then consider \verb|bar = *(foo)| as equivalent to \verb|bar = *foo| (but not the other way around) and capture both. Finally, it will generate \verb|bar = readb(foo)| as expected. %%% Local Variables: %%% mode: LaTeX %%% TeX-master: "main_grammar" %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/tutorial.tex0000644000175000017500000000002412247437436020156 0ustar eugeneugen\chapter{Tutorial} coccinelle-1.0.0-rc19/docs/manual/main_grammar.tex0000644000175000017500000000157712247437436020763 0ustar eugeneugen\documentclass{article} \usepackage{times} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{ifthen} \usepackage{hevea} \usepackage{alltt} \usepackage{xspace} \usepackage[pdfborder={0 0 0}]{hyperref} \usepackage{listings} \usepackage[usenames,dvipsnames]{color} \usepackage{multirow} \input{macros_listing_cocci} \input{macros_grammar} \input{macros_common} \input{macros} \ifhevea \newcommand{\phantom}{} \newcommand{\air}{ } \else \newcommand{\air}{\phantom{xxx}} \fi % Update version in macros.tex \title{The SmPL Grammar (version \cocciversion)} \author{Research group on Coccinelle} \date{\today} \begin{document} \maketitle \input{cocci_syntax} \include{examples} \include{tips} \end{document} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: t %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/installing.tex0000644000175000017500000000105712247437436020466 0ustar eugeneugen%############################################################################## \chapter{Installing Coccinelle} %############################################################################## %\chapter{Building \spatch and \sgrep} \section{Requirements} %coupling: with install.txt \section{Getting Coccinelle} \section{Compiling Coccinelle} %coupling: with install.txt \section{Running Coccinelle} %coupling: with readme.txt %%% Local Variables: %%% mode: LaTeX %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/options.tex0000644000175000017500000000021212247437436020005 0ustar eugeneugen\input{main_options.tex} % This is just a placeholder for 'main_options.tex' % Todo: actually replace this file with 'main_options.tex'? coccinelle-1.0.0-rc19/docs/manual/macros_options.tex0000644000175000017500000000050512247437436021356 0ustar eugeneugen \newcommand{\minimum}[2]{\paragraph*{\makebox[0in][r]{\FilledBigDiamondshape\,\,} {{#1}}} {#2}} \newcommand{\normal}[2]{\paragraph*{\makebox[0in][r]{\BigLowerDiamond\,\,} {{#1}}} {#2}} \newcommand{\rare}[2]{\paragraph*{\makebox[0in][r]{\BigDiamondshape\,\,} {{#1}}} {#2}} \newcommand{\developer}[2]{\paragraph*{{#1}} {#2}} coccinelle-1.0.0-rc19/docs/manual/main.tex0000644000175000017500000001200112247437436017235 0ustar eugeneugen\documentclass{report} %****************************************************************************** % Prelude %****************************************************************************** %------------------------------------------------------------------------------ % Packages %------------------------------------------------------------------------------ \usepackage{ifthen} \usepackage{hevea} \usepackage{times} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{amsmath} \usepackage{amssymb} % fancy symbol, but require latex-extra-fonts (huge) package \usepackage[geometry]{ifsym} \usepackage{graphics} \usepackage[pdftex]{graphicx} \usepackage{epsfig} \usepackage{subfigure} \usepackage{wrapfig} \usepackage[all]{xy} \usepackage{fancyvrb} \usepackage{moreverb} \usepackage{alltt} \usepackage{boxedminipage} \usepackage{xspace} \usepackage{endnotes} \usepackage{multirow} %\usepackage{colortbl} % conflict with color package below \usepackage{listings} %\usepackage{code/lgrind} \usepackage[pdfborder={0 0 0}]{hyperref} %\usepackage{url} \usepackage[usenames,dvipsnames]{color} %------------------------------------------------------------------------------ % Shortcuts %------------------------------------------------------------------------------ \input{macros_common} %e.g: % \newcommand{\mita}[1]{\mbox{\it{{#1}}}} \input{macros_options} \input{macros_listing_cocci} % order is important \input{macros_grammar} %------------------------------------------------------------------------------ % Globals %------------------------------------------------------------------------------ \input{macros} %e.g: % \newcommand{\avgcorrect}{96\%\xspace} % if consider all files % \newcommand{\MyTool}{aComment\xspace} % \newcommand{\bugsfound}{XXX\xspace} %****************************************************************************** % Title %****************************************************************************** \begin{document} %don't want date printed \date{} %------------------------------------------------------------------------------ \title{ {\Huge \bf Coccinelle}\\ {User's manual}\\ {release \cocciversion}\\ } %\title{\spatch and \sgrep manual} \author{ Julia Lawall and Yoann Padioleau \\ {(with contributions from Rene Rydhof Hansen, Nicolas Palix, Henrik Stuart) } } %src: Xavier Leroy manual \date{\today} \maketitle \tableofcontents %****************************************************************************** % Body %****************************************************************************** \chapter*{Foreword} This manual documents the release \cocciversion of Coccinelle. It is organized as follows: \begin{itemize} \item Part~\ref{part:usermanual} is an introduction to Coccinelle \item Part~\ref{part:refmanual} is the reference description of Coccinelle, its language and command line tool. \end{itemize} \section*{Conventions} \section*{Copyright} %coupling: copyright.txt Coccinelle copyright is\\ \copyright~2010, University of Copenhagen DIKU and INRIA.\\ \copyright~2005-2009, University of Copenhagen DIKU and Ecole des Mines de Nantes. Coccinelle is open source and can be freely redistributed under the terms of the GNU General Public License version 2. See the file \verb+license.txt+ in the distribution for licensing information.\\ \noindent Copyright \copyright~2010, Nicolas Palix, Julia Lawall, and Gilles Muller\\ Copyright \copyright~2008, 2009, Yoann Padioleau, Nicolas Palix, Julia Lawall, and Gilles Muller\\ Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled "GNU Free Documentation License". \section*{Availability} Coccinelle can be freely downloaded from \url{http://coccinelle.lip6.fr}.\\ This website contains also additional information and a wiki website. \part{User Manual} \label{part:usermanual} \input{introduction} \input{installing} \input{tutorial} \chapter{Examples} \input{examples} \input{tips} \input{isomorphisms} \input{parsing} \input{workflow} \input{advanced} \part{Reference Manual} \label{part:refmanual} \chapter{SmPL grammar} \input{cocci_syntax} \chapter{\spatch command line options} %coupling: ../spatch.1 \input{spatch_options} %****************************************************************************** % Appendix %****************************************************************************** \part{Appendix} \chapter*{GNU Free Documentation License} \input{license.txt} %index {\small \bibliographystyle{acm} \bibliography{main} } %****************************************************************************** % Postlude %****************************************************************************** \end{document} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: t %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/macros.tex0000644000175000017500000000027412247437436017606 0ustar eugeneugen\newcommand{\spatch}{\texttt{spatch}\xspace} \newcommand{\sgrep}{\texttt{sgrep}\xspace} \newcommand{\cpp}{\texttt{cpp}\xspace} \newcommand{\cocciversion}{\input{../../version}\xspace} coccinelle-1.0.0-rc19/docs/manual/examples.tex0000644000175000017500000003236712247437436020150 0ustar eugeneugen \section{Examples} %\label{sec:examples} This section presents a range of examples. Each example is presented along with some C code to which it is applied. The description explains the rules and the matching process. \subsection{Function renaming} One of the primary goals of Coccinelle is to perform software evolution. For instance, Coccinelle could be used to perform function renaming. In the following example, every occurrence of a call to the function \texttt{foo} is replaced by a call to the function \texttt{bar}.\\ \begin{tabular}{ccc} Before & Semantic patch & After \\ \begin{minipage}[t]{.3\linewidth} \begin{lstlisting} #DEFINE TEST "foo" printf("foo"); int main(int i) { //Test int k = foo(); if(1) { foo(); } else { foo(); } foo(); } \end{lstlisting} \end{minipage} & \begin{minipage}[t]{.3\linewidth} \begin{lstlisting}[language=Cocci] @M@@ @@@M @-- foo() @++ bar() \end{lstlisting} \end{minipage} & \begin{minipage}[t]{.3\linewidth} \begin{lstlisting} #DEFINE TEST "foo" printf("foo"); int main(int i) { //Test int k = bar(); if(1) { bar(); } else { bar(); } bar(); } \end{lstlisting} \end{minipage}\\ \end{tabular} \newpage \subsection{Removing a function argument} Another important kind of evolution is the introduction or deletion of a function argument. In the following example, the rule \texttt{rule1} looks for definitions of functions having return type \texttt{irqreturn\_t} and two parameters. A second \emph{anonymous} rule then looks for calls to the previously matched functions that have three arguments. The third argument is then removed to correspond to the new function prototype.\\ \begin{tabular}{c} \begin{lstlisting}[language=Cocci,name=arg] @M@ rule1 @ identifier fn; identifier irq, dev_id; typedef irqreturn_t; @@@M static irqreturn_t fn (int irq, void *dev_id) { ... } @M@@ identifier rule1.fn; expression E1, E2, E3; @@@M fn(E1, E2 @-- ,E3 ) \end{lstlisting}\\ \end{tabular} \vspace{1cm} \begin{tabular}{c} \texttt{drivers/atm/firestream.c} at line 1653 before transformation\\ \begin{lstlisting}[language=PatchC] static void fs_poll (unsigned long data) { struct fs_dev *dev = (struct fs_dev *) data; @- fs_irq (0, dev, NULL); dev->timer.expires = jiffies + FS_POLL_FREQ; add_timer (&dev->timer); } \end{lstlisting}\\ \vspace{1cm} \\ \texttt{drivers/atm/firestream.c} at line 1653 after transformation\\ \begin{lstlisting}[language=PatchC] static void fs_poll (unsigned long data) { struct fs_dev *dev = (struct fs_dev *) data; @+ fs_irq (0, dev); dev->timer.expires = jiffies + FS_POLL_FREQ; add_timer (&dev->timer); } \end{lstlisting}\\ \end{tabular} \newpage \subsection{Introduction of a macro} To avoid code duplication or error prone code, the kernel provides macros such as \texttt{BUG\_ON}, \texttt{DIV\_ROUND\_UP} and \texttt{FIELD\_SIZE}. In these cases, the semantic patches look for the old code pattern and replace it by the new code.\\ A semantic patch to introduce uses of the \texttt{DIV\_ROUND\_UP} macro looks for the corresponding expression, \emph{i.e.}, $(n + d - 1) / d$. When some code is matched, the metavariables \texttt{n} and \texttt{d} are bound to their corresponding expressions. Finally, Coccinelle rewrites the code with the \texttt{DIV\_ROUND\_UP} macro using the values bound to \texttt{n} and \texttt{d}, as illustrated in the patch that follows.\\ \begin{tabular}{c} Semantic patch to introduce uses of the \texttt{DIV\_ROUND\_UP} macro\\ \begin{lstlisting}[language=Cocci,name=divround] @M@ haskernel @ @@@M #include @M@ depends on haskernel @ expression n,d; @@@M ( @-- (((n) + (d)) - 1) / (d)) @++ DIV_ROUND_UP(n,d) | @-- (((n) + ((d) - 1)) / (d)) @++ DIV_ROUND_UP(n,d) ) \end{lstlisting} \end{tabular}\\ \vspace{1cm} \begin{tabular}{c} Example of a generated patch hunk\\ \begin{lstlisting}[language=PatchC] @---- a/drivers/atm/horizon.c @++++ b/drivers/atm/horizon.c @M@@ -698,7 +698,7 @@ got_it: if (bits) *bits = (div<) { BUG(); } | @-- if (E) { BUG(); } @++ BUG_ON(E); ) @M@ disable unlikely @ expression E,f; @@@M ( if (<+... f(...) ...+>) { BUG(); } | @-- if (unlikely(E)) { BUG(); } @++ BUG_ON(E); ) \end{lstlisting}\\ \end{tabular}\\ For instance, using the semantic patch above, Coccinelle generates patches like the following one. \begin{tabular}{c} \begin{lstlisting}[language=PatchC] @---- a/fs/ext3/balloc.c @++++ b/fs/ext3/balloc.c @M@@ -232,8 +232,7 @@ restart: prev = rsv; } printk("Window map complete.\n"); @-- if (bad) @-- BUG(); @++ BUG_ON(bad); } #define rsv_window_dump(root, verbose) \ __rsv_window_dump((root), (verbose), __FUNCTION__) \end{lstlisting} \end{tabular} \newpage \subsection{Look for \texttt{NULL} dereference} This SmPL match looks for \texttt{NULL} dereferences. Once an expression has been compared to \texttt{NULL}, a dereference to this expression is prohibited unless the pointer variable is reassigned.\\ \begin{tabular}{c} Original \\ \begin{lstlisting} foo = kmalloc(1024); if (!foo) { printk ("Error %s", foo->here); return; } foo->ok = 1; return; \end{lstlisting}\\ \end{tabular} \vspace{1cm} \begin{tabular}{c} Semantic match\\ \begin{lstlisting}[language=Cocci] @M@@ expression E, E1; identifier f; statement S1,S2,S3; @@@M @+* if (E == NULL) { ... when != if (E == NULL) S1 else S2 when != E = E1 @+* E->f ... when any return ...; } else S3 \end{lstlisting}\\ \end{tabular} \vspace{1cm} \begin{tabular}{c} Matched lines\\ \begin{lstlisting}[language=PatchC] foo = kmalloc(1024); @-if (!foo) { @- printk ("Error %s", foo->here); return; } foo->ok = 1; return; \end{lstlisting}\\ \end{tabular} \newpage \subsection{Reference counter: the of\_xxx API} Coccinelle can embed Python code. Python code is used inside special SmPL rule annotated with \texttt{script:python}. Python rules inherit metavariables, such as identifier or token positions, from other SmPL rules. The inherited metavariables can then be manipulated by Python code. The following semantic match looks for a call to the \texttt{of\_find\_node\_by\_name} function. This call increments a counter which must be decremented to release the resource. Then, when there is no call to \texttt{of\_node\_put}, no new assignment to the \texttt{device\_node} variable \texttt{n} and a \texttt{return} statement is reached, a bug is detected and the position \texttt{p1} and \texttt{p2} are initialized. As the Python only depends on the positions \texttt{p1} and \texttt{p2}, it is evaluated. In the following case, some emacs Org mode data are produced. This example illustrates the various fields that can be accessed in the Python code from a position variable. \begin{tabular}{c} \begin{lstlisting}[language=Cocci,breaklines=true] @M@ r exists @ local idexpression struct device_node *n; position p1, p2; statement S1,S2; expression E,E1; @@@M ( if (!(n@p1 = of_find_node_by_name(...))) S1 | n@p1 = of_find_node_by_name(...) ) <... when != of_node_put(n) when != if (...) { <+... of_node_put(n) ...+> } when != true !n || ... when != n = E when != E = n if (!n || ...) S2 ...> ( return <+...n...+>; | return@p2 ...; | n = E1 | E1 = n ) @M@ script:python @ p1 << r.p1; p2 << r.p2; @@@M print "* TODO [[view:%s::face=ovl-face1::linb=%s::colb=%s::cole=%s][inc. counter:%s::%s]]" % (p1[0].file,p1[0].line,p1[0].column,p1[0].column_end,p1[0].file,p1[0].line) print "[[view:%s::face=ovl-face2::linb=%s::colb=%s::cole=%s][return]]" % (p2[0].file,p2[0].line,p2[0].column,p2[0].column_end) \end{lstlisting} \end{tabular} \newpage Lines 13 to 17 list a variety of constructs that should not appear between a call to \texttt{of\_find\_node\_by\_name} and a buggy return site. Examples are a call to \texttt{of\_node\_put} (line 13) and a transition into the then branch of a conditional testing whether \texttt{n} is \texttt{NULL} (line 15). Any number of conditionals testing whether \texttt{n} is \texttt{NULL} are allowed as indicated by the use of a nest \texttt{<...~~...>} to describe the path between the call to \texttt{of\_find\_node\_by\_name}, the return and the conditional in the pattern on line 18.\\ The previously semantic match has been used to generate the following lines. They may be edited using the emacs Org mode to navigate in the code from a site to another. \begin{lstlisting}[language=,breaklines=true] * TODO [[view:/linux-next/arch/powerpc/platforms/pseries/setup.c::face=ovl-face1::linb=236::colb=18::cole=20][inc. counter:/linux-next/arch/powerpc/platforms/pseries/setup.c::236]] [[view:/linux-next/arch/powerpc/platforms/pseries/setup.c::face=ovl-face2::linb=250::colb=3::cole=9][return]] * TODO [[view:/linux-next/arch/powerpc/platforms/pseries/setup.c::face=ovl-face1::linb=236::colb=18::cole=20][inc. counter:/linux-next/arch/powerpc/platforms/pseries/setup.c::236]] [[view:/linux-next/arch/powerpc/platforms/pseries/setup.c::face=ovl-face2::linb=245::colb=3::cole=9][return]] \end{lstlisting} Note~: Coccinelle provides some predefined Python functions, \emph{i.e.}, \texttt{cocci.print\_main}, \texttt{cocci.print\_sec} and \texttt{cocci.print\_secs}. One could alternatively write the following SmPL rule instead of the previously presented one. \begin{tabular}{c} \begin{lstlisting}[language=Cocci] @M@ script:python @ p1 << r.p1; p2 << r.p2; @@@M cocci.print_main(p1) cocci.print_sec(p2,"return") \end{lstlisting} \end{tabular}\\ The function \texttt{cocci.print\_secs} is used when there is several positions which are matched by a single position variable and that every matched position should be printed. Any metavariable could be inherited in the Python code. However, accessible fields are not currently equally supported among them. \newpage \subsection{Filtering identifiers, declarers or iterators with regular expression} If you consider the following SmPL file which uses the regexp functionality to filter the identifiers that contain, begin or end by \texttt{foo}, \begin{tabular}{c@{\hspace{2cm}}c} \begin{lstlisting}[language=Cocci, name=Regexp] @M@anyid@ type t; identifier id; @@@M t id () {...} @M@script:python@ x << anyid.id; @@@M print "Identifier: %s" % x @M@contains@ type t; identifier foo =~ ".*foo"; @@@M t foo () {...} @M@script:python@ x << contains.foo; @@@M print "Contains foo: %s" % x \end{lstlisting} & \begin{lstlisting}[language=Cocci,name=Regexp] @M@endsby@ type t; identifier foo =~ ".*foo$"; @@@M t foo () {...} @M@script:python@ x << endsby.foo; @@@M print "Ends by foo: %s" % x @M@beginsby@ type t; identifier foo =~ "^foo"; @@@M t foo () {...} @M@script:python@ x << beginsby.foo; @@@M print "Begins by foo: %s" % x \end{lstlisting} \end{tabular}\\ and the following C program, on the left, which defines the functions \texttt{foo}, \texttt{bar}, \texttt{foobar}, \texttt{barfoobar} and \texttt{barfoo}, you will get the result on the right. \begin{tabular}{c@{\hspace{2cm}}c} \begin{lstlisting} int foo () { return 0; } int bar () { return 0; } int foobar () { return 0; } int barfoobar () { return 0; } int barfoo () { return 0; } \end{lstlisting} & \begin{lstlisting} Identifier: foo Identifier: bar Identifier: foobar Identifier: barfoobar Identifier: barfoo Contains foo: foo Contains foo: foobar Contains foo: barfoobar Contains foo: barfoo Ends by foo: foo Ends by foo: barfoo Begins by foo: foo Begins by foo: foobar \end{lstlisting} \end{tabular} % \begin{tabular}{ccc} % Before & Semantic patch & After \\ % \begin{minipage}[t]{.3\linewidth} % \begin{lstlisting} % \end{lstlisting} % \end{minipage} % & % \begin{minipage}[t]{.3\linewidth} % \begin{lstlisting}[language=Cocci] % \end{lstlisting} % \end{minipage} % & % \begin{minipage}[t]{.3\linewidth} % \begin{lstlisting} % \end{lstlisting} % \end{minipage}\\ % \end{tabular} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: "main_grammar" %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/hevea.sty0000644000175000017500000000576212247437436017440 0ustar eugeneugen% hevea : hevea.sty % This is a very basic style file for latex document to be processed % with hevea. It contains definitions of LaTeX environment which are % processed in a special way by the translator. % Mostly : % - latexonly, not processed by hevea, processed by latex. % - htmlonly , the reverse. % - rawhtml, to include raw HTML in hevea output. % - toimage, to send text to the image file. % The package also provides hevea logos, html related commands (ahref % etc.), void cutting and image commands. \NeedsTeXFormat{LaTeX2e} \ProvidesPackage{hevea}[2002/01/11] \RequirePackage{comment} \newif\ifhevea\heveafalse \@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse} \makeatletter% \newcommand{\heveasmup}[2]{% \raise #1\hbox{$\m@th$% \csname S@\f@size\endcsname \fontsize\sf@size 0% \math@fontsfalse\selectfont #2% }}% \DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}% \DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}% \DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}} %%%%%%%%% Hyperlinks hevea style \newcommand{\ahref}[2]{{#2}} \newcommand{\ahrefloc}[2]{{#2}} \newcommand{\aname}[2]{{#2}} \newcommand{\ahrefurl}[1]{\texttt{#1}} \newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}} \newcommand{\mailto}[1]{\texttt{#1}} \newcommand{\imgsrc}[2][]{} \newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1} \AtBeginDocument {\@ifundefined{url} {%url package is not loaded \let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref} {}} %% Void cutting instructions \newcounter{cuttingdepth} \newcommand{\tocnumber}{} \newcommand{\notocnumber}{} \newcommand{\cuttingunit}{} \newcommand{\cutdef}[2][]{} \newcommand{\cuthere}[2]{} \newcommand{\cutend}{} \newcommand{\htmlhead}[1]{} \newcommand{\htmlfoot}[1]{} \newcommand{\htmlprefix}[1]{} \newenvironment{cutflow}[1]{}{} \newcommand{\cutname}[1]{} \newcommand{\toplinks}[3]{} \newcommand{\setlinkstext}[3]{} \newcommand{\flushdef}[1]{} \newcommand{\footnoteflush}[1]{} %%%% Html only \excludecomment{rawhtml} \newcommand{\rawhtmlinput}[1]{} \excludecomment{htmlonly} %%%% Latex only \newenvironment{latexonly}{}{} \newenvironment{verblatex}{}{} %%%% Image file stuff \def\toimage{\endgroup} \def\endtoimage{\begingroup\def\@currenvir{toimage}} \def\verbimage{\endgroup} \def\endverbimage{\begingroup\def\@currenvir{verbimage}} \newcommand{\imageflush}[1][]{} %%% Bgcolor definition \newsavebox{\@bgcolorbin} \newenvironment{bgcolor}[2][] {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup} {\egroup\end{lrbox}% \begin{flushleft}% \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}% \end{flushleft}} %%% Style sheets macros, defined as no-ops \newcommand{\newstyle}[2]{} \newcommand{\addstyle}[1]{} \newcommand{\setenvclass}[2]{} \newcommand{\getenvclass}[1]{} \newcommand{\loadcssfile}[1]{} \newenvironment{divstyle}[1]{}{} \newenvironment{cellstyle}[2]{}{} \newif\ifexternalcss %%% Postlude \makeatother coccinelle-1.0.0-rc19/docs/manual/parsing.tex0000644000175000017500000000026112247437436017761 0ustar eugeneugen\chapter{Parsing C, \cpp, and \texttt{standard.h}} %%% Local Variables: %%% mode: LaTeX %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/license.txt0000644000175000017500000005465012247437436017772 0ustar eugeneugen GNU Free Documentation License Version 1.3, 3 November 2008 Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. 0. PREAMBLE The purpose of this License is to make a manual, textbook, or other functional and useful document "free" in the sense of freedom: to assure everyone the effective freedom to copy and redistribute it, with or without modifying it, either commercially or noncommercially. Secondarily, this License preserves for the author and publisher a way to get credit for their work, while not being considered responsible for modifications made by others. This License is a kind of "copyleft", which means that derivative works of the document must themselves be free in the same sense. It complements the GNU General Public License, which is a copyleft license designed for free software. We have designed this License in order to use it for manuals for free software, because free software needs free documentation: a free program should come with manuals providing the same freedoms that the software does. But this License is not limited to software manuals; it can be used for any textual work, regardless of subject matter or whether it is published as a printed book. We recommend this License principally for works whose purpose is instruction or reference. 1. APPLICABILITY AND DEFINITIONS This License applies to any manual or other work, in any medium, that contains a notice placed by the copyright holder saying it can be distributed under the terms of this License. Such a notice grants a world-wide, royalty-free license, unlimited in duration, to use that work under the conditions stated herein. The "Document", below, refers to any such manual or work. Any member of the public is a licensee, and is addressed as "you". You accept the license if you copy, modify or distribute the work in a way requiring permission under copyright law. A "Modified Version" of the Document means any work containing the Document or a portion of it, either copied verbatim, or with modifications and/or translated into another language. A "Secondary Section" is a named appendix or a front-matter section of the Document that deals exclusively with the relationship of the publishers or authors of the Document to the Document's overall subject (or to related matters) and contains nothing that could fall directly within that overall subject. (Thus, if the Document is in part a textbook of mathematics, a Secondary Section may not explain any mathematics.) The relationship could be a matter of historical connection with the subject or with related matters, or of legal, commercial, philosophical, ethical or political position regarding them. The "Invariant Sections" are certain Secondary Sections whose titles are designated, as being those of Invariant Sections, in the notice that says that the Document is released under this License. If a section does not fit the above definition of Secondary then it is not allowed to be designated as Invariant. The Document may contain zero Invariant Sections. If the Document does not identify any Invariant Sections then there are none. The "Cover Texts" are certain short passages of text that are listed, as Front-Cover Texts or Back-Cover Texts, in the notice that says that the Document is released under this License. A Front-Cover Text may be at most 5 words, and a Back-Cover Text may be at most 25 words. A "Transparent" copy of the Document means a machine-readable copy, represented in a format whose specification is available to the general public, that is suitable for revising the document straightforwardly with generic text editors or (for images composed of pixels) generic paint programs or (for drawings) some widely available drawing editor, and that is suitable for input to text formatters or for automatic translation to a variety of formats suitable for input to text formatters. A copy made in an otherwise Transparent file format whose markup, or absence of markup, has been arranged to thwart or discourage subsequent modification by readers is not Transparent. An image format is not Transparent if used for any substantial amount of text. A copy that is not "Transparent" is called "Opaque". Examples of suitable formats for Transparent copies include plain ASCII without markup, Texinfo input format, LaTeX input format, SGML or XML using a publicly available DTD, and standard-conforming simple HTML, PostScript or PDF designed for human modification. Examples of transparent image formats include PNG, XCF and JPG. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, SGML or XML for which the DTD and/or processing tools are not generally available, and the machine-generated HTML, PostScript or PDF produced by some word processors for output purposes only. The "Title Page" means, for a printed book, the title page itself, plus such following pages as are needed to hold, legibly, the material this License requires to appear in the title page. For works in formats which do not have any title page as such, "Title Page" means the text near the most prominent appearance of the work's title, preceding the beginning of the body of the text. The "publisher" means any person or entity that distributes copies of the Document to the public. A section "Entitled XYZ" means a named subunit of the Document whose title either is precisely XYZ or contains XYZ in parentheses following text that translates XYZ in another language. (Here XYZ stands for a specific section name mentioned below, such as "Acknowledgements", "Dedications", "Endorsements", or "History".) To "Preserve the Title" of such a section when you modify the Document means that it remains a section "Entitled XYZ" according to this definition. The Document may include Warranty Disclaimers next to the notice which states that this License applies to the Document. These Warranty Disclaimers are considered to be included by reference in this License, but only as regards disclaiming warranties: any other implication that these Warranty Disclaimers may have is void and has no effect on the meaning of this License. 2. VERBATIM COPYING You may copy and distribute the Document in any medium, either commercially or noncommercially, provided that this License, the copyright notices, and the license notice saying this License applies to the Document are reproduced in all copies, and that you add no other conditions whatsoever to those of this License. You may not use technical measures to obstruct or control the reading or further copying of the copies you make or distribute. However, you may accept compensation in exchange for copies. If you distribute a large enough number of copies you must also follow the conditions in section 3. You may also lend copies, under the same conditions stated above, and you may publicly display copies. 3. COPYING IN QUANTITY If you publish printed copies (or copies in media that commonly have printed covers) of the Document, numbering more than 100, and the Document's license notice requires Cover Texts, you must enclose the copies in covers that carry, clearly and legibly, all these Cover Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on the back cover. Both covers must also clearly and legibly identify you as the publisher of these copies. The front cover must present the full title with all words of the title equally prominent and visible. You may add other material on the covers in addition. Copying with changes limited to the covers, as long as they preserve the title of the Document and satisfy these conditions, can be treated as verbatim copying in other respects. If the required texts for either cover are too voluminous to fit legibly, you should put the first ones listed (as many as fit reasonably) on the actual cover, and continue the rest onto adjacent pages. If you publish or distribute Opaque copies of the Document numbering more than 100, you must either include a machine-readable Transparent copy along with each Opaque copy, or state in or with each Opaque copy a computer-network location from which the general network-using public has access to download using public-standard network protocols a complete Transparent copy of the Document, free of added material. If you use the latter option, you must take reasonably prudent steps, when you begin distribution of Opaque copies in quantity, to ensure that this Transparent copy will remain thus accessible at the stated location until at least one year after the last time you distribute an Opaque copy (directly or through your agents or retailers) of that edition to the public. It is requested, but not required, that you contact the authors of the Document well before redistributing any large number of copies, to give them a chance to provide you with an updated version of the Document. 4. MODIFICATIONS You may copy and distribute a Modified Version of the Document under the conditions of sections 2 and 3 above, provided that you release the Modified Version under precisely this License, with the Modified Version filling the role of the Document, thus licensing distribution and modification of the Modified Version to whoever possesses a copy of it. In addition, you must do these things in the Modified Version: A. Use in the Title Page (and on the covers, if any) a title distinct from that of the Document, and from those of previous versions (which should, if there were any, be listed in the History section of the Document). You may use the same title as a previous version if the original publisher of that version gives permission. B. List on the Title Page, as authors, one or more persons or entities responsible for authorship of the modifications in the Modified Version, together with at least five of the principal authors of the Document (all of its principal authors, if it has fewer than five), unless they release you from this requirement. C. State on the Title page the name of the publisher of the Modified Version, as the publisher. D. Preserve all the copyright notices of the Document. E. Add an appropriate copyright notice for your modifications adjacent to the other copyright notices. F. Include, immediately after the copyright notices, a license notice giving the public permission to use the Modified Version under the terms of this License, in the form shown in the Addendum below. G. Preserve in that license notice the full lists of Invariant Sections and required Cover Texts given in the Document's license notice. H. Include an unaltered copy of this License. I. Preserve the section Entitled "History", Preserve its Title, and add to it an item stating at least the title, year, new authors, and publisher of the Modified Version as given on the Title Page. If there is no section Entitled "History" in the Document, create one stating the title, year, authors, and publisher of the Document as given on its Title Page, then add an item describing the Modified Version as stated in the previous sentence. J. Preserve the network location, if any, given in the Document for public access to a Transparent copy of the Document, and likewise the network locations given in the Document for previous versions it was based on. These may be placed in the "History" section. You may omit a network location for a work that was published at least four years before the Document itself, or if the original publisher of the version it refers to gives permission. K. For any section Entitled "Acknowledgements" or "Dedications", Preserve the Title of the section, and preserve in the section all the substance and tone of each of the contributor acknowledgments and/or dedications given therein. L. Preserve all the Invariant Sections of the Document, unaltered in their text and in their titles. Section numbers or the equivalent are not considered part of the section titles. M. Delete any section Entitled "Endorsements". Such a section may not be included in the Modified Version. N. Do not retitle any existing section to be Entitled "Endorsements" or to conflict in title with any Invariant Section. O. Preserve any Warranty Disclaimers. If the Modified Version includes new front-matter sections or appendices that qualify as Secondary Sections and contain no material copied from the Document, you may at your option designate some or all of these sections as invariant. To do this, add their titles to the list of Invariant Sections in the Modified Version's license notice. These titles must be distinct from any other section titles. You may add a section Entitled "Endorsements", provided it contains nothing but endorsements of your Modified Version by various parties--for example, statements of peer review or that the text has been approved by an organization as the authoritative definition of a standard. You may add a passage of up to five words as a Front-Cover Text, and a passage of up to 25 words as a Back-Cover Text, to the end of the list of Cover Texts in the Modified Version. Only one passage of Front-Cover Text and one of Back-Cover Text may be added by (or through arrangements made by) any one entity. If the Document already includes a cover text for the same cover, previously added by you or by arrangement made by the same entity you are acting on behalf of, you may not add another; but you may replace the old one, on explicit permission from the previous publisher that added the old one. The author(s) and publisher(s) of the Document do not by this License give permission to use their names for publicity for or to assert or imply endorsement of any Modified Version. 5. COMBINING DOCUMENTS You may combine the Document with other documents released under this License, under the terms defined in section 4 above for modified versions, provided that you include in the combination all of the Invariant Sections of all of the original documents, unmodified, and list them all as Invariant Sections of your combined work in its license notice, and that you preserve all their Warranty Disclaimers. The combined work need only contain one copy of this License, and multiple identical Invariant Sections may be replaced with a single copy. If there are multiple Invariant Sections with the same name but different contents, make the title of each such section unique by adding at the end of it, in parentheses, the name of the original author or publisher of that section if known, or else a unique number. Make the same adjustment to the section titles in the list of Invariant Sections in the license notice of the combined work. In the combination, you must combine any sections Entitled "History" in the various original documents, forming one section Entitled "History"; likewise combine any sections Entitled "Acknowledgements", and any sections Entitled "Dedications". You must delete all sections Entitled "Endorsements". 6. COLLECTIONS OF DOCUMENTS You may make a collection consisting of the Document and other documents released under this License, and replace the individual copies of this License in the various documents with a single copy that is included in the collection, provided that you follow the rules of this License for verbatim copying of each of the documents in all other respects. You may extract a single document from such a collection, and distribute it individually under this License, provided you insert a copy of this License into the extracted document, and follow this License in all other respects regarding verbatim copying of that document. 7. AGGREGATION WITH INDEPENDENT WORKS A compilation of the Document or its derivatives with other separate and independent documents or works, in or on a volume of a storage or distribution medium, is called an "aggregate" if the copyright resulting from the compilation is not used to limit the legal rights of the compilation's users beyond what the individual works permit. When the Document is included in an aggregate, this License does not apply to the other works in the aggregate which are not themselves derivative works of the Document. If the Cover Text requirement of section 3 is applicable to these copies of the Document, then if the Document is less than one half of the entire aggregate, the Document's Cover Texts may be placed on covers that bracket the Document within the aggregate, or the electronic equivalent of covers if the Document is in electronic form. Otherwise they must appear on printed covers that bracket the whole aggregate. 8. TRANSLATION Translation is considered a kind of modification, so you may distribute translations of the Document under the terms of section 4. Replacing Invariant Sections with translations requires special permission from their copyright holders, but you may include translations of some or all Invariant Sections in addition to the original versions of these Invariant Sections. You may include a translation of this License, and all the license notices in the Document, and any Warranty Disclaimers, provided that you also include the original English version of this License and the original versions of those notices and disclaimers. In case of a disagreement between the translation and the original version of this License or a notice or disclaimer, the original version will prevail. If a section in the Document is Entitled "Acknowledgements", "Dedications", or "History", the requirement (section 4) to Preserve its Title (section 1) will typically require changing the actual title. 9. TERMINATION You may not copy, modify, sublicense, or distribute the Document except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, or distribute it is void, and will automatically terminate your rights under this License. However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, receipt of a copy of some or all of the same material does not give you any rights to use it. 10. FUTURE REVISIONS OF THIS LICENSE The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See http://www.gnu.org/copyleft/. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered version of this License "or any later version" applies to it, you have the option of following the terms and conditions either of that specified version or of any later version that has been published (not as a draft) by the Free Software Foundation. If the Document does not specify a version number of this License, you may choose any version ever published (not as a draft) by the Free Software Foundation. If the Document specifies that a proxy can decide which future versions of this License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Document. 11. RELICENSING "Massive Multiauthor Collaboration Site" (or "MMC Site") means any World Wide Web server that publishes copyrightable works and also provides prominent facilities for anybody to edit those works. A public wiki that anybody can edit is an example of such a server. A "Massive Multiauthor Collaboration" (or "MMC") contained in the site means any set of copyrightable works thus published on the MMC site. "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 license published by Creative Commons Corporation, a not-for-profit corporation with a principal place of business in San Francisco, California, as well as future copyleft versions of that license published by that same organization. "Incorporate" means to publish or republish a Document, in whole or in part, as part of another Document. An MMC is "eligible for relicensing" if it is licensed under this License, and if all works that were first published under this License somewhere other than this MMC, and subsequently incorporated in whole or in part into the MMC, (1) had no cover texts or invariant sections, and (2) were thus incorporated prior to November 1, 2008. The operator of an MMC Site may republish an MMC contained in the site under CC-BY-SA on the same site at any time before August 1, 2009, provided the MMC is eligible for relicensing. ADDENDUM: How to use this License for your documents To use this License in a document you have written, include a copy of the License in the document and put the following copyright and license notices just after the title page: Copyright (c) YEAR YOUR NAME. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled "GNU Free Documentation License". If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, replace the "with...Texts." line with this: with the Invariant Sections being LIST THEIR TITLES, with the Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST. If you have Invariant Sections without Cover Texts, or some other combination of the three, merge those two alternatives to suit the situation. If your document contains nontrivial examples of program code, we recommend releasing these examples in parallel under your choice of free software license, such as the GNU General Public License, to permit their use in free software. coccinelle-1.0.0-rc19/docs/manual/copyright.txt0000644000175000017500000000073312247437436020351 0ustar eugeneugenCoccinelle manual - Julia Lawall, Yoann Padioleau, Nicolas Palix Copyright (C) 2010 INRIA, University of Copenhagen DIKU Copyright (C) 2009, Julia Lawall, Yoann Padioleau, Nicolas Palix Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the file license.txt coccinelle-1.0.0-rc19/docs/manual/introduction.tex0000644000175000017500000000466512247437436021053 0ustar eugeneugen\chapter{Introduction} %src: cocci website, LWN article Coccinelle is a tool to help automate repetitive source-to-source style-preserving program transformations on C source code, like for instance to perform some refactorings. %coupling: readme.txt Coccinelle is presented as a command line tool called \spatch that takes as input the name of a file containing the specification of a program transformation, called a {\em semantic patch}, and a set of C files, and then performs the transformation on all those C files. %synopsis ? To make it easy to express those transformations, Coccinelle proposes a WYSISWYG approach where the C programmer can leverage the things he already knows: the C syntax and the patch syntax. Indeed, with Coccinelle transformations are written in specific language called SmPL, for Semantic Patch Language, which as the name suggests is very close to the syntax of a patch, but which does not work at a line level, than traditional patches do. but a more high level, or semantic level. Here is an example of a simple program transformation. To replace every calls to \verb+foo+ of any expression $x$ to a call to \verb+bar+, create a semantic patch file \verb+ex1.cocci+ (semantic patches usually ends with the \verb+.cocci+ filename extension) containing: \begin{verbatim} @@ expression x; @@ - foo(x) + bar(x) \end{verbatim} Then to ``apply'' the specified program transformation to a set of C files, simply do: \begin{verbatim} $ spatch -sp_file ex1.cocci *.c \end{verbatim} Coccinelle primarily targets ANSI C, and supports some GCC extensions. It has only partial support for K\&R C. K\&R function declarations are only recognized if the parameter declarations are indented. Furthermore, the parameter names are subsequently considered to be type names, due to confusion with function prototypes, in which a name by itself is indeed the name of a type. %command line: %can do inplace, or with git, cf chapter on developing ... %Other approaches %instead of %expressing the transformation on the internal representation %of a C frontend, for instance the abstract syntax tree %used internally by gcc, which would require for the user %to learn how to use this internal data structure, %if can find and transform, can also find, so semantic grep. %vs regexp %vs ast %features: %src: darcs manual %%% Local Variables: %%% mode: LaTeX %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/python.tex0000644000175000017500000000266512247437436017651 0ustar eugeneugen\documentclass{article} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{listings} \begin{document} \section{Python API from SmPL} \label{sec:python-api} \subsection{Output mode} \label{sec:output} \begin{tabular}{lp{8cm}} \texttt{-pyoutput coccilib.output.Console}& To output on the console \\ \texttt{-pyoutput coccilib.output.Gtk} & To output on a Gtk frame \\ \end{tabular} \subsection{Org mode} \label{sec:orgmode} \begin{tabular}{lp{8cm}} \texttt{cocci.print\_main}& For the main position \\ \texttt{cocci.print\_sec} & For the secondary position \\ \texttt{cocci.print\_secs}& For a set of secondary positions \\ \end{tabular} \begin{lstlisting} def print_main(p, msg="", color="ovl-face1") : print "* TODO [[view:%s::face=%s::linb=%s::colb=%s::cole=%s][%s %s::%s]]" % (p[0].file,color,p[0].line,p[0].column,p[0].column_end,msg,p[0].file,p[0].line) def print_sec(p, msg="", color="ovl-face2") : print "[[view:%s::face=%s::linb=%s::colb=%s::cole=%s][%s]]" % (p[0].file,color,p[0].line,p[0].column,p[0].column_end,msg) def print_secs(ps, msg="", color="ovl-face2") : for i in ps: print "[[view:%s::face=%s::linb=%s::colb=%s::cole=%s][%s]]" % (i.file,color,i.line,i.column,i.column_end,msg) \end{lstlisting} %\subsection{Trac} %\label{sec:trac} \end{document} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: t %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/cocci_syntax.tex0000644000175000017500000012447212247437436021017 0ustar eugeneugen %\section{The SmPL Grammar} % This section presents the SmPL grammar. This definition follows closely % our implementation using the Menhir parser generator \cite{menhir}. This document presents the grammar of the SmPL language used by the \href{http://coccinelle.lip6.fr/}{Coccinelle tool}. For the most part, the grammar is written using standard notation. In some rules, however, the left-hand side is in all uppercase letters. These are macros, which take one or more grammar rule right-hand-sides as arguments. The grammar also uses some unspecified nonterminals, such as \T{id}, \T{const}, etc. These refer to the sets suggested by the name, {\em i.e.}, \T{id} refers to the set of possible C-language identifiers, while \T{const} refers to the set of possible C-language constants. % \ifhevea A PDF version of this documentation is available at \url{http://coccinelle.lip6.fr/docs/main_grammar.pdf}. \else A HTML version of this documentation is available online at \url{http://coccinelle.lip6.fr/docs/main_grammar.html}. \fi \section{Program} \begin{grammar} \RULE{\rt{program}} \CASE{\any{\NT{include\_cocci}} \some{\NT{changeset}}} \RULE{\rt{include\_cocci}} \CASE{include \NT{string}} \CASE{using \NT{string}} \CASE{using \NT{pathToIsoFile}} \CASE{virtual \T{id} \ANY{, \T{id}}} \RULE{\rt{changeset}} \CASE{\NT{metavariables} \NT{transformation}} \CASE{\NT{script\_metavariables} \T{script\_code}} % \CASE{\NT{metavariables} \ANY{--- filename +++ filename} \NT{transformation}} \end{grammar} \noindent \T{script\_code} is any code in the chosen scripting language. Parsing of the semantic patch does not check the validity of this code; any errors are first detected when the code is executed. Furthermore, \texttt{@} should not be use in this code. Spatch scans the script code for the next \texttt{@} and considers that to be the beginning of the next rule, even if \texttt{@} occurs within e.g., a comment. \texttt{virtual} keyword is used to declare virtual rules. Virtual rules may be subsequently used as a dependency for the rules in the SmPL file. Whether a virtual rule is defined or not is controlled by the \texttt{-D} option on the command line. % Between the metavariables and the transformation rule, there can be a % specification of constraints on the names of the old and new files, % analogous to the filename specifications in the standard patch syntax. % (see Figure \ref{scsiglue_patch}). \section{Metavariables for transformations} The \NT{rulename} portion of the metavariable declaration can specify properties of a rule such as its name, the names of the rules that it depends on, the isomorphisms to be used in processing the rule, and whether quantification over paths should be universal or existential. The optional annotation {\tt expression} indicates that the pattern is to be considered as matching an expression, and thus can be used to avoid some parsing problems. The \NT{metadecl} portion of the metavariable declaration defines various types of metavariables that will be used for matching in the transformation section. \begin{grammar} \RULE{\rt{metavariables}} \CASE{@@ \any{\NT{metadecl}} @@} \CASE{@ \NT{rulename} @ \any{\NT{metadecl}} @@} \RULE{\rt{rulename}} \CASE{\T{id} \OPT{extends \T{id}} \OPT{depends on \NT{dep}} \opt{\NT{iso}} \opt{\NT{disable-iso}} \opt{\NT{exists}} \opt{expression}} \RULE{\rt{dep}} \CASE{\T{id}} \CASE{!\T{id}} \CASE{!(\NT{dep})} \CASE{ever \T{id}} \CASE{never \T{id}} \CASE{\NT{dep} \&\& \NT{dep}} \CASE{\NT{dep} || \NT{dep}} \CASE{(\NT{dep})} \RULE{\rt{iso}} \CASE{using \NT{string} \ANY{, \NT{string}}} \RULE{\rt{disable-iso}} \CASE{disable \NT{COMMA\_LIST}\mth{(}\T{id}\mth{)}} \RULE{\rt{exists}} \CASE{exists} \CASE{forall} % \CASE{\opt{reverse} forall} \RULE{\rt{COMMA\_LIST}\mth{(}\rt{elem}\mth{)}} \CASE{\NT{elem} \ANY{, \NT{elem}}} \end{grammar} The keyword \KW{disable} is normally used with the names of isomorphisms defined in standard.iso or whatever isomorphism file has been included. There are, however, some other isomorphisms that are built into the implementation of Coccinelle and that can be disabled as well. Their names are given below. In each case, the text describes the standard behavior. Using \NT{disable-iso} with the given name disables this behavior. \begin{itemize} \item \KW{optional\_storage}: A SmPL function definition that does not specify any visibility (i.e., static or extern), or a SmPL variable declaration that does not specify any storage (i.e., auto, static, register, or extern), matches a function declaration or variable declaration with any visibility or storage, respectively. \item \KW{optional\_qualifier}: This is similar to \KW{optional\_storage}, except that here is it the qualifier (i.e., const or volatile) that does not have to be specified in the SmPL code, but may be present in the C code. \item \KW{value\_format}: Integers in various formats, e.g., 1 and 0x1, are considered to be equivalent in the matching process. \item \KW{optional\_declarer\_semicolon}: Some declarers (top-level terms that look like function calls but serve to declare some variable) don't require a semicolon. This isomorphism allows a SmPL declarer with a semicolon to match such a C declarer, if no transformation is specified on the SmPL semicolon. \item \KW{comm\_assoc}: An expression of the form \NT{exp} \NT{bin\_op} \KW{...}, where \NT{bin\_op} is commutative and associative, is considered to match any top-level sequence of \NT{bin\_op} operators containing \NT{exp} as the top-level argument. \end{itemize} The possible types of metavariable declarations are defined by the grammar rule below. Metavariables should occur at least once in the transformation immediately following their declaration. Fresh identifier metavariables must only be used in {\tt +} code. These properties are not expressed in the grammar, but are checked by a subsequent analysis. The metavariables are designated according to the kind of terms they can match, such as a statement, an identifier, or an expression. An expression metavariable can be further constrained by its type. A declaration metavariable matches the declaration of one or more variables, all sharing the same type specification ({\em e.g.}, {\tt int a,b,c=3;}). A field metavariable does the same, but for structure fields. \begin{grammar} \RULE{\rt{metadecl}} \CASE{metavariable \NT{ids} ;} \CASE{fresh identifier \NT{ids} ;} \CASE{identifier \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_regexp}\mth{)} ;} \CASE{identifier \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_virt\_or\_not\_eq}\mth{)} ;} \CASE{parameter \opt{list} \NT{ids} ;} \CASE{parameter list [ \NT{id} ] \NT{ids} ;} \CASE{parameter list [ \NT{const} ] \NT{ids} ;} \CASE{type \NT{ids} ;} \CASE{statement \opt{list} \NT{ids} ;} \CASE{declaration \NT{ids} ;} \CASE{field \opt{list} \NT{ids} ;} \CASE{typedef \NT{ids} ;} \CASE{declarer name \NT{ids} ;} % \CASE{\opt{local} function \NT{pmid\_with\_not\_eq\_list} ;} \CASE{declarer \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_regexp}\mth{)} ;} \CASE{declarer \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{iterator name \NT{ids} ;} \CASE{iterator \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_regexp}\mth{)} ;} \CASE{iterator \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} % \CASE{error \NT{pmid\_with\_not\_eq\_list} ; } \CASE{\opt{local} idexpression \opt{\NT{ctype}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{\opt{local} idexpression \OPT{\ttlb \NT{ctypes}\ttrb~\any{*}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{\opt{local} idexpression \some{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{expression list \NT{ids} ;} \CASE{expression \some{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{expression enum \any{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{expression struct \any{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{expression union \any{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{expression \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_ceq}\mth{)} ;} \CASE{expression list [ \NT{id} ] \NT{ids} ;} \CASE{expression list [ \NT{const} ] \NT{ids} ;} \CASE{\NT{ctype} [ ] \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{\NT{ctype} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_ceq}\mth{)} ;} \CASE{\ttlb \NT{ctypes}\ttrb~\any{*} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_ceq}\mth{)} ;} \CASE{\ttlb \NT{ctypes}\ttrb~\any{*} [ ] \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{constant \opt{\NT{ctype}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{constant \OPT{\ttlb \NT{ctypes}\ttrb~\any{*}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{position \opt{any} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq\_mid}\mth{)} ;} \CASE{symbol \NT{ids};} \CASE{format \NT{ids};} \CASE{format list [ \NT{id} ] \NT{ids} ;} \CASE{format list [ \NT{const} ] \NT{ids} ;} \end{grammar} A metavariable declaration local idexpression v means that v is restricted to be a local variable. If it should just be a variable, but not necessarily a local one, then drop local. A more complex description of a location, such as a->b is considered to be an expression, not an ideexpression. Constant is for constants, such as 27. But it also considers an identifier that is all capital letters (possibly containing numbers) as a constant as well, because the names gives to macros in Linux usually have this form. An identifier is the name of a structure field, a macro, a function, or a variable. Is is the name of something rather than an expression that has a value. But an identifier can be used in the position of an expression as well, where it represents a variable. It is possible to specify that an expression list or a parameter list metavariable should match a specific number of expressions or parameters. It is possible to specify some information about the definition of a fresh identifier. See the wiki. A symbol declaration specifies that the provided identifiers should be considered C identifiers when encountered in the body of the rule. Identifiers in the body of the rule that are not declared explicitly are by default considered symbols, thus symbol declarations are optional. A position metavariable is used by attaching it using \texttt{@} to any token, including another metavariable. Its value is the position (file, line number, etc.) of the code matched by the token. It is also possible to attach expression, declaration, type, initialiser, and statement metavariables in this manner. In that case, the metavariable is bound to the closest enclosing expression, declaration, etc. If such a metavariable is itself followed by a position metavariable, the position metavariable applies to the metavariable that it follows, and not to the attached token. This makes it possible to get eg the starting and ending position of {\tt f(...)}, by writing {\tt f(...)@E@p}, for expression metavariable {\tt E} and position metavariable {\tt p}. When used, a format or format list metavariable must be enclosed by a pair of \texttt{@}s. A format metavariable matches the format descriptor part, i.e., \texttt{2x} in \texttt{\%2x}. A format list metavariable matches a sequence of format descriptors as well as the text between them. Any text around them is matched as well, if it is not matched by the surrounding text in the semantic patch. Such text is not partially matched. If the length of the format list is specified, that indicates the number of matched format descriptors. It is also possible to use \texttt{\ldots} in a format string, to match a sequence of text fragments and format descriptors. This only takes effect if the format string contains format descriptors. Note that this makes it impossible to require \texttt{\ldots} to match exactly in a string, if the semantic patch string contains format descriptors. If that is needed, some processing with a scripting language would be required. And example for the use of string format metavariables is found in demos/format.cocci. Other kinds of metavariables can also be attached using \texttt{@} to any token. In this case, the metavariable floats up to the enclosing appropriate expression. For example, {\tt 3 +@E 4}, where {\tt E} is an expression metavariable binds {\tt E} to {\tt 3 + 4}. A particular case is {\tt Ps@Es}, where {\tt Ps} is a parameter list and {\tt Es} is an expression list. This pattern matches a parameter list, and then matches {\tt Es} to the list of expressions, ie a possible argument list, represented by the names of the parameters. \begin{grammar} \RULE{\rt{ids}} \CASE{\NT{COMMA\_LIST}\mth{(}\NT{pmid}\mth{)}} \RULE{\rt{pmid}} \CASE{\T{id}} \CASE{\NT{mid}} % \CASE{list} % \CASE{error} % \CASE{type} \RULE{\rt{mid}} \CASE{\T{rulename\_id}.\T{id}} \RULE{\rt{pmid\_with\_regexp}} \CASE{\NT{pmid} =\~{} \NT{regexp}} \CASE{\NT{pmid} !\~{} \NT{regexp}} \RULE{\rt{pmid\_with\_not\_eq}} \CASE{\NT{pmid} \OPT{!= \NT{id\_or\_meta}}} \CASE{\NT{pmid} \OPT{!= \ttlb~\NT{COMMA\_LIST}\mth{(}\NT{id\_or\_meta}\mth{)} \ttrb}} \RULE{\rt{pmid\_with\_virt\_or\_not\_eq}} \CASE{virtual.\T{id}} \CASE{\NT{pmid\_with\_not\_eq}} \RULE{\rt{pmid\_with\_not\_ceq}} \CASE{\NT{pmid} \OPT{!= \NT{id\_or\_cst}}} \CASE{\NT{pmid} \OPT{!= \ttlb~\NT{COMMA\_LIST}\mth{(}\NT{id\_or\_cst}\mth{)} \ttrb}} \RULE{\rt{id\_or\_cst}} \CASE{\T{id}} \CASE{\T{integer}} \RULE{\rt{id\_or\_meta}} \CASE{\T{id}} \CASE{\T{rulename\_id}.\T{id}} \RULE{\rt{pmid\_with\_not\_eq\_mid}} \CASE{\NT{pmid} \OPT{!= \NT{mid}}} \CASE{\NT{pmid} \OPT{!= \ttlb~\NT{COMMA\_LIST}\mth{(}\NT{mid}\mth{)} \ttrb}} \end{grammar} Subsequently, we refer to arbitrary metavariables as \mth{\msf{metaid}^{\mbox{\scriptsize{\it{ty}}}}}, where {\it{ty}} indicates the {\it metakind} used in the declaration of the variable. For example, \mth{\msf{metaid}^{\ssf{Type}}} refers to a metavariable that was declared using \texttt{type} and stands for any type. {\tt metavariable} declares a metavariable for which the parser tried to figure out the metavariable type based on the usage context. Such a metavariable must be used consistently. These metavariables cannot be used in all contexts; specifically, they cannot be used in context that would make the parsing ambiguous. Some examples are the leftmost term of an expression, such as the left-hand side of an assignment, or the type in a variable declaration. These restrictions may seems somewhat arbitrary from the user's point of view. Thus, it is better to use metavariables with metavariable types. If Coccinelle is given the argument {\tt -parse\_cocci}, it will print information about the type that is inferred for each metavariable. The \NT{ctype} and \NT{ctypes} nonterminals are used by both the grammar of metavariable declarations and the grammar of transformations, and are defined on page~\pageref{types}. An identifier metavariable with {\tt virtual} as its ``rule name'' is given a value on the command line. For example, if a semantic patch contains a rule that declares an identifier metavariable with the name {\tt virtual.alloc}, then the command line could contain {\tt -D alloc=kmalloc}. There should not be space around the {\tt =}. An example is in {\tt demos/vm.cocci} and {\tt demos/vm.c}. \paragraph*{Warning:} Each metavariable declaration causes the declared metavariables to be immediately usable, without any inheritance indication. Thus the following are correct: \begin{quote} \begin{verbatim} @@ type r.T; T x; @@ [...] // some semantic patch code \end{verbatim} \end{quote} \begin{quote} \begin{verbatim} @@ r.T x; type r.T; @@ [...] // some semantic patch code \end{verbatim} \end{quote} \noindent But the following is not correct: \begin{quote} \begin{verbatim} @@ type r.T; r.T x; @@ [...] // some semantic patch code \end{verbatim} \end{quote} This applies to position variables, type metavariables, identifier metavariables that may be used in specifying a structure type, and metavariables used in the initialization of a fresh identifier. In the case of a structure type, any identifier metavariable indeed has to be declared as an identifier metavariable in advance. The syntax does not permit {\tt r.n} as the name of a structure or union type in such a declaration. \section{Metavariables for scripts} Metavariables for scripts can only be inherited from transformation rules. In the spirit of scripting languages such as Python that use dynamic typing, metavariables for scripts do not include type declarations. \begin{grammar} \RULE{\rt{script\_metavariables}} \CASE{@ script:\NT{language} \OPT{\NT{rulename}} \OPT{depends on \NT{dep}} @ \any{\NT{script\_metadecl}} @@} \CASE{@ initialize:\NT{language} \OPT{depends on \NT{dep}} @} \CASE{@ finalize:\NT{language} \OPT{depends on \NT{dep}} @} \RULE{\rt{language}} \CASE{python} \CASE{ocaml} \RULE{\rt{script\_metadecl}} \CASE{\T{id} <{}< \T{rulename\_id}.\T{id} ;} \CASE{\T{id} ;} \end{grammar} Currently, the only scripting languages that are supported are Python and OCaml, indicated using {\tt python} and {\tt ocaml}, respectively. The set of available scripting languages may be extended at some point. Script rules declared with \KW{initialize} are run before the treatment of any file. Script rules declared with \KW{finalize} are run when the treatment of all of the files has completed. There can be at most one of each per scripting language (thus currently at most one of each). Initialize and finalize script rules do not have access to SmPL metavariables. Nevertheless, a finalize script rule can access any variables initialized by the other script rules, allowing information to be transmitted from the matching process to the finalize rule. A script metavariable that does not specify an origin, using \texttt{<<}, is newly declared by the script. This metavariable should be assigned to a string and can be inherited by subsequent rules as an identifier. In Python, the assignment of such a metavariable $x$ should refer to the metavariable as {\tt coccinelle.\(x\)}. Examples are in the files \texttt{demos/pythontococci.cocci} and \texttt{demos/camltococci.cocci}. In an ocaml script, the following extended form of \textit{script\_metadecl} may be used: \begin{grammar} \RULE{\rt{script\_metadecl}} \CASE{(\T{id},\T{id}) <{}< \T{rulename\_id}.\T{id} ;} \CASE{\T{id} <{}< \T{rulename\_id}.\T{id} ;} \CASE{\T{id} ;} \end{grammar} \noindent In a declaration of the form \texttt{(\T{id},\T{id}) <{}< \T{rulename\_id}.\T{id} ;}, the left component of \texttt{(\T{id},\T{id})} receives a string representation of the value of the inherited metavariable while the right component receives its abstract syntax tree. The file \texttt{parsing\_c/ast\_c.ml} in the Coccinelle implementation gives some information about the structure of the abstract syntax tree. Either the left or right component may be replaced by \verb+_+, indicating that the string representation or abstract syntax trees representation is not wanted, respectively. The abstract syntax tree of a metavariable declared using {\tt metavariable} is not available. \section{Transformation} The transformation specification essentially has the form of C code, except that lines to remove are annotated with \verb+-+ in the first column, and lines to add are annotated with \verb-+-. A transformation specification can also use {\em dots}, ``\verb-...-'', describing an arbitrary sequence of function arguments or instructions within a control-flow path. Implicitly, ``\verb-...-'' matches the shortest path between something that matches the pattern before the dots (or the beginning of the function, if there is nothing before the dots) and something that matches the pattern after the dots (or the end of the function, if there is nothing after the dots). Dots may be modified with a {\tt when} clause, indicating a pattern that should not occur anywhere within the matched sequence. {\tt when any} removes the aforementioned constraint that ``\verb-...-'' matches the shortest path. Finally, a transformation can specify a disjunction of patterns, of the form \mtt{( \mth{\mita{pat}_1} | \mita{\ldots} | \mth{\mita{pat}_n} )} where each \texttt{(}, \texttt{|} or \texttt{)} is in column 0 or preceded by \texttt{\textbackslash}. The grammar that we present for the transformation is not actually the grammar of the SmPL code that can be written by the programmer, but is instead the grammar of the slice of this consisting of the {\tt -} annotated and the unannotated code (the context of the transformed lines), or the {\tt +} annotated code and the unannotated code. For example, for parsing purposes, the following transformation %presented in Section \ref{sec:seq2} is split into the two variants shown below and each is parsed separately. \begin{center} \begin{tabular}{c} \begin{lstlisting}[language=Cocci] proc_info_func(...) { <... @-- hostno @++ hostptr->host_no ...> } \end{lstlisting}\\ \end{tabular} \end{center} {%\sizecodebis \begin{center} \begin{tabular}{p{5cm}p{3cm}p{5cm}} \begin{lstlisting}[language=Cocci] proc_info_func(...) { <... @-- hostno ...> } \end{lstlisting} && \begin{lstlisting}[language=Cocci] proc_info_func(...) { <... @++ hostptr->host_no ...> } \end{lstlisting} \end{tabular} \end{center} } \noindent Requiring that both slices parse correctly ensures that the rule matches syntactically valid C code and that it produces syntactically valid C code. The generated parse trees are then merged for use in the subsequent matching and transformation process. The grammar for the minus or plus slice of a transformation is as follows: \begin{grammar} \RULE{\rt{transformation}} \CASE{\some{\NT{include}}} \CASE{\NT{OPTDOTSEQ}\mth{(}\NT{top}, \NT{when}\mth{)}} \RULE{\rt{include}} \CASE{\#include \T{include\_string}} \RULE{\rt{top}} \CASE{\NT{expr}} \CASE{\some{\NT{decl\_stmt}}} \CASE{\NT{fundecl}} % \RULE{\rt{fun\_decl\_stmt}} % \CASE{\NT{decl\_stmt}} % \CASE{\NT{fundecl}} % \CASE{\NT{ctype}} % \CASE{\ttlb \NT{initialize\_list} \ttrb} % \CASE{\NT{toplevel\_seq\_start\_after\_dots\_init}} % % \RULE{\rt{toplevel\_seq\_start\_after\_dots\_init}} % \CASE{\NT{stmt\_dots} \NT{toplevel\_after\_dots}} % \CASE{\NT{expr} \opt{\NT{toplevel\_after\_exp}}} % \CASE{\NT{decl\_stmt\_expr} \opt{\NT{toplevel\_after\_stmt}}} % % \RULE{\rt{stmt\_dots}} % \CASE{... \any{\NT{when}}} % \CASE{<... \any{\NT{when}} \NT{nest\_after\_dots} ...>} % \CASE{<+... \any{\NT{when}} \NT{nest\_after\_dots} ...+>} \RULE{\rt{when}} \CASE{when != \NT{when\_code}} \CASE{when = \NT{rule\_elem\_stmt}} \CASE{when \NT{COMMA\_LIST}\mth{(}\NT{any\_strict}\mth{)}} \CASE{when true != \NT{expr}} \CASE{when false != \NT{expr}} \RULE{\rt{when\_code}} \CASE{\NT{OPTDOTSEQ}\mth{(}\some{\NT{decl\_stmt}}, \NT{when}\mth{)}} \CASE{\NT{OPTDOTSEQ}\mth{(}\NT{expr}, \NT{when}\mth{)}} \RULE{\rt{rule\_elem\_stmt}} \CASE{\NT{one\_decl}} \CASE{\NT{expr};} \CASE{return \opt{\NT{expr}};} \CASE{break;} \CASE{continue;} \CASE{\bs(\NT{rule\_elem\_stmt} \SOME{\bs| \NT{rule\_elem\_stmt}}\bs)} \RULE{\rt{any\_strict}} \CASE{any} \CASE{strict} \CASE{forall} \CASE{exists} % \RULE{\rt{nest\_after\_dots}} % \CASE{\NT{decl\_stmt\_exp} \opt{\NT{nest\_after\_stmt}}} % \CASE{\opt{\NT{exp}} \opt{\NT{nest\_after\_exp}}} % % \RULE{\rt{nest\_after\_stmt}} % \CASE{\NT{stmt\_dots} \NT{nest\_after\_dots}} % \CASE{\NT{decl\_stmt} \opt{\NT{nest\_after\_stmt}}} % % \RULE{\rt{nest\_after\_exp}} % \CASE{\NT{stmt\_dots} \NT{nest\_after\_dots}} % % \RULE{\rt{toplevel\_after\_dots}} % \CASE{\opt{\NT{toplevel\_after\_exp}}} % \CASE{\NT{exp} \opt{\NT{toplevel\_after\_exp}}} % \CASE{\NT{decl\_stmt\_expr} \NT{toplevel\_after\_stmt}} % % \RULE{\rt{toplevel\_after\_exp}} % \CASE{\NT{stmt\_dots} \opt{\NT{toplevel\_after\_dots}}} % % \RULE{\rt{decl\_stmt\_expr}} % \CASE{TMetaStmList$^\ddag$} % \CASE{\NT{decl\_var}} % \CASE{\NT{stmt}} % \CASE{(\NT{stmt\_seq} \ANY{| \NT{stmt\_seq}})} % % \RULE{\rt{toplevel\_after\_stmt}} % \CASE{\NT{stmt\_dots} \opt{\NT{toplevel\_after\_dots}}} % \CASE{\NT{decl\_stmt} \NT{toplevel\_after\_stmt}} \end{grammar} \begin{grammar} \RULE{\rt{OPTDOTSEQ}\mth{(}\rt{grammar\_ds}, \rt{when\_ds}\mth{)}} \CASE{}\multicolumn{3}{r}{\hspace{1cm} \KW{\opt{... \ANY{\NT{when\_ds}}} \NT{grammar\_ds} \ANY{... \ANY{\NT{when\_ds}} \NT{grammar\_ds}} \opt{... \ANY{\NT{when\_ds}}}} } % \CASE{\opt{... \opt{\NT{when\_ds}}} \NT{grammar} % \ANY{... \opt{\NT{when\_ds}} \NT{grammar}} % \opt{... \opt{\NT{when\_ds}}}} % \CASE{<... \any{\NT{when\_ds}} \NT{grammar} ...>} % \CASE{<+... \any{\NT{when\_ds}} \NT{grammar} ...+>} \end{grammar} \noindent Lines may be annotated with an element of the set $\{\mtt{-}, \mtt{+}, \mtt{*}\}$ or the singleton $\mtt{?}$, or one of each set. \mtt{?} represents at most one match of the given pattern, ie a match of the pattern is optional. \mtt{*} is used for semantic match, \emph{i.e.}, a pattern that highlights the fragments annotated with \mtt{*}, but does not perform any modification of the matched code. \mtt{*} cannot be mixed with \mtt{-} and \mtt{+}. There are some constraints on the use of these annotations: \begin{itemize} \item Dots, {\em i.e.} \texttt{...}, cannot occur on a line marked \texttt{+}. \item Nested dots, {\em i.e.}, dots enclosed in {\tt <} and {\tt >}, cannot occur on a line with any marking. \end{itemize} Each element of a disjunction must be a proper term like an expression, a statement, an identifier or a declaration. Thus, the rule on the left below is not a syntactically correct SmPL rule. One may use the rule on the right instead. \begin{center} \begin{tabular}{l@{\hspace{5cm}}r} \begin{lstlisting}[language=Cocci] @@ type T; T b; @@ ( writeb(..., | readb(..., ) @--(T) b) \end{lstlisting} & \begin{lstlisting}[language=Cocci] @@ type T; T b; @@ ( read | write ) (..., @-- (T) b) \end{lstlisting} \\ \end{tabular} \end{center} Some kinds of terms can only appear in + code. These include comments, ifdefs, and attributes (\texttt{\_\_attribute\_\_((...))}). \section{Types} \label{types} \begin{grammar} \RULE{\rt{ctypes}} \CASE{\NT{COMMA\_LIST}\mth{(}\NT{ctype}\mth{)}} \RULE{\rt{ctype}} \CASE{\opt{\NT{const\_vol}} \NT{generic\_ctype} \any{*}} \CASE{\opt{\NT{const\_vol}} void \some{*}} \CASE{(\NT{ctype} \ANY{| \NT{ctype}})} \RULE{\rt{const\_vol}} \CASE{const} \CASE{volatile} \RULE{\rt{generic\_ctype}} \CASE{\NT{ctype\_qualif}} \CASE{\opt{\NT{ctype\_qualif}} char} \CASE{\opt{\NT{ctype\_qualif}} short} \CASE{\opt{\NT{ctype\_qualif}} short int} \CASE{\opt{\NT{ctype\_qualif}} int} \CASE{\opt{\NT{ctype\_qualif}} long} \CASE{\opt{\NT{ctype\_qualif}} long int} \CASE{\opt{\NT{ctype\_qualif}} long long} \CASE{\opt{\NT{ctype\_qualif}} long long int} \CASE{double} \CASE{long double} \CASE{float} \CASE{size\_t} \CASE{ssize\_t} \CASE{ptrdiff\_t} \CASE{enum \NT{id} \{ \NT{PARAMSEQ}\mth{(}\NT{dot\_expr}, \NT{exp\_whencode}\mth{)} \OPT{,} \}} \CASE{\OPT{struct\OR union} \T{id} \OPT{\{ \any{\NT{struct\_decl\_list}} \}}} \RULE{\rt{ctype\_qualif}} \CASE{unsigned} \CASE{signed} \RULE{\rt{struct\_decl\_list}} \CASE{\NT{struct\_decl\_list\_start}} \RULE{\rt{struct\_decl\_list\_start}} \CASE{\NT{struct\_decl}} \CASE{\NT{struct\_decl} \NT{struct\_decl\_list\_start}} \CASE{... \opt{when != \NT{struct\_decl}}$^\dag$ \opt{\NT{continue\_struct\_decl\_list}}} \RULE{\rt{continue\_struct\_decl\_list}} \CASE{\NT{struct\_decl} \NT{struct\_decl\_list\_start}} \CASE{\NT{struct\_decl}} \RULE{\rt{struct\_decl}} \CASE{\NT{ctype} \NT{d\_ident};} \CASE{\NT{fn\_ctype} (* \NT{d\_ident}) (\NT{PARAMSEQ}\mth{(}\NT{name\_opt\_decl}, \mth{\varepsilon)});)} \CASE{\opt{\NT{const\_vol}} \T{id} \NT{d\_ident};} \RULE{\rt{d\_ident}} \CASE{\T{id} \any{[\opt{\NT{expr}}]}} \RULE{\rt{fn\_ctype}} \CASE{\NT{generic\_ctype} \any{*}} \CASE{void \any{*}} \RULE{\rt{name\_opt\_decl}} \CASE{\NT{decl}} \CASE{\NT{ctype}} \CASE{\NT{fn\_ctype}} \end{grammar} $^\dag$ The optional \texttt{when} construct ends at the end of the line. \section{Function declarations} \begin{grammar} \RULE{\rt{fundecl}} \CASE{\opt{\NT{fn\_ctype}} \any{\NT{funinfo}} \NT{funid} (\opt{\NT{PARAMSEQ}\mth{(}\NT{param}, \mth{\varepsilon)}}) \ttlb~\opt{\NT{stmt\_seq}} \ttrb} \RULE{\rt{funproto}} \CASE{\opt{\NT{fn\_ctype}} \any{\NT{funinfo}} \NT{funid} (\opt{\NT{PARAMSEQ}\mth{(}\NT{param}, \mth{\varepsilon)}});} \RULE{\rt{funinfo}} \CASE{inline} \CASE{\NT{storage}} % \CASE{\NT{attr}} \RULE{\rt{storage}} \CASE{static} \CASE{auto} \CASE{register} \CASE{extern} \RULE{\rt{funid}} \CASE{\T{id}} \CASE{\mth{\T{metaid}^{\ssf{Id}}}} \CASE{\NT{OR}\mth{(}\NT{stmt}\mth{)}} % \CASE{\mth{\T{metaid}^{\ssf{Func}}}} % \CASE{\mth{\T{metaid}^{\ssf{LocalFunc}}}} \RULE{\rt{param}} \CASE{\NT{type} \T{id}} \CASE{\mth{\T{metaid}^{\ssf{Param}}}} \CASE{\mth{\T{metaid}^{\ssf{ParamList}}}} \RULE{\rt{decl}} \CASE{\NT{ctype} \NT{id}} \CASE{\NT{fn\_ctype} (* \NT{id}) (\NT{PARAMSEQ}\mth{(}\NT{name\_opt\_decl}, \mth{\varepsilon)})} \CASE{void} \CASE{\mth{\T{metaid}^{\ssf{Param}}}} \end{grammar} \begin{grammar} \RULE{\rt{PARAMSEQ}\mth{(}\rt{gram\_p}, \rt{when\_p}\mth{)}} \CASE{\NT{COMMA\_LIST}\mth{(}\NT{gram\_p} \OR \ldots \opt{\NT{when\_p}}\mth{)}} \end{grammar} To match a function it is not necessary to provide all of the annotations that appear before the function name. For example, the following semantic patch: \begin{lstlisting}[language=Cocci] @@ @@ foo() { ... } \end{lstlisting} \noindent matches a function declared as follows: \begin{lstlisting}[language=C] static int foo() { return 12; } \end{lstlisting} \noindent This behavior can be turned off by disabling the \KW{optional\_storage} isomorphism. If one adds code before a function declaration, then the effect depends on the kind of code that is added. If the added code is a function definition or CPP code, then the new code is placed before all information associated with the function definition, including any comments preceding the function definition. On the other hand, if the new code is associated with the function, such as the addition of the keyword {\tt static}, the new code is placed exactly where it appears with respect to the rest of the function definition in the semantic patch. For example, \begin{lstlisting}[language=Cocci] @@ @@ + static foo() { ... } \end{lstlisting} \noindent causes static to be placed just before the function name. The following causes it to be placed just before the type \begin{lstlisting}[language=Cocci] @@ type T; @@ + static T foo() { ... } \end{lstlisting} \noindent It may be necessary to consider several cases to ensure that the added ode is placed in the right position. For example, one may need one pattern that considers that the function is declared {\tt inline} and another that considers that it is not. %\newpage \section{Declarations} \begin{grammar} \RULE{\rt{decl\_var}} % \CASE{\NT{type} \opt{\NT{id} \opt{[\opt{\NT{dot\_expr}}]} % \ANY{, \NT{id} \opt{[ \opt{\NT{dot\_expr}}]}}};} \CASE{\NT{common\_decl}} \CASE{\opt{\NT{storage}} \NT{ctype} \NT{COMMA\_LIST}\mth{(}\NT{d\_ident}\mth{)} ;} \CASE{\opt{\NT{storage}} \opt{\NT{const\_vol}} \T{id} \NT{COMMA\_LIST}\mth{(}\NT{d\_ident}\mth{)} ;} \CASE{\opt{\NT{storage}} \NT{fn\_ctype} ( * \NT{d\_ident} ) ( \NT{PARAMSEQ}\mth{(}\NT{name\_opt\_decl}, \mth{\varepsilon)} ) = \NT{initialize} ;} \CASE{typedef \NT{ctype} \NT{typedef\_ident} ;} \RULE{\rt{one\_decl}} \CASE{\NT{common\_decl}} \CASE{\opt{\NT{storage}} \NT{ctype} \NT{id};} % \CASE{\NT{storage} \NT{ctype} \NT{id} \opt{[\opt{\NT{dot\\_expr}}]} = \NT{nest\\_expr};} \CASE{\opt{\NT{storage}} \opt{\NT{const\_vol}} \T{id} \NT{d\_ident} ;} \RULE{\rt{common\_decl}} \CASE{\NT{ctype};} \CASE{\NT{funproto}} \CASE{\opt{\NT{storage}} \NT{ctype} \NT{d\_ident} = \NT{initialize} ;} \CASE{\opt{\NT{storage}} \opt{\NT{const\_vol}} \T{id} \NT{d\_ident} = \NT{initialize} ;} \CASE{\opt{\NT{storage}} \NT{fn\_ctype} ( * \NT{d\_ident} ) ( \NT{PARAMSEQ}\mth{(}\NT{name\_opt\_decl}, \mth{\varepsilon)} ) ;} \CASE{\NT{decl\_ident} ( \OPT{\NT{COMMA\_LIST}\mth{(}\NT{expr}\mth{)}} ) ;} \RULE{\rt{initialize}} \CASE{\NT{dot\_expr}} \CASE{\mth{\T{metaid}^{\ssf{Initialiser}}}} \CASE{\ttlb~\opt{\NT{COMMA\_LIST}\mth{(}\NT{init\_list\_elem}\mth{)}}~\ttrb} \RULE{\rt{init\_list\_elem}} \CASE{\NT{dot\_expr}} \CASE{\NT{designator} = \NT{initialize}} \CASE{\mth{\T{metaid}^{\ssf{Initialiser}}}} \CASE{\mth{\T{metaid}^{\ssf{InitialiserList}}}} \CASE{\NT{id} : \NT{dot\_expr}} \RULE{\rt{designator}} \CASE{. \NT{id}} \CASE{[ \NT{dot\_expr} ]} \CASE{[ \NT{dot\_expr} ... \NT{dot\_expr} ]} \RULE{\rt{decl\_ident}} \CASE{\T{DeclarerId}} \CASE{\mth{\T{metaid}^{\ssf{Declarer}}}} \end{grammar} An initializer for a structure can be ordered or unordered. It is considered to be unordered if there is at least one key-value pair initializer, e.g., \texttt{.x = e}. A declaration can have \textit{e.g.} the form \texttt{register x;}. In this case, the variable implicitly has type int, and SmPL code that declares an int variable will match such a declaration. On the other hand, the implicit int type has no position. If the SmPL code tries to record the position of the type, the match will fail. \section{Statements} The first rule {\em statement} describes the various forms of a statement. The remaining rules implement the constraints that are sensitive to the context in which the statement occurs: {\em single\_statement} for a context in which only one statement is allowed, and {\em decl\_statement} for a context in which a declaration, statement, or sequence thereof is allowed. \begin{grammar} \RULE{\rt{stmt}} \CASE{\NT{directive}} \CASE{\mth{\T{metaid}^{\ssf{Stmt}}}} \CASE{\NT{expr};} \CASE{if (\NT{dot\_expr}) \NT{single\_stmt} \opt{else \NT{single\_stmt}}} \CASE{for (\opt{\NT{dot\_expr}}; \opt{\NT{dot\_expr}}; \opt{\NT{dot\_expr}}) \NT{single\_stmt}} \CASE{while (\NT{dot\_expr}) \NT{single\_stmt}} \CASE{do \NT{single\_stmt} while (\NT{dot\_expr});} \CASE{\NT{iter\_ident} (\any{\NT{dot\_expr}}) \NT{single\_stmt}} \CASE{switch (\opt{\NT{dot\_expr}}) \ttlb \any{\NT{case\_line}} \ttrb} \CASE{return \opt{\NT{dot\_expr}};} \CASE{\ttlb~\opt{\NT{stmt\_seq}} \ttrb} \CASE{\NT{NEST}\mth{(}\some{\NT{decl\_stmt}}, \NT{when}\mth{)}} \CASE{\NT{NEST}\mth{(}\NT{expr}, \NT{when}\mth{)}} \CASE{break;} \CASE{continue;} \CASE{\NT{id}:} \CASE{goto \NT{id};} \CASE{\ttlb \NT{stmt\_seq} \ttrb} \RULE{\rt{directive}} \CASE{\NT{include}} \CASE{\#define \NT{id} \opt{\NT{top}}} \CASE{\#define \NT{id} (\NT{PARAMSEQ}\mth{(}\NT{id}, \mth{\varepsilon)}) \opt{\NT{top}}} \CASE{\#undef \NT{id}} \CASE{\#pragma \NT{id} \some{\NT{id}}} \CASE{\#pragma \NT{id} (\NT{PARAMSEQ}\mth{(}\NT{expr}, \mth{\varepsilon)})} \CASE{\#pragma \NT{id} ...} \RULE{\rt{single\_stmt}} \CASE{\NT{stmt}} \CASE{\NT{OR}\mth{(}\NT{stmt}\mth{)}} \RULE{\rt{decl\_stmt}} \CASE{\mth{\T{metaid}^{\ssf{StmtList}}}} \CASE{\NT{decl\_var}} \CASE{\NT{stmt}} \CASE{\NT{OR}\mth{(}\NT{stmt\_seq}\mth{)}} \RULE{\rt{stmt\_seq}} \CASE{\any{\NT{decl\_stmt}} \opt{\NT{DOTSEQ}\mth{(}\some{\NT{decl\_stmt}}, \NT{when}\mth{)} \any{\NT{decl\_stmt}}}} \CASE{\any{\NT{decl\_stmt}} \opt{\NT{DOTSEQ}\mth{(}\NT{expr}, \NT{when}\mth{)} \any{\NT{decl\_stmt}}}} \RULE{\rt{case\_line}} \CASE{default :~\NT{stmt\_seq}} \CASE{case \NT{dot\_expr} :~\NT{stmt\_seq}} \RULE{\rt{iter\_ident}} \CASE{\T{IteratorId}} \CASE{\mth{\T{metaid}^{\ssf{Iterator}}}} \end{grammar} \begin{grammar} \RULE{\rt{OR}\mth{(}\rt{gram\_o}\mth{)}} \CASE{( \NT{gram\_o} \ANY{\ttmid \NT{gram\_o}})} \RULE{\rt{DOTSEQ}\mth{(}\rt{gram\_d}, \rt{when\_d}\mth{)}} \CASE{\ldots \opt{\NT{when\_d}} \ANY{\NT{gram\_d} \ldots \opt{\NT{when\_d}}}} \RULE{\rt{NEST}\mth{(}\rt{gram\_n}, \rt{when\_n}\mth{)}} \CASE{<\ldots \opt{\NT{when\_n}} \NT{gram\_n} \ANY{\ldots \opt{\NT{when\_n}} \NT{gram\_n}} \ldots>} \CASE{<+\ldots \opt{\NT{when\_n}} \NT{gram\_n} \ANY{\ldots \opt{\NT{when\_n}} \NT{gram\_n}} \ldots+>} \end{grammar} \noindent OR is a macro that generates a disjunction of patterns. The three tokens \T{(}, \T{\ttmid}, and \T{)} must appear in the leftmost column, to differentiate them from the parentheses and bit-or tokens that can appear within expressions (and cannot appear in the leftmost column). These token may also be preceded by \texttt{\bs} when they are used in an other column. These tokens are furthermore different from (, \(\mid\), and ), which are part of the grammar metalanguage. \section{Expressions} A nest or a single ellipsis is allowed in some expression contexts, and causes ambiguity in others. For example, in a sequence \mtt{\ldots \mita{expr} \ldots}, the nonterminal \mita{expr} must be instantiated as an explicit C-language expression, while in an array reference, \mtt{\mth{\mita{expr}_1} \mtt{[} \mth{\mita{expr}_2} \mtt{]}}, the nonterminal \mth{\mita{expr}_2}, because it is delimited by brackets, can be also instantiated as \mtt{\ldots}, representing an arbitrary expression. To distinguish between the various possibilities, we define three nonterminals for expressions: {\em expr} does not allow either top-level nests or ellipses, {\em nest\_expr} allows a nest but not an ellipsis, and {\em dot\_expr} allows both. The EXPR macro is used to express these variants in a concise way. \begin{grammar} \RULE{\rt{expr}} \CASE{\NT{EXPR}\mth{(}\NT{expr}\mth{)}} \RULE{\rt{nest\_expr}} \CASE{\NT{EXPR}\mth{(}\NT{nest\_expr}\mth{)}} \CASE{\NT{NEST}\mth{(}\NT{nest\_expr}, \NT{exp\_whencode}\mth{)}} \RULE{\rt{dot\_expr}} \CASE{\NT{EXPR}\mth{(}\NT{dot\_expr}\mth{)}} \CASE{\NT{NEST}\mth{(}\NT{dot\_expr}, \NT{exp\_whencode}\mth{)}} \CASE{...~\opt{\NT{exp\_whencode}}} \RULE{\rt{EXPR}\mth{(}\rt{exp}\mth{)}} \CASE{\NT{exp} \NT{assign\_op} \NT{exp}} \CASE{\NT{exp}++} \CASE{\NT{exp}--} \CASE{\NT{unary\_op} \NT{exp}} \CASE{\NT{exp} \NT{bin\_op} \NT{exp}} \CASE{\NT{exp} ?~\NT{dot\_expr} :~\NT{exp}} \CASE{(\NT{type}) \NT{exp}} \CASE{\NT{exp} [\NT{dot\_expr}]} \CASE{\NT{exp} .~\NT{id}} \CASE{\NT{exp} -> \NT{id}} \CASE{\NT{exp}(\opt{\NT{PARAMSEQ}\mth{(}\NT{arg}, \NT{exp\_whencode}\mth{)}})} \CASE{\NT{id}} \CASE{(\NT{type}) \ttlb~{\NT{COMMA\_LIST}\mth{(}\NT{init\_list\_elem}\mth{)}}~\ttrb} % \CASE{\mth{\T{metaid}^{\ssf{Func}}}} % \CASE{\mth{\T{metaid}^{\ssf{LocalFunc}}}} \CASE{\mth{\T{metaid}^{\ssf{Exp}}}} % \CASE{\mth{\T{metaid}^{\ssf{Err}}}} \CASE{\mth{\T{metaid}^{\ssf{Const}}}} \CASE{\NT{const}} \CASE{(\NT{dot\_expr})} \CASE{\NT{OR}\mth{(}\NT{exp}\mth{)}} \RULE{\rt{arg}} \CASE{\NT{nest\_expr}} \CASE{\mth{\T{metaid}^{\ssf{ExpList}}}} \RULE{\rt{exp\_whencode}} \CASE{when != \NT{expr}} \RULE{\rt{assign\_op}} \CASE{= \OR -= \OR += \OR *= \OR /= \OR \%=} \CASE{\&= \OR |= \OR \caret= \OR \lt\lt= \OR \gt\gt=} \RULE{\rt{bin\_op}} \CASE{* \OR / \OR \% \OR + \OR -} \CASE{\lt\lt \OR \gt\gt \OR \caret\xspace \OR \& \OR \ttmid} \CASE{< \OR > \OR <= \OR >= \OR == \OR != \OR \&\& \OR \ttmid\ttmid} \RULE{\rt{unary\_op}} \CASE{++ \OR -- \OR \& \OR * \OR + \OR - \OR !} \end{grammar} \section{Constants, Identifiers and Types for Transformations} \begin{grammar} \RULE{\rt{const}} \CASE{\NT{string}} \CASE{[0-9]+} \CASE{\mth{\cdots}} \RULE{\rt{string}} \CASE{"\any{[\^{}"]}"} \RULE{\rt{id}} \CASE{\T{id} \OR \mth{\T{metaid}^{\ssf{Id}}} \OR {\NT{OR}\mth{(}\NT{stmt}\mth{)}}} \RULE{\rt{typedef\_ident}} \CASE{\T{id} \OR \mth{\T{metaid}^{\ssf{Type}}}} \RULE{\rt{type}} \CASE{\NT{ctype} \OR \mth{\T{metaid}^{\ssf{Type}}}} \RULE{\rt{pathToIsoFile}} \CASE{<.*>} \RULE{\rt{regexp}} \CASE{"\any{[\^{}"]}"} \end{grammar} \section{Comments and preprocessor directives} A \verb+//+ or \verb+/* */+ comment that is annotated with + in the leftmost column is considered to be added code. A \verb+//+ or \verb+/* */+ comment without such an annotation is considered to be a comment about the SmPL code, and thus is not matched in the C code. The following preprocessor directives can likewise be added. They cannot be matched against. The entire line is added, but it is not parsed. \begin{itemize} \item \verb+if+ \item \verb+ifdef+ \item \verb+ifndef+ \item \verb+else+ \item \verb+elif+ \item \verb+endif+ \item \verb+error+ %\item \verb+pragma+ \item \verb+line+ \end{itemize} \section{Command-line semantic match} It is possible to specify a semantic match on the spatch command line, using the argument {\tt -sp}. In such a semantic match, any token beginning with a capital letter is assumed to be a metavariable of type {\tt metavariable}. In this case, the parser must be able to figure out what kind of metavariable it is. It is also possible to specify the type of a metavariable by enclosing the type in :'s, concatenated directly to the metavariable name. Some examples of semantic matches that can be given as an argument to {\tt -sp} are as follows: \begin{itemize} \item \texttt{f(e)}: This only matches the expression \texttt{f(e)}. \item \texttt{f(E)}: This matches a call to f with any argument. \item \texttt{F(E)}: This gives a parse error; the semantic patch parser cannot figure out what kind of metavariable \texttt{F} is. \item \texttt{F:identifier:(E)}: This matches any one argument function call. \item \texttt{f:identifier:(e:struct foo *:)}: This matches any one argument function call where the argument has type \texttt{struct foo *}. Since the types of the metavariables are specified, it is not necessary for the metavariable names to begin with a capital letter. \item \texttt{F:identifier:(F)}: This matches any one argument function call where the argument is the name of the function itself. This example shows that it is not necessary to repeat the metavariable type name. \item \texttt{F:identifier:(F:identifier:)}: This matches any one argument function call where the argument is the name of the function itself. This example shows that it is possible to repeat the metavariable type name. \end{itemize} \texttt{When} constraints, \textit{e.g.} \texttt{when != e}, are allowed but the expression \texttt{e} must be represented as a single token. The generated semantic match behaves as though there were a \texttt{*} in front of every token. %%% Local Variables: %%% mode: LaTeX %%% TeX-master: "main_grammar" %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/advanced.tex0000644000175000017500000000003412247437436020061 0ustar eugeneugen\chapter{Advanced Features} coccinelle-1.0.0-rc19/docs/manual/cocci-python.txt0000644000175000017500000000612412247437436020740 0ustar eugeneugenPython extensions for Coccinelle ================================ Coccinelle embeds a python interpreter to support processing matches using the full expressive power of python. Scripting with python --------------------- A python script part to a .cocci file must not be the first rule. A typical sample for searching for constantly sized arrays and its uses could be: @ rule1 @ type T; identifier I; expression C, E; position p1, p2; @@ T I[C@p1]; <+... I[E@p2] ...+> @ script:python @ x_mv << rule1.C; y_mv << rule1.E; x_pos << rule1.p1; y_pos << rule1.p2; @@ x = cocci.combine(x_mv, x_pos) y = cocci.combine(y_mv, y_pos) print x.location print y.location Here cocci is the interface class for interfacting with Coccinelle's OCaml core. It is part python and part OCaml code. The combine function ensures that the filename, line number and column number of the matches are registered with a meta-variable. Controlling environments ------------------------ The python script will be called for each environment generated by Coccinelle with matches to the previous rules. By default, the python script keeps each environment unless otherwise is indicated in the script using cocci.include_match(False). As a short-cut for registering information that "belongs together", the Output class also provides a register_match method that may be overridden in derived classes. This method can be called like: cocci.register_match(True, [(x, 'Array size'), (y, 'Array index size')]). Here the True is automatically passed on to include_match (so one could use False in order to drop the environment, but still print information). In the GTK frontend, this will result in the "Array index size" information being shown as a child node to the "Array size". cocci.exit() simply aborts the treatment of the current file. Previously made changes do take effect. Output methods for the python scripts ------------------------------------- By default Coccinelle contains two output modes: a console-based output, and a GTK-based output. Which one is used is specified using the -pyoutput switch to spatch. -pyoutput coccilib.output.Console (this is the default) -pyoutput coccilib.output.Gtk The latter depends on pygtk2, and the dependency will not be evaluated until runtime. Creating new python output classes ---------------------------------- If you have a need to tailor special output based on your python script, e.g. using register_match of existing scripts, you can do this by deriving from coccilib.output.Output and override the implementation of register_match(self, include, messages). The method expects that the first thing you call is "self.include_match(include)", but otherwise the details of the method is left up to you. To use your custom output class, just specify it as an argument to -pyoutput. It needs to exist in the default python execution environment or in PYTHON_PATH. Running spatch from a different directory than it is stored in -------------------------------------------------------------- In order for spatch to be able to find coccilib, PYTHON_PATH must be set to include the directory in which spatch resides. coccinelle-1.0.0-rc19/docs/manual/main_options.tex0000644000175000017500000000114012247437436021012 0ustar eugeneugen\documentclass{article} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{ifthen} \usepackage{fullpage} \usepackage{amsmath} \usepackage{amssymb} \usepackage{xspace} % fancy symbol, but require latex-extra-fonts (huge) package \usepackage[geometry]{ifsym} \input{macros_options} \input{macros} % Update version in macros.tex \title{Coccinelle Usage (version \cocciversion)} \begin{document} \maketitle \input{spatch_options} \end{document} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: t %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/macros_common.tex0000644000175000017500000000214012247437436021150 0ustar eugeneugen % Very convenient to add comments on the paper. Just set the boolean % to false before sending the paper: \newboolean{showcomments} \setboolean{showcomments}{true} \ifthenelse{\boolean{showcomments}} { \newcommand{\mynote}[2]{ \fbox{\bfseries\sffamily\scriptsize#1} {\small$\blacktriangleright$\textsf{\emph{#2}}$\blacktriangleleft$}}} { \newcommand{\mynote}[2]{}} \newcommand\jl[1]{\mynote{Julia}{#1}} \newcommand\np[1]{\mynote{Nicolas}{#1}} \newcommand{\sizecodebis}[0]{\scriptsize} \newcommand{\mita}[1]{\mbox{\it{{#1}}}} \newcommand{\mtt}[1]{\mbox{\tt{{#1}}}} \newcommand{\msf}[1]{\mbox{\sf{{#1}}}} \newcommand{\stt}[1]{\mbox{\scriptsize\tt{{#1}}}} \newcommand{\ssf}[1]{\mbox{\scriptsize\sf{{#1}}}} \newcommand{\sita}[1]{\mbox{\scriptsize\it{{#1}}}} \newcommand{\mrm}[1]{\mbox{\rm{{#1}}}} \newcommand{\mth}[1]{\({#1}\)} \newcommand{\entails}[2]{\begin{array}{@{}c@{}}{#1}\\\hline{#2}\end{array}} \newcommand{\ttlb}{\mbox{\tt \char'173}} \newcommand{\ttrb}{\mbox{\tt \char'175}} \newcommand{\ttmid}{\mbox{\tt \char'174}} \newcommand{\tttld}{\mbox{\tt \char'176}} \newcommand{\fixme}[1]{{\color{red} #1}} coccinelle-1.0.0-rc19/docs/manual/isomorphisms.tex0000644000175000017500000000025712247437436021057 0ustar eugeneugen\chapter{Isomorphisms and \texttt{standard.iso}} %%% Local Variables: %%% mode: LaTeX %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/manual.tex0000644000175000017500000000020012247437436017564 0ustar eugeneugen\input{main.tex} % Thisis just a placeholder for the actual contents of the manual. % Todo: replace this file with 'main.tex'? coccinelle-1.0.0-rc19/docs/manual/Makefile0000644000175000017500000001023012247437436017231 0ustar eugeneugen############################################################################## # Variables ############################################################################## ifneq ($(MAKECMDGOALS),distclean) include ../../Makefile.config endif MAINSRC=main.tex SRC=$(wildcard *.tex) PDFLATEX_CMD=$(PDFLATEX) -halt-on-error #tools: # latex, pdflatex # xfig # emacs, auctex, ediff # darcs # latexdiff ############################################################################## # Top rules ############################################################################## .PHONY: all clean distclean .SUFFIXES: .pdf .tex all: manual.pdf main_grammar.pdf options.pdf manual.pdf: $(SRC) $(PDFLATEX_CMD) manual.tex $(PDFLATEX_CMD) manual.tex main_grammar.pdf: main_grammar.tex cocci_syntax.tex macros_listing_cocci.tex macros_grammar.tex macros_common.tex examples.tex tips.tex $(PDFLATEX_CMD) main_grammar.tex $(PDFLATEX_CMD) main_grammar.tex options.pdf: main_options.tex spatch_options.tex macros_options.tex $(PDFLATEX_CMD) options.tex $(PDFLATEX_CMD) options.tex distclean:: clean @if test -z "${KEEP_GENERATED}"; then \ rm -f manual.pdf cocci_syntax.pdf options.pdf; fi # lindig trick #RERUN = Rerun (LaTeX|to get cross-references right) # #pdf: $(PDF) # #%.pdf: %.tex # $(PDFLATEX) $< # if egrep -s '$(RERUN)' $*.log ;then $(PDFLATEX) $<; fi # if egrep -s '$(RERUN)' $*.log ;then $(PDFLATEX) $<; fi ############################################################################## # Html version ############################################################################## .PHONY: html check .SUFFIXES: .html .tex TEX=main_grammar.tex WEB=/var/www/localhost/htdocs/coccinelle/ EMNWEB=~/website PDF=$(TEX:.tex=.pdf) HTML=$(TEX:.tex=.html) html: $(HTML) clean:: rm -f *.aux *.dvi *.haux *.htoc *.log *.out *~ distclean:: clean @if test -z "${KEEP_GENERATED}"; then \ rm -f *.pdf *.html *.gif *.css; fi check: $(HTML) checklink $< world: all html universe: world install install: cp *.css *.gif *.html $(WEB) cp $(PDF) $(WEB) chown apache:apache -R $(WEB) chmod a-w -R $(WEB) emn_install: world cp *.css *.gif *.html $(EMNWEB)/docs cp $(PDF) $(EMNWEB)/docs cp options.pdf $(EMNWEB)/ .tex.html: # For Gentoo: /usr/lib64/hevea # For Ubuntu family: /usr/share/hevea # For default installation @if [ -f /usr/lib64/hevea/xxdate.exe ]; then \ hevea -exec /usr/lib64/hevea/xxdate.exe $< ; \ hevea -exec /usr/lib64/hevea/xxdate.exe $< ; \ elif [ -f /usr/share/hevea/xxdate.exe ]; then \ hevea -exec /usr/share/hevea/xxdate.exe $< ; \ hevea -exec /usr/share/hevea/xxdate.exe $< ; \ elif [ -f /usr/local/lib/hevea/xxdate.exe ]; then \ hevea -exec /usr/local/lib/hevea/xxdate.exe $< ; \ hevea -exec /usr/local/lib/hevea/xxdate.exe $< ; \ elif [ -f /opt/local/share/hevea/xxdate.exe ]; then \ hevea -exec /opt/local/share/hevea/xxdate.exe $< ; \ hevea -exec /opt/local/share/hevea/xxdate.exe $< ; \ else \ echo -e "\n\n *** Hevea: Unable to find xxdate.exe ***\n\n"; \ fi hacha -o index.html main_grammar.html # hacha -o index.html cocci_syntax.html ############################################################################## # Install ############################################################################## ############################################################################## # Developer rules ############################################################################## LATEXDIFFOPT=--type=CTRADITIONAL #if multi files ? sed sur les \input{} ? ou create in another dir ? latexdiff: latexdiff $(LATEXDIFFOPT) main-old.tex main.tex > main-diff.tex $(MAKE) MAINSRC=main-diff rm -f main-diff.aux replacediff: cp main-old.tex main-older.tex cp main.tex main-old.tex clean:: rm -f main-diff.* update: commit: ############################################################################## # Generic rules ############################################################################## FORMAT=letter %.ps: %.dvi dvips -P cmz $< -o $@ -t $(FORMAT) clean:: rm -f *.aux \ *.bbl \ *.blg \ *.dvi \ *.log \ *.out \ *.toc include ../../Makefile.common coccinelle-1.0.0-rc19/docs/manual/spatch_options.tex0000644000175000017500000007375612247437436021376 0ustar eugeneugen\section{Introduction} This document describes the options provided by Coccinelle. The options have an impact on various phases of the semantic patch application process. These are: \begin{enumerate} \item Selecting and parsing the semantic patch. \item Selecting and parsing the C code. \item Application of the semantic patch to the C code. \item Transformation. \item Generation of the result. \end{enumerate} \noindent One can either initiate the complete process from step 1, or to perform step 1 or step 2 individually. Coccinelle has quite a lot of options. The most common usages are as follows, for a semantic match {\tt foo.cocci}, a C file {\tt foo.c}, and a directory {\tt foodir}: \begin{itemize} \item {\tt spatch --parse-cocci foo.cocci}: Check that the semantic patch is syntactically correct. \item {\tt spatch --parse-c foo.c}: Check that the C file is syntactically correct. The Coccinelle C parser tries to recover during the parsing process, so if one function does not parse, it will start up again with the next one. Thus, a parse error is often not a cause for concern, unless it occurs in a function that is relevant to the semantic patch. \item {\tt spatch --sp-file foo.cocci foo.c}: Apply the semantic patch {\tt foo.cocci} to the file {\tt foo.c} and print out any transformations as the changes between the original and transformed code, using the program {\tt diff}. {\tt --sp-file} is optional in this and the following cases. \item {\tt spatch --sp-file foo.cocci foo.c --debug}: The same as the previous case, but print out some information about the matching process. \item {\tt spatch --sp-file foo.cocci --dir foodir}: Apply the semantic patch {\tt foo.cocci} to all of the C files in the directory {\tt foodir}. \item {\tt spatch --sp-file foo.cocci --dir foodir --include-headers}: Apply the semantic patch {\tt foo.cocci} to all of the C files and header files in the directory {\tt foodir}. \end{itemize} In the rest of this document, the options are annotated as follows: \begin{itemize} \item \FilledBigDiamondshape: a basic option, that is most likely of interest to all users. \item \BigLowerDiamond: an option that is frequently used, often for better understanding the effect of a semantic patch. \item \BigDiamondshape: an option that is likely to be rarely used, but whose effect is still comprehensible to a user. \item An option with no annotation is likely of interest only to developers. \end{itemize} \section{Selecting and parsing the semantic patch} \subsection{Standalone options} \normal{--parse-cocci $\langle$file$\rangle$}{ Parse a semantic patch file and print out some information about it.} \subsection{The semantic patch} \minimum{--sp-file $\langle$file$\rangle$, -c $\langle$file$\rangle$, -cocci-file $\langle$file$\rangle$}{ Specify the name of the file containing the semantic patch. The file name should end in {\tt .cocci}. All three options do the same thing. These options are optional. If they are not used, the single file whose name ends in \texttt{.cocci} is assoumed to be the name of the file containing the semantic patch.} \rare{--sp ``semantic patch string''}{Specify a semantic match as a command-line argument. See the section ``Command-line semantic match'' in the manual.} \subsection{Isomorphisms} \rare{--iso, --iso-file}{ Specify a file containing isomorphisms to be used in place of the standard one. Normally one should use the {\tt using} construct within a semantic patch to specify isomorphisms to be used {\em in addition to} the standard ones.} \rare{--iso-limit $\langle$int$\rangle$} Limit the depth of application of isomorphisms to the specified integer. \rare{--no-iso-limit} Put no limit on the number of times that isomorphisms can be applied. This is the default. \rare{--disable-iso}{Disable a specific isomorphism from the command line. This option can be specified multiple times.} \developer{--track-iso}{ Gather information about isomorphism usage.} \developer{--profile-iso}{ Gather information about the time required for isomorphism expansion.} \subsection{Display options} \rare{--show-cocci}{Show the semantic patch that is being processed before expanding isomorphisms.} \rare{--show-SP}{Show the semantic patch that is being processed after expanding isomorphisms.} \rare{--show-ctl-text}{ Show the representation of the semantic patch in CTL.} \rare{--ctl-inline-let}{ Sometimes {\tt let} is used to name intermediate terms CTL representation. This option causes the let-bound terms to be inlined at the point of their reference. This option implicitly sets {\bf --show-ctl-text}.} \rare{--ctl-show-mcodekind}{ Show transformation information within the CTL representation of the semantic patch. This option implicitly sets {\bf --show-ctl-text}.} \rare{--show-ctl-tex}{ Create a LaTeX files showing the representation of the semantic patch in CTL.} \section{Selecting and parsing the C files} \subsection{Standalone options} \normal{--parse-c $\langle$file/dir$\rangle$}{ Parse a {\tt .c} file or all of the {\tt .c} files in a directory. This generates information about any parse errors encountered.} \normal{--parse-h $\langle$file/dir$\rangle$}{ Parse a {\tt .h} file or all of the {\tt .h} files in a directory. This generates information about any parse errors encountered.} \normal{--parse-ch $\langle$file/dir$\rangle$}{ Parse a {\tt .c} or {\tt .h} file or all of the {\tt .c} or {\tt .h} files in a directory. This generates information about any parse errors encountered.} \normal{--control-flow $\langle$file$\rangle$, --control-flow $\langle$file$\rangle$:$\langle$function$\rangle$}{ Print a control-flow graph for all of the functions in a file or for a specific function in a file. This requires {\tt dot} (http://www.graphviz.org/) and {\tt gv}.} \rare{--control-flow-to-file $\langle$file$\rangle$, --control-flow-to-file $\langle$file$\rangle$:$\langle$function$\rangle$}{ Like --control-flow but just puts the dot output in a file in the {\em current} directory. For PATH/file.c, this produces file:xxx.dot for each (selected) function xxx in PATH/file.c.} \rare{--type-c $\langle$file$\rangle$}{ Parse a C file and pretty-print a version including type information.} \developer{--tokens-c $\langle$file$\rangle$}{Prints the tokens in a C file.} \developer{--parse-unparse $\langle$file$\rangle$}{Parse and then reconstruct a C file.} \developer{--compare-c $\langle$file$\rangle$ $\langle$file$\rangle$, --compare-c-hardcoded}{Compares one C file to another, or compare the file tests/compare1.c to the file tests/compare2.c.} \developer{--test-cfg-ifdef $\langle$file$\rangle$}{Do some special processing of \#ifdef and display the resulting control-flow graph. This requires {\tt dot} and {\tt gv}.} \developer{--test-attributes $\langle$file$\rangle$, --test-cpp $\langle$file$\rangle$}{ Test the parsing of cpp code and attributes, respectively.} \subsection{Selecting C files} An argument that ends in {\tt .c} is assumed to be a C file to process. Normally, only one C file or one directory is specified. If multiple C files are specified, they are treated in parallel, {\em i.e.}, the first semantic patch rule is applied to all functions in all files, then the second semantic patch rule is applied to all functions in all files, etc. If a directory is specified then no files may be specified and only the rightmost directory specified is used. \normal{--include-headers}{ This option causes header files to be processed independently. This option only makes sense if a directory is specified using {\bf --dir}.} \normal{--use-glimpse}{ Use a glimpse index to select the files to which a semantic patch may be relevant. This option requires that a directory is specified. The index may be created using the script {\tt coccinelle/scripts/ glimpseindex-cocci.sh}. Glimpse is available at http://webglimpse.net/. In conjunction with the option {\bf --patch-cocci} this option prints the regular expression that will be passed to glimpse.} \normal{--use-idutils $[\langle$file$\rangle]$} { Use an id-utils index created using lid to select the files to which a semantic patch may be relevant. This option requires that a directory is specified. The index may be created using the script {\tt coccinelle/scripts/ idindex-cocci.sh}. In conjunction with the option {\bf --patch-cocci} this option prints the regular expression that will be passed to glimpse. The optional file name option is the name of the file in which to find the index. It has been reported that the viewer seascope can be used to generate an appropriate index. If no file name is specified, the default is .id-utils.index. } \normal{--use-coccigrep}{ Use a version of grep implemented in Coccinelle to check that selected files are relevant to the semantic patch. This option is only relevant to the case of working on a complete directory, when parallelism is requested (max and index options). Otherwise it is the default, except when multiple files are requested to be treated as a single unit. In that case grep is used. Note that coccigrep or grep is used even if glimpse or id-utils is selected, to account for imprecision in the index (glimpse at least does not distinguish between underline and space, leading to false positives).} \rare{--selected-only}{Just show what files will be selected for processing.} \normal{--dir}{ Specify a directory containing C files to process. A trailing {\tt /} is permitted on the directory name and has no impact on the result. By default, the include path will be set to the ``include'' subdirectory of this directory. A different include path can be specified using the option {\bf -I}. {\bf --dir} only considers the rightmost directory in the argument list. This behavior is convenient for creating a script that always works on a single directory, but allows the user of the script to override the provided directory with another one. Spatch collects the files in the directory using {\tt find} and does not follow symbolic links.} \developer{--kbuild-info $\langle$file$\rangle$}{ The specified file contains information about which sets of files should be considered in parallel.} \developer{--disable-worth-trying-opt}{Normally, a C file is only processed if it contains some keywords that have been determined to be essential for the semantic patch to match somewhere in the file. This option disables this optimization and tries the semantic patch on all files.} \developer{--test $\langle$file$\rangle$}{ A shortcut for running Coccinelle on the semantic patch ``file{\tt{.cocci}}'' and the C file ``file{\tt{.c}}''. The result is put in the file {\tt /tmp/file{\tt{.res}}}. If writing a file in /tmp with a non-fresh name is a concern, then do not use this option. } \developer{--testall}{A shortcut for running Coccinelle on all files in a subdirectory {\tt tests} such that there are all of a {\tt .cocci} file, a {\tt .c} file, and a {\tt .res} file, where the {\tt .res} contains the expected result.} \developer{--test-okfailed, --test-regression-okfailed} Other options for keeping track of tests that have succeeded and failed. \developer{--compare-with-expected}{Compare the result of applying Coccinelle to file{\tt{.c}} to the file file{\tt{.res}} representing the expected result.} \developer{--expected-score-file $\langle$file$\rangle$}{ which score file to compare with in the testall run} \subsection{Parsing C files} \rare{--show-c}{Show the C code that is being processed.} \rare{--parse-error-msg}{Show parsing errors in the C file.} \rare{--verbose-parsing}{Show parsing errors in the C file, as well as information about attempts to accomodate such errors. This implicitly sets --parse-error-msg.} \rare{--type-error-msg}{Show information about where the C type checker was not able to determine the type of an expression.} \rare{--int-bits $\langle$n$\rangle$, --long-bits $\langle$n$\rangle$}{Provide integer size information. n is the number of bits in an unsigned integer or unsigned long, respectively. If only the option {\bf --int-bits} is used, unsigned longs will be assumed to have twice as many bits as unsigned integers. If only the option {\bf -long-bits} is used, unsigned ints will be assumed to have half as many bits as unsigned integers. This information is only used in determining the types of integer constants, according to the ANSI C standard (C89). If neither is provided, the type of an integer constant is determined by the sequence of ``u'' and ``l'' annotations following the constant. If there is none, the constant is assumed to be a signed integer. If there is only ``u'', the constant is assumed to be an unsigned integer, etc.} \rare{--no-loops}{Drop back edges for loops. This may make a semantic patch/match run faster, at the cost of not finding matches that wrap around loops.} \developer{--use-cache}{Use preparsed versions of the C files that are stored in a cache.} \developer{--cache-prefix}{Specify the directory in which to store preparsed versions of the C files. This sets {--use-cache}} \developer{--cache-limit}{Specify the maximum number of preparsed C files to store. The cache is cleared of all files with names ending in .ast-raw and .depend-raw on reaching this limit. Only effective if --cache-prefix is used as well. This is most useful when iteration is used to process a file multiple times within a single run of Coccinelle.} \developer{--debug-cpp, --debug-lexer, --debug-etdt, --debug-typedef}{Various options for debugging the C parser.} \developer{--filter-msg, --filter-define-error, --filter-passed-level}{Various options for debugging the C parser.} \developer{--only-return-is-error-exit}{In matching ``{\tt{\ldots}}'' in a semantic patch or when forall is specified, a rule must match all control-flow paths starting from a node matching the beginning of the rule. This is relaxed, however, for error handling code. Normally, error handling code is considered to be a conditional with only a then branch that ends in goto, break, continue, or return. If this option is set, then only a then branch ending in a return is considered to be error handling code. Usually a better strategy is to use {\tt when strict} in the semantic patch, and then match explicitly the case where there is a conditional whose then branch ends in a return.} \subsubsection*{Macros and other preprocessor code} \normal{--macro-file $\langle$file$\rangle$}{ Extra macro definitions to be taken into account when parsing the C files. This uses the provided macro definitions in addition to those in the default macro file.} \normal{--macro-file-builtins $\langle$file$\rangle$}{ Builtin macro definitions to be taken into account when parsing the C files. This causes the macro definitions provided in the default macro file to be ignored and the ones in the specified file to be used instead.} \rare{--ifdef-to-if,-no-ifdef-to-if}{ The option {\bf --ifdef-to-if} represents an {\tt \#ifdef} in the source code as a conditional in the control-flow graph when doing so represents valid code. {\bf -no-ifdef-to-if} disables this feature. {\bf --ifdef-to-if} is the default. } \rare{--noif0-passing}{ Normally code under \#if 0 is ignored. If this option is set then the code is considered, just like the code under any other \#ifdef.} \rare{--defined $s$}{The string $s$ is a comma-separated list of constants that should be considered to be defined, with respect to uses of {\tt \#ifdef} and {\tt \#ifndef} in C code. No spaces should appear in $s$. Multiple {\bf --defined} arguments can be provided and the list of strings accumulates. For the provided strings any {\tt \#else}s of {\tt \#ifdef}s are ignored and any {\tt \#ifndef}s are ignored, unless the argument {\bf --noif0-passing} is also given, in which case {\bf --defined} has no effect. Note that occurrences of {\tt \#define} in the C code have no effect on the list of defined constants.} \rare{--undefined $s$}{Analogous to {\bf --defined} except that the strings represent constants that should be considered to be undefined.} \developer{--noadd-typedef-root}{This seems to reduce the scope of a typedef declaration found in the C code.} \subsubsection*{Include files} \normal{--recursive-includes, --all-includes, --local-includes, --no-includes}{ These options control which include files mentioned in a C file are taken into account. {\bf --recursive-includes} indicates that all included files mentioned in the .c file(s) or any included files will be processed. {\bf --all-includes} indicates that all included files mentioned in the .c file(s) will be processed. {\bf --local-includes} indicates that only included files in the current directory will be processed. {\bf --no-includes} indicates that no included files will be processed. If the semantic patch contains type specifications on expression metavariables, then the default is {\bf --local-includes}. Otherwise the default is {\bf --no-includes}. At most one of these options can be specified.} \normal{-I $\langle$path$\rangle$}{ This option specifies a directory in which to find non-local include files. This option can be used several times to specify multipls include paths.} \rare{--include $\langle$file$\rangle$}{ This option give the name of a file to consider as being included in each processed file. The file is added to the end of the file's list of included files. The complete path name should be given; the {\bf -I} options are not taken into account to find the file. This option can be used several times to include multiple files.} \rare{--relax-include-path}{This option when combined with --all-includes causes the search for local include files to consider the current directory, even if the include patch specifies a subdirectory. This is really only useful for testing, eg with the option {\bf --testall}} \rare{--c++}{Make an extremely minimal effort to parse C++ code. Currently, this is limited to allowing identifiers to contain ``::'', tilde, and template invocations. Consider testing your code first with spatch --type-c to see if there are any type annotations in the code you are interested in processing. If not, then it was probably not parsed.} \rare{--ibm}{Make a effort to parse IBM C code. Currently decimal declarations are supported.} \section{Application of the semantic patch to the C code} \subsection{Feedback at the rule level during the application of the semantic patch} \normal{--show-bindings}{ Show the environments with respect to which each rule is applied and the bindings that result from each such application.} \normal{--show-dependencies}{ Show the status (matched or unmatched) of the rules on which a given rule depends. {\bf --show-dependencies} implicitly sets {\bf --show-bindings}, as the values of the dependencies are environment-specific.} \normal{--show-trying}{ Show the name of each program element to which each rule is applied.} \normal{--show-transinfo}{ Show information about each transformation that is performed. The node numbers that are referenced are the number of the nodes in the control-flow graph, which can be seen using the option {\bf --control-flow} (the initial control-flow graph only) or the option {\bf --show-flow} (the control-flow graph before and after each rule application).} \normal{--show-misc}{Show some miscellaneous information.} \rare{--show-flow $\langle$file$\rangle$, --show-flow $\langle$file$\rangle$:$\langle$function$\rangle$} Show the control-flow graph before and after the application of each rule. \developer{--show-before-fixed-flow}{This is similar to {\bf --show-flow}, but shows a preliminary version of the control-flow graph.} \subsection{Feedback at the CTL level during the application of the semantic patch} \normal{--verbose-engine}{Show a trace of the matching of atomic terms to C code.} \rare{--verbose-ctl-engine}{Show a trace of the CTL matching process. This is unfortunately rather voluminous and not so helpful for someone who is not familiar with CTL in general and the translation of SmPL into CTL specifically. This option implicitly sets the option {\bf --show-ctl-text}.} \rare{--graphical-trace}{Create a pdf file containing the control flow graph annotated with the various nodes matched during the CTL matching process. Unfortunately, except for the most simple examples, the output is voluminous, and so the option is not really practical for most examples. This requires {\tt dot} (http://www.graphviz.org/) and {\tt pdftk}.} \rare{--gt-without-label}{The same as {\bf --graphical-trace}, but the PDF file does not contain the CTL code.} \rare{--partial-match}{ Report partial matches of the semantic patch on the C file. This can be substantially slower than normal matching.} \rare{--verbose-match}{ Report on when CTL matching is not applied to a function or other program unit because it does not contain some required atomic pattern. This can be viewed as a simpler, more efficient, but less informative version of {\bf --partial-match}.} \subsection{Actions during the application of the semantic patch} \normal{-D rulename}{Run the patch considering that the virtual rule ``rulename'' is satisfied. Virtual rules should be declared at the beginning of the semantic patch in a comma separated list following the keyword virtual. Other rules can depend on the satisfaction or non satifaction of these rules using the keyword {\tt depends on} in the usual way.} \normal{-D variable=value}{Run the patch considering that the virtual identifier metavariable ``variable'' is bound to ``value''. Any identifier metavariable can be designated as being virtual by giving it the rule name {\tt virtual}. An example is in demos/vm.coci} \rare{--allow-inconsistent-paths}{Normally, a term that is transformed should only be accessible from other terms that are matched by the semantic patch. This option removes this constraint. Doing so, is unsafe, however, because the properties that hold along the matched path might not hold at all along the unmatched path.} \rare{--disallow-nested-exps}{In an expression that contains repeated nested subterms, {\em e.g.} of the form {\tt f(f(x))}, a pattern can match a single expression in multiple ways, some nested inside others. This option causes the matching process to stop immediately at the outermost match. Thus, in the example {\tt f(f(x))}, the possibility that the pattern {\tt f(E)}, with metavariable {\tt E}, matches with {\tt E} as {\tt x} will not be considered.} \rare{--no-safe-expressions}{normally, we check that an expression does not match something earlier in the disjunction. But for large disjunctions, this can result in a very big CTL formula. So this option give the user the option to say he doesn't want this feature, if that is the case.} \rare{--pyoutput coccilib.output.Gtk, --pyoutput coccilib.output.Console}{ This controls whether Python output is sent to Gtk or to the console. {\bf --pyoutput coccilib.output.Console} is the default. The Gtk option is currently not well supported.} \developer{--loop}{When there is ``{\tt{\ldots}}'' in the semantic patch, the CTL operator {\sf AU} is used if the current function does not contain a loop, and {\sf AW} may be used if it does. This option causes {\sf AW} always to be used.} \rare{--ocaml-regexps}{Use the regular expressions provided by the OCaml \texttt{Str} library. This is the default if the PCRE library is not available. Otherwise PCRE regular expressions are used by default.} \developer{--steps $\langle$int$\rangle$}{ This limits the number of steps performed by the CTL engine to the specified number. This option is unsafe as it might cause a rule to fail due to running out of steps rather than due to not matching.} \developer{--bench $\langle$int$\rangle$}{This collects various information about the operations performed during the CTL matching process.} % \developer{--popl, --popl-mark-all, --popl-keep-all-wits}{ % These options use a simplified version of the SmPL language. {\bf % --popl-mark-all} and {\bf --popl-keep-all-wits} implicitly set {\bf % --popl}.} \rare{--reverse}{Inverts the semantic patch before applying it. A potential use case is backporting changes to previous versions. If a semantic patch represents an API change, then the reverse undoes the API change. Note that inverting a semantic patch is not always possible. In particular, the composition of a semantic patch with its inverse is not guaranteed to be an empty patch.} \section{Generation of the result} Normally, the only output is the differences between the original code and the transformed code obtained using the program {\tt diff} with the unified format option. If stars are used in column 0 rather than {\tt -} and {\tt +}, then the {\tt -} lines in the output are the lines that matched the stars. \normal{--keep-comments}{Don't remove comments adjacent to removed code.} \normal{--linux-spacing, --smpl-spacing}{Control the spacing within the code added by the semantic patch. The option {\bf --linux-spacing} causes spatch to follow the conventions of Linux, regardless of the spacing in the semantic patch. This is the default. The option {\bf --smpl-spacing} causes spatch to follow the spacing given in the semantic patch, within individual lines.} \rare{-o $\langle$file$\rangle$}{ This causes the transformed code to be placed in the file {\tt file}. The difference between the original code and the transformed code is still printed to the standard output using {\tt diff} with the unified format option. This option only makes sense when {\tt -} and {\tt +} are used.} \rare{--in-place}{ Modify the input file to contain the transformed code. The difference between the original code and the transformed code is still printed to the standard output using {\tt diff} with the unified format option. By default, the input file is overwritten when using this option, with no backup. This option only makes sense when {\tt -} and {\tt +} are used.} \rare{--backup-suffix $s$}{The suffix $s$ of the file to use in making a backup of the original file(s). This suffix should include the leading ``.'', if one is desired. This option only has an effect when the option {\tt --in-place} is also used.} \rare{--out-place}{ Store the result of modifying the code in a .cocci-res file. The difference between the original code and the transformed code is still printed to the standard output using {\tt diff} with the unified format option. This option only makes sense when {\tt -} and {\tt +} are used.} \rare{--no-show-diff}{ Normally, the difference between the original and transformed code is printed on the standard output. This option causes this not to be done.} \rare{-U}{ Set number of context lines to be provided by {\tt diff}.} \rare{--patch $\langle$path$\rangle$}{The prefix of the pathname of the directory or file name that should dropped from the {\tt diff} line in the generated patch. This is useful if you want to apply a patch only to a subdirectory of a source code tree but want to create a patch that can be applied at the root of the source code tree. An example could be {\tt spatch --sp-file foo.cocci --dir /var/linuxes/linux-next/drivers --patch /var/linuxes/linux-next}. A trailing {\tt /} is permitted on the directory name and has no impact on the result.} \rare{--save-tmp-files}{Coccinelle creates some temporary files in {\tt /tmp} that it deletes after use. This option causes these files to be saved.} \developer{--debug-unparsing}{Show some debugging information about the generation of the transformed code. This has the side-effect of deleting the transformed code.} \section{Other options} \subsection{Version information} \normal{--version}{ The version of Coccinelle is printed on the standard output. No other options are allowed.} \normal{--date}{ The date of the current version of Coccinelle are printed on the standard output. No other options are allowed.} \subsection{Help} \minimum{--h, --shorthelp}{ The most useful commands.} \minimum{--help, --help, --longhelp}{ A complete listing of the available commands.} \subsection{Controlling the execution of Coccinelle} \normal{--timeout $\langle$int$\rangle$}{ The maximum time in seconds for processing a single file.} \rare{--max $\langle$int$\rangle$}{This option informs Coccinelle of the number of instances of Coccinelle that will be run concurrently. This option requires {\bf --index}. It is usually used with {\bf --dir}.} \rare{--index $\langle$int$\rangle$}{This option informs Coccinelle of which of the concurrent instances is the current one. This option requires {\bf --max}.} \rare{--mod-distrib}{When multiple instances of Coccinelle are run in parallel, normally the first instance processes the first $n$ files, the second instance the second $n$ files, etc. With this option, the files are distributed among the instances in a round-robin fashion.} \developer{--debugger}{Option for running Coccinelle from within the OCaml debugger.} \developer{--profile}{ Gather timing information about the main Coccinelle functions.} \developer{--disable-once}{Print various warning messages every time some condition occurs, rather than only once.} \subsection{External analyses} \developer{--external-analysis-file}{Loads in the contents of a database produced by some external analysis tool. Each entry contains the analysis result of a particular source location. Currently, such a database is a .csv file providing integer bounds or an integer set for some subset of the source locations that references an integer memory location. This database can be inspected with coccilib functions, e.g. to control the pattern match process.} \subsection{Miscellaneous} \rare{--quiet}{Suppress most output. This is the default.} %\developer{--pad, -hrule $\langle$dir$\rangle$, -xxx, -l1}{} \developer{--pad, --xxx, --l1}{} %%% Local Variables: %%% mode: LaTeX %%% TeX-master: "main_options" %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.0-rc19/docs/manual/macros_listing_cocci.tex0000644000175000017500000000303512247437436022475 0ustar eugeneugen\lstset{basicstyle=\ttfamily,numbers=left, numberstyle=\tiny, stepnumber=1, numbersep=5pt,language=C,commentstyle=\color{OliveGreen},keywordstyle=\color{blue},stringstyle=\color{BrickRed}} % % You must prefix the +/- lines of % cocci files with @+/@- respectively. % This will enable the automatic coloration. % % Note: You need at least the following version of hevea % http://hevea.inria.fr/distri/unstable/hevea-2008-12-17.tar.gz % \ifhevea % For HTML generation \lstdefinelanguage{Cocci}{ morekeywords={idexpression,expression,statement,identifier,type, parameter,list,when,strict,any,forall,local,position,typedef}, keywordstyle=\color{OliveGreen}\bfseries, sensitive=false, moredelim=[is][\color{blue}]{@M}{@M}, moredelim=[il][\color{OliveGreen}]{@+}, moredelim=[il][\color{BrickRed}]{@-}} \lstdefinelanguage{PatchC}[ANSI]{C}{ stringstyle=\color{black}, moredelim=[il][\color{OliveGreen}]{@+}, moredelim=[il][\color{BrickRed}]{@-}, moredelim=[il][\color{Plum}]{@M}} \else % For DVI/PS/PDF generation \lstdefinelanguage{Cocci}{ morekeywords={idexpression,expression,statement,identifier,type, parameter,list,when,strict,any,forall,local,position,typedef}, keywordstyle=\color{OliveGreen}\bfseries, sensitive=false, moredelim=*[is][\color{blue}]{@M}{@M}, moredelim=[il][\color{OliveGreen}]{@+}, moredelim=[il][\color{BrickRed}]{@-}} \lstdefinelanguage{PatchC}[ANSI]{C}{ stringstyle=\color{black}, moredelim=[il][\color{OliveGreen}]{@+}, moredelim=[il][\color{BrickRed}]{@-}, moredelim=[il][\color{Plum}]{@M}} \fi \newif\iflanguagestyle \languagestylefalse coccinelle-1.0.0-rc19/docs/manual/workflow.tex0000644000175000017500000000011412247437436020165 0ustar eugeneugen\chapter{Developing a Semantic Patch} %editing semantic patch, emacs mode coccinelle-1.0.0-rc19/docs/Coccilib.3cocci0000644000175000017500000000734212247437436017122 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH COCCILIB 3COCCI "May 18, 2011" .\" see http://www.fnal.gov/docs/products/ups/ReferenceManual/html/manpages.html .\" see http://www.linuxjournal.com/article/1158 .\" see http://www.schweikhardt.net/man_page_howto.html .\" groff -Tascii -man ./Coccilib.3cocci | more .\" .\" Some roff macros, for reference: .\" .nh disable hyphenation .\" .hy enable hyphenation .\" .ad l left justify .\" .ad b justify to both left and right margins .\" .nf disable filling .\" .fi enable filling .\" .br insert line break .\" .sp insert n+1 empty lines .\" for manpage-specific macros, see man(7) .\" .\" TeX users may be more comfortable with the \fB\fP and .\" \fI\fP escape sequences to invode bold face and italics, .\" respectively. Also \fR for roman. .\" pad: src: deputy man page .SH NAME Coccilib \- Library of functions for use with Coccinelle OCaml script code .SH MODULE Module Coccilib .SH DOCUMENTATION .sp Module .BI "Coccilib" : .B sig end .B === .B Positions .B === .PP .I type pos = { current_element : .B string ; file : .B string ; line : .B int ; col : .B int ; line_end : .B int ; col_end : .B int ; } .sp A value of type .B pos describes a position in a source file\&. .B current_element is the name of the function containing the matched position; .B file is the name of the file containing the matched position; .B line is the number of the line containing the first character of the matched position; .B col is the (0-based) column containing the first character of the matched position; .B line_end is the number of the line containing the last character of the matched position; .B col_end is the (0-based) column containing the last character of the matched position\&. .sp .B === .B Abstract Syntax Tree .B === .PP .I type param_type = | Pos .B of .B pos list | Str .B of .B string | Type .B of .B Ast_c.fullType | Init .B of .B Ast_c.initialiser | InitList .B of .B Ast_c.initialiser Ast_c.wrap2 list | Int .B of .B int | Param .B of .B Ast_c.parameterType | ParamList .B of .B Ast_c.parameterType Ast_c.wrap2 list | Expr .B of .B Ast_c.expression | ExprList .B of .B Ast_c.argument Ast_c.wrap2 list | Decl .B of .B Ast_c.declaration | Field .B of .B Ast_c.field | FieldList .B of .B Ast_c.field list | Stmt .B of .B Ast_c.statement .sp .B === .B Match management functions .B === .I val include_match : .B bool -> unit .sp If the argument is true, retain the environment with respect to which the ocaml script code is being executed for use in subsequent rules. If the argument is false, discard this environment. By default, the environment is retained. .sp .I val exit : .B unit -> unit .sp If called, aborts the treatment of the current file. All previous changes take effect. .sp .I val dir : .B unit -> string .sp Returns the directory on which spatch was launched. .sp .I val print_main : .B ?color:string -> string -> pos list -> unit .sp Print information about a main position using org mode. .sp .I val print_sec : .B ?color:string -> string -> pos list -> unit .sp Print information about a single secondary position using org mode. .sp .I val print_secs : .B ?color:string -> string -> pos list -> unit .sp Print information about a list of secondary positions using org mode. .sp .SH REFERENCES Y. Padioleau, J.L. Lawall, R.R Hansen, G. Muller "Documenting and Automating Collateral Evolutions in Linux Device Driver" .I EuroSys 2008, Glasgow, Scotland (April 2008) pp. 247-260. .SH AUTHOR This manual page was written by Julia Lawall . .SH REPORTING BUGS Send a mail to .SH COPYRIGHT Copyright 2011, DIKU, University of Copenhagen and INRIA. coccinelle-1.0.0-rc19/docs/graph-module-dependencies.ps0000644000175000017500000034337212247437436021710 0ustar eugeneugen%!PS-Adobe-2.0 %%Creator: dot version 2.8 (Wed Dec 20 14:50:18 UTC 2006) %%For: (pad) pad,,, %%Title: G %%Pages: (atend) %%BoundingBox: 36 36 584 196 %%EndComments save %%BeginProlog /DotDict 200 dict def DotDict begin /setupLatin1 { mark /EncodingVector 256 array def EncodingVector 0 ISOLatin1Encoding 0 255 getinterval putinterval EncodingVector 45 /hyphen put % Set up ISO Latin 1 character encoding /starnetISO { dup dup findfont dup length dict begin { 1 index /FID ne { def }{ pop pop } ifelse } forall /Encoding EncodingVector def currentdict end definefont } def /Times-Roman starnetISO def /Times-Italic starnetISO def /Times-Bold starnetISO def /Times-BoldItalic starnetISO def /Helvetica starnetISO def /Helvetica-Oblique starnetISO def /Helvetica-Bold starnetISO def /Helvetica-BoldOblique starnetISO def /Courier starnetISO def /Courier-Oblique starnetISO def /Courier-Bold starnetISO def /Courier-BoldOblique starnetISO def cleartomark } bind def %%BeginResource: procset graphviz 0 0 /coord-font-family /Times-Roman def /default-font-family /Times-Roman def /coordfont coord-font-family findfont 8 scalefont def /InvScaleFactor 1.0 def /set_scale { dup 1 exch div /InvScaleFactor exch def dup scale } bind def % styles /solid { [] 0 setdash } bind def /dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def /dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def /invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def /bold { 2 setlinewidth } bind def /filled { } bind def /unfilled { } bind def /rounded { } bind def /diagonals { } bind def % hooks for setting color /nodecolor { sethsbcolor } bind def /edgecolor { sethsbcolor } bind def /graphcolor { sethsbcolor } bind def /nopcolor {pop pop pop} bind def /beginpage { % i j npages /npages exch def /j exch def /i exch def /str 10 string def npages 1 gt { gsave coordfont setfont 0 0 moveto (\() show i str cvs show (,) show j str cvs show (\)) show grestore } if } bind def /set_font { findfont exch scalefont setfont } def % draw aligned label in bounding box aligned to current point /alignedtext { % width adj text /text exch def /adj exch def /width exch def gsave width 0 gt { text stringwidth pop adj mul 0 rmoveto } if [] 0 setdash text show grestore } def /boxprim { % xcorner ycorner xsize ysize 4 2 roll moveto 2 copy exch 0 rlineto 0 exch rlineto pop neg 0 rlineto closepath } bind def /ellipse_path { /ry exch def /rx exch def /y exch def /x exch def matrix currentmatrix newpath x y translate rx ry scale 0 0 1 0 360 arc setmatrix } bind def /endpage { showpage } bind def /showpage { } def /layercolorseq [ % layer color sequence - darkest to lightest [0 0 0] [.2 .8 .8] [.4 .8 .8] [.6 .8 .8] [.8 .8 .8] ] def /layerlen layercolorseq length def /setlayer {/maxlayer exch def /curlayer exch def layercolorseq curlayer 1 sub layerlen mod get aload pop sethsbcolor /nodecolor {nopcolor} def /edgecolor {nopcolor} def /graphcolor {nopcolor} def } bind def /onlayer { curlayer ne {invis} if } def /onlayers { /myupper exch def /mylower exch def curlayer mylower lt curlayer myupper gt or {invis} if } def /curlayer 0 def %%EndResource %%EndProlog %%BeginSetup 14 default-font-family set_font 1 setmiterlimit % /arrowlength 10 def % /arrowwidth 5 def % make sure pdfmark is harmless for PS-interpreters other than Distiller /pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse % make '<<' and '>>' safe on PS Level 1 devices /languagelevel where {pop languagelevel}{1} ifelse 2 lt { userdict (<<) cvn ([) cvn load put userdict (>>) cvn ([) cvn load put } if %%EndSetup %%Page: 1 1 %%PageBoundingBox: 36 36 584 196 %%PageOrientation: Portrait gsave 36 36 548 160 boxprim clip newpath 36 36 translate 0 0 1 beginpage 0.1451 set_scale 28 28 translate 0 rotate 0.000 0.000 1.000 graphcolor 0.000 0.000 1.000 graphcolor newpath -41 -41 moveto -41 1089 lineto 3762 1089 lineto 3762 -41 lineto closepath fill 0.000 0.000 1.000 graphcolor newpath -41 -41 moveto -41 1089 lineto 3762 1089 lineto 3762 -41 lineto closepath stroke 0.000 0.000 0.000 graphcolor 14.00 /Times-Roman set_font % Mktex gsave 10 dict begin 3447 666 32 18 ellipse_path stroke gsave 10 dict begin 3428 661 moveto (Mktex) [12.48 6.96 3.84 6.24 6.96] xshow end grestore end grestore % Common gsave 10 dict begin 1496 90 39 18 ellipse_path stroke gsave 10 dict begin 1470 85 moveto (Common) [9.36 6.96 10.8 10.8 6.96 6.96] xshow end grestore end grestore % Mktex->Common newpath 3428 651 moveto 3367 603 3166 451 2981 360 curveto 2937 338 2912 358 2878 324 curveto 2841 288 2868 257 2840 216 curveto 2812 175 2801 162 2756 144 curveto 2642 99 1764 91 1545 90 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 87 moveto 1535 90 lineto 1545 94 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 87 moveto 1535 90 lineto 1545 94 lineto closepath stroke end grestore % Config gsave 10 dict begin 3159 594 32 18 ellipse_path stroke gsave 10 dict begin 3139 589 moveto (Config) [9.36 6.96 6.96 4.56 3.84 6.96] xshow end grestore end grestore % Mktex->Config newpath 3423 654 moveto 3418 652 3412 649 3406 648 curveto 3319 621 3292 636 3205 612 curveto 3201 611 3198 610 3194 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3196 606 moveto 3185 605 lineto 3193 612 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3196 606 moveto 3185 605 lineto 3193 612 lineto closepath stroke end grestore % Commonop gsave 10 dict begin 1446 18 46 18 ellipse_path stroke gsave 10 dict begin 1413 13 moveto (Commonop) [9.36 6.96 10.8 10.8 6.96 6.96 6.96 6.96] xshow end grestore end grestore % Common->Commonop newpath 1484 73 moveto 1478 64 1470 53 1464 43 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1467 41 moveto 1458 35 lineto 1461 45 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1467 41 moveto 1458 35 lineto 1461 45 lineto closepath stroke end grestore % Dumper gsave 10 dict begin 1546 18 36 18 ellipse_path stroke gsave 10 dict begin 1522 13 moveto (Dumper) [10.08 6.96 10.8 6.96 6.24 4.56] xshow end grestore end grestore % Common->Dumper newpath 1508 73 moveto 1514 64 1522 53 1528 43 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1531 45 moveto 1534 35 lineto 1525 41 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1531 45 moveto 1534 35 lineto 1525 41 lineto closepath stroke end grestore % Init gsave 10 dict begin 3298 666 27 18 ellipse_path stroke gsave 10 dict begin 3288 661 moveto (Init) [4.56 6.96 3.84 3.84] xshow end grestore end grestore % Init->Config newpath 3277 655 moveto 3255 643 3218 625 3192 611 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3193 608 moveto 3183 606 lineto 3190 614 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3193 608 moveto 3183 606 lineto 3190 614 lineto closepath stroke end grestore % Diff gsave 10 dict begin 3370 666 27 18 ellipse_path stroke gsave 10 dict begin 3357 661 moveto (Diff) [10.08 3.84 4.56 4.56] xshow end grestore end grestore % Diff->Config newpath 3349 654 moveto 3344 652 3339 650 3334 648 curveto 3278 626 3261 630 3205 612 curveto 3202 611 3198 610 3195 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3196 605 moveto 3185 605 lineto 3193 612 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3196 605 moveto 3185 605 lineto 3193 612 lineto closepath stroke end grestore % Ce gsave 10 dict begin 3154 666 27 18 ellipse_path stroke gsave 10 dict begin 3146 661 moveto (Ce) [9.36 6.24] xshow end grestore end grestore % Ce->Config newpath 3155 648 moveto 3156 640 3156 631 3157 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3160 622 moveto 3158 612 lineto 3154 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3160 622 moveto 3158 612 lineto 3154 622 lineto closepath stroke end grestore % Ast0 gsave 10 dict begin 3226 666 27 18 ellipse_path stroke gsave 10 dict begin 3212 661 moveto (Ast0) [10.08 5.52 3.84 6.96] xshow end grestore end grestore % Ast0->Config newpath 3211 650 moveto 3202 640 3191 628 3181 617 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3184 615 moveto 3174 610 lineto 3179 620 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3184 615 moveto 3174 610 lineto 3179 620 lineto closepath stroke end grestore % Generate_dependencies gsave 10 dict begin 2760 738 79 18 ellipse_path stroke gsave 10 dict begin 2693 733 moveto (Generate_dependencies) [10.08 6.24 6.96 6.24 4.56 6.24 3.84 6.24 6.96 6.96 6.24 6.96 6.24 6.96 6.96 6.24 6.96 6.24 3.84 6.24 5.52] xshow end grestore end grestore % C_info gsave 10 dict begin 2852 666 32 18 ellipse_path stroke gsave 10 dict begin 2832 661 moveto (C_info) [9.36 6.96 3.84 6.96 4.56 6.96] xshow end grestore end grestore % Generate_dependencies->C_info newpath 2782 721 moveto 2794 710 2811 697 2825 687 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2827 690 moveto 2833 681 lineto 2823 684 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2827 690 moveto 2833 681 lineto 2823 684 lineto closepath stroke end grestore % Parse_c gsave 10 dict begin 2937 666 35 18 ellipse_path stroke gsave 10 dict begin 2915 661 moveto (Parse_c) [7.68 6.24 4.56 5.52 6.24 6.96 6.24] xshow end grestore end grestore % Generate_dependencies->Parse_c newpath 2799 722 moveto 2825 711 2861 697 2893 684 curveto 2895 683 2897 682 2900 681 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2901 684 moveto 2909 677 lineto 2898 678 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2901 684 moveto 2909 677 lineto 2898 678 lineto closepath stroke end grestore % Visitor_c gsave 10 dict begin 2986 522 39 18 ellipse_path stroke gsave 10 dict begin 2959 517 moveto (Visitor_c) [10.08 3.84 5.52 3.84 3.84 6.96 4.56 6.96 6.24] xshow end grestore end grestore % C_info->Visitor_c newpath 2867 650 moveto 2891 625 2936 576 2963 546 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2965 549 moveto 2970 539 lineto 2960 544 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2965 549 moveto 2970 539 lineto 2960 544 lineto closepath stroke end grestore % Flag gsave 10 dict begin 1829 594 27 18 ellipse_path stroke gsave 10 dict begin 1816 589 moveto (Flag) [7.68 3.84 6.24 6.96] xshow end grestore end grestore % C_info->Flag newpath 2828 654 moveto 2823 651 2817 649 2811 648 curveto 2764 636 2040 603 1866 595 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1866 592 moveto 1856 595 lineto 1866 599 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1866 592 moveto 1856 595 lineto 1866 599 lineto closepath stroke end grestore % Parse_c->Config newpath 2967 656 moveto 3007 643 3078 621 3121 606 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3122 609 moveto 3131 603 lineto 3120 603 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3122 609 moveto 3131 603 lineto 3120 603 lineto closepath stroke end grestore % Parse_c->Visitor_c newpath 2939 648 moveto 2941 629 2947 600 2956 576 curveto 2960 566 2965 557 2969 548 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2972 549 moveto 2974 539 lineto 2966 546 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2972 549 moveto 2974 539 lineto 2966 546 lineto closepath stroke end grestore % Lexer_c gsave 10 dict begin 2765 522 36 18 ellipse_path stroke gsave 10 dict begin 2742 517 moveto (Lexer_c) [8.64 6.24 6.96 6.24 4.56 6.96 6.24] xshow end grestore end grestore % Parse_c->Lexer_c newpath 2910 654 moveto 2905 652 2899 650 2893 648 curveto 2833 628 2794 661 2756 612 curveto 2742 594 2746 568 2753 549 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2756 551 moveto 2757 540 lineto 2750 548 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2756 551 moveto 2757 540 lineto 2750 548 lineto closepath stroke end grestore % Parsing_hacks gsave 10 dict begin 2818 594 53 18 ellipse_path stroke gsave 10 dict begin 2777 589 moveto (Parsing_hacks) [7.68 6.24 4.56 5.52 3.84 6.96 6.96 6.96 6.96 6.24 6.24 6.96 5.52] xshow end grestore end grestore % Parse_c->Parsing_hacks newpath 2914 652 moveto 2897 642 2873 627 2853 615 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2854 612 moveto 2844 610 lineto 2851 618 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2854 612 moveto 2844 610 lineto 2851 618 lineto closepath stroke end grestore % Split_patch gsave 10 dict begin 414 234 45 18 ellipse_path stroke gsave 10 dict begin 382 229 moveto (Split_patch) [7.68 6.96 3.84 3.84 3.84 6.96 6.96 6.24 3.84 6.24 6.96] xshow end grestore end grestore % Classic_patch gsave 10 dict begin 473 162 52 18 ellipse_path stroke gsave 10 dict begin 434 157 moveto (Classic_patch) [9.36 3.84 6.24 5.52 5.52 3.84 6.24 6.96 6.96 6.24 3.84 6.24 6.96] xshow end grestore end grestore % Split_patch->Classic_patch newpath 428 217 moveto 435 208 444 197 452 187 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 455 189 moveto 459 179 lineto 450 184 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 455 189 moveto 459 179 lineto 450 184 lineto closepath stroke end grestore % Maintainers gsave 10 dict begin 356 162 47 18 ellipse_path stroke gsave 10 dict begin 322 157 moveto (Maintainers) [12.48 6.24 3.84 6.96 3.84 6.24 3.84 6.96 6.24 4.56 5.52] xshow end grestore end grestore % Split_patch->Maintainers newpath 400 217 moveto 393 208 384 197 376 187 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 379 185 moveto 370 179 lineto 373 189 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 379 185 moveto 370 179 lineto 373 189 lineto closepath stroke end grestore % Classic_patch->Common newpath 511 150 moveto 520 147 530 145 539 144 curveto 716 115 1276 97 1447 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath stroke end grestore % Maintainers->Common newpath 390 149 moveto 397 147 405 145 412 144 curveto 614 107 1263 94 1447 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath stroke end grestore % Extract_c_and_res gsave 10 dict begin 3388 162 65 18 ellipse_path stroke gsave 10 dict begin 3335 157 moveto (Extract_c_and_res) [8.64 6.96 3.84 4.56 6.24 6.24 3.84 6.96 6.24 6.96 6.24 6.96 6.96 6.96 4.56 6.24 5.52] xshow end grestore end grestore % Extract_c_and_res->Common newpath 3342 149 moveto 3333 147 3323 145 3314 144 curveto 3134 119 1818 96 1545 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath stroke end grestore % Meta_files gsave 10 dict begin 114 234 43 18 ellipse_path stroke gsave 10 dict begin 83 229 moveto (Meta_files) [12.48 6.24 3.84 6.24 6.96 4.56 3.84 3.84 6.24 5.52] xshow end grestore end grestore % Meta_files->Maintainers newpath 150 224 moveto 187 213 248 196 300 180 curveto 303 179 307 178 310 177 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 311 180 moveto 320 174 lineto 309 174 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 311 180 moveto 320 174 lineto 309 174 lineto closepath stroke end grestore % Kbuild gsave 10 dict begin 114 162 32 18 ellipse_path stroke gsave 10 dict begin 94 157 moveto (Kbuild) [10.08 6.96 6.96 3.84 3.84 6.96] xshow end grestore end grestore % Meta_files->Kbuild newpath 114 216 moveto 114 208 114 199 114 190 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 118 190 moveto 114 180 lineto 111 190 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 118 190 moveto 114 180 lineto 111 190 lineto closepath stroke end grestore % Kbuild->Common newpath 141 152 moveto 150 149 161 146 171 144 curveto 423 100 1238 91 1447 90 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath stroke end grestore % S gsave 10 dict begin 1229 738 27 18 ellipse_path stroke gsave 10 dict begin 1229 733 moveto 8.0 -0.5 (S) alignedtext end grestore end grestore % Plus gsave 10 dict begin 1229 666 27 18 ellipse_path stroke gsave 10 dict begin 1216 661 moveto (Plus) [7.68 3.84 6.96 5.52] xshow end grestore end grestore % S->Plus newpath 1229 720 moveto 1229 712 1229 703 1229 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1233 694 moveto 1229 684 lineto 1226 694 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1233 694 moveto 1229 684 lineto 1226 694 lineto closepath stroke end grestore % Visitor_ast gsave 10 dict begin 1327 594 44 18 ellipse_path stroke gsave 10 dict begin 1295 589 moveto (Visitor_ast) [10.08 3.84 5.52 3.84 3.84 6.96 4.56 6.96 6.24 5.52 3.84] xshow end grestore end grestore % Plus->Visitor_ast newpath 1247 652 moveto 1261 642 1281 628 1298 616 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1300 619 moveto 1306 610 lineto 1296 613 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1300 619 moveto 1306 610 lineto 1296 613 lineto closepath stroke end grestore % Parse_aux gsave 10 dict begin 1241 522 42 18 ellipse_path stroke gsave 10 dict begin 1212 517 moveto (Parse_aux) [7.68 6.24 4.56 5.52 6.24 6.96 6.24 6.96 6.96] xshow end grestore end grestore % Parse_aux->Common newpath 1272 509 moveto 1290 500 1312 487 1325 468 curveto 1348 434 1344 418 1344 378 curveto 1344 378 1344 378 1344 234 curveto 1344 190 1350 175 1380 144 curveto 1399 123 1428 110 1451 101 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1452 104 moveto 1461 98 lineto 1450 98 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1452 104 moveto 1461 98 lineto 1450 98 lineto closepath stroke end grestore % Data gsave 10 dict begin 1157 450 27 18 ellipse_path stroke gsave 10 dict begin 1143 445 moveto (Data) [10.08 6.24 3.84 6.24] xshow end grestore end grestore % Parse_aux->Data newpath 1222 506 moveto 1210 495 1194 482 1182 471 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1184 468 moveto 1174 464 lineto 1179 473 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1184 468 moveto 1174 464 lineto 1179 473 lineto closepath stroke end grestore % Semantic_cocci gsave 10 dict begin 1259 450 57 18 ellipse_path stroke gsave 10 dict begin 1214 445 moveto (Semantic_cocci) [7.68 6.24 10.8 6.24 6.96 3.84 3.84 6.24 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Parse_aux->Semantic_cocci newpath 1246 504 moveto 1248 496 1250 487 1252 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1255 479 moveto 1255 468 lineto 1249 477 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1255 479 moveto 1255 468 lineto 1249 477 lineto closepath stroke end grestore % Ast0_cocci gsave 10 dict begin 1026 378 45 18 ellipse_path stroke gsave 10 dict begin 993 373 moveto (Ast0_cocci) [10.08 5.52 3.84 6.96 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Data->Ast0_cocci newpath 1136 438 moveto 1116 427 1086 410 1062 398 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1063 395 moveto 1053 393 lineto 1060 401 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1063 395 moveto 1053 393 lineto 1060 401 lineto closepath stroke end grestore % Lexer_cocci gsave 10 dict begin 786 666 48 18 ellipse_path stroke gsave 10 dict begin 751 661 moveto (Lexer_cocci) [8.64 6.24 6.96 6.24 4.56 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Parser_cocci_menhir gsave 10 dict begin 1155 594 72 18 ellipse_path stroke gsave 10 dict begin 1096 589 moveto (Parser_cocci_menhir) [7.68 6.24 4.56 5.52 6.24 4.56 6.96 6.24 6.96 6.24 6.24 3.84 6.96 10.8 6.24 6.96 6.96 3.84 4.56] xshow end grestore end grestore % Lexer_cocci->Parser_cocci_menhir newpath 823 654 moveto 831 652 840 650 848 648 curveto 927 629 1019 614 1082 604 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1082 607 moveto 1092 603 lineto 1082 601 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1082 607 moveto 1092 603 lineto 1082 601 lineto closepath stroke end grestore % Parser_cocci_menhir->Parse_aux newpath 1176 577 moveto 1187 567 1202 555 1214 545 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1216 548 moveto 1221 538 lineto 1211 543 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1216 548 moveto 1221 538 lineto 1211 543 lineto closepath stroke end grestore % Top_level gsave 10 dict begin 1140 522 41 18 ellipse_path stroke gsave 10 dict begin 1111 517 moveto (Top_level) [8.64 6.96 6.96 6.96 3.84 6.24 6.96 6.24 3.84] xshow end grestore end grestore % Parser_cocci_menhir->Top_level newpath 1151 576 moveto 1150 568 1148 559 1146 550 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1149 549 moveto 1144 540 lineto 1143 550 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1149 549 moveto 1144 540 lineto 1143 550 lineto closepath stroke end grestore % Semantic gsave 10 dict begin 252 162 39 18 ellipse_path stroke gsave 10 dict begin 226 157 moveto (Semantic) [7.68 6.24 10.8 6.24 6.96 3.84 3.84 6.24] xshow end grestore end grestore % Semantic->Common newpath 280 149 moveto 287 147 293 145 300 144 curveto 524 98 1251 91 1447 90 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath stroke end grestore % Semantic_c gsave 10 dict begin 2785 234 46 18 ellipse_path stroke gsave 10 dict begin 2752 229 moveto (Semantic_c) [7.68 6.24 10.8 6.24 6.96 3.84 3.84 6.24 6.96 6.24] xshow end grestore end grestore % Semantic_c->Common newpath 2779 216 moveto 2770 194 2752 159 2725 144 curveto 2673 114 1767 96 1545 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath stroke end grestore % Lib_parsing_c gsave 10 dict begin 3018 594 53 18 ellipse_path stroke gsave 10 dict begin 2977 589 moveto (Lib_parsing_c) [8.64 3.84 6.96 6.96 6.96 6.24 4.56 5.52 3.84 6.96 6.96 6.96 6.24] xshow end grestore end grestore % Lib_parsing_c->Visitor_c newpath 3010 576 moveto 3006 568 3002 558 2998 549 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3001 548 moveto 2994 540 lineto 2995 551 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3001 548 moveto 2994 540 lineto 2995 551 lineto closepath stroke end grestore % Control_flow_c gsave 10 dict begin 2472 450 57 18 ellipse_path stroke gsave 10 dict begin 2427 445 moveto (Control_flow_c) [9.36 6.96 6.96 3.84 4.56 6.96 3.84 6.96 4.56 3.84 6.96 10.08 6.96 6.24] xshow end grestore end grestore % Visitor_c->Control_flow_c newpath 2957 510 moveto 2951 508 2944 505 2938 504 curveto 2778 466 2733 490 2572 468 curveto 2558 466 2544 463 2531 461 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2531 458 moveto 2521 459 lineto 2530 464 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2531 458 moveto 2521 459 lineto 2530 464 lineto closepath stroke end grestore % Ast_c gsave 10 dict begin 2326 378 30 18 ellipse_path stroke gsave 10 dict begin 2309 373 moveto (Ast_c) [10.08 5.52 3.84 6.96 6.24] xshow end grestore end grestore % Ast_c->Common newpath 2300 369 moveto 2180 327 1684 155 1537 104 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1538 101 moveto 1527 101 lineto 1536 107 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1538 101 moveto 1527 101 lineto 1536 107 lineto closepath stroke end grestore % Ast_cocci gsave 10 dict begin 1576 306 42 18 ellipse_path stroke gsave 10 dict begin 1547 301 moveto (Ast_cocci) [10.08 5.52 3.84 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Ast_c->Ast_cocci newpath 2296 375 moveto 2183 364 1773 325 1627 311 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1627 308 moveto 1617 310 lineto 1627 314 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1627 308 moveto 1617 310 lineto 1627 314 lineto closepath stroke end grestore % Type_cocci gsave 10 dict begin 1576 234 46 18 ellipse_path stroke gsave 10 dict begin 1543 229 moveto (Type_cocci) [8.64 6.96 6.96 6.24 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Ast_cocci->Type_cocci newpath 1576 288 moveto 1576 280 1576 271 1576 262 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1580 262 moveto 1576 252 lineto 1573 262 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1580 262 moveto 1576 252 lineto 1573 262 lineto closepath stroke end grestore % Parser_c gsave 10 dict begin 2765 450 37 18 ellipse_path stroke gsave 10 dict begin 2740 445 moveto (Parser_c) [7.68 6.24 4.56 5.52 6.24 4.56 6.96 6.24] xshow end grestore end grestore % Lexer_c->Parser_c newpath 2765 504 moveto 2765 496 2765 487 2765 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2769 478 moveto 2765 468 lineto 2762 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2769 478 moveto 2765 468 lineto 2762 478 lineto closepath stroke end grestore % Parser_c->Semantic_c newpath 2773 432 moveto 2778 422 2783 409 2785 396 curveto 2793 349 2791 294 2788 262 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2791 262 moveto 2787 252 lineto 2785 262 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2791 262 moveto 2787 252 lineto 2785 262 lineto closepath stroke end grestore % Parser_c->Ast_c newpath 2731 442 moveto 2715 439 2695 435 2678 432 curveto 2543 410 2505 428 2373 396 curveto 2369 395 2365 393 2361 392 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2362 389 moveto 2351 389 lineto 2360 395 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2362 389 moveto 2351 389 lineto 2360 395 lineto closepath stroke end grestore % Lexer_parser gsave 10 dict begin 2726 378 50 18 ellipse_path stroke gsave 10 dict begin 2689 373 moveto (Lexer_parser) [8.64 6.24 6.96 6.24 4.56 6.96 6.96 6.24 4.56 5.52 6.24 4.56] xshow end grestore end grestore % Parser_c->Lexer_parser newpath 2756 433 moveto 2752 424 2746 414 2741 405 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2744 403 moveto 2736 396 lineto 2738 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2744 403 moveto 2736 396 lineto 2738 406 lineto closepath stroke end grestore % Sgrep gsave 10 dict begin 1775 378 29 18 ellipse_path stroke gsave 10 dict begin 1758 373 moveto (Sgrep) [7.68 6.96 4.56 6.24 6.96] xshow end grestore end grestore % Sgrep->Common newpath 1766 361 moveto 1743 319 1679 210 1601 144 curveto 1581 128 1556 115 1535 105 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1537 102 moveto 1526 101 lineto 1534 108 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1537 102 moveto 1526 101 lineto 1534 108 lineto closepath stroke end grestore % Sgrep->Ast_cocci newpath 1753 366 moveto 1747 364 1742 362 1737 360 curveto 1698 344 1653 329 1621 319 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1622 316 moveto 1611 316 lineto 1620 322 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1622 316 moveto 1611 316 lineto 1620 322 lineto closepath stroke end grestore % Lib_engine gsave 10 dict begin 2298 594 45 18 ellipse_path stroke gsave 10 dict begin 2266 589 moveto (Lib_engine) [8.64 3.84 6.96 6.96 6.24 6.96 6.96 3.84 6.96 6.24] xshow end grestore end grestore % Lib_engine->Control_flow_c newpath 2308 576 moveto 2319 556 2340 525 2365 504 curveto 2382 488 2405 477 2425 468 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2426 471 moveto 2434 464 lineto 2423 465 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2426 471 moveto 2434 464 lineto 2423 465 lineto closepath stroke end grestore % Wrapper_ctl gsave 10 dict begin 2625 522 48 18 ellipse_path stroke gsave 10 dict begin 2589 517 moveto (Wrapper_ctl) [13.2 4.56 6.24 6.96 6.96 6.24 4.56 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Lib_engine->Wrapper_ctl newpath 2332 582 moveto 2338 580 2345 578 2352 576 curveto 2446 552 2473 562 2568 540 curveto 2572 539 2575 538 2579 537 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2580 540 moveto 2589 534 lineto 2578 534 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2580 540 moveto 2589 534 lineto 2578 534 lineto closepath stroke end grestore % Control_flow_c->Ast_c newpath 2441 435 moveto 2416 423 2383 406 2358 394 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2360 391 moveto 2349 390 lineto 2357 397 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2360 391 moveto 2349 390 lineto 2357 397 lineto closepath stroke end grestore % Flag_parsing_c gsave 10 dict begin 2627 306 56 18 ellipse_path stroke gsave 10 dict begin 2583 301 moveto (Flag_parsing_c) [7.68 3.84 6.24 6.96 6.96 6.96 6.24 4.56 5.52 3.84 6.96 6.96 6.96 6.24] xshow end grestore end grestore % Control_flow_c->Flag_parsing_c newpath 2490 433 moveto 2518 407 2570 359 2601 330 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2604 332 moveto 2609 323 lineto 2599 327 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2604 332 moveto 2609 323 lineto 2599 327 lineto closepath stroke end grestore % Ograph_extended gsave 10 dict begin 2909 378 63 18 ellipse_path stroke gsave 10 dict begin 2859 373 moveto (Ograph_extended) [10.08 6.96 4.56 6.24 6.96 6.96 6.96 6.24 6.96 3.84 6.24 6.96 6.96 6.24 6.96] xshow end grestore end grestore % Control_flow_c->Ograph_extended newpath 2521 441 moveto 2537 438 2555 435 2572 432 curveto 2666 416 2775 399 2843 388 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2844 391 moveto 2853 386 lineto 2843 385 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2844 391 moveto 2853 386 lineto 2843 385 lineto closepath stroke end grestore % Ctl_engine gsave 10 dict begin 2625 450 44 18 ellipse_path stroke gsave 10 dict begin 2594 445 moveto (Ctl_engine) [9.36 3.84 3.84 6.96 6.24 6.96 6.96 3.84 6.96 6.24] xshow end grestore end grestore % Wrapper_ctl->Ctl_engine newpath 2625 504 moveto 2625 496 2625 487 2625 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2629 478 moveto 2625 468 lineto 2622 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2629 478 moveto 2625 468 lineto 2622 478 lineto closepath stroke end grestore % Isomorphisms_c_c gsave 10 dict begin 2232 450 66 18 ellipse_path stroke gsave 10 dict begin 2179 445 moveto (Isomorphisms_c_c) [4.56 5.52 6.96 10.8 6.96 4.56 6.96 6.96 3.84 5.52 10.8 5.52 6.96 6.24 6.96 6.24] xshow end grestore end grestore % Isomorphisms_c_c->Ast_c newpath 2254 433 moveto 2267 423 2285 409 2299 398 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2301 401 moveto 2307 392 lineto 2297 395 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2301 401 moveto 2307 392 lineto 2297 395 lineto closepath stroke end grestore % Check_exhaustive_pattern gsave 10 dict begin 2472 522 87 18 ellipse_path stroke gsave 10 dict begin 2397 517 moveto (Check_exhaustive_pattern) [9.36 6.96 6.24 6.24 6.96 6.96 6.24 6.96 6.96 6.24 6.96 5.52 3.84 3.84 6.96 6.24 6.96 6.96 6.24 3.84 3.84 6.24 4.56 6.96] xshow end grestore end grestore % Check_exhaustive_pattern->Control_flow_c newpath 2472 504 moveto 2472 496 2472 487 2472 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2476 478 moveto 2472 468 lineto 2469 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2476 478 moveto 2472 468 lineto 2469 478 lineto closepath stroke end grestore % Test_ctl gsave 10 dict begin 2673 594 36 18 ellipse_path stroke gsave 10 dict begin 2650 589 moveto (Test_ctl) [8.64 6.24 5.52 3.84 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Test_ctl->Wrapper_ctl newpath 2661 577 moveto 2656 568 2649 557 2642 548 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2645 546 moveto 2637 539 lineto 2639 549 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2645 546 moveto 2637 539 lineto 2639 549 lineto closepath stroke end grestore % Oseth gsave 10 dict begin 3606 306 29 18 ellipse_path stroke gsave 10 dict begin 3589 301 moveto (Oseth) [10.08 5.52 6.24 3.84 6.96] xshow end grestore end grestore % Oset gsave 10 dict begin 3492 234 27 18 ellipse_path stroke gsave 10 dict begin 3479 229 moveto (Oset) [10.08 5.52 6.24 3.84] xshow end grestore end grestore % Oseth->Oset newpath 3586 293 moveto 3568 282 3541 264 3521 251 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3522 248 moveto 3512 246 lineto 3519 254 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3522 248 moveto 3512 246 lineto 3519 254 lineto closepath stroke end grestore % Ocollection gsave 10 dict begin 3113 162 46 18 ellipse_path stroke gsave 10 dict begin 3080 157 moveto (Ocollection) [10.08 6.24 6.96 3.84 3.84 6.24 6.24 3.84 3.84 6.96 6.96] xshow end grestore end grestore % Oset->Ocollection newpath 3465 231 moveto 3409 224 3276 206 3168 180 curveto 3165 179 3161 178 3158 177 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3159 174 moveto 3148 174 lineto 3157 180 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3159 174 moveto 3148 174 lineto 3157 180 lineto closepath stroke end grestore % Seti gsave 10 dict begin 3204 162 27 18 ellipse_path stroke gsave 10 dict begin 3193 157 moveto (Seti) [7.68 6.24 3.84 3.84] xshow end grestore end grestore % Oset->Seti newpath 3465 230 moveto 3419 224 3320 207 3240 180 curveto 3238 179 3236 179 3234 178 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3236 175 moveto 3225 174 lineto 3233 181 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3236 175 moveto 3225 174 lineto 3233 181 lineto closepath stroke end grestore % SetPt gsave 10 dict begin 3277 162 28 18 ellipse_path stroke gsave 10 dict begin 3262 157 moveto (SetPt) [7.68 6.24 3.84 7.68 3.84] xshow end grestore end grestore % Oset->SetPt newpath 3467 228 moveto 3432 219 3367 201 3314 180 curveto 3312 179 3310 179 3308 178 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3309 175 moveto 3299 173 lineto 3306 181 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3309 175 moveto 3299 173 lineto 3306 181 lineto closepath stroke end grestore % Setb gsave 10 dict begin 3498 162 27 18 ellipse_path stroke gsave 10 dict begin 3485 157 moveto (Setb) [7.68 6.24 3.84 6.96] xshow end grestore end grestore % Oset->Setb newpath 3494 216 moveto 3495 208 3495 199 3496 190 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3500 190 moveto 3496 180 lineto 3493 190 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3500 190 moveto 3496 180 lineto 3493 190 lineto closepath stroke end grestore % Ocollection->Common newpath 3068 158 moveto 3019 154 2940 148 2873 144 curveto 2353 115 1724 96 1545 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath stroke end grestore % Oassocid gsave 10 dict begin 3234 306 39 18 ellipse_path stroke gsave 10 dict begin 3208 301 moveto (Oassocid) [10.08 6.24 5.52 5.52 6.96 6.24 3.84 6.96] xshow end grestore end grestore % Oassoc gsave 10 dict begin 3126 234 33 18 ellipse_path stroke gsave 10 dict begin 3105 229 moveto (Oassoc) [10.08 6.24 5.52 5.52 6.96 6.24] xshow end grestore end grestore % Oassocid->Oassoc newpath 3212 291 moveto 3196 280 3173 266 3155 254 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3157 251 moveto 3147 248 lineto 3153 257 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3157 251 moveto 3147 248 lineto 3153 257 lineto closepath stroke end grestore % Oassoc->Ocollection newpath 3123 216 moveto 3122 208 3120 199 3118 190 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3121 189 moveto 3116 180 lineto 3115 190 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3121 189 moveto 3116 180 lineto 3115 190 lineto closepath stroke end grestore % Oassoch gsave 10 dict begin 3328 306 37 18 ellipse_path stroke gsave 10 dict begin 3304 301 moveto (Oassoch) [10.08 6.24 5.52 5.52 6.96 6.24 6.96] xshow end grestore end grestore % Oassoch->Oassoc newpath 3299 294 moveto 3293 292 3287 290 3282 288 curveto 3242 273 3196 257 3165 246 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3166 243 moveto 3155 243 lineto 3164 249 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3166 243 moveto 3155 243 lineto 3164 249 lineto closepath stroke end grestore % Oassocdbm gsave 10 dict begin 3025 306 46 18 ellipse_path stroke gsave 10 dict begin 2992 301 moveto (Oassocdbm) [10.08 6.24 5.52 5.52 6.96 6.24 6.96 6.96 10.8] xshow end grestore end grestore % Oassocdbm->Oassoc newpath 3047 290 moveto 3062 280 3082 266 3098 255 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3100 258 moveto 3106 249 lineto 3096 252 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3100 258 moveto 3106 249 lineto 3096 252 lineto closepath stroke end grestore % Oassocb gsave 10 dict begin 2924 306 37 18 ellipse_path stroke gsave 10 dict begin 2900 301 moveto (Oassocb) [10.08 6.24 5.52 5.52 6.96 6.24 6.96] xshow end grestore end grestore % Oassocb->Oassoc newpath 2952 294 moveto 2958 292 2964 290 2970 288 curveto 3010 273 3056 257 3087 246 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3088 249 moveto 3097 243 lineto 3086 243 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3088 249 moveto 3097 243 lineto 3086 243 lineto closepath stroke end grestore % Mapb gsave 10 dict begin 2924 234 30 18 ellipse_path stroke gsave 10 dict begin 2907 229 moveto (Mapb) [12.48 6.24 6.96 6.96] xshow end grestore end grestore % Oassocb->Mapb newpath 2924 288 moveto 2924 280 2924 271 2924 262 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2928 262 moveto 2924 252 lineto 2921 262 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2928 262 moveto 2924 252 lineto 2921 262 lineto closepath stroke end grestore % Oassoc_buffer gsave 10 dict begin 3314 378 54 18 ellipse_path stroke gsave 10 dict begin 3273 373 moveto (Oassoc_buffer) [10.08 6.24 5.52 5.52 6.96 6.24 6.96 6.96 6.96 4.56 4.56 6.24 4.56] xshow end grestore end grestore % Oassoc_buffer->Oassocb newpath 3267 369 moveto 3250 366 3231 363 3214 360 curveto 3105 342 3075 352 2970 324 curveto 2967 323 2964 322 2962 321 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2963 318 moveto 2952 318 lineto 2961 324 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2963 318 moveto 2952 318 lineto 2961 324 lineto closepath stroke end grestore % Osetb gsave 10 dict begin 3492 306 29 18 ellipse_path stroke gsave 10 dict begin 3475 301 moveto (Osetb) [10.08 5.52 6.24 3.84 6.96] xshow end grestore end grestore % Oassoc_buffer->Osetb newpath 3350 365 moveto 3379 354 3419 339 3454 324 curveto 3456 323 3458 322 3460 321 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3461 324 moveto 3469 317 lineto 3458 318 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3461 324 moveto 3469 317 lineto 3458 318 lineto closepath stroke end grestore % Osetb->Oset newpath 3492 288 moveto 3492 280 3492 271 3492 262 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3496 262 moveto 3492 252 lineto 3489 262 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3496 262 moveto 3492 252 lineto 3489 262 lineto closepath stroke end grestore % Fullcommon gsave 10 dict begin 3435 450 49 18 ellipse_path stroke gsave 10 dict begin 3399 445 moveto (Fullcommon) [7.68 6.96 3.84 3.84 6.24 6.96 10.8 10.8 6.96 6.96] xshow end grestore end grestore % Fullcommon->Oassoch newpath 3425 432 moveto 3413 414 3395 384 3377 360 curveto 3369 350 3360 339 3351 330 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3353 327 moveto 3344 322 lineto 3348 332 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3353 327 moveto 3344 322 lineto 3348 332 lineto closepath stroke end grestore % Fullcommon->Oassoc_buffer newpath 3409 435 moveto 3392 425 3369 411 3350 399 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3351 396 moveto 3341 394 lineto 3348 402 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3351 396 moveto 3341 394 lineto 3348 402 lineto closepath stroke end grestore % Oarray gsave 10 dict begin 3173 378 32 18 ellipse_path stroke gsave 10 dict begin 3153 373 moveto (Oarray) [10.08 6.24 4.56 4.56 6.24 6.96] xshow end grestore end grestore % Fullcommon->Oarray newpath 3395 439 moveto 3346 425 3261 402 3212 389 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3213 386 moveto 3202 386 lineto 3211 392 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3213 386 moveto 3202 386 lineto 3211 392 lineto closepath stroke end grestore % Ograph2way gsave 10 dict begin 3473 378 49 18 ellipse_path stroke gsave 10 dict begin 3436 373 moveto (Ograph2way) [10.08 6.96 4.56 6.24 6.96 6.96 6.96 10.08 6.24 6.96] xshow end grestore end grestore % Fullcommon->Ograph2way newpath 3444 432 moveto 3448 424 3454 414 3459 405 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3462 406 moveto 3464 396 lineto 3456 403 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3462 406 moveto 3464 396 lineto 3456 403 lineto closepath stroke end grestore % Oseti gsave 10 dict begin 3568 378 28 18 ellipse_path stroke gsave 10 dict begin 3553 373 moveto (Oseti) [10.08 5.52 6.24 3.84 3.84] xshow end grestore end grestore % Fullcommon->Oseti newpath 3463 435 moveto 3485 424 3515 407 3537 395 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3539 398 moveto 3546 390 lineto 3536 392 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3539 398 moveto 3546 390 lineto 3536 392 lineto closepath stroke end grestore % Osequence gsave 10 dict begin 3133 306 44 18 ellipse_path stroke gsave 10 dict begin 3102 301 moveto (Osequence) [10.08 5.52 6.24 6.96 6.96 6.24 6.96 6.24 6.24] xshow end grestore end grestore % Oarray->Osequence newpath 3163 361 moveto 3159 352 3153 342 3148 333 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3151 331 moveto 3143 324 lineto 3145 334 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3151 331 moveto 3143 324 lineto 3145 334 lineto closepath stroke end grestore % Ograph2way->Osetb newpath 3478 360 moveto 3480 352 3482 343 3484 334 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3487 335 moveto 3487 324 lineto 3481 333 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3487 335 moveto 3487 324 lineto 3481 333 lineto closepath stroke end grestore % Ograph gsave 10 dict begin 3687 306 34 18 ellipse_path stroke gsave 10 dict begin 3666 301 moveto (Ograph) [10.08 6.96 4.56 6.24 6.96 6.96] xshow end grestore end grestore % Ograph2way->Ograph newpath 3510 366 moveto 3557 352 3631 328 3644 324 curveto 3646 323 3648 322 3651 321 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3652 324 moveto 3660 317 lineto 3649 318 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3652 324 moveto 3660 317 lineto 3649 318 lineto closepath stroke end grestore % Oseti->Oset newpath 3562 360 moveto 3555 342 3543 312 3530 288 curveto 3524 278 3517 268 3511 258 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3514 256 moveto 3505 250 lineto 3508 260 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3514 256 moveto 3505 250 lineto 3508 260 lineto closepath stroke end grestore % Seti->Common newpath 3184 150 moveto 3179 147 3173 145 3168 144 curveto 3006 103 1805 92 1545 90 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 87 moveto 1535 90 lineto 1545 94 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 87 moveto 1535 90 lineto 1545 94 lineto closepath stroke end grestore % Osetpt gsave 10 dict begin 3414 306 31 18 ellipse_path stroke gsave 10 dict begin 3395 301 moveto (Osetpt) [10.08 5.52 6.24 3.84 6.96 3.84] xshow end grestore end grestore % Osetpt->Oset newpath 3431 291 moveto 3442 281 3456 267 3468 256 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3471 258 moveto 3476 249 lineto 3466 253 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3471 258 moveto 3476 249 lineto 3466 253 lineto closepath stroke end grestore % Ograph->Oset newpath 3661 295 moveto 3655 292 3649 290 3644 288 curveto 3604 273 3557 256 3526 245 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3527 242 moveto 3516 242 lineto 3525 248 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3527 242 moveto 3516 242 lineto 3525 248 lineto closepath stroke end grestore % Ast_popl gsave 10 dict begin 534 378 39 18 ellipse_path stroke gsave 10 dict begin 507 373 moveto (Ast_popl) [10.08 5.52 3.84 6.96 6.96 6.96 6.96 3.84] xshow end grestore end grestore % Ast_popl->Ast_cocci newpath 573 375 moveto 732 364 1342 322 1524 310 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1524 313 moveto 1534 309 lineto 1524 307 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1524 313 moveto 1534 309 lineto 1524 307 lineto closepath stroke end grestore % Main gsave 10 dict begin 1667 1026 28 18 ellipse_path stroke gsave 10 dict begin 1651 1021 moveto (Main) [12.48 6.24 3.84 6.96] xshow end grestore end grestore % Main->Kbuild newpath 1639 1025 moveto 1421 1018 10 967 10 882 curveto 10 882 10 882 10 306 curveto 10 254 56 208 86 182 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 88 185 moveto 94 176 lineto 84 179 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 88 185 moveto 94 176 lineto 84 179 lineto closepath stroke end grestore % Main->Fullcommon newpath 1695 1025 moveto 1927 1020 3507 977 3507 882 curveto 3507 882 3507 882 3507 594 curveto 3507 548 3477 502 3456 475 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3459 473 moveto 3450 467 lineto 3453 477 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3459 473 moveto 3450 467 lineto 3453 477 lineto closepath stroke end grestore % Asttoctl gsave 10 dict begin 1514 738 36 18 ellipse_path stroke gsave 10 dict begin 1491 733 moveto (Asttoctl) [10.08 5.52 3.84 3.84 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Main->Asttoctl newpath 1658 1009 moveto 1632 961 1559 823 1528 764 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1531 762 moveto 1523 755 lineto 1525 765 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1531 762 moveto 1523 755 lineto 1525 765 lineto closepath stroke end grestore % Testing gsave 10 dict begin 1821 954 34 18 ellipse_path stroke gsave 10 dict begin 1799 949 moveto (Testing) [8.64 6.24 5.52 3.84 3.84 6.96 6.96] xshow end grestore end grestore % Main->Testing newpath 1690 1015 moveto 1715 1003 1756 984 1786 970 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1787 973 moveto 1795 966 lineto 1784 967 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1787 973 moveto 1795 966 lineto 1784 967 lineto closepath stroke end grestore % Unify_ast gsave 10 dict begin 1515 666 41 18 ellipse_path stroke gsave 10 dict begin 1486 661 moveto (Unify_ast) [10.08 6.96 3.84 4.56 6.96 6.96 6.24 5.52 3.84] xshow end grestore end grestore % Asttoctl->Unify_ast newpath 1514 720 moveto 1515 712 1515 703 1515 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1519 694 moveto 1515 684 lineto 1512 694 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1519 694 moveto 1515 684 lineto 1512 694 lineto closepath stroke end grestore % Free_vars gsave 10 dict begin 1025 666 41 18 ellipse_path stroke gsave 10 dict begin 997 661 moveto (Free_vars) [7.68 4.56 6.24 6.24 6.96 6.96 6.24 4.56 5.52] xshow end grestore end grestore % Asttoctl->Free_vars newpath 1478 736 moveto 1402 732 1222 719 1075 684 curveto 1072 683 1069 682 1066 681 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1067 678 moveto 1056 678 lineto 1065 684 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1067 678 moveto 1056 678 lineto 1065 684 lineto closepath stroke end grestore % Pretty_print_engine gsave 10 dict begin 1966 666 68 18 ellipse_path stroke gsave 10 dict begin 1910 661 moveto (Pretty_print_engine) [7.68 4.56 6.24 3.84 3.84 6.96 6.96 6.96 4.56 3.84 6.96 3.84 6.96 6.24 6.96 6.96 3.84 6.96 6.24] xshow end grestore end grestore % Asttoctl->Pretty_print_engine newpath 1548 733 moveto 1622 721 1799 693 1898 677 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1899 680 moveto 1908 675 lineto 1898 674 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1899 680 moveto 1908 675 lineto 1898 674 lineto closepath stroke end grestore % Compare_c gsave 10 dict begin 3036 738 45 18 ellipse_path stroke gsave 10 dict begin 3003 733 moveto (Compare_c) [9.36 6.96 10.8 6.96 6.24 4.56 6.24 6.96 6.24] xshow end grestore end grestore % Testing->Compare_c newpath 1855 952 moveto 1979 944 2419 910 2772 828 curveto 2853 808 2943 774 2995 755 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2996 758 moveto 3004 751 lineto 2993 752 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2996 758 moveto 3004 751 lineto 2993 752 lineto closepath stroke end grestore % Cocci gsave 10 dict begin 1821 882 29 18 ellipse_path stroke gsave 10 dict begin 1804 877 moveto (Cocci) [9.36 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Testing->Cocci newpath 1821 936 moveto 1821 928 1821 919 1821 910 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1825 910 moveto 1821 900 lineto 1818 910 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1825 910 moveto 1821 900 lineto 1818 910 lineto closepath stroke end grestore % Visitor_ast0 gsave 10 dict begin 1026 450 48 18 ellipse_path stroke gsave 10 dict begin 991 445 moveto (Visitor_ast0) [10.08 3.84 5.52 3.84 3.84 6.96 4.56 6.96 6.24 5.52 3.84 6.96] xshow end grestore end grestore % Visitor_ast0->Ast0_cocci newpath 1026 432 moveto 1026 424 1026 415 1026 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1030 406 moveto 1026 396 lineto 1023 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1030 406 moveto 1026 396 lineto 1023 406 lineto closepath stroke end grestore % Ast0_cocci->Ast_cocci newpath 1069 372 moveto 1170 358 1419 326 1526 312 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1526 315 moveto 1536 311 lineto 1526 309 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1526 315 moveto 1536 311 lineto 1526 309 lineto closepath stroke end grestore % Unitary_ast0 gsave 10 dict begin 1134 666 50 18 ellipse_path stroke gsave 10 dict begin 1097 661 moveto (Unitary_ast0) [10.08 6.96 3.84 3.84 6.24 4.56 6.96 6.96 6.24 5.52 3.84 6.96] xshow end grestore end grestore % Unitary_ast0->Visitor_ast0 newpath 1110 650 moveto 1097 641 1082 627 1074 612 curveto 1049 569 1067 550 1052 504 curveto 1049 495 1045 485 1041 477 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1044 475 moveto 1036 468 lineto 1038 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1044 475 moveto 1036 468 lineto 1038 478 lineto closepath stroke end grestore % Unitary_ast0->Flag newpath 1170 654 moveto 1178 651 1186 649 1193 648 curveto 1417 605 1693 596 1792 594 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1792 598 moveto 1802 594 lineto 1792 591 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1792 598 moveto 1802 594 lineto 1792 591 lineto closepath stroke end grestore % Top_level->Ast0_cocci newpath 1131 504 moveto 1120 486 1102 455 1083 432 curveto 1073 421 1063 410 1053 401 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1055 398 moveto 1045 394 lineto 1050 403 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1055 398 moveto 1045 394 lineto 1050 403 lineto closepath stroke end grestore % Single_statement gsave 10 dict begin 367 666 61 18 ellipse_path stroke gsave 10 dict begin 318 661 moveto (Single_statement) [7.68 3.84 6.96 6.96 3.84 6.24 6.96 5.52 3.84 6.24 3.84 6.24 10.8 6.24 6.96 3.84] xshow end grestore end grestore % Iso_pattern gsave 10 dict begin 698 594 44 18 ellipse_path stroke gsave 10 dict begin 666 589 moveto (Iso_pattern) [4.56 5.52 6.96 6.96 6.96 6.24 3.84 3.84 6.24 4.56 6.96] xshow end grestore end grestore % Single_statement->Iso_pattern newpath 412 654 moveto 420 652 429 650 437 648 curveto 510 631 596 614 648 604 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 649 607 moveto 658 602 lineto 648 601 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 649 607 moveto 658 602 lineto 648 601 lineto closepath stroke end grestore % Iso_pattern->Visitor_ast0 newpath 726 580 moveto 745 570 771 555 793 540 curveto 812 525 812 515 834 504 curveto 888 474 909 485 969 468 curveto 972 467 976 466 979 465 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 980 468 moveto 989 462 lineto 978 462 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 980 468 moveto 989 462 lineto 978 462 lineto closepath stroke end grestore % Unparse_ast0 gsave 10 dict begin 908 450 52 18 ellipse_path stroke gsave 10 dict begin 869 445 moveto (Unparse_ast0) [10.08 6.96 6.96 6.24 4.56 5.52 6.24 6.96 6.24 5.52 3.84 6.96] xshow end grestore end grestore % Iso_pattern->Unparse_ast0 newpath 717 577 moveto 744 553 792 510 801 504 curveto 821 490 845 478 866 468 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 867 471 moveto 875 464 lineto 864 465 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 867 471 moveto 875 464 lineto 864 465 lineto closepath stroke end grestore % Compute_lines gsave 10 dict begin 707 450 55 18 ellipse_path stroke gsave 10 dict begin 664 445 moveto (Compute_lines) [9.36 6.96 10.8 6.96 6.96 3.84 6.24 6.96 3.84 3.84 6.96 6.24 5.52] xshow end grestore end grestore % Iso_pattern->Compute_lines newpath 675 579 moveto 663 569 649 556 642 540 curveto 635 525 635 518 642 504 curveto 648 491 658 480 670 472 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 672 475 moveto 678 466 lineto 668 469 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 672 475 moveto 678 466 lineto 668 469 lineto closepath stroke end grestore % Flag_parsing_cocci gsave 10 dict begin 1774 522 68 18 ellipse_path stroke gsave 10 dict begin 1719 517 moveto (Flag_parsing_cocci) [7.68 3.84 6.24 6.96 6.96 6.96 6.24 4.56 5.52 3.84 6.96 6.96 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Iso_pattern->Flag_parsing_cocci newpath 732 582 moveto 742 580 752 577 762 576 curveto 1064 526 1144 556 1450 540 curveto 1534 535 1632 530 1697 526 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1697 530 moveto 1707 526 lineto 1697 523 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1697 530 moveto 1707 526 lineto 1697 523 lineto closepath stroke end grestore % Visitor_ast->Ast_cocci newpath 1365 585 moveto 1418 570 1511 535 1553 468 curveto 1578 426 1580 369 1579 334 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1582 334 moveto 1578 324 lineto 1576 334 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1582 334 moveto 1578 324 lineto 1576 334 lineto closepath stroke end grestore % Merge gsave 10 dict begin 1011 522 32 18 ellipse_path stroke gsave 10 dict begin 992 517 moveto (Merge) [12.48 6.24 4.56 6.96 6.24] xshow end grestore end grestore % Merge->Visitor_ast0 newpath 1015 504 moveto 1016 496 1018 487 1020 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1023 478 moveto 1022 468 lineto 1017 477 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1023 478 moveto 1022 468 lineto 1017 477 lineto closepath stroke end grestore % Index gsave 10 dict begin 809 450 29 18 ellipse_path stroke gsave 10 dict begin 793 445 moveto (Index) [4.56 6.96 6.96 6.24 6.96] xshow end grestore end grestore % Index->Ast0_cocci newpath 831 438 moveto 836 436 842 434 847 432 curveto 890 416 941 400 978 390 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 979 393 moveto 988 388 lineto 978 387 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 979 393 moveto 988 388 lineto 978 387 lineto closepath stroke end grestore % Function_prototypes gsave 10 dict begin 517 666 71 18 ellipse_path stroke gsave 10 dict begin 459 661 moveto (Function_prototypes) [7.68 6.96 6.96 6.24 3.84 3.84 6.96 6.96 6.96 6.96 4.56 6.96 3.84 6.96 3.84 6.96 6.96 6.24 5.52] xshow end grestore end grestore % Function_prototypes->Iso_pattern newpath 555 651 moveto 586 639 627 623 656 611 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 658 614 moveto 666 607 lineto 655 607 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 658 614 moveto 666 607 lineto 655 607 lineto closepath stroke end grestore % Insert_plus gsave 10 dict begin 815 594 44 18 ellipse_path stroke gsave 10 dict begin 783 589 moveto (Insert_plus) [4.56 6.96 5.52 6.24 4.56 3.84 6.96 6.96 3.84 6.96 5.52] xshow end grestore end grestore % Function_prototypes->Insert_plus newpath 571 654 moveto 618 644 689 627 751 612 curveto 757 610 763 609 769 607 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 770 610 moveto 779 604 lineto 768 604 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 770 610 moveto 779 604 lineto 768 604 lineto closepath stroke end grestore % Ast0toast gsave 10 dict begin 883 522 40 18 ellipse_path stroke gsave 10 dict begin 856 517 moveto (Ast0toast) [10.08 5.52 3.84 6.96 3.84 6.96 6.24 5.52 3.84] xshow end grestore end grestore % Insert_plus->Ast0toast newpath 831 577 moveto 840 568 850 557 860 547 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 863 549 moveto 867 539 lineto 858 544 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 863 549 moveto 867 539 lineto 858 544 lineto closepath stroke end grestore % Insert_plus->Flag_parsing_cocci newpath 851 584 moveto 863 581 876 578 888 576 curveto 927 569 1489 538 1697 527 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1697 530 moveto 1707 526 lineto 1697 524 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1697 530 moveto 1707 526 lineto 1697 524 lineto closepath stroke end grestore % Context_neg gsave 10 dict begin 700 522 49 18 ellipse_path stroke gsave 10 dict begin 664 517 moveto (Context_neg) [9.36 6.96 6.96 3.84 6.24 6.96 3.84 6.96 6.96 6.24 6.96] xshow end grestore end grestore % Insert_plus->Context_neg newpath 791 579 moveto 774 569 752 555 734 544 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 735 541 moveto 725 538 lineto 731 546 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 735 541 moveto 725 538 lineto 731 546 lineto closepath stroke end grestore % Check_meta gsave 10 dict begin 1496 450 48 18 ellipse_path stroke gsave 10 dict begin 1461 445 moveto (Check_meta) [9.36 6.96 6.24 6.24 6.96 6.96 10.8 6.24 3.84 6.24] xshow end grestore end grestore % Check_meta->Common newpath 1496 432 moveto 1496 404 1496 351 1496 306 curveto 1496 306 1496 306 1496 234 curveto 1496 194 1496 147 1496 118 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1500 118 moveto 1496 108 lineto 1493 118 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1500 118 moveto 1496 108 lineto 1493 118 lineto closepath stroke end grestore % Check_meta->Ast0_cocci newpath 1451 443 moveto 1364 430 1172 400 1078 386 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1078 383 moveto 1068 384 lineto 1077 389 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1078 383 moveto 1068 384 lineto 1077 389 lineto closepath stroke end grestore % Ast0toast->Visitor_ast0 newpath 910 508 moveto 932 497 963 481 988 469 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 989 472 moveto 997 465 lineto 986 466 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 989 472 moveto 997 465 lineto 986 466 lineto closepath stroke end grestore % Arity gsave 10 dict begin 317 594 28 18 ellipse_path stroke gsave 10 dict begin 301 589 moveto (Arity) [10.08 4.56 3.84 3.84 6.96] xshow end grestore end grestore % Arity->Ast0_cocci newpath 326 577 moveto 346 542 396 465 463 432 curveto 508 409 838 388 971 381 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 971 384 moveto 981 380 lineto 971 378 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 971 384 moveto 981 380 lineto 971 378 lineto closepath stroke end grestore % Unparse_ast0->Ast0_cocci newpath 934 434 moveto 951 424 974 410 992 398 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 994 401 moveto 1001 393 lineto 991 395 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 994 401 moveto 1001 393 lineto 991 395 lineto closepath stroke end grestore % Pretty_print_cocci gsave 10 dict begin 1664 378 64 18 ellipse_path stroke gsave 10 dict begin 1612 373 moveto (Pretty_print_cocci) [7.68 4.56 6.24 3.84 3.84 6.96 6.96 6.96 4.56 3.84 6.96 3.84 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Unparse_ast0->Pretty_print_cocci newpath 946 437 moveto 953 435 961 433 969 432 curveto 1086 410 1437 390 1591 382 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1591 385 moveto 1601 381 lineto 1591 379 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1591 385 moveto 1601 381 lineto 1591 379 lineto closepath stroke end grestore % Pretty_print_cocci->Common newpath 1664 360 moveto 1662 328 1657 263 1631 216 curveto 1605 171 1559 133 1527 111 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1529 108 moveto 1519 105 lineto 1525 114 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1529 108 moveto 1519 105 lineto 1525 114 lineto closepath stroke end grestore % Pretty_print_cocci->Ast_cocci newpath 1643 361 moveto 1631 351 1616 339 1603 328 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1605 325 moveto 1595 322 lineto 1601 331 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1605 325 moveto 1595 322 lineto 1601 331 lineto closepath stroke end grestore % Unify_ast->Visitor_ast newpath 1484 654 moveto 1453 642 1403 624 1368 610 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1370 607 moveto 1359 606 lineto 1367 613 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1370 607 moveto 1359 606 lineto 1367 613 lineto closepath stroke end grestore % Type_infer gsave 10 dict begin 941 594 44 18 ellipse_path stroke gsave 10 dict begin 909 589 moveto (Type_infer) [8.64 6.96 6.96 6.24 6.96 3.84 6.96 4.56 6.24 4.56] xshow end grestore end grestore % Type_infer->Visitor_ast0 newpath 944 576 moveto 948 557 955 526 970 504 curveto 977 492 987 482 996 473 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 999 475 moveto 1004 466 lineto 994 470 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 999 475 moveto 1004 466 lineto 994 470 lineto closepath stroke end grestore % Parse_cocci gsave 10 dict begin 928 738 46 18 ellipse_path stroke gsave 10 dict begin 894 733 moveto (Parse_cocci) [7.68 6.24 4.56 5.52 6.24 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Parse_cocci->Config newpath 973 734 moveto 1088 725 1381 701 1422 684 curveto 1444 674 1441 656 1465 648 curveto 1633 584 2901 634 3080 612 curveto 3093 610 3107 607 3120 604 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3121 607 moveto 3130 602 lineto 3120 601 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3121 607 moveto 3130 602 lineto 3120 601 lineto closepath stroke end grestore % Parse_cocci->Lexer_cocci newpath 900 724 moveto 878 713 848 697 824 685 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 826 682 moveto 815 681 lineto 823 688 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 826 682 moveto 815 681 lineto 823 688 lineto closepath stroke end grestore % Parse_cocci->Unitary_ast0 newpath 962 726 moveto 997 714 1050 695 1089 682 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1090 685 moveto 1098 679 lineto 1087 679 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1090 685 moveto 1098 679 lineto 1087 679 lineto closepath stroke end grestore % Parse_cocci->Single_statement newpath 883 735 moveto 795 729 599 713 437 684 curveto 432 683 427 682 421 680 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 421 677 moveto 411 678 lineto 420 683 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 421 677 moveto 411 678 lineto 420 683 lineto closepath stroke end grestore % Parse_cocci->Function_prototypes newpath 885 731 moveto 823 722 703 703 602 684 curveto 595 683 589 681 582 680 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 582 677 moveto 572 678 lineto 581 683 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 582 677 moveto 572 678 lineto 581 683 lineto closepath stroke end grestore % Parse_cocci->Check_meta newpath 973 734 moveto 1082 726 1352 702 1389 684 curveto 1408 674 1405 661 1422 648 curveto 1446 628 1466 638 1483 612 curveto 1508 570 1506 513 1501 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1504 478 moveto 1500 468 lineto 1498 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1504 478 moveto 1500 468 lineto 1498 478 lineto closepath stroke end grestore % Parse_cocci->Arity newpath 882 738 moveto 743 736 336 726 297 684 curveto 281 666 289 639 300 620 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 303 621 moveto 305 611 lineto 297 618 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 303 621 moveto 305 611 lineto 297 618 lineto closepath stroke end grestore % Parse_cocci->Type_infer newpath 882 736 moveto 807 732 666 720 635 684 curveto 624 671 624 660 635 648 curveto 669 608 816 622 868 612 curveto 877 610 885 608 894 606 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 895 609 moveto 904 604 lineto 894 603 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 895 609 moveto 904 604 lineto 894 603 lineto closepath stroke end grestore % Disjdistr gsave 10 dict begin 928 666 38 18 ellipse_path stroke gsave 10 dict begin 903 661 moveto (Disjdistr) [10.08 3.84 5.52 3.84 6.96 3.84 5.52 3.84 4.56] xshow end grestore end grestore % Parse_cocci->Disjdistr newpath 928 720 moveto 928 712 928 703 928 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 932 694 moveto 928 684 lineto 925 694 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 932 694 moveto 928 684 lineto 925 694 lineto closepath stroke end grestore % Parse_cocci->Free_vars newpath 950 722 moveto 963 712 981 699 996 688 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 998 691 moveto 1004 682 lineto 994 685 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 998 691 moveto 1004 682 lineto 994 685 lineto closepath stroke end grestore % Get_constants gsave 10 dict begin 1327 666 53 18 ellipse_path stroke gsave 10 dict begin 1287 661 moveto (Get_constants) [10.08 6.24 3.84 6.96 6.24 6.96 6.96 5.52 3.84 6.24 6.96 3.84 5.52] xshow end grestore end grestore % Parse_cocci->Get_constants newpath 972 733 moveto 1037 724 1160 707 1265 684 curveto 1269 683 1273 682 1277 681 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1278 684 moveto 1287 678 lineto 1276 678 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1278 684 moveto 1287 678 lineto 1276 678 lineto closepath stroke end grestore % Simple_assignments gsave 10 dict begin 1371 522 70 18 ellipse_path stroke gsave 10 dict begin 1313 517 moveto (Simple_assignments) [7.68 3.84 10.8 6.96 3.84 6.24 6.96 6.24 5.52 5.52 3.84 6.96 6.96 10.8 6.24 6.96 3.84 5.52] xshow end grestore end grestore % Parse_cocci->Simple_assignments newpath 908 721 moveto 888 702 861 670 881 648 curveto 934 589 1163 645 1236 612 curveto 1257 602 1255 589 1274 576 curveto 1290 563 1310 552 1328 543 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1330 546 moveto 1337 538 lineto 1327 540 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1330 546 moveto 1337 538 lineto 1327 540 lineto closepath stroke end grestore % Disjdistr->Visitor_ast newpath 956 654 moveto 962 652 969 649 975 648 curveto 1102 616 1140 639 1269 612 curveto 1274 611 1279 610 1283 608 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1284 611 moveto 1293 606 lineto 1283 605 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1284 611 moveto 1293 606 lineto 1283 605 lineto closepath stroke end grestore % Free_vars->Common newpath 995 654 moveto 988 652 982 649 975 648 curveto 903 631 698 662 645 612 curveto 620 589 624 448 624 378 curveto 624 378 624 378 624 234 curveto 624 150 1263 104 1447 93 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 96 moveto 1457 92 lineto 1447 90 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 96 moveto 1457 92 lineto 1447 90 lineto closepath stroke end grestore % Free_vars->Visitor_ast newpath 1056 654 moveto 1062 652 1069 650 1075 648 curveto 1159 625 1183 633 1269 612 curveto 1274 611 1278 610 1282 608 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1283 611 moveto 1292 605 lineto 1281 605 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1283 611 moveto 1292 605 lineto 1281 605 lineto closepath stroke end grestore % Get_constants->Common newpath 1352 650 moveto 1381 629 1430 588 1450 540 curveto 1456 525 1452 519 1450 504 curveto 1447 487 1443 484 1439 468 curveto 1428 428 1420 418 1420 378 curveto 1420 378 1420 378 1420 234 curveto 1420 187 1451 141 1473 115 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1476 117 moveto 1480 107 lineto 1471 112 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1476 117 moveto 1480 107 lineto 1471 112 lineto closepath stroke end grestore % Get_constants->Flag newpath 1374 658 moveto 1392 654 1413 651 1432 648 curveto 1564 627 1722 607 1792 598 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1792 601 moveto 1802 597 lineto 1792 595 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1792 601 moveto 1802 597 lineto 1792 595 lineto closepath stroke end grestore % Get_constants->Visitor_ast newpath 1327 648 moveto 1327 640 1327 631 1327 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1331 622 moveto 1327 612 lineto 1324 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1331 622 moveto 1327 612 lineto 1324 622 lineto closepath stroke end grestore % Simple_assignments->Common newpath 1373 504 moveto 1377 476 1382 423 1382 378 curveto 1382 378 1382 378 1382 234 curveto 1382 192 1381 177 1406 144 curveto 1419 127 1438 114 1456 105 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1457 108 moveto 1465 101 lineto 1454 102 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1457 108 moveto 1465 101 lineto 1454 102 lineto closepath stroke end grestore % Simple_assignments->Visitor_ast0 newpath 1319 510 moveto 1310 508 1301 506 1292 504 curveto 1218 488 1133 470 1079 460 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1079 457 moveto 1069 458 lineto 1078 463 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1079 457 moveto 1069 458 lineto 1078 463 lineto closepath stroke end grestore % Compute_lines->Ast0_cocci newpath 748 438 moveto 756 436 764 434 771 432 curveto 841 414 923 397 975 388 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 976 391 moveto 985 386 lineto 975 385 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 976 391 moveto 985 386 lineto 975 385 lineto closepath stroke end grestore % Context_neg->Visitor_ast0 newpath 744 514 moveto 808 501 926 479 969 468 curveto 973 467 976 466 980 465 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 981 468 moveto 990 462 lineto 979 462 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 981 468 moveto 990 462 lineto 979 462 lineto closepath stroke end grestore % Context_neg->Index newpath 724 506 moveto 740 495 763 480 781 468 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 782 471 moveto 789 463 lineto 779 465 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 782 471 moveto 789 463 lineto 779 465 lineto closepath stroke end grestore % Context_neg->Unparse_ast0 newpath 736 510 moveto 770 498 823 479 861 466 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 862 469 moveto 871 463 lineto 860 463 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 862 469 moveto 871 463 lineto 860 463 lineto closepath stroke end grestore % Context_neg->Compute_lines newpath 702 504 moveto 703 496 703 487 704 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 707 478 moveto 705 468 lineto 701 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 707 478 moveto 705 468 lineto 701 478 lineto closepath stroke end grestore % Token_helpers gsave 10 dict begin 2874 522 55 18 ellipse_path stroke gsave 10 dict begin 2832 517 moveto (Token_helpers) [8.64 6.96 6.96 6.24 6.96 6.96 6.96 6.24 3.84 6.96 6.24 4.56 5.52] xshow end grestore end grestore % Parsing_hacks->Token_helpers newpath 2832 577 moveto 2838 568 2847 557 2854 547 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2857 549 moveto 2860 539 lineto 2851 545 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2857 549 moveto 2860 539 lineto 2851 545 lineto closepath stroke end grestore % Token_helpers->Parser_c newpath 2850 506 moveto 2834 496 2813 482 2795 471 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2797 468 moveto 2787 465 lineto 2793 474 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2797 468 moveto 2787 465 lineto 2793 474 lineto closepath stroke end grestore % Lexer_parser->Common newpath 2724 360 moveto 2722 339 2714 306 2692 288 curveto 2511 140 1747 99 1545 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1545 88 moveto 1535 91 lineto 1545 95 lineto closepath stroke end grestore % Lexer_parser->Flag_parsing_c newpath 2704 362 moveto 2691 352 2673 339 2658 329 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2660 326 moveto 2650 323 lineto 2656 332 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2660 326 moveto 2650 323 lineto 2656 332 lineto closepath stroke end grestore % Ograph_extended->Oassocb newpath 2913 360 moveto 2914 352 2916 343 2918 334 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2921 334 moveto 2920 324 lineto 2915 333 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2921 334 moveto 2920 324 lineto 2915 333 lineto closepath stroke end grestore % Ograph_extended->Osetb newpath 2970 373 moveto 3102 362 3408 336 3454 324 curveto 3456 324 3458 323 3461 322 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3462 325 moveto 3470 318 lineto 3459 319 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3462 325 moveto 3470 318 lineto 3459 319 lineto closepath stroke end grestore % Compare_c->Parse_c newpath 3014 722 moveto 3000 712 2981 698 2965 687 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2967 684 moveto 2957 681 lineto 2963 690 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2967 684 moveto 2957 681 lineto 2963 690 lineto closepath stroke end grestore % Compare_c->Lib_parsing_c newpath 3034 720 moveto 3030 695 3025 651 3021 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3024 622 moveto 3020 612 lineto 3018 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3024 622 moveto 3020 612 lineto 3018 622 lineto closepath stroke end grestore % Ast_to_flow gsave 10 dict begin 2715 810 48 18 ellipse_path stroke gsave 10 dict begin 2679 805 moveto (Ast_to_flow) [10.08 5.52 3.84 6.96 3.84 6.96 6.96 4.56 3.84 6.96 10.08] xshow end grestore end grestore % Ast_to_flow->Visitor_c newpath 2762 807 moveto 2858 799 3068 780 3090 756 curveto 3102 742 3120 641 3080 576 curveto 3068 557 3047 544 3028 536 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3030 533 moveto 3019 532 lineto 3027 539 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3030 533 moveto 3019 532 lineto 3027 539 lineto closepath stroke end grestore % Type_annoter_c gsave 10 dict begin 2915 738 58 18 ellipse_path stroke gsave 10 dict begin 2869 733 moveto (Type_annoter_c) [8.64 6.96 6.96 6.24 6.96 6.24 6.96 6.96 6.96 3.84 6.24 4.56 6.96 6.24] xshow end grestore end grestore % Type_annoter_c->Parse_c newpath 2921 720 moveto 2923 712 2926 702 2929 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2932 695 moveto 2932 684 lineto 2926 693 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2932 695 moveto 2932 684 lineto 2926 693 lineto closepath stroke end grestore % Type_annoter_c->Lib_parsing_c newpath 2940 722 moveto 2954 712 2970 699 2981 684 curveto 2995 665 3004 640 3010 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3013 623 moveto 3013 612 lineto 3007 621 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3013 623 moveto 3013 612 lineto 3007 621 lineto closepath stroke end grestore % Pretty_print_c gsave 10 dict begin 2566 594 53 18 ellipse_path stroke gsave 10 dict begin 2526 589 moveto (Pretty_print_c) [7.68 4.56 6.24 3.84 3.84 6.96 6.96 6.96 4.56 3.84 6.96 3.84 6.96 6.24] xshow end grestore end grestore % Pretty_print_c->Ast_c newpath 2526 582 moveto 2519 580 2511 578 2504 576 curveto 2447 559 2418 581 2376 540 curveto 2340 504 2330 442 2327 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2330 406 moveto 2326 396 lineto 2324 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2330 406 moveto 2326 396 lineto 2324 406 lineto closepath stroke end grestore % Pretty_print_c->Flag_parsing_c newpath 2603 581 moveto 2634 570 2673 554 2682 540 curveto 2690 526 2682 519 2682 504 curveto 2681 471 2684 463 2678 432 curveto 2673 412 2653 365 2639 333 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2642 332 moveto 2635 324 lineto 2636 335 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2642 332 moveto 2635 324 lineto 2636 335 lineto closepath stroke end grestore % Unparse_cocci gsave 10 dict begin 2611 666 55 18 ellipse_path stroke gsave 10 dict begin 2568 661 moveto (Unparse_cocci) [10.08 6.96 6.96 6.24 4.56 5.52 6.24 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Unparse_cocci->Lib_engine newpath 2569 654 moveto 2560 652 2551 650 2542 648 curveto 2458 629 2435 633 2352 612 curveto 2348 611 2345 610 2342 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath stroke end grestore % Unparse_cocci->Pretty_print_c newpath 2600 648 moveto 2595 640 2588 630 2582 620 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2585 619 moveto 2577 612 lineto 2579 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2585 619 moveto 2577 612 lineto 2579 622 lineto closepath stroke end grestore % Unparse_c gsave 10 dict begin 2416 738 43 18 ellipse_path stroke gsave 10 dict begin 2385 733 moveto (Unparse_c) [10.08 6.96 6.96 6.24 4.56 5.52 6.24 6.96 6.24] xshow end grestore end grestore % Unparse_c->Parse_c newpath 2448 726 moveto 2454 723 2461 721 2468 720 curveto 2653 680 2708 728 2893 684 curveto 2896 684 2899 683 2901 682 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2903 685 moveto 2911 678 lineto 2900 678 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2903 685 moveto 2911 678 lineto 2900 678 lineto closepath stroke end grestore % Unparse_c->Unparse_cocci newpath 2449 726 moveto 2480 714 2529 696 2564 683 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2566 686 moveto 2574 679 lineto 2563 679 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2566 686 moveto 2574 679 lineto 2563 679 lineto closepath stroke end grestore % Flag_engine gsave 10 dict begin 2414 666 48 18 ellipse_path stroke gsave 10 dict begin 2379 661 moveto (Flag_engine) [7.68 3.84 6.24 6.96 6.96 6.24 6.96 6.96 3.84 6.96 6.24] xshow end grestore end grestore % Unparse_c->Flag_engine newpath 2415 720 moveto 2415 712 2415 703 2415 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2418 694 moveto 2414 684 lineto 2412 694 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2418 694 moveto 2414 684 lineto 2412 694 lineto closepath stroke end grestore % Transformation3 gsave 10 dict begin 2118 738 60 18 ellipse_path stroke gsave 10 dict begin 2071 733 moveto (Transformation3) [8.64 4.56 6.24 6.96 5.52 4.56 6.96 4.56 10.8 6.24 3.84 3.84 6.96 6.96 6.96] xshow end grestore end grestore % Transformation3->Sgrep newpath 2122 720 moveto 2128 692 2138 639 2138 594 curveto 2138 594 2138 594 2138 522 curveto 2138 480 2144 459 2114 432 curveto 2070 392 1894 382 1814 379 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1814 376 moveto 1804 379 lineto 1814 383 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1814 376 moveto 1804 379 lineto 1814 383 lineto closepath stroke end grestore % Transformation3->Lib_engine newpath 2167 727 moveto 2209 717 2265 701 2281 684 curveto 2295 667 2299 642 2299 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2303 622 moveto 2299 612 lineto 2296 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2303 622 moveto 2299 612 lineto 2296 622 lineto closepath stroke end grestore % Transformation3->Pretty_print_cocci newpath 2114 720 moveto 2109 692 2100 639 2100 594 curveto 2100 594 2100 594 2100 522 curveto 2100 502 1838 426 1720 394 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1721 391 moveto 1710 391 lineto 1719 397 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1721 391 moveto 1710 391 lineto 1719 397 lineto closepath stroke end grestore % Transformation3->Flag_parsing_cocci newpath 2106 720 moveto 2093 700 2069 669 2043 648 curveto 1977 596 1886 559 1828 539 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1829 536 moveto 1818 536 lineto 1827 542 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1829 536 moveto 1818 536 lineto 1827 542 lineto closepath stroke end grestore % Cocci_vs_c_3 gsave 10 dict begin 2219 666 53 18 ellipse_path stroke gsave 10 dict begin 2179 661 moveto (Cocci_vs_c_3) [9.36 6.96 6.24 6.24 3.84 6.96 6.96 5.52 6.96 6.24 6.96 6.96] xshow end grestore end grestore % Transformation3->Cocci_vs_c_3 newpath 2141 721 moveto 2155 711 2173 699 2188 688 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2190 691 moveto 2196 682 lineto 2186 685 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2190 691 moveto 2196 682 lineto 2186 685 lineto closepath stroke end grestore % Cocci_vs_c_3->Lib_parsing_c newpath 2268 659 moveto 2294 655 2327 651 2357 648 curveto 2588 624 2648 635 2880 612 curveto 2905 609 2934 605 2959 602 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2959 605 moveto 2969 601 lineto 2959 599 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2959 605 moveto 2969 601 lineto 2959 599 lineto closepath stroke end grestore % Cocci_vs_c_3->Flag newpath 2172 657 moveto 2094 643 1936 614 1865 601 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1865 598 moveto 1855 599 lineto 1864 604 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1865 598 moveto 1855 599 lineto 1864 604 lineto closepath stroke end grestore % C_vs_c gsave 10 dict begin 2219 522 34 18 ellipse_path stroke gsave 10 dict begin 2197 517 moveto (C_vs_c) [9.36 6.96 6.96 5.52 6.96 6.24] xshow end grestore end grestore % Cocci_vs_c_3->C_vs_c newpath 2219 648 moveto 2219 623 2219 579 2219 550 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2223 550 moveto 2219 540 lineto 2216 550 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2223 550 moveto 2219 540 lineto 2216 550 lineto closepath stroke end grestore % Pretty_print_engine->Lib_engine newpath 2019 655 moveto 2082 641 2186 619 2248 605 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2249 608 moveto 2258 603 lineto 2248 602 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2249 608 moveto 2258 603 lineto 2248 602 lineto closepath stroke end grestore % Pretty_print_engine->Pretty_print_cocci newpath 1956 648 moveto 1938 616 1898 549 1851 504 curveto 1806 460 1744 422 1704 399 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1705 396 moveto 1695 394 lineto 1702 402 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1705 396 moveto 1695 394 lineto 1702 402 lineto closepath stroke end grestore % Pretty_print_engine->Pretty_print_c newpath 2030 660 moveto 2167 646 2481 616 2504 612 curveto 2508 611 2512 610 2517 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2518 612 moveto 2527 606 lineto 2516 606 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2518 612 moveto 2527 606 lineto 2516 606 lineto closepath stroke end grestore % Ctltotex gsave 10 dict begin 1730 666 36 18 ellipse_path stroke gsave 10 dict begin 1707 661 moveto (Ctltotex) [9.36 3.84 3.84 3.84 6.96 3.84 6.24 6.96] xshow end grestore end grestore % Ctltotex->Lib_engine newpath 1765 662 moveto 1861 649 2130 615 2245 600 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2245 603 moveto 2255 599 lineto 2245 597 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2245 603 moveto 2255 599 lineto 2245 597 lineto closepath stroke end grestore % Ctltotex->Pretty_print_cocci newpath 1725 648 moveto 1718 624 1706 579 1697 540 curveto 1686 493 1675 438 1669 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1672 405 moveto 1667 396 lineto 1666 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1672 405 moveto 1667 396 lineto 1666 406 lineto closepath stroke end grestore % Ctlcocci_integration gsave 10 dict begin 2160 810 70 18 ellipse_path stroke gsave 10 dict begin 2103 805 moveto (Ctlcocci_integration) [9.36 3.84 3.84 6.24 6.96 6.24 6.24 3.84 6.96 3.84 6.96 3.84 6.24 6.96 4.56 6.24 3.84 3.84 6.96 6.96] xshow end grestore end grestore % Ctlcocci_integration->Flag_parsing_cocci newpath 2113 796 moveto 2082 787 2041 773 2006 756 curveto 1950 729 1924 733 1889 684 curveto 1860 643 1893 615 1865 576 curveto 1854 561 1839 550 1823 542 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1824 539 moveto 1814 537 lineto 1821 545 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1824 539 moveto 1814 537 lineto 1821 545 lineto closepath stroke end grestore % Ctlcocci_integration->Pretty_print_engine newpath 2121 795 moveto 2099 786 2071 772 2049 756 curveto 2025 738 2001 711 1985 692 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1988 690 moveto 1979 684 lineto 1982 694 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1988 690 moveto 1979 684 lineto 1982 694 lineto closepath stroke end grestore % Check_reachability gsave 10 dict begin 2428 594 67 18 ellipse_path stroke gsave 10 dict begin 2373 589 moveto (Check_reachability) [9.36 6.96 6.24 6.24 6.96 6.96 4.56 6.24 6.24 6.24 6.96 6.24 6.96 3.84 3.84 3.84 3.84 6.96] xshow end grestore end grestore % Ctlcocci_integration->Check_reachability newpath 2199 795 moveto 2226 785 2263 770 2295 756 curveto 2326 741 2332 733 2364 720 curveto 2410 700 2441 724 2471 684 curveto 2485 664 2470 638 2454 619 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2457 617 moveto 2447 612 lineto 2452 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2457 617 moveto 2447 612 lineto 2452 622 lineto closepath stroke end grestore % Pattern3 gsave 10 dict begin 2250 738 36 18 ellipse_path stroke gsave 10 dict begin 2226 733 moveto (Pattern3) [7.68 6.24 3.84 3.84 6.24 4.56 6.96 6.96] xshow end grestore end grestore % Ctlcocci_integration->Pattern3 newpath 2182 793 moveto 2194 783 2210 770 2223 760 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2226 762 moveto 2231 753 lineto 2221 757 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2226 762 moveto 2231 753 lineto 2221 757 lineto closepath stroke end grestore % Postprocess_transinfo gsave 10 dict begin 2551 738 74 18 ellipse_path stroke gsave 10 dict begin 2489 733 moveto (Postprocess_transinfo) [7.68 6.96 5.52 3.84 6.96 4.56 6.96 6.24 6.24 5.52 5.52 6.96 3.84 4.56 6.24 6.96 5.52 3.84 6.96 4.56 6.96] xshow end grestore end grestore % Ctlcocci_integration->Postprocess_transinfo newpath 2219 800 moveto 2281 790 2381 772 2468 756 curveto 2474 755 2480 753 2486 752 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2487 755 moveto 2496 750 lineto 2486 749 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2487 755 moveto 2496 750 lineto 2486 749 lineto closepath stroke end grestore % Check_reachability->Control_flow_c newpath 2405 577 moveto 2394 567 2382 554 2376 540 curveto 2370 525 2367 517 2376 504 curveto 2385 487 2403 475 2421 466 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2422 469 moveto 2430 462 lineto 2419 463 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2422 469 moveto 2430 462 lineto 2419 463 lineto closepath stroke end grestore % Check_reachability->Wrapper_ctl newpath 2468 579 moveto 2501 567 2547 550 2580 538 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2582 541 moveto 2590 534 lineto 2579 534 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2582 541 moveto 2590 534 lineto 2579 534 lineto closepath stroke end grestore % Pattern3->Lib_engine newpath 2274 724 moveto 2289 715 2306 701 2314 684 curveto 2323 664 2318 639 2311 621 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2314 620 moveto 2307 612 lineto 2308 623 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2314 620 moveto 2307 612 lineto 2308 623 lineto closepath stroke end grestore % Pattern3->Flag_engine newpath 2277 726 moveto 2303 715 2343 697 2374 684 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2375 687 moveto 2383 680 lineto 2372 681 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2375 687 moveto 2383 680 lineto 2372 681 lineto closepath stroke end grestore % Pattern3->Cocci_vs_c_3 newpath 2242 720 moveto 2238 712 2234 702 2231 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2234 692 moveto 2227 684 lineto 2227 695 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2234 692 moveto 2227 684 lineto 2227 695 lineto closepath stroke end grestore % Postprocess_transinfo->Parse_c newpath 2614 728 moveto 2709 714 2879 688 2893 684 curveto 2896 683 2898 682 2901 681 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2902 684 moveto 2910 678 lineto 2899 678 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2902 684 moveto 2910 678 lineto 2899 678 lineto closepath stroke end grestore % Postprocess_transinfo->Lib_engine newpath 2540 720 moveto 2526 699 2501 666 2471 648 curveto 2424 618 2404 628 2352 612 curveto 2349 611 2345 610 2342 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath stroke end grestore % C_vs_c->Ast_c newpath 2247 512 moveto 2267 503 2292 489 2307 468 curveto 2320 450 2324 425 2325 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2328 406 moveto 2326 396 lineto 2322 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2328 406 moveto 2326 396 lineto 2322 406 lineto closepath stroke end grestore % Asttomember gsave 10 dict begin 1625 666 51 18 ellipse_path stroke gsave 10 dict begin 1586 661 moveto (Asttomember) [10.08 5.52 3.84 3.84 6.96 10.8 6.24 10.8 6.96 6.24 4.56] xshow end grestore end grestore % Asttomember->Lib_engine newpath 1662 653 moveto 1669 651 1677 649 1685 648 curveto 1887 608 2135 598 2243 595 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2243 599 moveto 2253 595 lineto 2243 592 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2243 599 moveto 2253 595 lineto 2243 592 lineto closepath stroke end grestore % Asttomember->Visitor_ast newpath 1587 654 moveto 1579 652 1572 650 1565 648 curveto 1501 631 1425 614 1377 604 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1377 601 moveto 1367 602 lineto 1376 607 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1377 601 moveto 1367 602 lineto 1376 607 lineto closepath stroke end grestore % Asttomember->Pretty_print_cocci newpath 1627 648 moveto 1634 599 1653 465 1661 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1664 406 moveto 1662 396 lineto 1658 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1664 406 moveto 1662 396 lineto 1658 406 lineto closepath stroke end grestore % Asttoctl2 gsave 10 dict begin 1821 738 39 18 ellipse_path stroke gsave 10 dict begin 1794 733 moveto (Asttoctl2) [10.08 5.52 3.84 3.84 6.96 6.24 3.84 3.84 6.96] xshow end grestore end grestore % Asttoctl2->Flag newpath 1822 720 moveto 1823 695 1825 651 1827 622 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1830 622 moveto 1828 612 lineto 1824 622 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1830 622 moveto 1828 612 lineto 1824 622 lineto closepath stroke end grestore % Asttoctl2->Unify_ast newpath 1784 732 moveto 1734 723 1641 705 1565 684 curveto 1562 683 1559 682 1556 681 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1557 678 moveto 1546 678 lineto 1555 684 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1557 678 moveto 1546 678 lineto 1555 684 lineto closepath stroke end grestore % Asttoctl2->Flag_parsing_cocci newpath 1817 720 moveto 1811 696 1801 651 1793 612 curveto 1788 591 1783 568 1780 550 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1783 549 moveto 1778 540 lineto 1777 550 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1783 549 moveto 1778 540 lineto 1777 550 lineto closepath stroke end grestore % Asttoctl2->Pretty_print_engine newpath 1848 725 moveto 1869 714 1900 699 1925 687 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1927 690 moveto 1934 682 lineto 1924 684 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1927 690 moveto 1934 682 lineto 1924 684 lineto closepath stroke end grestore % Unparse_c2 gsave 10 dict begin 2416 810 47 18 ellipse_path stroke gsave 10 dict begin 2382 805 moveto (Unparse_c2) [10.08 6.96 6.96 6.24 4.56 5.52 6.24 6.96 6.24 6.96] xshow end grestore end grestore % Unparse_c2->Unparse_c newpath 2416 792 moveto 2416 784 2416 775 2416 766 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2420 766 moveto 2416 756 lineto 2413 766 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2420 766 moveto 2416 756 lineto 2413 766 lineto closepath stroke end grestore % Unparse_cocci2 gsave 10 dict begin 2743 666 59 18 ellipse_path stroke gsave 10 dict begin 2697 661 moveto (Unparse_cocci2) [10.08 6.96 6.96 6.24 4.56 5.52 6.24 6.96 6.24 6.96 6.24 6.24 3.84 6.96] xshow end grestore end grestore % Unparse_c2->Unparse_cocci2 newpath 2458 802 moveto 2513 791 2604 772 2634 756 curveto 2654 744 2654 735 2672 720 curveto 2684 709 2698 698 2711 689 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2713 692 moveto 2719 683 lineto 2709 686 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2713 692 moveto 2719 683 lineto 2709 686 lineto closepath stroke end grestore % Unparse_cocci2->Lib_engine newpath 2700 653 moveto 2692 651 2683 649 2675 648 curveto 2533 621 2493 643 2352 612 curveto 2349 611 2345 610 2342 609 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2343 606 moveto 2332 606 lineto 2341 612 lineto closepath stroke end grestore % Unparse_cocci2->Pretty_print_c newpath 2707 651 moveto 2679 639 2640 623 2609 612 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2611 609 moveto 2600 608 lineto 2608 615 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2611 609 moveto 2600 608 lineto 2608 615 lineto closepath stroke end grestore % Pretty_print_ctl gsave 10 dict begin 2439 378 57 18 ellipse_path stroke gsave 10 dict begin 2395 373 moveto (Pretty_print_ctl) [7.68 4.56 6.24 3.84 3.84 6.96 6.96 6.96 4.56 3.84 6.96 3.84 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Pretty_print_ctl->Common newpath 2401 364 moveto 2294 327 1982 218 1719 144 curveto 1658 126 1587 110 1542 100 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1542 97 moveto 1532 98 lineto 1541 103 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1542 97 moveto 1532 98 lineto 1541 103 lineto closepath stroke end grestore % Ast_ctl gsave 10 dict begin 2398 306 34 18 ellipse_path stroke gsave 10 dict begin 2377 301 moveto (Ast_ctl) [10.08 5.52 3.84 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Pretty_print_ctl->Ast_ctl newpath 2429 360 moveto 2425 352 2419 342 2413 333 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2416 331 moveto 2408 324 lineto 2410 334 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2416 331 moveto 2408 324 lineto 2410 334 lineto closepath stroke end grestore % Flag_ctl gsave 10 dict begin 2486 306 36 18 ellipse_path stroke gsave 10 dict begin 2463 301 moveto (Flag_ctl) [7.68 3.84 6.24 6.96 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Pretty_print_ctl->Flag_ctl newpath 2451 360 moveto 2456 352 2463 342 2469 332 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2472 334 moveto 2475 324 lineto 2466 330 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2472 334 moveto 2475 324 lineto 2466 330 lineto closepath stroke end grestore % Ctl_engine->Ograph_extended newpath 2662 441 moveto 2711 429 2796 407 2852 392 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2853 395 moveto 2862 390 lineto 2852 389 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2853 395 moveto 2862 390 lineto 2852 389 lineto closepath stroke end grestore % Ctl_engine->Pretty_print_ctl newpath 2593 438 moveto 2563 426 2518 409 2485 396 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2486 392 moveto 2475 392 lineto 2483 399 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2486 392 moveto 2475 392 lineto 2483 399 lineto closepath stroke end grestore % Osequence->Oassoc newpath 3131 288 moveto 3130 280 3130 271 3129 262 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 3132 262 moveto 3128 252 lineto 3126 262 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 3132 262 moveto 3128 252 lineto 3126 262 lineto closepath stroke end grestore % Pretty_print_popl gsave 10 dict begin 534 450 62 18 ellipse_path stroke gsave 10 dict begin 484 445 moveto (Pretty_print_popl) [7.68 4.56 6.24 3.84 3.84 6.96 6.96 6.96 4.56 3.84 6.96 3.84 6.96 6.96 6.96 6.96 3.84] xshow end grestore end grestore % Pretty_print_popl->Ast_popl newpath 534 432 moveto 534 424 534 415 534 406 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 538 406 moveto 534 396 lineto 531 406 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 538 406 moveto 534 396 lineto 531 406 lineto closepath stroke end grestore % Pretty_print_popl->Pretty_print_cocci newpath 586 440 moveto 604 437 624 434 643 432 curveto 996 393 1421 381 1590 379 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1590 383 moveto 1600 379 lineto 1590 376 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1590 383 moveto 1600 379 lineto 1590 376 lineto closepath stroke end grestore % Popltoctl gsave 10 dict begin 682 666 38 18 ellipse_path stroke gsave 10 dict begin 656 661 moveto (Popltoctl) [7.68 6.96 6.96 3.84 3.84 6.96 6.24 3.84 3.84] xshow end grestore end grestore % Popltoctl->Lib_engine newpath 710 653 moveto 716 651 723 649 729 648 curveto 976 598 1612 621 1865 612 curveto 2000 606 2160 600 2243 596 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2243 600 moveto 2253 596 lineto 2243 593 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2243 600 moveto 2253 596 lineto 2243 593 lineto closepath stroke end grestore % Popltoctl->Ast_popl newpath 651 655 moveto 627 646 595 631 571 612 curveto 509 561 488 543 463 468 curveto 457 452 455 446 463 432 curveto 470 417 484 405 497 396 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 499 399 moveto 506 391 lineto 496 393 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 499 399 moveto 506 391 lineto 496 393 lineto closepath stroke end grestore % Popltoctl->Visitor_ast newpath 710 653 moveto 716 651 723 649 729 648 curveto 949 599 1012 641 1236 612 curveto 1250 610 1264 607 1278 605 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1279 608 moveto 1288 603 lineto 1278 602 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1279 608 moveto 1288 603 lineto 1278 602 lineto closepath stroke end grestore % Popl gsave 10 dict begin 240 738 27 18 ellipse_path stroke gsave 10 dict begin 227 733 moveto (Popl) [7.68 6.96 6.96 3.84] xshow end grestore end grestore % Popl->Popltoctl newpath 266 734 moveto 326 726 474 706 597 684 curveto 610 682 624 679 637 676 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 638 679 moveto 647 674 lineto 637 673 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 638 679 moveto 647 674 lineto 637 673 lineto closepath stroke end grestore % Asttopopl gsave 10 dict begin 337 450 41 18 ellipse_path stroke gsave 10 dict begin 308 445 moveto (Asttopopl) [10.08 5.52 3.84 3.84 6.96 6.96 6.96 6.96 3.84] xshow end grestore end grestore % Popl->Asttopopl newpath 243 720 moveto 249 689 262 627 280 576 curveto 292 541 310 502 323 477 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 326 478 moveto 328 468 lineto 320 475 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 326 478 moveto 328 468 lineto 320 475 lineto closepath stroke end grestore % Insert_befaft gsave 10 dict begin 229 450 49 18 ellipse_path stroke gsave 10 dict begin 193 445 moveto (Insert_befaft) [4.56 6.96 5.52 6.24 4.56 3.84 6.96 6.96 6.24 4.56 6.24 4.56 3.84] xshow end grestore end grestore % Popl->Insert_befaft newpath 234 720 moveto 231 710 228 696 226 684 curveto 217 610 222 523 226 478 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 229 478 moveto 227 468 lineto 223 478 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 229 478 moveto 227 468 lineto 223 478 lineto closepath stroke end grestore % Insert_quantifiers gsave 10 dict begin 100 450 62 18 ellipse_path stroke gsave 10 dict begin 50 445 moveto (Insert_quantifiers) [4.56 6.96 5.52 6.24 4.56 3.84 6.96 6.96 6.96 6.24 6.96 3.84 3.84 4.56 3.84 6.24 4.56 5.52] xshow end grestore end grestore % Popl->Insert_quantifiers newpath 232 721 moveto 208 673 142 536 113 477 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 116 476 moveto 109 468 lineto 110 479 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 116 476 moveto 109 468 lineto 110 479 lineto closepath stroke end grestore % Asttopopl->Ast_popl newpath 369 438 moveto 403 426 457 406 493 393 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 495 396 moveto 503 389 lineto 492 389 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 495 396 moveto 503 389 lineto 492 389 lineto closepath stroke end grestore % Asttopopl->Pretty_print_cocci newpath 375 443 moveto 400 439 433 435 463 432 curveto 683 411 1364 388 1590 380 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1590 384 moveto 1600 380 lineto 1590 377 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1590 384 moveto 1600 380 lineto 1590 377 lineto closepath stroke end grestore % Insert_befaft->Common newpath 249 433 moveto 324 371 588 152 610 144 curveto 687 114 1272 96 1447 91 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 95 moveto 1457 91 lineto 1447 88 lineto closepath stroke end grestore % Insert_befaft->Ast_popl newpath 265 438 moveto 272 436 280 434 287 432 curveto 372 410 396 418 481 396 curveto 485 395 489 393 493 392 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 494 395 moveto 503 389 lineto 492 389 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 494 395 moveto 503 389 lineto 492 389 lineto closepath stroke end grestore % Insert_quantifiers->Common newpath 118 433 moveto 143 408 185 358 185 306 curveto 185 306 185 306 185 234 curveto 185 193 173 170 204 144 curveto 251 103 1216 92 1447 90 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1447 94 moveto 1457 90 lineto 1447 87 lineto closepath stroke end grestore % Insert_quantifiers->Ast_popl newpath 146 438 moveto 154 436 163 434 171 432 curveto 282 409 416 392 486 383 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 486 386 moveto 496 382 lineto 486 380 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 486 386 moveto 496 382 lineto 486 380 lineto closepath stroke end grestore % Cocci->Parse_cocci newpath 1793 878 moveto 1751 872 1673 857 1613 828 curveto 1588 816 1589 801 1565 792 curveto 1538 781 1134 752 983 742 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 983 739 moveto 973 741 lineto 983 745 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 983 739 moveto 973 741 lineto 983 745 lineto closepath stroke end grestore % Cocci->Ast_to_flow newpath 1850 880 moveto 1949 874 2281 853 2555 828 curveto 2589 824 2628 820 2659 817 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2659 820 moveto 2669 816 lineto 2659 814 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2659 820 moveto 2669 816 lineto 2659 814 lineto closepath stroke end grestore % Cocci->Type_annoter_c newpath 1850 881 moveto 1942 876 2233 860 2472 828 curveto 2555 816 2575 807 2658 792 curveto 2742 775 2764 775 2848 756 curveto 2853 755 2858 754 2862 752 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2863 755 moveto 2872 750 lineto 2862 749 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2863 755 moveto 2872 750 lineto 2862 749 lineto closepath stroke end grestore % Cocci->Transformation3 newpath 1844 871 moveto 1894 846 2014 788 2077 757 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2078 760 moveto 2086 753 lineto 2075 754 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2078 760 moveto 2086 753 lineto 2075 754 lineto closepath stroke end grestore % Cocci->Ctltotex newpath 1814 864 moveto 1798 827 1761 738 1741 693 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1744 692 moveto 1737 684 lineto 1738 695 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1744 692 moveto 1737 684 lineto 1738 695 lineto closepath stroke end grestore % Cocci->Ctlcocci_integration newpath 1848 876 moveto 1902 865 2021 839 2096 823 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2097 826 moveto 2106 821 lineto 2096 820 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2097 826 moveto 2106 821 lineto 2096 820 lineto closepath stroke end grestore % Cocci->Asttomember newpath 1793 877 moveto 1748 869 1665 850 1646 828 curveto 1614 790 1615 730 1620 694 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1623 694 moveto 1622 684 lineto 1617 693 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1623 694 moveto 1622 684 lineto 1617 693 lineto closepath stroke end grestore % Cocci->Asttoctl2 newpath 1821 864 moveto 1821 839 1821 795 1821 766 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1825 766 moveto 1821 756 lineto 1818 766 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1825 766 moveto 1821 756 lineto 1818 766 lineto closepath stroke end grestore % Cocci->Unparse_c2 newpath 1850 879 moveto 1943 867 2238 832 2361 816 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 2361 819 moveto 2371 815 lineto 2361 813 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 2361 819 moveto 2371 815 lineto 2361 813 lineto closepath stroke end grestore % Cocci->Popl newpath 1792 879 moveto 1599 862 495 761 277 741 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 277 738 moveto 267 740 lineto 277 744 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 277 738 moveto 267 740 lineto 277 744 lineto closepath stroke end grestore % Flag_cocci gsave 10 dict begin 1699 810 44 18 ellipse_path stroke gsave 10 dict begin 1668 805 moveto (Flag_cocci) [7.68 3.84 6.24 6.96 6.96 6.24 6.96 6.24 6.24 3.84] xshow end grestore end grestore % Cocci->Flag_cocci newpath 1800 869 moveto 1782 858 1755 842 1733 830 curveto stroke gsave 10 dict begin solid 1 setlinewidth 0.000 0.000 0.000 edgecolor newpath 1734 827 moveto 1724 825 lineto 1731 833 lineto closepath fill 0.000 0.000 0.000 edgecolor newpath 1734 827 moveto 1724 825 lineto 1731 833 lineto closepath stroke end grestore endpage showpage grestore %%PageTrailer %%EndPage: 1 %%Trailer %%Pages: 1 end restore %%EOF coccinelle-1.0.0-rc19/docs/Makefile0000644000175000017500000000046312247437436015763 0ustar eugeneugenSUBDIR=manual .PHONY: all clean distclean spatch.1 ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif all: spatch.1 $(MAKE) -C $(SUBDIR) $@ distclean: $(MAKE) -C manual distclean rm -f spatch.1 rm -rf ./html rm -rf ./man clean: $(MAKE) -C $(SUBDIR) $@ include ../Makefile.common coccinelle-1.0.0-rc19/configure.ac0000644000175000017500000004603612247437436015667 0ustar eugeneugendnl run 'autoreconf' to obtain aclocal.m4, and update configure and setup/pkg.m4 dnl run 'automake -acf' to update setup/{install-sh,missing} dnl standard initialization (we only use autoconf not automake) AC_PREREQ([2.68]) AC_INIT([coccinelle], m4_esyscmd([cat ./version | tr -d '\n']), [cocci@systeme.lip6.fr], [], [http://coccinelle.lip6.fr/]) AC_CONFIG_MACRO_DIR([setup]) AC_CONFIG_AUX_DIR([setup]) AC_SUBST([CONFIGURE_FLAGS], ["$*"]) AC_SUBST([COCCI_VERSION], ["$PACKAGE_VERSION"]) AC_SUBST([COCCI_SRCDIR], ["$(pwd)"]) AC_MSG_NOTICE([configuring coccinelle $COCCI_VERSION in $COCCI_SRCDIR]) AM_INIT_AUTOMAKE AC_CONFIG_SRCDIR([cocci.ml]) dnl this file must be present in our src directory AC_COCCI_CONFVERSION dnl reminder that this configure depends on macros generated by aclocal AC_MSG_NOTICE([this configure program uses pkg-config m4 macros]) AC_MSG_NOTICE([this configure program uses ocaml m4 macros (see setup/ocaml.m4)]) AC_MSG_NOTICE([this configure program uses custom m4 macros (see setup/cocci.m4)]) AC_MSG_NOTICE([some fake substitutions for required but unavailable programs may be used (see setup/fake*)]) dnl dnl Note: the conditionals in this configure script are tricky. dnl The approach taken here is that many tools can be enabled/disabled dnl and paths can be given explicitly via commandline parameters or dnl environment variables. dnl dnl dnl Basic tools dnl AC_MSG_NOTICE([verifying basic tools]) AC_PROG_INSTALL AC_PROG_MKDIR_P AC_PROG_CPP AC_PATH_PROG([BASH],[bash]) AC_PATH_PROG([TAR],[tar]) AC_PATH_PROG([PATCH],[patch]) AC_PATH_PROG([ECHO],[echo]) dnl ensures that INSTALL points to an absolute install-sh when that one is configured. AS_IF([test "$INSTALL" = "setup/install-sh -c" -o "$INSTALL" = "./setup-install-sh -c"], [dnl AC_SUBST([INSTALL], ["$COCCI_SRCDIR/$INSTALL"]) ]) dnl the same for MKDIR_P AS_IF([test "$MKDIR_P" = "setup/install-sh -c -d" -o "$INSTALL" = "./setup-install-sh -c -d"], [dnl AC_SUBST([MKDIR_P], ["$COCCI_SRCDIR/$MKDIR_P"]) ]) dnl Try to ensure that ECHO will support -e option to handle \t and \n AS_IF([test "`$ECHO --version`" = "--version"], [dnl AC_SUBST([ECHO],["$COCCI_SRCDIR/setup/echo.sh"]) ]) dnl patchelf is an optional dependency and in principle not used for building coccinelle AC_PATH_PROG([PATCHELF],[patchelf]) dnl pkg config is required, but we have an alternative script for it AC_COCCI_TOOL([PKG_CONFIG],[pkg-config]) AS_IF([test "x$PKG_CONFIG" = xno], [dnl no specific pkg-config configured AC_SUBST([PKG_CONFIG_ORIG],[pkg-config]) ], [dnl a specific pkg-config configured AC_SUBST([PKG_CONFIG_ORIG],[$PKG_CONFIG]) ]) dnl always use the wrapper around pkg-config AC_SUBST([PKG_CONFIG],["$COCCI_SRCDIR/setup/fake-subst.sh $PKG_CONFIG_ORIG"]) dnl ocaml compiler configuration AC_PROG_OCAML AC_CHECK_OCAMLVERSION([OCAMLATLEAST310],[3.10]) AC_CHECK_OCAMLVERSION([OCAMLATLEAST311],[3.11]) AC_SUBST([OCAMLCORIG],["$OCAMLC"]) AS_IF([test "x$OCAMLC" = xno -o "x$OCAMLDEP" = xno -o "x$OCAMLDOC" = xno -o "x$OCAMLMKLIB" = xno], [dnl AC_MSG_ERROR([You must install the OCaml compiler]) ]) AS_IF([test "x$OCAMLATLEAST310" = xno],[AC_MSG_NOTICE([a more recent OCaml installation may be required])]) dnl ocaml tools AC_PROG_CAMLP4 AC_COCCI_TOOL([OCAMLLEX],[ocamllex],[]) AC_COCCI_TOOL([OCAMLYACC],[ocamlyacc],[]) AC_COCCI_TOOL([OCAMLFIND],[ocamlfind],[$COCCI_SRCDIR/setup/fake-subst.sh ocamlfind]) AC_COCCI_TOOL([OCAMLPROF],[ocamlprof],[]) dnl enforce ocaml tool requirements AS_IF([test "x$OCAMLLEX" = xno], [dnl AC_MSG_ERROR([the OCaml Lexer needs to be installed (the ocamllex command). It should be part of your OCaml distribution.]) ]) AS_IF([test "x$OCAMLYACC" = xno], [dnl AC_MSG_ERROR([The OCaml parser generated needs to be installed (the ocamlyacc command). It should be part of your OCaml distribution.]) ]) AS_IF([test "x$OCAMLFIND" = xno], [dnl AC_MSG_ERROR([A suitable OCaml findlib (the ocamlfind command) could not be found.]) ]) dnl these runtime commands can also be passed as runtime flags to spatch. AC_COCCI_RUNTIME_CMD([OCAMLFIND],[ocamlfind]) AC_COCCI_RUNTIME_CMD([OCAMLC],[ocamlc]) AC_COCCI_RUNTIME_CMD([OCAMLOPT],[ocamlopt]) AC_COCCI_RUNTIME_CMD([OCAMLDEP],[ocamldep]) AC_COCCI_RUNTIME_CMD([CAMLP4],[camlp4]) AC_COCCI_RUNTIME_CMD([CAMLP4O],[camlp4o]) dnl AC_CACHE_SAVE dnl dnl Basic ocaml modules dnl AC_MSG_NOTICE([verifying basic ocaml modules]) dnl default dir with the bundled ocaml packages AC_COCCI_SET_EXTERNAL_DIR([$COCCI_SRCDIR/bundles]) dnl set some defaults dnl add a line for each package that is dnl configured via AC_CHECK_COCCI_EXTPKG dnl or AC_REQ_COCCI_EXTPKG AC_COCCI_INIT_PKG_EMPTY([menhirLib]) AC_COCCI_INIT_PKG_EMPTY([dynlink]) AC_COCCI_INIT_PKG_EMPTY([pcre]) AC_COCCI_INIT_PKG_EMPTY([pycaml]) AC_COCCI_INIT_PKG_EMPTY([camlp4]) dnl required ocaml packages AC_MSG_NOTICE([the following OCaml packages should be provided by your ocaml installation]) AC_REQ_COCCI_STDPKG([unix]) AC_REQ_COCCI_STDPKG([bigarray]) AC_REQ_COCCI_STDPKG([num]) AC_REQ_COCCI_STDPKG([str]) dnl required modules (Some are available locally too) AC_REQ_COCCI_EXTPKG([dynlink]) AC_REQ_COCCI_EXTPKG([camlp4]) AC_REQ_COCCI_EXTPKG([menhirLib]) dnl AC_CACHE_SAVE dnl dnl Handling of optional features dnl AC_MSG_NOTICE([verifying optional features]) dnl test if the optimized version of dynlink is available AS_IF([test "x$OCAML_PKG_dynlink" != xno -a -f "$PATH_dynlink/dynlink.cmxa"], [dnl yes AC_SUBST([OPTIMIZED_dynlink], [yes]) ], [dnl no AC_SUBST([OPTIMIZED_dynlink], [no]) ]) dnl menhir handling dnl variables: dnl with_menhir: whether or not menhir must be used AC_COCCI_TOOL([MENHIR],[menhir],[$COCCI_SRCDIR/setup/fake-menhir.sh menhir]) AS_IF([test "x$SUBSTITUTED_MENHIR" = xyes], [dnl AC_MSG_NOTICE([pregenerated parsers will be required as substitute for Menhir]) ]) dnl ocaml script handling dnl variables: dnl enable_ocaml: whether to enable ocaml scripts AC_ARG_ENABLE([ocaml], AS_HELP_STRING([--enable-ocaml], [enable ocaml scripting (default: auto)])) AS_IF([test "x$OCAML_PKG_dynlink" = xno], [dnl AS_IF([test -z "$enable_ocaml"], [dnl AC_SUBST([enable_ocaml], [no]) AC_MSG_NOTICE([ocaml scripting is disabled because the 'dynlink' package is not installed]) ], [test "x$enable_ocaml" != xno], [dnl AC_MSG_ERROR([the OCaml package dynlink is required for ocaml scripting]) ]) ]) dnl too old ocaml version, disable dynlink by default AS_IF([test "x$OCAMLATLEAST311" = xno], [dnl AS_IF([test -z "$enable_ocaml"], [dnl AC_SUBST([enable_ocaml], [no]) AC_MSG_NOTICE([ocaml scripting has been disabled by default because your OCaml version may not support dynamic linking properly]) ], [test "x$enable_ocaml" = xyes], [dnl AC_MSG_NOTICE([warning: your ocaml version may be too old for dynamic linking, thus ocaml scripting may not work]) ]) ]) dnl no optimized version, disable dynlink by default AS_IF([test "x$OPTIMIZED_dynlink" = xno], [dnl AS_IF([test -z "$enable_ocaml"], [dnl AC_SUBST([enable_ocaml], [no]) AC_MSG_NOTICE([ocaml scripting has been disabled by default because the optimized version of dynlink is not available]) ], [test "x$enable_ocaml" = xyes], [dnl AC_MSG_NOTICE([warning: the optimized version of dynlink is not available, thus ocaml scripting may not work]) ]) ]) dnl scripting requirement on ocamlfind AS_IF([test -n "$SUBSTITUTED_OCAMLFIND"], [dnl AS_IF([test -z "$enable_ocaml"], [dnl this is perhaps a bit too strict AC_SUBST([enable_ocaml],[no]) AC_MSG_NOTICE([ocaml scripting is disabled because it depends on ocamlfind]) ], [test "x$enable_ocaml" != xno], [dnl AC_MSG_NOTICE([warning: ocamlfind is not found but may be required when ocaml scripts are used]) ]) ]) dnl scripting requirement on camlp4 AS_IF([test "x$CAMLP4" = xno], [dnl AS_IF([test -z "$enable_ocaml"], [dnl this is perhaps a bit too strict AC_SUBST([enable_ocaml],no) AC_MSG_NOTICE([ocaml scripting is disabled because it requires camlp4 which is not available]) ], [test "x$enable_ocaml" != xno], [dnl AC_MSG_NOTICE([warning: camlp4 is not found but may be required when ocaml scripts are used]) ]) ]) AS_IF([test "x$enable_ocaml" = xno], [dnl AC_COCCI_INIT_PKG_EMPTY([dynlink]) dnl prevent linking with it AC_SUBST(OCAMLCOCCI_MODULE, [No_prepare_ocamlcocci]) AC_SUBST(OCAMLCOCCI_FILE, [no_prepare_ocamlcocci.ml]) ], [dnl AC_SUBST([enable_ocaml], [yes]) AC_SUBST(OCAMLCOCCI_MODULE, [Yes_prepare_ocamlcocci]) AC_SUBST(OCAMLCOCCI_FILE, [yes_prepare_ocamlcocci.ml]) ]) dnl python handling dnl variables: dnl with_python: whether to enable the python feature (and what version) dnl OCAML_PKG_pycaml: if "local" use local pycaml package AC_ARG_VAR([PYTHON], [path to python when the version is determined automatically]) AC_ARG_ENABLE([python], [AS_HELP_STRING([--enable-python], [enable python scripting (yes/no) (default: auto)])]) AS_IF([test "x$enable_python" != xno], [dnl dnl an explicitly set --with-python disables the global pycaml by default dnl set --enable-pycaml if it is clear that the installed pycaml library dnl is consistent with the chosen python version AS_IF([test -n "$enable_python" -a -z "$enable_pycaml"], [dnl if explicit python given: AC_MSG_NOTICE([skipped the selection of a global pycaml module because --enable-python is given explicitly but --enable-pycaml is not.]) AC_SUBST([enable_pycaml], [no]) ]) dnl sets "$PYVER" if python is available AC_COCCI_PYVER AS_IF([test -z "$PYVER"], [dnl PYVER undetermined AS_IF([test "x$enable_python" = xyes], [dnl AC_MSG_ERROR([python scripting is enabled explicitly but the version of python could not be determined]) ]) ], [dnl AC_MSG_NOTICE([looking for the corresponding python library]) PKG_CHECK_MODULES([PYTHON], [python-$PYVER],[AC_SUBST(HAVE_PYTHON,[yes])],[AC_SUBST(HAVE_PYTHON,[no])]) AS_IF([test "x$HAVE_PYTHON" != xyes -a "x$enable_python" != xyes], [dnl fallback if the above failed AC_MSG_NOTICE([trying the default python library as fallback]) PKG_CHECK_MODULES([PYTHON], [python],[AC_SUBST(HAVE_PYTHON,[yes])],[AC_SUBST(HAVE_PYTHON,[no])]) ]) ]) ]) AS_IF([test -z "$enable_python"], [dnl AS_IF([test "x$HAVE_PYTHON" = xyes], [dnl AC_SUBST([enable_python], [yes]) ], [dnl AC_SUBST([enable_python], [no]) ]) ]) AS_IF([test "x$enable_python" != xno], [dnl AS_IF([test "x$HAVE_PYTHON" = xyes], [dnl AC_MSG_NOTICE([support for python scripts is enabled]) ], [dnl AC_MSG_ERROR([the python scripts feature is enabled but the pkg-config python library is not found]) ]) AC_REQ_COCCI_EXTPKG([pycaml]) AC_SUBST([PYCOCCI_MODULE], [Yes_pycocci]) AC_SUBST([PYCOCCI_FILE],[yes_pycocci.ml]) ], [dnl AC_COCCI_INIT_PKG_EMPTY([pycaml]) AC_SUBST([PYCOCCI_MODULE], [No_pycocci]) AC_SUBST([PYCOCCI_FILE],[no_pycocci.ml]) ]) dnl pcre handling dnl variables: dnl enable_pcre: whether to enable the pcre feature dnl OCAML_PKG_pcre: if "local" use str package AC_ARG_ENABLE([pcre-syntax], AS_HELP_STRING([--enable-pcre-syntax], [enable pcre regular expression syntax (default: auto)])) AS_IF([test "x$enable_pcre_syntax" != "xno"], [dnl PKG_CHECK_MODULES([PCRE], [libpcre],[AC_SUBST([HAVE_PCRE],[yes])],[AC_SUBST([HAVE_PCRE],[no])]) AS_IF([test -z "$enable_pcre_syntax" -a "x$HAVE_PCRE" != xyes], [dnl AC_SUBST([enable_pcre_syntax], [no]) ], [dnl AC_CHECK_COCCI_EXTPKG([pcre]) dnl will set $enable_pcre to 'yes', 'no', or 'local' enable_pcre_syntax=$enable_pcre ]) ]) AS_IF([test "x$enable_pcre_syntax" != xno], [dnl AS_IF([test "x$HAVE_PCRE" = xyes], [dnl AC_MSG_NOTICE([support for pcre syntax is enabled]) ], [dnl AC_MSG_ERROR([the pcre feature is enabled but the pkg-config libpcre library is not found]) ]) AC_SUBST([REGEXP_MODULE], [Regexp_pcre]) AC_SUBST([REGEXP_FILE], [regexp_pcre.ml]) ], [dnl AC_COCCI_INIT_PKG_EMPTY([pcre]) AC_SUBST([REGEXP_MODULE], [Regexp_str]) AC_SUBST([REGEXP_FILE], [regexp_str.ml]) ]) dnl AC_CACHE_SAVE dnl obtain the value of $prefix AS_IF([test "$prefix" = "NONE"],[prefix=$ac_default_prefix]) dnl dnl backwards compatibility dnl dnl defines some variables needed by the Make infrastructure AC_SUBST(SHAREDIR,["${prefix}/share/coccinelle"]) AS_IF([test "x$enable_python" != xno], [dnl AC_SUBST(FEATURE_PYTHON, [1]) ], [dnl AC_SUBST(FEATURE_PYTHON, [0]) ]) AS_IF([test "x$enable_ocaml" != xno], [dnl AC_SUBST(FEATURE_OCAML, [1]) ], [dnl AC_SUBST(FEATURE_OCAML, [0]) ]) dnl dynlink stuff depending on the OCaml version and whether it is enabled AS_IF([test "x$OCAMLATLEAST311" = xyes -a "x$enable_ocaml" = xyes -a "x$OCAMLOPT" != xno], [dnl AC_SUBST([DYNLINK_IS_NATIVE], [Dynlink.is_native]) ], [dnl AC_SUBST([DYNLINK_IS_NATIVE], [false]) ]) dnl in case of the compilation of the manual AC_COCCI_TOOL([PDFLATEX],[pdflatex],[$COCCI_SRCDIR/setup/fake-pdflatex.sh pdflatex]) dnl determine release configuration AC_ARG_ENABLE([release], [AS_HELP_STRING([--enable-release], [build with a release configuration (yes,no,profile default: no)])]) AS_IF([test -z "$enable_release"], [dnl AC_MSG_NOTICE([choosing the development Makefile configuration because the release configuration is not explicitly requested.]) AC_SUBST([enable_release], [no]) ]) AC_SUBST([MODULES_profiling],[]) AS_IF([test "x$enable_release" = xyes], [dnl set the default target to 'release' when enable_release is given AC_SUBST([MAKETARGET_ALL], [all-release]) ], [test "x$enable_release" = xno], [dnl otherwise, set the default target to 'dev' AC_SUBST([MAKETARGET_ALL], [all-dev]) ], [test "x$enable_release" = xprofile], [dnl selected profiling AS_IF([test -z "$OCAMLPROF" -o "x$OCAMLPROF" = xno], [dnl AC_MSG_ERROR([ocamlprof is required for profiling, but is absent.]) ]) dnl configuration-time overrides for profiling AC_SUBST([MAKETARGET_ALL], [all-dev]) AC_SUBST([OCAMLC], ["$COCCI_SRCDIR/setup/wrapper-ocamlcp.sh $OCAMLCORIG $OCAMLPROF"]) AC_SUBST([MODULES_profiling], [profiling.cmo]) AC_MSG_NOTICE([configured coccinelle for profiling]) ], [dnl custom target given AC_SUBST([MAKETARGET_ALL], ["$enable_release"]) ]) dnl determine whether to build the optimizing version AC_ARG_ENABLE([opt], [AS_HELP_STRING([--enable-opt], [build an optimized spatch (yes,no, default: auto)])]) AS_IF([test "x$OCAMLOPT" = xno -a "x$enable_opt" != xno], [dnl AS_IF([test -n "$enable_release" -a "x$enable_release" != xyes -a "x$enable_release" != xno], [dnl AC_MSG_NOTICE([warning: ensure that make target $enable_release does not depend on the unavailable ocamlopt]) ], [test "x$enable_opt" = xyes], [dnl AC_MSG_ERROR([the optimized version of coccinelle is requested explicitly, but ocamlopt is absent]) ], [dnl AC_MSG_NOTICE([the optimized version of coccinelle will not be build because ocamlopt is not present]) AC_SUBST([enable_opt], [no]) ]) ]) AS_IF([test "x$OCAMLVERSION" = x3.11.2 -a -z "$enable_opt"], [dnl the optimized version may not be buildable with ocaml 3.11.2 (know bug), hence disable it by default AC_MSG_NOTICE([the optimized version of coccinelle will not be build by default due to OCaml version $OCAMLVERSION]) AC_SUBST([enable_opt], [no]) ]) dnl disable the optimized target when dynlinking is enabled but the optimized version of dynlink is not available AS_IF([test "x$OPTIMIZED_dynlink" = xno -a "x$enable_ocaml" = xyes], [dnl AS_IF([test -z "$enable_opt"], [dnl AC_MSG_NOTICE([the optimized version of coccinelle will not be build by default because ocaml scripting is enabled but the required optimized dynlink package is not present]) AC_SUBST([enable_opt], [no]) ], [test "x$enable_opt" = xyes], [dnl AC_MSG_ERROR([the optimized version of coccinelle in combination with ocaml scripting requires the optimized version of the dynlik package, which is not present]) ]) ]) dnl set the default enable-opt setting AS_IF([test -z "$enable_opt"], [dnl AS_IF([test "x$enable_release" = xyes -o "x$enable_release" = xno], [dnl AC_SUBST([enable_opt], ["$enable_release"]) ]) ]) dnl variables depending on whether we build the optimized spatch AS_IF([test "x$enable_opt" = xyes], [dnl default target for the optimized version AC_SUBST([SPATCHNAME], [spatch.opt]) AC_SUBST([MAKETARGET_SPATCH], [opt-only]) ], [dnl default target for the bytecode version AC_SUBST([SPATCHNAME], [spatch]) AC_SUBST([MAKETARGET_SPATCH], [byte-only]) ]) dnl ocamlbuild handling AC_ARG_ENABLE([ocamlbuild], AS_HELP_STRING([--enable-ocamlbuild], [enable ocamlbuild support (default: no)])) AS_IF([test "x$enable_ocamlbuild" = xyes], [dnl ocamlbuild support requested AS_IF([test -z "$OCAMLBUILD" -o "x$OCAMLBUILD" = xno], [dnl AC_MSG_ERROR([Ocamlbuild is required but is not installed.]) ]) AC_SUBST([FEATURE_OCAMLBUILD], [yes]) ], [dnl default: disable ocamlbuild support AC_SUBST([FEATURE_OCAMLBUILD], [ ]) ]) dnl dnl generating configuration dnl AC_CONFIG_FILES([ Makefile.config version.ml commons/commands.ml globals/config.ml globals/regexp.ml python/pycocci.ml ocaml/prepare_ocamlcocci.ml scripts/spatch.sh docs/spatch.1 myocamlbuild.ml setup/Makefile ]) AC_OUTPUT AC_MSG_NOTICE([configuration completed]) cat << EOF ------------------------------------------------------------------------------ Summary configure flags: $CONFIGURE_FLAGS findlib: $OCAMLFIND (an actual version is strongly recommended) menhir: $MENHIR (should be an optional tool) menhirLib module: $enable_menhirLib (for local package use --disable-menhirLib) ocaml scripting: $enable_ocaml (overridable with --enable-ocaml) python scripting: $enable_python (overridable with --enable-python) pycaml module: $enable_pycaml (for local package use --disable-pycaml) pcre regexes: $enable_pcre_syntax (overridable with --enable-pcre-syntax) pcre module: $enable_pcre (for local package use --disable-pcre) pcre library: $HAVE_PCRE (requires the dev version of libpcre) release config: $enable_release (strongly recommended to be 'yes', overridable with --enable-release) optimized spatch: $enable_opt (overridable with --disable-opt) ------------------------------------------------------------------------------ Coccinelle can now be compiled and installed. If you compile coccinelle again after source code changes or configuration changes, you may need to run first: \$ make clean To compile coccinelle, run: \$ make all To install coccinelle, run: \$ make install Then, to test coccinelle, run for example: \$ spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c Or when coccinelle is not installed yet: \$ COCCINELLE_HOME=$(pwd) ./scripts/spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c EOF if test "x$enable_python" != "xno"; then cat << EOF ------------------------------------------------------------------------------ You may need to set some environment variables so that the python libraries are found. The frontend 'spatch' sets the following variables: \$ export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:$prefix/lib \$ export PYTHONPATH=\$PYTHONPATH:$prefix/share/coccinelle/python EOF fi cat << EOF ------------------------------------------------------------------------------ EOF coccinelle-1.0.0-rc19/cocci.mli0000644000175000017500000000637212247442614015155 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci.mli" open Common (* full_engine takes (coccifile, isofile) and cfiles in parameters and * returns a list associating to the input cfiles, and maybe header * files that was also required to be modified, the files containing the * result (in general files in /tmp). * pre_engine does the compilation of the SmPL code and runs any initially * scripts * post_engine runs any finally scripts * * This function uses memoisation internally, which is useful when * using -dir to not redo twice the same work. So take care! *) type cocci_info type constant_info = string list option (*grep tokens*) * string list option (*glimpse tokens*) * (Str.regexp * Str.regexp list) option (*coccigrep tokens*) * Get_constants2.combine option val pre_engine : (filename * filename) -> cocci_info * constant_info val worth_trying : filename list -> constant_info -> bool val full_engine : cocci_info -> filename list -> (filename * filename option) list val post_engine : cocci_info -> unit (* because of the #include "toto.c" and also because we may associate the * same C file to multiple drivers because they share code, we can * modify multiple times the same file when use -dir. This check * remove duplicates and check that the modification are consistent * among the different drivers. *) val check_duplicate_modif : (filename * filename option) list -> (filename * filename option) list (* provides memoization *) val sp_of_file : filename (* coccifile *) -> filename option (* isofile *) -> Ast_cocci.metavar list list * Ast_cocci.rule list * Ast_cocci.meta_name list list list * Ast_cocci.meta_name list list list * (Ast_cocci.meta_name list list list (*used after list*) * (*fresh used after list*) Ast_cocci.meta_name list list list * (*fresh used after list seeds*) Ast_cocci.meta_name list list list) * Ast_cocci.meta_name list list list * (string list option (*grep tokens*) * string list option (*glimpse tokens*) * (Str.regexp * Str.regexp list) option (*coccigrep tokens*) * Get_constants2.combine option) * bool (* format information needed for strings? *) val normalize_path : string -> string coccinelle-1.0.0-rc19/standard.h0000644000175000017500000005222012247437436015342 0ustar eugeneugen// **************************************************************************** // Prelude, this file is used with -macro_file_builtins option of the C parser // **************************************************************************** /* This file contains: * - macros found in <.h> * - macros found in ".h" * but where we cannot detect that it will be a "bad macro" * - hints, cf below. * * A "bad macro" is a macro using free variables or when expanded * that influence the control-flow of the code. In those cases it * is preferable to expand the macro so that the coccinelle engine * has a more accurate representation of what is going on. * * * * * old: this file was also containing what is below but now we * try to expand on demand the macro found in the c file, so those cases * are not needed any more: * - macros found in .c; macros that cannot be parsed. * In the future should be autodetected * (not so easy to do same for macros in .h cos require to access .h file) * - macros found in .c; macros correctly parsed * but where we cannot detect that it will be a "bad macro" * * Some of those macros could be deleted and the C code rewritten because * they are "bad" macros. * * todo? perhaps better if could enable/disable some of those expansions * as different software may use conflicting macros. * * * can maybe have a look in sparse/lib.c to see a list of default #define * handled builtin apparently by gcc. */ // **************************************************************************** // Hints // **************************************************************************** /* Cooperation with parsing_hack.ml: some body of macros in this file, such * as MACROSTATEMENT, are considered as magic strings. * I can't just expand those macros into some 'whatever();' because I need * to generate a TMacroStmt for solving some ambiguities in the grammar * for the toplevel stuff I think. * Right now a set of special strings are used as "hints" to the parser * to help it parse code. Those hints are specified in parsing_hack.ml: * * - YACFE_ITERATOR * - YACFE_DECLARATOR * - YACFE_STRING * - YACFE_STATEMENT, or MACROSTATEMENT * - YACFE_ATTRIBUTE * - YACFE_IDENT_BUILDER */ // **************************************************************************** // Test macros // **************************************************************************** // #define FOO(a, OP, b) a OP b // #define FOO(a,b) fn(a,b) #define FOO_METH_TEST(a) YACFE_IDENT_BUILDER //#define FOO YACFE_DECLARATOR // **************************************************************************** // Generic macros // **************************************************************************** // this is defined by windows compiler, and so can not be found via a macro // after a -extract_macros // update: now handled in lexer, simplify stuff //#define __stdcall /*could: YACFE_ATTRIBUTE*/ //#define __declspec(a) //#define WINAPI //#define CALLBACK // **************************************************************************** // Linux macros // **************************************************************************** // ---------------------------------------------------------------------------- // Attributes. could perhaps generalize via "__.*" // ---------------------------------------------------------------------------- #define __init #define __exit #define __user #define __iomem #define __initdata #define __exitdata #define __devinit #define __devexit #define __devinitdata #define __cpuinit #define __cpuinitdata #define __init_or_module #define __initdata_or_module #define __pminit #define __pminitdata #define __irq_entry #define __cacheline_aligned #define ____cacheline_aligned #define __cacheline_aligned_in_smp #define ____cacheline_aligned_in_smp #define ____cacheline_internodealigned_in_smp #define __ALIGNED__ #define __3xp_aligned #define __pmac #define __force #define __nocast #define __read_mostly #define __must_check // pb #define __unused #define __maybe_unused #define __attribute_used__ #define __attribute_pure__ #define __attribute_const__ // #define _attribute__const __attribute__((const)) #define __always_inline #define __xipram // in the other part of the kernel, in arch/, mm/, etc #define __sched #define __initmv #define __exception #define __cpuexit #define __kprobes #define __meminit #define __meminitdata #define __nosavedata #define __kernel #define __nomods_init #define __apicdebuginit #define __ipc_init #define __modinit #define __lockfunc #define __weak #define __tlb_handler_align #define __lock_aligned #define __force_data #define __nongprelbss #define __nongpreldata #define __noreturn #define __section_jiffies #define __vsyscall_fn #define __section_vgetcpu_mode #define __section_vsyscall_gtod_data // in header files #define __bitwise #define __bitwise__ #define __deprecated // last found #define __init_refok // maybe only in old kernel #define __openfirmware // now in lexer //#define __extension__ #define __thread #define __used #define __pure #define __ref #define __refdata #define __uses_jump_to_uncached // last last #define __net_init #define __net_exit #define __net_initdata #define __paginginit // in mm // ---------------------------------------------------------------------------- // String macros // ---------------------------------------------------------------------------- /* string macro. normally handle quite well by mu lalr(k), but * sometimes not enough, if have for instance the XX YY case, could * be considered as a declaration with XX being a typedef, so would * Have ambiguity. So at least by adding this special case, we can * catch more correct string-macro, no more a XX YY but now a good * "XX" YY * * cf include/linux/kernel.h * * For stringification I need to have at least a witness, a string, * and sometimes have just printk(KERN_WARNING MYSTR) and it could * be transformed in a typedef later, so better to at least * transform in string already the string-macro we know. * * Perhaps better to apply also as soon as possible the * correct macro-annotation tagging (__init & co) to be able to * filter them as soon as possible so that they will not polluate * our pattern-matching that come later. */ #define KERN_EMERG "KERN_EMERG" #define KERN_ALERT "KERN_ALERT" #define KERN_CRIT "KERN_CRIT" #define KERN_ERR "KERN_ERR" #define KERN_WARNING "KERN_WARNING" #define KERN_NOTICE "KERN_NOTICE" #define KERN_INFO "KERN_INFO" #define KERN_DEBUG "KERN_DEBUG" /* EX_TABLE & co. * * Replaced by a string. We can't put everything as comment * because it can be part of an expression where we wait for * something, where we wait for a string. So at least we * must keep the EX_TABLE token and transform it as a string. * * normally not needed if have good stringification of macro * but those macros are sometimes used multiple times * as in EX_TABLE(0b) EX_TABLE(1b) and we don't detect * it well yet. */ // TODO don't use x :( #define EX_TABLE(x) "TOTO" #define ASM_EXCEPTIONTABLE_ENTRY(x) "TOTO" #define DCACHE_CLEAR(x) "TOTO" #define PPC405_ERR77(x) "TOTO" // ---------------------------------------------------------------------------- // Alias keywords // ---------------------------------------------------------------------------- // pb, false positive, can also be a #define cst and use as 'case CONST:' //#define CONST const #define STATIC static #define _static static #define noinline #define __CS4231_INLINE__ inline #define CCIO_INLINE inline #define SBA_INLINE inline #define STATIC_INLINE static inline #define __EXTERN_INLINE extern inline #define AGPEXTERN extern #define PNMI_STATIC static #define RLMT_STATIC static #define SISINITSTATIC static #define SCTP_STATIC static #define BUGLVL if #define IFDEBUG if #define TRACE_EXIT return #define notrace #define noinline_for_stack // in fs #define debug_noinline // in net // ---------------------------------------------------------------------------- // linkage // ---------------------------------------------------------------------------- #define fastcall #define asmlinkage #define far #define SK_FAR // pb //#define near // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- #define INITSECTION #define NORET_TYPE #define compat_init_data #define DIVA_EXIT_FUNCTION #define DIVA_INIT_FUNCTION #define ACPI_SYSTEM_XFACE #define ASC_INITDATA #define in2000__INITDATA #define PACKED #define WPMINFO #define CPMINFO #define PMINFO #define ACPI_INTERNAL_VAR_XFACE #define SISIOMEMTYPE #define ACPI_STATE_COMMON #define ACPI_PARSE_COMMON #define ACPI_COMMON_DEBUG_MEM_HEADER #define nabi_no_regargs #define ATTRIB_NORET #define ATTRIBUTE_UNUSED #define BTEXT #define BTDATA #define PAGE_ALIGNED #define EARLY_INIT_SECTION_ATTR // pb //#define INIT #define IDI_CALL_ENTITY_T #define IDI_CALL_LINK_T /* cf gcc-linux.h * A trick to suppress uninitialized variable warning without generating any * code */ #define uninitialized_var(x) x = x // as in u16 uninitialized_var(ioboard_type); /* GCC be quiet */ // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- #define __releases(x) #define __acquires(x) //now in lexer //#define __declspec(x) #define __page_aligned(x) #define __aligned(x) #define __vsyscall(x) // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- //conflict with a macro of firefox //#define FASTCALL(x) x #define PARAMS(x) x // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // include/asm-arm/mach/arch.h // #define MACHINE_START(x) struct foo { x } #define MACHINE_START(_type,_name) \ static const struct machine_desc __mach_desc_##_type \ /* __used*/ \ __attribute__((__section__(".arch.info.init"))) = { \ .nr = MACH_TYPE_##_type, \ .name = _name, #define MACHINE_END \ }; // include/asm-powerpc/machdep.h #define define_machine(name) \ extern struct machdep_calls mach_##name; \ EXPORT_SYMBOL(mach_##name); \ struct machdep_calls mach_##name /*__machine_desc*/ = // ---------------------------------------------------------------------------- // Declare like macros (in structure def), or tricky Declare macros // ---------------------------------------------------------------------------- // include/asm-i386/pci.h // the DECLARE are detected by parsing_hack but not when they are // inside a struct def. #define DECLARE_PCI_UNMAP_ADDR(ADDR_NAME) #define DECLARE_PCI_UNMAP_LEN(LEN_NAME) // defined in drivers/infiniband/hw/mthca/mthca_doorbell.h #define MTHCA_DECLARE_DOORBELL_LOCK(doorbell_lock) // include/linux/types.h //#define BITS_TO_LONGS(bits) \ // (((bits)+BITS_PER_LONG-1)/BITS_PER_LONG) #define DECLARE_BITMAP(name,bits) // /*unsigned*/ long name[BITS_TO_LONGS(bits)] // include/asm-i386/percpu.h // interesting macro where we see the need of __typeof__(type) with // for example DECLARE_PER_CPU(char[256], iucv_dbf_txt_buf); #define DEFINE_PER_CPU(type, name) \ __attribute__((__section__(".data.percpu"))) __typeof__(type) per_cpu__##name #define DECLARE_PER_CPU(type, name) extern __typeof__(type) per_cpu__##name // include/linux/kobject.h #define decl_subsys(_name,_type,_uevent_ops) \ struct subsystem _name##_subsys = { \ .kset = { \ .kobj = { .name = __stringify(_name) }, \ .ktype = _type, \ .uevent_ops =_uevent_ops, \ } \ } // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // pb: if use this macro then we will not transform the argument of CS_CHECK // in some rules. //#define CS_CHECK(fn, ret) \ // do { last_fn = (fn); if ((last_ret = (ret)) != 0) goto cs_failed; } while (0) // bt2/hci_bcsp.c #define BCSP_CRC_INIT(x) x = 0xffff // sound/oss/cs46xx_wrapper-24.h #define CS_OWNER .owner = #define CS_THIS_MODULE THIS_MODULE, // sound/sparc/dbri.c // "bad macro", have a ',' at the end #define CS4215_SINGLE(xname, entry, shift, mask, invert) \ { .iface = SNDRV_CTL_ELEM_IFACE_MIXER, .name = xname, \ .info = snd_cs4215_info_single, \ .get = snd_cs4215_get_single, .put = snd_cs4215_put_single, \ .private_value = entry | (shift << 8) | (mask << 16) | (invert << 24) }, // drivers/media/video/sn9c102/sn9c102_sensor.h //#define sn9c102_write_const_regs(sn9c102_device, data...) \ // ({ const static u8 _valreg[][2] = {data}; \ // sn9c102_write_regs(sn9c102_device, _valreg, ARRAY_SIZE(_valreg)); }) // drivers/s390/cio/qdio.h #define SYNC_MEMORY if (unlikely(q->siga_sync)) qdio_siga_sync_q(q) #define SYNC_MEMORY_ALL if (unlikely(q->siga_sync)) \ qdio_siga_sync(q,~0U,~0U) #define SYNC_MEMORY_ALL_OUTB if (unlikely(q->siga_sync)) \ qdio_siga_sync(q,~0U,0) // drivers/scsi/g_NCR5380.c #define ANDP , // drivers/scsi/ncr53c8xx.c // generate lots of errors because error en cascade car dans l'initialiseur // il y'a des '}' dans la premiere colonne #define PREFETCH_FLUSH SCR_CALL, PADDRH (wait_dma), // drivers/net/e100.c // pbs false positive, defined in another manner in some files //#define X(a,b) a,b // net/ipv4/netfilter/ip_conntrack_helper_h323_asn1.c // also used in other.c that don't do any include :( // but locally redefined in drivers/net/bnx2.c :( with a // #define FNAME 0x8 #define FNAME(name) name, // drivers/net/tulip/de4x5.c #define DESC_ALIGN // in .h #define MPI_POINTER * // mega4/soc.c mega4/socal.c // cause false typedef inference if let soc_printk #define soc_printk printk #define socal_printk printk // ---------------------------------------------------------------------------- // Initializer array macros // ---------------------------------------------------------------------------- // drivers/net/wireless/bcm43xx/bcm43xx_wx.c // defined in similar way multiple times, in the same file and in another one #define WX(ioctl) [(ioctl) - SIOCSIWCOMMIT] // #define WX(x) [(x)-SIOCIWFIRST] // drivers/net/wireless/ipw2200.c #define IW_IOCTL(x) [(x)-SIOCSIWCOMMIT] // drivers/net/wireless/zd1211rw/zd_netdev.c #define PRIV_OFFSET(x) [(x)-SIOCIWFIRSTPRIV] // drivers/net/wireless/zd1211rw/zd_rf.h #define RF_CHANNEL(ch) [(ch)-1] // drivers/net/wireless/zd1211rw/zd_rf_uw2453.c #define RF_CHANPAIR(a,b) [CHAN_TO_PAIRIDX(a)] // drivers/net/wireless/arlan-proc.c // incomplete macro, the real macro is quite complex and use other macros #define ARLAN_SYSCTL_TABLE_TOTAL(x) // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // drivers/net/cxgb3/t3_hw.c #define VPD_ENTRY(name, len) \ u8 name##_kword[2]; u8 name##_len; u8 name##_data[len] // #define rtrc(i) {} // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- // drivers/video/nvidia/nv_type.h // use: SetBitField(h_blank_e, 5: 5, 7:7) //#define BITMASK(t,b) (((unsigned)(1U << (((t)-(b)+1)))-1) << (b)) //#define MASKEXPAND(mask) BITMASK(1?mask,0?mask) //#define SetBF(mask,value) ((value) << (0?mask)) //#define GetBF(var,mask) (((unsigned)((var) & MASKEXPAND(mask))) >> (0?mask) ) //#define SetBitField(value,from,to) SetBF(to, GetBF(value,from)) //#define SetBit(n) (1<<(n)) //#define Set8Bits(value) ((value)&0xff) // drivers/video/sis/init.c // use: GETBITSTR((SiS_Pr->CVTotal -2), 10:10, 0:0) //#define BITMASK(h,l) (((unsigned)(1U << ((h)-(l)+1))-1)<<(l)) //#define GENMASK(mask) BITMASK(1?mask,0?mask) //#define GETBITS(var,mask) (((var) & GENMASK(mask)) >> (0?mask)) //#define GETBITSTR(val,from,to) ((GETBITS(val,from)) << (0?to)) // fs/afs/internal.h #define ASSERTCMP(X, OP, Y) \ do { \ if (unlikely(!((X) OP (Y)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu " /*#OP*/ " %lu is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ printk(KERN_ERR "0x%lx " /*#OP*/ " 0x%lx is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ BUG(); \ } \ } while(0) #define ASSERTIFCMP(C, X, OP, Y) \ do { \ if (unlikely((C) && !((X) OP (Y)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu " /*#OP*/ " %lu is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ printk(KERN_ERR "0x%lx " /*#OP*/ " 0x%lx is false\n", \ (unsigned long)(X), (unsigned long)(Y)); \ BUG(); \ } \ } while(0) #define ASSERTRANGE(L, OP1, N, OP2, H) \ do { \ if (unlikely(!((L) OP1 (N)) || !((N) OP2 (H)))) { \ printk(KERN_ERR "\n"); \ printk(KERN_ERR "AFS: Assertion failed\n"); \ printk(KERN_ERR "%lu "/*#OP1*/" %lu "/*#OP2*/" %lu is false\n", \ (unsigned long)(L), (unsigned long)(N), \ (unsigned long)(H)); \ printk(KERN_ERR "0x%lx "/*#OP1*/" 0x%lx "/*#OP2*/" 0x%lx is false\n", \ (unsigned long)(L), (unsigned long)(N), \ (unsigned long)(H)); \ BUG(); \ } \ } while(0) // loop, macro without ';', single macro. ex: DEBUG() // TODO should find the definition because we don't use 'x' and so // may lose code sites with coccinelle. If expand correctly, will // still don't transform correctly but at least will detect the place. #define ASSERT(x) MACROSTATEMENT #define IRDA_ASSERT(x) MACROSTATEMENT #define CHECK_NULL(x) MACROSTATEMENT //#define DEBUG(x) MACROSTATEMENT #define DEBUG0(x) MACROSTATEMENT #define DEBUG1(x) MACROSTATEMENT #define DEBUG2(x) MACROSTATEMENT #define DEBUG3(x) MACROSTATEMENT #define DBG(x) MACROSTATEMENT #define DEB(x) MACROSTATEMENT #define PARSEDEBUG(x) MACROSTATEMENT #define DEBC(x) MACROSTATEMENT #define DBG_TRC(x) MACROSTATEMENT #define DBG_ERR(x) MACROSTATEMENT #define DBG_FTL(x) MACROSTATEMENT #define DBGINFO(x) MACROSTATEMENT #define DFLOW(x) MACROSTATEMENT #define DFLIP(x) MACROSTATEMENT #define DLOG_INT_TRIG(x) MACROSTATEMENT #define D3(x) MACROSTATEMENT #define D1(x) MACROSTATEMENT #define DB(x) MACROSTATEMENT #define DCBDEBUG(x) MACROSTATEMENT #define SCSI_LOG_MLQUEUE(x) MACROSTATEMENT #define PLND(x) MACROSTATEMENT #define FCALND(x) MACROSTATEMENT #define FCALD(x) MACROSTATEMENT #define DEBUGRECURSION(x) MACROSTATEMENT #define DEBUGPIO(x) MACROSTATEMENT #define VDEB(x) MACROSTATEMENT #define READ_UNLOCK_IRQRESTORE(x) MACROSTATEMENT #define TRACE_CATCH(x) MACROSTATEMENT #define PDBGG(x) MACROSTATEMENT #define IF_ABR(x) MACROSTATEMENT #define IF_EVENT(x) MACROSTATEMENT #define IF_ERR(x) MACROSTATEMENT #define IF_CBR(x) MACROSTATEMENT #define IF_INIT(x) MACROSTATEMENT #define IF_RX(x) MACROSTATEMENT #define SOD(x) MACROSTATEMENT #define KDBG(x) MACROSTATEMENT #define IRDA_ASSERT_LABEL(x) MACROSTATEMENT // ---------------------------------------------------------------------------- // Difficult foreach // ---------------------------------------------------------------------------- // include/linux/sched.h #define while_each_thread(g, t) \ while ((t = next_thread(t)) != g) // net/decnet/dn_fib.c #define for_fib_info() { struct dn_fib_info *fi;\ for(fi = dn_fib_info_list; fi; fi = fi->fib_next) #define endfor_fib_info() } #define for_nexthops(fi) { int nhsel; const struct dn_fib_nh *nh;\ for(nhsel = 0, nh = (fi)->fib_nh; nhsel < (fi)->fib_nhs; nh++, nhsel++) #define change_nexthops(fi) { int nhsel; struct dn_fib_nh *nh;\ for(nhsel = 0, nh = (struct dn_fib_nh *)((fi)->fib_nh); nhsel < (fi)->fib_nhs; nh++, nhsel++) #define endfor_nexthops(fi) } // ---------------------------------------------------------------------------- // Macros around function prototype // ---------------------------------------------------------------------------- // net/sched/em_meta.c #define META_COLLECTOR(FUNC) static void meta_##FUNC(struct sk_buff *skb, \ struct tcf_pkt_info *info, struct meta_value *v, \ struct meta_obj *dst, int *err) #define GDTH_INITFUNC(x,y) x y #define ASC_INITFUNC(x,y) x y // ---------------------------------------------------------------------------- // If-like macros // ---------------------------------------------------------------------------- // include/linux/lockd/debug.h // include/linux/nfs_fs.h // include/linux/nfsd/debug.h // include/linux/sunrpc/debug.h //#define ifdebug(flag) if (unlikely(nlm_debug & NLMDBG_##flag)) #define ifdebug(flag) if (0) // ---------------------------------------------------------------------------- //#define __PROM_O32 // ---------------------------------------------------------------------------- // for tests-big/ macros, may be obsolete now cos fixed in latest kernel // ---------------------------------------------------------------------------- // rule10 //#define ACPI_MODULE_NAME(x) coccinelle-1.0.0-rc19/configure0000755000175000017500000177474012247442574015322 0ustar eugeneugen#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.69 for coccinelle 1.0.0-rc19. # # Report bugs to . # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. $as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 as_fn_exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : else exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" if (eval "$as_required") 2>/dev/null; then : as_have_required=yes else as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir/$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : CONFIG_SHELL=$as_shell as_have_required=yes if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : break 2 fi fi done;; esac as_found=false done $as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : CONFIG_SHELL=$SHELL as_have_required=yes fi; } IFS=$as_save_IFS if test "x$CONFIG_SHELL" != x; then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. $as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno; then : $as_echo "$0: This script requires a shell more modern than all" $as_echo "$0: the shells that I found on your system." if test x${ZSH_VERSION+set} = xset ; then $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" $as_echo "$0: be upgraded to zsh 4.3.4 or later." else $as_echo "$0: Please tell bug-autoconf@gnu.org and $0: cocci@systeme.lip6.fr about your system, including any $0: error possibly output before this message. Then install $0: a modern shell, or manually run the script under such a $0: shell if you do have one." fi exit 1 fi fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" as_awk_strverscmp=' # Use only awk features that work with 7th edition Unix awk (1978). # My, what an old awk you have, Mr. Solaris! END { while (length(v1) && length(v2)) { # Set d1 to be the next thing to compare from v1, and likewise for d2. # Normally this is a single character, but if v1 and v2 contain digits, # compare them as integers and fractions as strverscmp does. if (v1 ~ /^[0-9]/ && v2 ~ /^[0-9]/) { # Split v1 and v2 into their leading digit string components d1 and d2, # and advance v1 and v2 past the leading digit strings. for (len1 = 1; substr(v1, len1 + 1) ~ /^[0-9]/; len1++) continue for (len2 = 1; substr(v2, len2 + 1) ~ /^[0-9]/; len2++) continue d1 = substr(v1, 1, len1); v1 = substr(v1, len1 + 1) d2 = substr(v2, 1, len2); v2 = substr(v2, len2 + 1) if (d1 ~ /^0/) { if (d2 ~ /^0/) { # Compare two fractions. while (d1 ~ /^0/ && d2 ~ /^0/) { d1 = substr(d1, 2); len1-- d2 = substr(d2, 2); len2-- } if (len1 != len2 && ! (len1 && len2 && substr(d1, 1, 1) == substr(d2, 1, 1))) { # The two components differ in length, and the common prefix # contains only leading zeros. Consider the longer to be less. d1 = -len1 d2 = -len2 } else { # Otherwise, compare as strings. d1 = "x" d1 d2 = "x" d2 } } else { # A fraction is less than an integer. exit 1 } } else { if (d2 ~ /^0/) { # An integer is greater than a fraction. exit 2 } else { # Compare two integers. d1 += 0 d2 += 0 } } } else { # The normal case, without worrying about digits. d1 = substr(v1, 1, 1); v1 = substr(v1, 2) d2 = substr(v2, 1, 1); v2 = substr(v2, 2) } if (d1 < d2) exit 1 if (d1 > d2) exit 2 } # Beware Solaris /usr/xgp4/bin/awk (at least through Solaris 10), # which mishandles some comparisons of empty strings to integers. if (length(v2)) exit 1 if (length(v1)) exit 2 } ' test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='coccinelle' PACKAGE_TARNAME='coccinelle' PACKAGE_VERSION='1.0.0-rc19' PACKAGE_STRING='coccinelle 1.0.0-rc19' PACKAGE_BUGREPORT='cocci@systeme.lip6.fr' PACKAGE_URL='http://coccinelle.lip6.fr/' ac_unique_file="cocci.ml" ac_subst_vars='am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS LIBOBJS FEATURE_OCAMLBUILD MAKETARGET_SPATCH SPATCHNAME enable_opt MAKETARGET_ALL MODULES_profiling enable_release SUBSTITUTED_PDFLATEX with_PDFLATEX PDFLATEX DYNLINK_IS_NATIVE FEATURE_OCAML FEATURE_PYTHON SHAREDIR REGEXP_FILE REGEXP_MODULE MAKE_pcre OPTFLAGS_pcre enable_pcre GLOBAL_pcre OCAML_PKG_pcre enable_pcre_syntax HAVE_PCRE PCRE_LIBS PCRE_CFLAGS PYCOCCI_FILE PYCOCCI_MODULE MAKE_pycaml OPTFLAGS_pycaml GLOBAL_pycaml OCAML_PKG_pycaml enable_python HAVE_PYTHON PYTHON_LIBS PYTHON_CFLAGS PYVER_MAJOR SUBSTITUTED_PYTHON with_PYTHON enable_pycaml PYTHON OCAMLCOCCI_FILE OCAMLCOCCI_MODULE enable_ocaml SUBSTITUTED_MENHIR with_MENHIR MENHIR OPTIMIZED_dynlink MAKE_menhirLib OPTFLAGS_menhirLib enable_menhirLib GLOBAL_menhirLib OCAML_PKG_menhirLib MAKE_camlp4 OPTFLAGS_camlp4 enable_camlp4 GLOBAL_camlp4 OCAML_PKG_camlp4 MAKE_dynlink OPTFLAGS_dynlink enable_dynlink GLOBAL_dynlink OCAML_PKG_dynlink PATH_str OCAML_PKG_str PATH_num OCAML_PKG_num PATH_bigarray OCAML_PKG_bigarray PATH_unix OCAML_PKG_unix PATH_camlp4 MODULESOPT_camlp4 MODULES_camlp4 FLAGS_camlp4 LOCALLIB_camlp4 FEATURE_camlp4 PATH_pycaml MODULESOPT_pycaml MODULES_pycaml FLAGS_pycaml LOCALLIB_pycaml FEATURE_pycaml PATH_pcre MODULESOPT_pcre MODULES_pcre FLAGS_pcre LOCALLIB_pcre FEATURE_pcre PATH_dynlink MODULESOPT_dynlink MODULES_dynlink FLAGS_dynlink LOCALLIB_dynlink FEATURE_dynlink PATH_menhirLib MODULESOPT_menhirLib MODULES_menhirLib FLAGS_menhirLib LOCALLIB_menhirLib FEATURE_menhirLib COCCI_OCAML_EXTERNAL RUNTIME_CAMLP4O_CMD RUNTIME_CAMLP4_CMD RUNTIME_OCAMLDEP_CMD RUNTIME_OCAMLOPT_CMD RUNTIME_OCAMLC_CMD RUNTIME_OCAMLFIND_CMD SUBSTITUTED_OCAMLPROF with_OCAMLPROF OCAMLPROF SUBSTITUTED_OCAMLFIND with_OCAMLFIND OCAMLFIND SUBSTITUTED_OCAMLYACC with_OCAMLYACC SUBSTITUTED_OCAMLLEX with_OCAMLLEX CAMLP4RF CAMLP4R CAMLP4PROF CAMLP4ORF CAMLP4OOF CAMLP4OF CAMLP4O CAMLP4BOOT CAMLP4 OCAMLCORIG OCAMLATLEAST311 OCAMLATLEAST310 OCAMLBUILD OCAMLDOC OCAMLMKLIB OCAMLMKTOP OCAMLDEP OCAML OCAMLOPTDOTOPT OCAMLCDOTOPT OCAMLBEST OCAMLOPT OCAMLLIB OCAMLVERSION OCAMLC PKG_CONFIG_ORIG SUBSTITUTED_PKG_CONFIG OCAMLYACC OCAMLLEXDOTOPT OCAMLLEX PKG_CONFIG_LIBDIR PKG_CONFIG_PATH with_PKG_CONFIG PKG_CONFIG PATCHELF INSTALL ECHO PATCH TAR BASH CPP am__fastdepCC_FALSE am__fastdepCC_TRUE CCDEPMODE am__nodep AMDEPBACKSLASH AMDEP_FALSE AMDEP_TRUE am__quote am__include DEPDIR OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC DATE GIT CONFVERSION AM_BACKSLASH AM_DEFAULT_VERBOSITY AM_DEFAULT_V AM_V am__untar am__tar AMTAR am__leading_dot SET_MAKE AWK mkdir_p MKDIR_P INSTALL_STRIP_PROGRAM STRIP install_sh MAKEINFO AUTOHEADER AUTOMAKE AUTOCONF ACLOCAL VERSION PACKAGE CYGPATH_W am__isrc INSTALL_DATA INSTALL_SCRIPT INSTALL_PROGRAM COCCI_SRCDIR COCCI_VERSION CONFIGURE_FLAGS target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL PYVER' ac_subst_files='' ac_user_opts=' enable_option_checking enable_silent_rules enable_dependency_tracking with_pkg_config with_ocamllex with_ocamlyacc with_ocamlfind with_ocamlprof with_runtime_ocamlfind with_runtime_ocamlc with_runtime_ocamlopt with_runtime_ocamldep with_runtime_camlp4 with_runtime_camlp4o enable_dynlink enable_camlp4 enable_menhirLib with_menhir enable_ocaml enable_python with_python enable_pycaml enable_pcre_syntax enable_pcre with_pdflatex enable_release enable_opt enable_ocamlbuild ' ac_precious_vars='PYVER build_alias host_alias target_alias CC CFLAGS LDFLAGS LIBS CPPFLAGS CPP PKG_CONFIG PKG_CONFIG_PATH PKG_CONFIG_LIBDIR OCAMLLEX OCAMLYACC OCAMLFIND OCAMLPROF RUNTIME_OCAMLFIND_CMD RUNTIME_OCAMLC_CMD RUNTIME_OCAMLOPT_CMD RUNTIME_OCAMLDEP_CMD RUNTIME_CAMLP4_CMD RUNTIME_CAMLP4O_CMD COCCI_OCAML_EXTERNAL MENHIR PYTHON PYTHON_CFLAGS PYTHON_LIBS PCRE_CFLAGS PCRE_LIBS PDFLATEX' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error $? "unrecognized option: \`$ac_option' Try \`$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures coccinelle 1.0.0-rc19 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/coccinelle] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF Program names: --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of coccinelle 1.0.0-rc19:";; esac cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-silent-rules less verbose build output (undo: "make V=1") --disable-silent-rules verbose build output (undo: "make V=0") --enable-dependency-tracking do not reject slow dependency extractors --disable-dependency-tracking speeds up one-time build --enable-dynlink enable global package dynlink (yes,no) (default: auto) --enable-camlp4 enable global package camlp4 (yes,no) (default: auto) --enable-menhirLib enable global package menhirLib (yes,no) (default: auto) --enable-ocaml enable ocaml scripting (default: auto) --enable-python enable python scripting (yes/no) (default: auto) --enable-pycaml enable global package pycaml (yes,no) (default: auto) --enable-pcre-syntax enable pcre regular expression syntax (default: auto) --enable-pcre enable global package pcre (yes,no) (default: auto) --enable-release build with a release configuration (yes,no,profile default: no) --enable-opt build an optimized spatch (yes,no, default: auto) --enable-ocamlbuild enable ocamlbuild support (default: no) Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-pkg-config whether/which pkg-config to use (default: auto) --with-ocamllex whether/which ocamllex to use (default: auto) --with-ocamlyacc whether/which ocamlyacc to use (default: auto) --with-ocamlfind whether/which ocamlfind to use (default: auto) --with-ocamlprof whether/which ocamlprof to use (default: auto) --with-runtime-ocamlfind override the runtime cmd for ocamlfind --with-runtime-ocamlc override the runtime cmd for ocamlc --with-runtime-ocamlopt override the runtime cmd for ocamlopt --with-runtime-ocamldep override the runtime cmd for ocamldep --with-runtime-camlp4 override the runtime cmd for camlp4 --with-runtime-camlp4o override the runtime cmd for camlp4o --with-menhir whether/which menhir to use (default: auto) --with-python whether/which python to use (default: auto) --with-pdflatex whether/which pdflatex to use (default: auto) Some influential environment variables: PYVER python version CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor PKG_CONFIG path to pkg-config PKG_CONFIG_PATH directories to add to pkg-config's search path PKG_CONFIG_LIBDIR path overriding pkg-config's built-in search path OCAMLLEX path to ocamllex OCAMLYACC path to ocamlyacc OCAMLFIND path to ocamlfind OCAMLPROF path to ocamlprof RUNTIME_OCAMLFIND_CMD path to ocamlfind RUNTIME_OCAMLC_CMD path to ocamlc RUNTIME_OCAMLOPT_CMD path to ocamlopt RUNTIME_OCAMLDEP_CMD path to ocamldep RUNTIME_CAMLP4_CMD path to camlp4 RUNTIME_CAMLP4O_CMD path to camlp4o COCCI_OCAML_EXTERNAL path to extra ocaml packages (default: $COCCI_SRCDIR/bundles) MENHIR path to menhir PYTHON path to python when the version is determined automatically PYTHON_CFLAGS C compiler flags for PYTHON, overriding pkg-config PYTHON_LIBS linker flags for PYTHON, overriding pkg-config PCRE_CFLAGS C compiler flags for PCRE, overriding pkg-config PCRE_LIBS linker flags for PCRE, overriding pkg-config PDFLATEX path to pdflatex Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . coccinelle home page: . _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF coccinelle configure 1.0.0-rc19 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then : ac_retval=0 else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_try_cpp LINENO # ---------------------- # Try to preprocess conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_cpp () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : ac_retval=0 else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by coccinelle $as_me 1.0.0-rc19, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. $as_echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo $as_echo "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo $as_echo "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then $as_echo "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then $as_echo "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && $as_echo "$as_me: caught signal $ac_signal" $as_echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h $as_echo "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_URL "$PACKAGE_URL" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then # We do not want a PATH search for config.site. case $CONFIG_SITE in #(( -*) ac_site_file1=./$CONFIG_SITE;; */*) ac_site_file1=$CONFIG_SITE;; *) ac_site_file1=./$CONFIG_SITE;; esac elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site else ac_site_file1=$ac_default_prefix/share/config.site ac_site_file2=$ac_default_prefix/etc/config.site fi for ac_site_file in "$ac_site_file1" "$ac_site_file2" do test "x$ac_site_file" = xNONE && continue if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 $as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 $as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 $as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 $as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 $as_echo "$as_me: former value: \`$ac_old_val'" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 $as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_aux_dir= for ac_dir in setup "$srcdir"/setup; do if test -f "$ac_dir/install-sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f "$ac_dir/install.sh"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f "$ac_dir/shtool"; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then as_fn_error $? "cannot find install-sh, install.sh, or shtool in setup \"$srcdir\"/setup" "$LINENO" 5 fi # These three variables are undocumented and unsupported, # and are intended to be withdrawn in a future Autoconf release. # They can cause serious problems if a builder's source tree is in a directory # whose full name contains unusual characters. ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. CONFIGURE_FLAGS="$*" COCCI_VERSION="$PACKAGE_VERSION" COCCI_SRCDIR="$(pwd)" { $as_echo "$as_me:${as_lineno-$LINENO}: configuring coccinelle $COCCI_VERSION in $COCCI_SRCDIR" >&5 $as_echo "$as_me: configuring coccinelle $COCCI_VERSION in $COCCI_SRCDIR" >&6;} am__api_version='1.13' # Find a good install program. We prefer a C program (faster), # so one script is as good as another. But avoid the broken or # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install # AmigaOS /C/install, which installs bootblocks on floppy discs # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # OS/2's system install, which has a completely different semantic # ./install, which can be erroneously created by make from ./install.sh. # Reject install programs that cannot install multiple files. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 $as_echo_n "checking for a BSD-compatible install... " >&6; } if test -z "$INSTALL"; then if ${ac_cv_path_install+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. # Account for people who put trailing slashes in PATH elements. case $as_dir/ in #(( ./ | .// | /[cC]/* | \ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ /usr/ucb/* ) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. # Don't use installbsd from OSF since it installs stuff as root # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. : elif test $ac_prog = install && grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # program-specific install script used by HP pwplus--don't use. : else rm -rf conftest.one conftest.two conftest.dir echo one > conftest.one echo two > conftest.two mkdir conftest.dir if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && test -s conftest.one && test -s conftest.two && test -s conftest.dir/conftest.one && test -s conftest.dir/conftest.two then ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" break 3 fi fi fi done done ;; esac done IFS=$as_save_IFS rm -rf conftest.one conftest.two conftest.dir fi if test "${ac_cv_path_install+set}" = set; then INSTALL=$ac_cv_path_install else # As a last resort, use the slow shell script. Don't cache a # value for INSTALL within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the value is a relative name. INSTALL=$ac_install_sh fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 $as_echo "$INSTALL" >&6; } # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 $as_echo_n "checking whether build environment is sane... " >&6; } # Reject unsafe characters in $srcdir or the absolute working directory # name. Accept space and tab only in the latter. am_lf=' ' case `pwd` in *[\\\"\#\$\&\'\`$am_lf]*) as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; esac case $srcdir in *[\\\"\#\$\&\'\`$am_lf\ \ ]*) as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; esac # Do 'set' in a subshell so we don't clobber the current shell's # arguments. Must try -L first in case configure is actually a # symlink; some systems play weird games with the mod time of symlinks # (eg FreeBSD returns the mod time of the symlink's containing # directory). if ( am_has_slept=no for am_try in 1 2; do echo "timestamp, slept: $am_has_slept" > conftest.file set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` if test "$*" = "X"; then # -L didn't work. set X `ls -t "$srcdir/configure" conftest.file` fi if test "$*" != "X $srcdir/configure conftest.file" \ && test "$*" != "X conftest.file $srcdir/configure"; then # If neither matched, then we have a broken ls. This can happen # if, for instance, CONFIG_SHELL is bash and it inherits a # broken ls alias from the environment. This has actually # happened. Such a system could not be considered "sane". as_fn_error $? "ls -t appears to fail. Make sure there is not a broken alias in your environment" "$LINENO" 5 fi if test "$2" = conftest.file || test $am_try -eq 2; then break fi # Just in case. sleep 1 am_has_slept=yes done test "$2" = conftest.file ) then # Ok. : else as_fn_error $? "newly created file is older than distributed files! Check your system clock" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } # If we didn't sleep, we still need to ensure time stamps of config.status and # generated files are strictly newer. am_sleep_pid= if grep 'slept: no' conftest.file >/dev/null 2>&1; then ( sleep 1 ) & am_sleep_pid=$! fi rm -f conftest.file test "$program_prefix" != NONE && program_transform_name="s&^&$program_prefix&;$program_transform_name" # Use a double $ so make ignores it. test "$program_suffix" != NONE && program_transform_name="s&\$&$program_suffix&;$program_transform_name" # Double any \ or $. # By default was `s,x,x', remove it if useless. ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` # expand $ac_aux_dir to an absolute path am_aux_dir=`cd $ac_aux_dir && pwd` if test x"${MISSING+set}" != xset; then case $am_aux_dir in *\ * | *\ *) MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; *) MISSING="\${SHELL} $am_aux_dir/missing" ;; esac fi # Use eval to expand $SHELL if eval "$MISSING --is-lightweight"; then am_missing_run="$MISSING " else am_missing_run= { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5 $as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;} fi if test x"${install_sh}" != xset; then case $am_aux_dir in *\ * | *\ *) install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; *) install_sh="\${SHELL} $am_aux_dir/install-sh" esac fi # Installed binaries are usually stripped using 'strip' when the user # run "make install-strip". However 'strip' might not be the right # tool to use in cross-compilation environments, therefore Automake # will honor the 'STRIP' environment variable to overrule this program. if test "$cross_compiling" != no; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. set dummy ${ac_tool_prefix}strip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_STRIP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$STRIP"; then ac_cv_prog_STRIP="$STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_STRIP="${ac_tool_prefix}strip" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi STRIP=$ac_cv_prog_STRIP if test -n "$STRIP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 $as_echo "$STRIP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_prog_STRIP"; then ac_ct_STRIP=$STRIP # Extract the first word of "strip", so it can be a program name with args. set dummy strip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_STRIP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_STRIP"; then ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_STRIP="strip" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP if test -n "$ac_ct_STRIP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 $as_echo "$ac_ct_STRIP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_ct_STRIP" = x; then STRIP=":" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac STRIP=$ac_ct_STRIP fi else STRIP="$ac_cv_prog_STRIP" fi fi INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 $as_echo_n "checking for a thread-safe mkdir -p... " >&6; } if test -z "$MKDIR_P"; then if ${ac_cv_path_mkdir+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_prog in mkdir gmkdir; do for ac_exec_ext in '' $ac_executable_extensions; do as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( 'mkdir (GNU coreutils) '* | \ 'mkdir (coreutils) '* | \ 'mkdir (fileutils) '4.1*) ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext break 3;; esac done done done IFS=$as_save_IFS fi test -d ./--version && rmdir ./--version if test "${ac_cv_path_mkdir+set}" = set; then MKDIR_P="$ac_cv_path_mkdir -p" else # As a last resort, use the slow shell script. Don't cache a # value for MKDIR_P within a source directory, because that will # break other packages using the cache if that directory is # removed, or if the value is a relative name. MKDIR_P="$ac_install_sh -d" fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 $as_echo "$MKDIR_P" >&6; } for ac_prog in gawk mawk nawk awk do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_AWK+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$AWK"; then ac_cv_prog_AWK="$AWK" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_AWK="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi AWK=$ac_cv_prog_AWK if test -n "$AWK"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 $as_echo "$AWK" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$AWK" && break done { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 $as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' _ACEOF # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. case `${MAKE-make} -f conftest.make 2>/dev/null` in *@@@%%%=?*=@@@%%%*) eval ac_cv_prog_make_${ac_make}_set=yes;; *) eval ac_cv_prog_make_${ac_make}_set=no;; esac rm -f conftest.make fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } SET_MAKE= else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } SET_MAKE="MAKE=${MAKE-make}" fi rm -rf .tst 2>/dev/null mkdir .tst 2>/dev/null if test -d .tst; then am__leading_dot=. else am__leading_dot=_ fi rmdir .tst 2>/dev/null # Check whether --enable-silent-rules was given. if test "${enable_silent_rules+set}" = set; then : enableval=$enable_silent_rules; fi case $enable_silent_rules in # ((( yes) AM_DEFAULT_VERBOSITY=0;; no) AM_DEFAULT_VERBOSITY=1;; *) AM_DEFAULT_VERBOSITY=1;; esac am_make=${MAKE-make} { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5 $as_echo_n "checking whether $am_make supports nested variables... " >&6; } if ${am_cv_make_support_nested_variables+:} false; then : $as_echo_n "(cached) " >&6 else if $as_echo 'TRUE=$(BAR$(V)) BAR0=false BAR1=true V=1 am__doit: @$(TRUE) .PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then am_cv_make_support_nested_variables=yes else am_cv_make_support_nested_variables=no fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5 $as_echo "$am_cv_make_support_nested_variables" >&6; } if test $am_cv_make_support_nested_variables = yes; then AM_V='$(V)' AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' else AM_V=$AM_DEFAULT_VERBOSITY AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY fi AM_BACKSLASH='\' if test "`cd $srcdir && pwd`" != "`pwd`"; then # Use -I$(srcdir) only when $(srcdir) != ., so that make's output # is not polluted with repeated "-I." am__isrc=' -I$(srcdir)' # test to see if srcdir already configured if test -f $srcdir/config.status; then as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 fi fi # test whether we have cygpath if test -z "$CYGPATH_W"; then if (cygpath --version) >/dev/null 2>/dev/null; then CYGPATH_W='cygpath -w' else CYGPATH_W=echo fi fi # Define the identity of the package. PACKAGE='coccinelle' VERSION='1.0.0-rc19' cat >>confdefs.h <<_ACEOF #define PACKAGE "$PACKAGE" _ACEOF cat >>confdefs.h <<_ACEOF #define VERSION "$VERSION" _ACEOF # Some tools Automake needs. ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} # For better backward compatibility. To be removed once Automake 1.9.x # dies out for good. For more background, see: # # mkdir_p='$(MKDIR_P)' # We need awk for the "check" target. The system "awk" is bad on # some platforms. # Always define AMTAR for backward compatibility. Yes, it's still used # in the wild :-( We should find a proper way to deprecate it ... AMTAR='$${TAR-tar}' # We'll loop over all known methods to create a tar archive until one works. _am_tools='gnutar pax cpio none' am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' { $as_echo "$as_me:${as_lineno-$LINENO}: determining version suffix" >&5 $as_echo "$as_me: determining version suffix" >&6;} if test -z "$CONFVERSION" -a -d "./.git"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: building a version from a git repository" >&5 $as_echo "$as_me: building a version from a git repository" >&6;} if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}git", so it can be a program name with args. set dummy ${ac_tool_prefix}git; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_GIT+:} false; then : $as_echo_n "(cached) " >&6 else case $GIT in [\\/]* | ?:[\\/]*) ac_cv_path_GIT="$GIT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_GIT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi GIT=$ac_cv_path_GIT if test -n "$GIT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GIT" >&5 $as_echo "$GIT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_GIT"; then ac_pt_GIT=$GIT # Extract the first word of "git", so it can be a program name with args. set dummy git; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_GIT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_GIT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_GIT="$ac_pt_GIT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_GIT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_GIT=$ac_cv_path_ac_pt_GIT if test -n "$ac_pt_GIT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_GIT" >&5 $as_echo "$ac_pt_GIT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_GIT" = x; then GIT="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac GIT=$ac_pt_GIT fi else GIT="$ac_cv_path_GIT" fi if test -n "$GIT"; then : CONFVERSION=`$GIT log -1 --date-order --date=rfc --pretty="format:%cd"` fi fi if test -z "$CONFVERSION"; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}date", so it can be a program name with args. set dummy ${ac_tool_prefix}date; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_DATE+:} false; then : $as_echo_n "(cached) " >&6 else case $DATE in [\\/]* | ?:[\\/]*) ac_cv_path_DATE="$DATE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_DATE="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi DATE=$ac_cv_path_DATE if test -n "$DATE"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DATE" >&5 $as_echo "$DATE" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_DATE"; then ac_pt_DATE=$DATE # Extract the first word of "date", so it can be a program name with args. set dummy date; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_DATE+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_DATE in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_DATE="$ac_pt_DATE" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_DATE="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_DATE=$ac_cv_path_ac_pt_DATE if test -n "$ac_pt_DATE"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_DATE" >&5 $as_echo "$ac_pt_DATE" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_DATE" = x; then DATE="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac DATE=$ac_pt_DATE fi else DATE="$ac_cv_path_DATE" fi if test -n "$DATE"; then : CONFVERSION=`$DATE "+%a, %d %b %Y %H:%M:%S %z"` fi fi if test -z "$CONFVERSION"; then : CONFVERSION=unknown fi { $as_echo "$as_me:${as_lineno-$LINENO}: version suffix set to $CONFVERSION" >&5 $as_echo "$as_me: version suffix set to $CONFVERSION" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: this configure program uses pkg-config m4 macros" >&5 $as_echo "$as_me: this configure program uses pkg-config m4 macros" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: this configure program uses ocaml m4 macros (see setup/ocaml.m4)" >&5 $as_echo "$as_me: this configure program uses ocaml m4 macros (see setup/ocaml.m4)" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: this configure program uses custom m4 macros (see setup/cocci.m4)" >&5 $as_echo "$as_me: this configure program uses custom m4 macros (see setup/cocci.m4)" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: some fake substitutions for required but unavailable programs may be used (see setup/fake*)" >&5 $as_echo "$as_me: some fake substitutions for required but unavailable programs may be used (see setup/fake*)" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: verifying basic tools" >&5 $as_echo "$as_me: verifying basic tools" >&6;} DEPDIR="${am__leading_dot}deps" ac_config_commands="$ac_config_commands depfiles" am_make=${MAKE-make} cat > confinc << 'END' am__doit: @echo this is the am__doit target .PHONY: am__doit END # If we don't find an include directive, just comment out the code. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 $as_echo_n "checking for style of include used by $am_make... " >&6; } am__include="#" am__quote= _am_result=none # First try GNU make style include. echo "include confinc" > confmf # Ignore all kinds of additional output from 'make'. case `$am_make -s -f confmf 2> /dev/null` in #( *the\ am__doit\ target*) am__include=include am__quote= _am_result=GNU ;; esac # Now try BSD make style include. if test "$am__include" = "#"; then echo '.include "confinc"' > confmf case `$am_make -s -f confmf 2> /dev/null` in #( *the\ am__doit\ target*) am__include=.include am__quote="\"" _am_result=BSD ;; esac fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 $as_echo "$_am_result" >&6; } rm -f confinc confmf # Check whether --enable-dependency-tracking was given. if test "${enable_dependency_tracking+set}" = set; then : enableval=$enable_dependency_tracking; fi if test "x$enable_dependency_tracking" != xno; then am_depcomp="$ac_aux_dir/depcomp" AMDEPBACKSLASH='\' am__nodep='_no' fi if test "x$enable_dependency_tracking" != xno; then AMDEP_TRUE= AMDEP_FALSE='#' else AMDEP_TRUE='#' AMDEP_FALSE= fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 $as_echo "$ac_ct_CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 $as_echo "$ac_ct_CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 $as_echo_n "checking whether the C compiler works... " >&6; } ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi if test -z "$ac_file"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 $as_echo_n "checking for C compiler default output file name... " >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 $as_echo "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 $as_echo_n "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 $as_echo "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int main () { FILE *f = fopen ("conftest.out", "w"); return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 $as_echo_n "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details" "$LINENO" 5; } fi fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 $as_echo "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; } if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 $as_echo "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_compiler_gnu=yes else ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 $as_echo "$ac_cv_c_compiler_gnu" >&6; } if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes else CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : else ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 $as_echo "$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include struct stat; /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_c89=$ac_arg fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 $as_echo "none needed" >&6; } ;; xno) { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 $as_echo "unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 $as_echo "$ac_cv_prog_cc_c89" >&6; } ;; esac if test "x$ac_cv_prog_cc_c89" != xno; then : fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu depcc="$CC" am_compiler_list= { $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 $as_echo_n "checking dependency style of $depcc... " >&6; } if ${am_cv_CC_dependencies_compiler_type+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then # We make a subdir and do the tests there. Otherwise we can end up # making bogus files that we don't know about and never remove. For # instance it was reported that on HP-UX the gcc test will end up # making a dummy file named 'D' -- because '-MD' means "put the output # in D". rm -rf conftest.dir mkdir conftest.dir # Copy depcomp to subdir because otherwise we won't find it if we're # using a relative directory. cp "$am_depcomp" conftest.dir cd conftest.dir # We will build objects and dependencies in a subdirectory because # it helps to detect inapplicable dependency modes. For instance # both Tru64's cc and ICC support -MD to output dependencies as a # side effect of compilation, but ICC will put the dependencies in # the current directory while Tru64 will put them in the object # directory. mkdir sub am_cv_CC_dependencies_compiler_type=none if test "$am_compiler_list" = ""; then am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` fi am__universal=false case " $depcc " in #( *\ -arch\ *\ -arch\ *) am__universal=true ;; esac for depmode in $am_compiler_list; do # Setup a source with many dependencies, because some compilers # like to wrap large dependency lists on column 80 (with \), and # we should not choose a depcomp mode which is confused by this. # # We need to recreate these files for each test, as the compiler may # overwrite some of them when testing with obscure command lines. # This happens at least with the AIX C compiler. : > sub/conftest.c for i in 1 2 3 4 5 6; do echo '#include "conftst'$i'.h"' >> sub/conftest.c # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with # Solaris 10 /bin/sh. echo '/* dummy */' > sub/conftst$i.h done echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf # We check with '-c' and '-o' for the sake of the "dashmstdout" # mode. It turns out that the SunPro C++ compiler does not properly # handle '-M -o', and we need to detect this. Also, some Intel # versions had trouble with output in subdirs. am__obj=sub/conftest.${OBJEXT-o} am__minus_obj="-o $am__obj" case $depmode in gcc) # This depmode causes a compiler race in universal mode. test "$am__universal" = false || continue ;; nosideeffect) # After this tag, mechanisms are not by side-effect, so they'll # only be used when explicitly requested. if test "x$enable_dependency_tracking" = xyes; then continue else break fi ;; msvc7 | msvc7msys | msvisualcpp | msvcmsys) # This compiler won't grok '-c -o', but also, the minuso test has # not run yet. These depmodes are late enough in the game, and # so weak that their functioning should not be impacted. am__obj=conftest.${OBJEXT-o} am__minus_obj= ;; none) break ;; esac if depmode=$depmode \ source=sub/conftest.c object=$am__obj \ depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ >/dev/null 2>conftest.err && grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && grep $am__obj sub/conftest.Po > /dev/null 2>&1 && ${MAKE-make} -s -f confmf > /dev/null 2>&1; then # icc doesn't choke on unknown options, it will just issue warnings # or remarks (even with -Werror). So we grep stderr for any message # that says an option was ignored or not supported. # When given -MP, icc 7.0 and 7.1 complain thusly: # icc: Command line warning: ignoring option '-M'; no argument required # The diagnosis changed in icc 8.0: # icc: Command line remark: option '-MP' not supported if (grep 'ignoring option' conftest.err || grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else am_cv_CC_dependencies_compiler_type=$depmode break fi fi done cd .. rm -rf conftest.dir else am_cv_CC_dependencies_compiler_type=none fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 $as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type if test "x$enable_dependency_tracking" != xno \ && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then am__fastdepCC_TRUE= am__fastdepCC_FALSE='#' else am__fastdepCC_TRUE='#' am__fastdepCC_FALSE= fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 $as_echo_n "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO"; then : else # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi done ac_cv_prog_CPP=$CPP fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 $as_echo "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # Prefer to if __STDC__ is defined, since # exists even on freestanding compilers. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __STDC__ # include #else # include #endif Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO"; then : else # Broken: fails on valid input. continue fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO"; then : # Broken: success on invalid input. continue else # Passes both tests. ac_preproc_ok=: break fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Extract the first word of "bash", so it can be a program name with args. set dummy bash; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_BASH+:} false; then : $as_echo_n "(cached) " >&6 else case $BASH in [\\/]* | ?:[\\/]*) ac_cv_path_BASH="$BASH" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_BASH="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi BASH=$ac_cv_path_BASH if test -n "$BASH"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $BASH" >&5 $as_echo "$BASH" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "tar", so it can be a program name with args. set dummy tar; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_TAR+:} false; then : $as_echo_n "(cached) " >&6 else case $TAR in [\\/]* | ?:[\\/]*) ac_cv_path_TAR="$TAR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_TAR="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi TAR=$ac_cv_path_TAR if test -n "$TAR"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TAR" >&5 $as_echo "$TAR" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "patch", so it can be a program name with args. set dummy patch; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PATCH+:} false; then : $as_echo_n "(cached) " >&6 else case $PATCH in [\\/]* | ?:[\\/]*) ac_cv_path_PATCH="$PATCH" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PATCH="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PATCH=$ac_cv_path_PATCH if test -n "$PATCH"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATCH" >&5 $as_echo "$PATCH" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Extract the first word of "echo", so it can be a program name with args. set dummy echo; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ECHO+:} false; then : $as_echo_n "(cached) " >&6 else case $ECHO in [\\/]* | ?:[\\/]*) ac_cv_path_ECHO="$ECHO" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ECHO="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ECHO=$ac_cv_path_ECHO if test -n "$ECHO"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ECHO" >&5 $as_echo "$ECHO" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$INSTALL" = "setup/install-sh -c" -o "$INSTALL" = "./setup-install-sh -c"; then : INSTALL="$COCCI_SRCDIR/$INSTALL" fi if test "$MKDIR_P" = "setup/install-sh -c -d" -o "$INSTALL" = "./setup-install-sh -c -d"; then : MKDIR_P="$COCCI_SRCDIR/$MKDIR_P" fi if test "`$ECHO --version`" = "--version"; then : ECHO="$COCCI_SRCDIR/setup/echo.sh" fi # Extract the first word of "patchelf", so it can be a program name with args. set dummy patchelf; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PATCHELF+:} false; then : $as_echo_n "(cached) " >&6 else case $PATCHELF in [\\/]* | ?:[\\/]*) ac_cv_path_PATCHELF="$PATCHELF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PATCHELF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PATCHELF=$ac_cv_path_PATCHELF if test -n "$PATCHELF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATCHELF" >&5 $as_echo "$PATCHELF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi # Check whether --with-pkg-config was given. if test "${with_pkg_config+set}" = set; then : withval=$with_pkg_config; fi with_PKG_CONFIG="$with_pkg_config" if test -n "$with_PKG_CONFIG" -a "x$with_PKG_CONFIG" != xno -a "x$with_PKG_CONFIG" != xyes; then : PKG_CONFIG="$with_PKG_CONFIG" else PKG_CONFIG="pkg-config" fi if test "x$with_PKG_CONFIG" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: pkg-config is disabled explicitly" >&5 $as_echo "$as_me: pkg-config is disabled explicitly" >&6;} PKG_CONFIG=no else if test "x$PKG_CONFIG" = xpkg-config -a "xPKG_CONFIG" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$PKG_CONFIG" = xocamllex -a "xPKG_CONFIG" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$PKG_CONFIG" = xocamlyacc -a "xPKG_CONFIG" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]PKG_CONFIG", so it can be a program name with args. set dummy ${ac_tool_prefix}$PKG_CONFIG; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "[$]PKG_CONFIG", so it can be a program name with args. set dummy $PKG_CONFIG; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi fi if test -z "$PKG_CONFIG" -o "x$PKG_CONFIG" = xno; then : if test "x$with_PKG_CONFIG" = xyes; then : as_fn_error $? "--with=pkg-config is given explicitly but not found" "$LINENO" 5 fi if test -n ""; then : { $as_echo "$as_me:${as_lineno-$LINENO}: pkg-config not found. Trying substitute ." >&5 $as_echo "$as_me: pkg-config not found. Trying substitute ." >&6;} PKG_CONFIG="" if test "xpkg-config" = xpkg-config -a "xPKG_CONFIG" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xpkg-config" = xocamllex -a "xPKG_CONFIG" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xpkg-config" = xocamlyacc -a "xPKG_CONFIG" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi SUBSTITUTED_PKG_CONFIG=yes fi fi if test -z "$PKG_CONFIG"; then : PKG_CONFIG=no fi if test "x$PKG_CONFIG" = xno; then : PKG_CONFIG_ORIG=pkg-config else PKG_CONFIG_ORIG=$PKG_CONFIG fi PKG_CONFIG="$COCCI_SRCDIR/setup/fake-subst.sh $PKG_CONFIG_ORIG" # checking for ocamlc if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLC="$OCAMLC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLC=$ac_cv_path_OCAMLC if test -n "$OCAMLC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLC" >&5 $as_echo "$OCAMLC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLC"; then ac_pt_OCAMLC=$OCAMLC # Extract the first word of "ocamlc", so it can be a program name with args. set dummy ocamlc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLC="$ac_pt_OCAMLC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLC=$ac_cv_path_ac_pt_OCAMLC if test -n "$ac_pt_OCAMLC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLC" >&5 $as_echo "$ac_pt_OCAMLC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLC" = x; then OCAMLC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLC=$ac_pt_OCAMLC fi else OCAMLC="$ac_cv_path_OCAMLC" fi if test "$OCAMLC" != "no"; then OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` { $as_echo "$as_me:${as_lineno-$LINENO}: result: OCaml version is $OCAMLVERSION" >&5 $as_echo "OCaml version is $OCAMLVERSION" >&6; } # If OCAMLLIB is set, use it if test "$OCAMLLIB" = ""; then OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` else { $as_echo "$as_me:${as_lineno-$LINENO}: result: OCAMLLIB previously set; preserving it." >&5 $as_echo "OCAMLLIB previously set; preserving it." >&6; } fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: OCaml library path is $OCAMLLIB" >&5 $as_echo "OCaml library path is $OCAMLLIB" >&6; } # checking for ocamlopt if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlopt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlopt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLOPT="$OCAMLOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLOPT=$ac_cv_path_OCAMLOPT if test -n "$OCAMLOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLOPT" >&5 $as_echo "$OCAMLOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLOPT"; then ac_pt_OCAMLOPT=$OCAMLOPT # Extract the first word of "ocamlopt", so it can be a program name with args. set dummy ocamlopt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLOPT="$ac_pt_OCAMLOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLOPT=$ac_cv_path_ac_pt_OCAMLOPT if test -n "$ac_pt_OCAMLOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLOPT" >&5 $as_echo "$ac_pt_OCAMLOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLOPT" = x; then OCAMLOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLOPT=$ac_pt_OCAMLOPT fi else OCAMLOPT="$ac_cv_path_OCAMLOPT" fi OCAMLBEST=byte if test "$OCAMLOPT" = "no"; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find ocamlopt; bytecode compilation only." >&5 $as_echo "$as_me: WARNING: Cannot find ocamlopt; bytecode compilation only." >&2;} else TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: versions differs from ocamlc; ocamlopt discarded." >&5 $as_echo "versions differs from ocamlc; ocamlopt discarded." >&6; } OCAMLOPT=no else OCAMLBEST=opt fi fi # checking for ocamlc.opt if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlc.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlc.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLCDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLCDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLCDOTOPT="$OCAMLCDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLCDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLCDOTOPT=$ac_cv_path_OCAMLCDOTOPT if test -n "$OCAMLCDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLCDOTOPT" >&5 $as_echo "$OCAMLCDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLCDOTOPT"; then ac_pt_OCAMLCDOTOPT=$OCAMLCDOTOPT # Extract the first word of "ocamlc.opt", so it can be a program name with args. set dummy ocamlc.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLCDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLCDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLCDOTOPT="$ac_pt_OCAMLCDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLCDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLCDOTOPT=$ac_cv_path_ac_pt_OCAMLCDOTOPT if test -n "$ac_pt_OCAMLCDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLCDOTOPT" >&5 $as_echo "$ac_pt_OCAMLCDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLCDOTOPT" = x; then OCAMLCDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLCDOTOPT=$ac_pt_OCAMLCDOTOPT fi else OCAMLCDOTOPT="$ac_cv_path_OCAMLCDOTOPT" fi if test "$OCAMLCDOTOPT" != "no"; then TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: versions differs from ocamlc; ocamlc.opt discarded." >&5 $as_echo "versions differs from ocamlc; ocamlc.opt discarded." >&6; } else OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" != "no" ; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlopt.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlopt.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLOPTDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLOPTDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLOPTDOTOPT="$OCAMLOPTDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLOPTDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLOPTDOTOPT=$ac_cv_path_OCAMLOPTDOTOPT if test -n "$OCAMLOPTDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLOPTDOTOPT" >&5 $as_echo "$OCAMLOPTDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLOPTDOTOPT"; then ac_pt_OCAMLOPTDOTOPT=$OCAMLOPTDOTOPT # Extract the first word of "ocamlopt.opt", so it can be a program name with args. set dummy ocamlopt.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLOPTDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLOPTDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLOPTDOTOPT="$ac_pt_OCAMLOPTDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLOPTDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLOPTDOTOPT=$ac_cv_path_ac_pt_OCAMLOPTDOTOPT if test -n "$ac_pt_OCAMLOPTDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLOPTDOTOPT" >&5 $as_echo "$ac_pt_OCAMLOPTDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLOPTDOTOPT" = x; then OCAMLOPTDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLOPTDOTOPT=$ac_pt_OCAMLOPTDOTOPT fi else OCAMLOPTDOTOPT="$ac_cv_path_OCAMLOPTDOTOPT" fi if test "$OCAMLOPTDOTOPT" != "no"; then TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: version differs from ocamlc; ocamlopt.opt discarded." >&5 $as_echo "version differs from ocamlc; ocamlopt.opt discarded." >&6; } else OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi fi # checking for ocaml toplevel if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocaml", so it can be a program name with args. set dummy ${ac_tool_prefix}ocaml; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAML+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAML in [\\/]* | ?:[\\/]*) ac_cv_path_OCAML="$OCAML" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAML="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAML=$ac_cv_path_OCAML if test -n "$OCAML"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAML" >&5 $as_echo "$OCAML" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAML"; then ac_pt_OCAML=$OCAML # Extract the first word of "ocaml", so it can be a program name with args. set dummy ocaml; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAML+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAML in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAML="$ac_pt_OCAML" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAML="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAML=$ac_cv_path_ac_pt_OCAML if test -n "$ac_pt_OCAML"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAML" >&5 $as_echo "$ac_pt_OCAML" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAML" = x; then OCAML="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAML=$ac_pt_OCAML fi else OCAML="$ac_cv_path_OCAML" fi # checking for ocamldep if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamldep", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamldep; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLDEP+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLDEP in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLDEP="$OCAMLDEP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLDEP="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLDEP=$ac_cv_path_OCAMLDEP if test -n "$OCAMLDEP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDEP" >&5 $as_echo "$OCAMLDEP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLDEP"; then ac_pt_OCAMLDEP=$OCAMLDEP # Extract the first word of "ocamldep", so it can be a program name with args. set dummy ocamldep; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLDEP+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLDEP in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLDEP="$ac_pt_OCAMLDEP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLDEP="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLDEP=$ac_cv_path_ac_pt_OCAMLDEP if test -n "$ac_pt_OCAMLDEP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLDEP" >&5 $as_echo "$ac_pt_OCAMLDEP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLDEP" = x; then OCAMLDEP="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLDEP=$ac_pt_OCAMLDEP fi else OCAMLDEP="$ac_cv_path_OCAMLDEP" fi # checking for ocamlmktop if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlmktop", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlmktop; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLMKTOP+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLMKTOP in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLMKTOP="$OCAMLMKTOP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLMKTOP="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLMKTOP=$ac_cv_path_OCAMLMKTOP if test -n "$OCAMLMKTOP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLMKTOP" >&5 $as_echo "$OCAMLMKTOP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLMKTOP"; then ac_pt_OCAMLMKTOP=$OCAMLMKTOP # Extract the first word of "ocamlmktop", so it can be a program name with args. set dummy ocamlmktop; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLMKTOP+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLMKTOP in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLMKTOP="$ac_pt_OCAMLMKTOP" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLMKTOP="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLMKTOP=$ac_cv_path_ac_pt_OCAMLMKTOP if test -n "$ac_pt_OCAMLMKTOP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLMKTOP" >&5 $as_echo "$ac_pt_OCAMLMKTOP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLMKTOP" = x; then OCAMLMKTOP="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLMKTOP=$ac_pt_OCAMLMKTOP fi else OCAMLMKTOP="$ac_cv_path_OCAMLMKTOP" fi # checking for ocamlmklib if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlmklib", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlmklib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLMKLIB+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLMKLIB in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLMKLIB="$OCAMLMKLIB" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLMKLIB="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLMKLIB=$ac_cv_path_OCAMLMKLIB if test -n "$OCAMLMKLIB"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLMKLIB" >&5 $as_echo "$OCAMLMKLIB" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLMKLIB"; then ac_pt_OCAMLMKLIB=$OCAMLMKLIB # Extract the first word of "ocamlmklib", so it can be a program name with args. set dummy ocamlmklib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLMKLIB+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLMKLIB in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLMKLIB="$ac_pt_OCAMLMKLIB" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLMKLIB="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLMKLIB=$ac_cv_path_ac_pt_OCAMLMKLIB if test -n "$ac_pt_OCAMLMKLIB"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLMKLIB" >&5 $as_echo "$ac_pt_OCAMLMKLIB" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLMKLIB" = x; then OCAMLMKLIB="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLMKLIB=$ac_pt_OCAMLMKLIB fi else OCAMLMKLIB="$ac_cv_path_OCAMLMKLIB" fi # checking for ocamldoc if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamldoc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamldoc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLDOC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLDOC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLDOC="$OCAMLDOC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLDOC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLDOC=$ac_cv_path_OCAMLDOC if test -n "$OCAMLDOC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDOC" >&5 $as_echo "$OCAMLDOC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLDOC"; then ac_pt_OCAMLDOC=$OCAMLDOC # Extract the first word of "ocamldoc", so it can be a program name with args. set dummy ocamldoc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLDOC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLDOC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLDOC="$ac_pt_OCAMLDOC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLDOC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLDOC=$ac_cv_path_ac_pt_OCAMLDOC if test -n "$ac_pt_OCAMLDOC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLDOC" >&5 $as_echo "$ac_pt_OCAMLDOC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLDOC" = x; then OCAMLDOC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLDOC=$ac_pt_OCAMLDOC fi else OCAMLDOC="$ac_cv_path_OCAMLDOC" fi # checking for ocamlbuild if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlbuild", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlbuild; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLBUILD+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLBUILD in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLBUILD="$OCAMLBUILD" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLBUILD="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLBUILD=$ac_cv_path_OCAMLBUILD if test -n "$OCAMLBUILD"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLBUILD" >&5 $as_echo "$OCAMLBUILD" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLBUILD"; then ac_pt_OCAMLBUILD=$OCAMLBUILD # Extract the first word of "ocamlbuild", so it can be a program name with args. set dummy ocamlbuild; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLBUILD+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLBUILD in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLBUILD="$ac_pt_OCAMLBUILD" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLBUILD="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLBUILD=$ac_cv_path_ac_pt_OCAMLBUILD if test -n "$ac_pt_OCAMLBUILD"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLBUILD" >&5 $as_echo "$ac_pt_OCAMLBUILD" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLBUILD" = x; then OCAMLBUILD="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLBUILD=$ac_pt_OCAMLBUILD fi else OCAMLBUILD="$ac_cv_path_OCAMLBUILD" fi { versioncheck=; unset versioncheck;} { $as_echo "$as_me:${as_lineno-$LINENO}: checking that the OCaml version is at least 3.10" >&5 $as_echo_n "checking that the OCaml version is at least 3.10... " >&6; } as_arg_v1=$OCAMLVERSION as_arg_v2=3.10 awk "$as_awk_strverscmp" v1="$as_arg_v1" v2="$as_arg_v2" /dev/null case $? in #( 1) : versioncheck=no ;; #( 0) : versioncheck=yes ;; #( 2) : versioncheck=yes ;; #( *) : ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: result: $versioncheck" >&5 $as_echo "$versioncheck" >&6; } OCAMLATLEAST310=$versioncheck { versioncheck=; unset versioncheck;} { $as_echo "$as_me:${as_lineno-$LINENO}: checking that the OCaml version is at least 3.11" >&5 $as_echo_n "checking that the OCaml version is at least 3.11... " >&6; } as_arg_v1=$OCAMLVERSION as_arg_v2=3.11 awk "$as_awk_strverscmp" v1="$as_arg_v1" v2="$as_arg_v2" /dev/null case $? in #( 1) : versioncheck=no ;; #( 0) : versioncheck=yes ;; #( 2) : versioncheck=yes ;; #( *) : ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: result: $versioncheck" >&5 $as_echo "$versioncheck" >&6; } OCAMLATLEAST311=$versioncheck OCAMLCORIG="$OCAMLC" if test "x$OCAMLC" = xno -o "x$OCAMLDEP" = xno -o "x$OCAMLDOC" = xno -o "x$OCAMLMKLIB" = xno; then : as_fn_error $? "You must install the OCaml compiler" "$LINENO" 5 fi if test "x$OCAMLATLEAST310" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: a more recent OCaml installation may be required" >&5 $as_echo "$as_me: a more recent OCaml installation may be required" >&6;} fi # checking for camlp4 if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4 in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4="$CAMLP4" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4=$ac_cv_path_CAMLP4 if test -n "$CAMLP4"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4" >&5 $as_echo "$CAMLP4" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4"; then ac_pt_CAMLP4=$CAMLP4 # Extract the first word of "camlp4", so it can be a program name with args. set dummy camlp4; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4 in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4="$ac_pt_CAMLP4" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4=$ac_cv_path_ac_pt_CAMLP4 if test -n "$ac_pt_CAMLP4"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4" >&5 $as_echo "$ac_pt_CAMLP4" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4" = x; then CAMLP4="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4=$ac_pt_CAMLP4 fi else CAMLP4="$ac_cv_path_CAMLP4" fi if test "$CAMLP4" != "no"; then TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: versions differs from ocamlc" >&5 $as_echo "versions differs from ocamlc" >&6; } CAMLP4=no fi fi # checking for companion tools if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4boot", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4boot; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4BOOT+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4BOOT in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4BOOT="$CAMLP4BOOT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4BOOT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4BOOT=$ac_cv_path_CAMLP4BOOT if test -n "$CAMLP4BOOT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4BOOT" >&5 $as_echo "$CAMLP4BOOT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4BOOT"; then ac_pt_CAMLP4BOOT=$CAMLP4BOOT # Extract the first word of "camlp4boot", so it can be a program name with args. set dummy camlp4boot; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4BOOT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4BOOT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4BOOT="$ac_pt_CAMLP4BOOT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4BOOT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4BOOT=$ac_cv_path_ac_pt_CAMLP4BOOT if test -n "$ac_pt_CAMLP4BOOT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4BOOT" >&5 $as_echo "$ac_pt_CAMLP4BOOT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4BOOT" = x; then CAMLP4BOOT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4BOOT=$ac_pt_CAMLP4BOOT fi else CAMLP4BOOT="$ac_cv_path_CAMLP4BOOT" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4o", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4o; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4O+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4O in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4O="$CAMLP4O" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4O="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4O=$ac_cv_path_CAMLP4O if test -n "$CAMLP4O"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4O" >&5 $as_echo "$CAMLP4O" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4O"; then ac_pt_CAMLP4O=$CAMLP4O # Extract the first word of "camlp4o", so it can be a program name with args. set dummy camlp4o; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4O+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4O in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4O="$ac_pt_CAMLP4O" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4O="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4O=$ac_cv_path_ac_pt_CAMLP4O if test -n "$ac_pt_CAMLP4O"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4O" >&5 $as_echo "$ac_pt_CAMLP4O" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4O" = x; then CAMLP4O="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4O=$ac_pt_CAMLP4O fi else CAMLP4O="$ac_cv_path_CAMLP4O" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4of", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4of; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4OF+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4OF in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4OF="$CAMLP4OF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4OF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4OF=$ac_cv_path_CAMLP4OF if test -n "$CAMLP4OF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4OF" >&5 $as_echo "$CAMLP4OF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4OF"; then ac_pt_CAMLP4OF=$CAMLP4OF # Extract the first word of "camlp4of", so it can be a program name with args. set dummy camlp4of; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4OF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4OF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4OF="$ac_pt_CAMLP4OF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4OF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4OF=$ac_cv_path_ac_pt_CAMLP4OF if test -n "$ac_pt_CAMLP4OF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4OF" >&5 $as_echo "$ac_pt_CAMLP4OF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4OF" = x; then CAMLP4OF="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4OF=$ac_pt_CAMLP4OF fi else CAMLP4OF="$ac_cv_path_CAMLP4OF" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4oof", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4oof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4OOF+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4OOF in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4OOF="$CAMLP4OOF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4OOF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4OOF=$ac_cv_path_CAMLP4OOF if test -n "$CAMLP4OOF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4OOF" >&5 $as_echo "$CAMLP4OOF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4OOF"; then ac_pt_CAMLP4OOF=$CAMLP4OOF # Extract the first word of "camlp4oof", so it can be a program name with args. set dummy camlp4oof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4OOF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4OOF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4OOF="$ac_pt_CAMLP4OOF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4OOF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4OOF=$ac_cv_path_ac_pt_CAMLP4OOF if test -n "$ac_pt_CAMLP4OOF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4OOF" >&5 $as_echo "$ac_pt_CAMLP4OOF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4OOF" = x; then CAMLP4OOF="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4OOF=$ac_pt_CAMLP4OOF fi else CAMLP4OOF="$ac_cv_path_CAMLP4OOF" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4orf", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4orf; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4ORF+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4ORF in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4ORF="$CAMLP4ORF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4ORF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4ORF=$ac_cv_path_CAMLP4ORF if test -n "$CAMLP4ORF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4ORF" >&5 $as_echo "$CAMLP4ORF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4ORF"; then ac_pt_CAMLP4ORF=$CAMLP4ORF # Extract the first word of "camlp4orf", so it can be a program name with args. set dummy camlp4orf; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4ORF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4ORF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4ORF="$ac_pt_CAMLP4ORF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4ORF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4ORF=$ac_cv_path_ac_pt_CAMLP4ORF if test -n "$ac_pt_CAMLP4ORF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4ORF" >&5 $as_echo "$ac_pt_CAMLP4ORF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4ORF" = x; then CAMLP4ORF="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4ORF=$ac_pt_CAMLP4ORF fi else CAMLP4ORF="$ac_cv_path_CAMLP4ORF" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4prof", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4prof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4PROF+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4PROF in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4PROF="$CAMLP4PROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4PROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4PROF=$ac_cv_path_CAMLP4PROF if test -n "$CAMLP4PROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4PROF" >&5 $as_echo "$CAMLP4PROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4PROF"; then ac_pt_CAMLP4PROF=$CAMLP4PROF # Extract the first word of "camlp4prof", so it can be a program name with args. set dummy camlp4prof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4PROF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4PROF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4PROF="$ac_pt_CAMLP4PROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4PROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4PROF=$ac_cv_path_ac_pt_CAMLP4PROF if test -n "$ac_pt_CAMLP4PROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4PROF" >&5 $as_echo "$ac_pt_CAMLP4PROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4PROF" = x; then CAMLP4PROF="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4PROF=$ac_pt_CAMLP4PROF fi else CAMLP4PROF="$ac_cv_path_CAMLP4PROF" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4r", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4r; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4R+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4R in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4R="$CAMLP4R" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4R="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4R=$ac_cv_path_CAMLP4R if test -n "$CAMLP4R"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4R" >&5 $as_echo "$CAMLP4R" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4R"; then ac_pt_CAMLP4R=$CAMLP4R # Extract the first word of "camlp4r", so it can be a program name with args. set dummy camlp4r; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4R+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4R in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4R="$ac_pt_CAMLP4R" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4R="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4R=$ac_cv_path_ac_pt_CAMLP4R if test -n "$ac_pt_CAMLP4R"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4R" >&5 $as_echo "$ac_pt_CAMLP4R" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4R" = x; then CAMLP4R="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4R=$ac_pt_CAMLP4R fi else CAMLP4R="$ac_cv_path_CAMLP4R" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}camlp4rf", so it can be a program name with args. set dummy ${ac_tool_prefix}camlp4rf; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_CAMLP4RF+:} false; then : $as_echo_n "(cached) " >&6 else case $CAMLP4RF in [\\/]* | ?:[\\/]*) ac_cv_path_CAMLP4RF="$CAMLP4RF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_CAMLP4RF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi CAMLP4RF=$ac_cv_path_CAMLP4RF if test -n "$CAMLP4RF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4RF" >&5 $as_echo "$CAMLP4RF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_CAMLP4RF"; then ac_pt_CAMLP4RF=$CAMLP4RF # Extract the first word of "camlp4rf", so it can be a program name with args. set dummy camlp4rf; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_CAMLP4RF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_CAMLP4RF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_CAMLP4RF="$ac_pt_CAMLP4RF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_CAMLP4RF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_CAMLP4RF=$ac_cv_path_ac_pt_CAMLP4RF if test -n "$ac_pt_CAMLP4RF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_CAMLP4RF" >&5 $as_echo "$ac_pt_CAMLP4RF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_CAMLP4RF" = x; then CAMLP4RF="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CAMLP4RF=$ac_pt_CAMLP4RF fi else CAMLP4RF="$ac_cv_path_CAMLP4RF" fi # Check whether --with-ocamllex was given. if test "${with_ocamllex+set}" = set; then : withval=$with_ocamllex; fi with_OCAMLLEX="$with_ocamllex" if test -n "$with_OCAMLLEX" -a "x$with_OCAMLLEX" != xno -a "x$with_OCAMLLEX" != xyes; then : OCAMLLEX="$with_OCAMLLEX" else OCAMLLEX="ocamllex" fi if test "x$with_OCAMLLEX" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamllex is disabled explicitly" >&5 $as_echo "$as_me: ocamllex is disabled explicitly" >&6;} OCAMLLEX=no else if test "x$OCAMLLEX" = xpkg-config -a "xOCAMLLEX" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$OCAMLLEX" = xocamllex -a "xOCAMLLEX" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$OCAMLLEX" = xocamlyacc -a "xOCAMLLEX" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]OCAMLLEX", so it can be a program name with args. set dummy ${ac_tool_prefix}$OCAMLLEX; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "[$]OCAMLLEX", so it can be a program name with args. set dummy $OCAMLLEX; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi fi fi if test -z "$OCAMLLEX" -o "x$OCAMLLEX" = xno; then : if test "x$with_OCAMLLEX" = xyes; then : as_fn_error $? "--with=ocamllex is given explicitly but not found" "$LINENO" 5 fi if test -n ""; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamllex not found. Trying substitute ." >&5 $as_echo "$as_me: ocamllex not found. Trying substitute ." >&6;} OCAMLLEX="" if test "xocamllex" = xpkg-config -a "xOCAMLLEX" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xocamllex" = xocamllex -a "xOCAMLLEX" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xocamllex" = xocamlyacc -a "xOCAMLLEX" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi fi SUBSTITUTED_OCAMLLEX=yes fi fi if test -z "$OCAMLLEX"; then : OCAMLLEX=no fi # Check whether --with-ocamlyacc was given. if test "${with_ocamlyacc+set}" = set; then : withval=$with_ocamlyacc; fi with_OCAMLYACC="$with_ocamlyacc" if test -n "$with_OCAMLYACC" -a "x$with_OCAMLYACC" != xno -a "x$with_OCAMLYACC" != xyes; then : OCAMLYACC="$with_OCAMLYACC" else OCAMLYACC="ocamlyacc" fi if test "x$with_OCAMLYACC" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlyacc is disabled explicitly" >&5 $as_echo "$as_me: ocamlyacc is disabled explicitly" >&6;} OCAMLYACC=no else if test "x$OCAMLYACC" = xpkg-config -a "xOCAMLYACC" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$OCAMLYACC" = xocamllex -a "xOCAMLYACC" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$OCAMLYACC" = xocamlyacc -a "xOCAMLYACC" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]OCAMLYACC", so it can be a program name with args. set dummy ${ac_tool_prefix}$OCAMLYACC; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "[$]OCAMLYACC", so it can be a program name with args. set dummy $OCAMLYACC; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi fi fi if test -z "$OCAMLYACC" -o "x$OCAMLYACC" = xno; then : if test "x$with_OCAMLYACC" = xyes; then : as_fn_error $? "--with=ocamlyacc is given explicitly but not found" "$LINENO" 5 fi if test -n ""; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlyacc not found. Trying substitute ." >&5 $as_echo "$as_me: ocamlyacc not found. Trying substitute ." >&6;} OCAMLYACC="" if test "xocamlyacc" = xpkg-config -a "xOCAMLYACC" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xocamlyacc" = xocamllex -a "xOCAMLYACC" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xocamlyacc" = xocamlyacc -a "xOCAMLYACC" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi fi SUBSTITUTED_OCAMLYACC=yes fi fi if test -z "$OCAMLYACC"; then : OCAMLYACC=no fi # Check whether --with-ocamlfind was given. if test "${with_ocamlfind+set}" = set; then : withval=$with_ocamlfind; fi with_OCAMLFIND="$with_ocamlfind" if test -n "$with_OCAMLFIND" -a "x$with_OCAMLFIND" != xno -a "x$with_OCAMLFIND" != xyes; then : OCAMLFIND="$with_OCAMLFIND" else OCAMLFIND="ocamlfind" fi if test "x$with_OCAMLFIND" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlfind is disabled explicitly" >&5 $as_echo "$as_me: ocamlfind is disabled explicitly" >&6;} OCAMLFIND=no else if test "x$OCAMLFIND" = xpkg-config -a "xOCAMLFIND" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$OCAMLFIND" = xocamllex -a "xOCAMLFIND" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$OCAMLFIND" = xocamlyacc -a "xOCAMLFIND" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]OCAMLFIND", so it can be a program name with args. set dummy ${ac_tool_prefix}$OCAMLFIND; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLFIND+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLFIND in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLFIND="$OCAMLFIND" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLFIND="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLFIND=$ac_cv_path_OCAMLFIND if test -n "$OCAMLFIND"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLFIND" >&5 $as_echo "$OCAMLFIND" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLFIND"; then ac_pt_OCAMLFIND=$OCAMLFIND # Extract the first word of "[$]OCAMLFIND", so it can be a program name with args. set dummy $OCAMLFIND; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLFIND+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLFIND in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLFIND="$ac_pt_OCAMLFIND" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLFIND="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLFIND=$ac_cv_path_ac_pt_OCAMLFIND if test -n "$ac_pt_OCAMLFIND"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLFIND" >&5 $as_echo "$ac_pt_OCAMLFIND" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLFIND" = x; then OCAMLFIND="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLFIND=$ac_pt_OCAMLFIND fi else OCAMLFIND="$ac_cv_path_OCAMLFIND" fi fi fi if test -z "$OCAMLFIND" -o "x$OCAMLFIND" = xno; then : if test "x$with_OCAMLFIND" = xyes; then : as_fn_error $? "--with=ocamlfind is given explicitly but not found" "$LINENO" 5 fi if test -n "$COCCI_SRCDIR/setup/fake-subst.sh ocamlfind"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlfind not found. Trying substitute $COCCI_SRCDIR/setup/fake-subst.sh ocamlfind." >&5 $as_echo "$as_me: ocamlfind not found. Trying substitute $COCCI_SRCDIR/setup/fake-subst.sh ocamlfind." >&6;} OCAMLFIND="$COCCI_SRCDIR/setup/fake-subst.sh ocamlfind" if test "xocamlfind" = xpkg-config -a "xOCAMLFIND" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xocamlfind" = xocamllex -a "xOCAMLFIND" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xocamlfind" = xocamlyacc -a "xOCAMLFIND" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlfind", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlfind; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLFIND+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLFIND in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLFIND="$OCAMLFIND" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLFIND="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLFIND=$ac_cv_path_OCAMLFIND if test -n "$OCAMLFIND"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLFIND" >&5 $as_echo "$OCAMLFIND" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLFIND"; then ac_pt_OCAMLFIND=$OCAMLFIND # Extract the first word of "ocamlfind", so it can be a program name with args. set dummy ocamlfind; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLFIND+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLFIND in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLFIND="$ac_pt_OCAMLFIND" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLFIND="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLFIND=$ac_cv_path_ac_pt_OCAMLFIND if test -n "$ac_pt_OCAMLFIND"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLFIND" >&5 $as_echo "$ac_pt_OCAMLFIND" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLFIND" = x; then OCAMLFIND="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLFIND=$ac_pt_OCAMLFIND fi else OCAMLFIND="$ac_cv_path_OCAMLFIND" fi fi SUBSTITUTED_OCAMLFIND=yes fi fi if test -z "$OCAMLFIND"; then : OCAMLFIND=no fi # Check whether --with-ocamlprof was given. if test "${with_ocamlprof+set}" = set; then : withval=$with_ocamlprof; fi with_OCAMLPROF="$with_ocamlprof" if test -n "$with_OCAMLPROF" -a "x$with_OCAMLPROF" != xno -a "x$with_OCAMLPROF" != xyes; then : OCAMLPROF="$with_OCAMLPROF" else OCAMLPROF="ocamlprof" fi if test "x$with_OCAMLPROF" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlprof is disabled explicitly" >&5 $as_echo "$as_me: ocamlprof is disabled explicitly" >&6;} OCAMLPROF=no else if test "x$OCAMLPROF" = xpkg-config -a "xOCAMLPROF" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$OCAMLPROF" = xocamllex -a "xOCAMLPROF" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$OCAMLPROF" = xocamlyacc -a "xOCAMLPROF" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]OCAMLPROF", so it can be a program name with args. set dummy ${ac_tool_prefix}$OCAMLPROF; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLPROF+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLPROF in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLPROF="$OCAMLPROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLPROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLPROF=$ac_cv_path_OCAMLPROF if test -n "$OCAMLPROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLPROF" >&5 $as_echo "$OCAMLPROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLPROF"; then ac_pt_OCAMLPROF=$OCAMLPROF # Extract the first word of "[$]OCAMLPROF", so it can be a program name with args. set dummy $OCAMLPROF; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLPROF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLPROF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLPROF="$ac_pt_OCAMLPROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLPROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLPROF=$ac_cv_path_ac_pt_OCAMLPROF if test -n "$ac_pt_OCAMLPROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLPROF" >&5 $as_echo "$ac_pt_OCAMLPROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLPROF" = x; then OCAMLPROF="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLPROF=$ac_pt_OCAMLPROF fi else OCAMLPROF="$ac_cv_path_OCAMLPROF" fi fi fi if test -z "$OCAMLPROF" -o "x$OCAMLPROF" = xno; then : if test "x$with_OCAMLPROF" = xyes; then : as_fn_error $? "--with=ocamlprof is given explicitly but not found" "$LINENO" 5 fi if test -n ""; then : { $as_echo "$as_me:${as_lineno-$LINENO}: ocamlprof not found. Trying substitute ." >&5 $as_echo "$as_me: ocamlprof not found. Trying substitute ." >&6;} OCAMLPROF="" if test "xocamlprof" = xpkg-config -a "xOCAMLPROF" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xocamlprof" = xocamllex -a "xOCAMLPROF" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xocamlprof" = xocamlyacc -a "xOCAMLPROF" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlprof", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlprof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLPROF+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLPROF in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLPROF="$OCAMLPROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLPROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLPROF=$ac_cv_path_OCAMLPROF if test -n "$OCAMLPROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLPROF" >&5 $as_echo "$OCAMLPROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLPROF"; then ac_pt_OCAMLPROF=$OCAMLPROF # Extract the first word of "ocamlprof", so it can be a program name with args. set dummy ocamlprof; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLPROF+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLPROF in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLPROF="$ac_pt_OCAMLPROF" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLPROF="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLPROF=$ac_cv_path_ac_pt_OCAMLPROF if test -n "$ac_pt_OCAMLPROF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLPROF" >&5 $as_echo "$ac_pt_OCAMLPROF" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLPROF" = x; then OCAMLPROF="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLPROF=$ac_pt_OCAMLPROF fi else OCAMLPROF="$ac_cv_path_OCAMLPROF" fi fi SUBSTITUTED_OCAMLPROF=yes fi fi if test -z "$OCAMLPROF"; then : OCAMLPROF=no fi if test "x$OCAMLLEX" = xno; then : as_fn_error $? "the OCaml Lexer needs to be installed (the ocamllex command). It should be part of your OCaml distribution." "$LINENO" 5 fi if test "x$OCAMLYACC" = xno; then : as_fn_error $? "The OCaml parser generated needs to be installed (the ocamlyacc command). It should be part of your OCaml distribution." "$LINENO" 5 fi if test "x$OCAMLFIND" = xno; then : as_fn_error $? "A suitable OCaml findlib (the ocamlfind command) could not be found." "$LINENO" 5 fi # Check whether --with-runtime-ocamlfind was given. if test "${with_runtime_ocamlfind+set}" = set; then : withval=$with_runtime_ocamlfind; fi if test -z "$RUNTIME_OCAMLFIND_CMD"; then : if test "x$with_runtime_ocamlfind" = xno; then : RUNTIME_OCAMLFIND_CMD=$OCAMLFIND elif test -n "$with_runtime_ocamlfind" -a "x$with_runtime_ocamlfind" != xyes; then : RUNTIME_OCAMLFIND_CMD="$with_runtime_ocamlfind" else RUNTIME_OCAMLFIND_CMD="ocamlfind" fi fi # Check whether --with-runtime-ocamlc was given. if test "${with_runtime_ocamlc+set}" = set; then : withval=$with_runtime_ocamlc; fi if test -z "$RUNTIME_OCAMLC_CMD"; then : if test "x$with_runtime_ocamlc" = xno; then : RUNTIME_OCAMLC_CMD=$OCAMLC elif test -n "$with_runtime_ocamlc" -a "x$with_runtime_ocamlc" != xyes; then : RUNTIME_OCAMLC_CMD="$with_runtime_ocamlc" else RUNTIME_OCAMLC_CMD="ocamlc" fi fi # Check whether --with-runtime-ocamlopt was given. if test "${with_runtime_ocamlopt+set}" = set; then : withval=$with_runtime_ocamlopt; fi if test -z "$RUNTIME_OCAMLOPT_CMD"; then : if test "x$with_runtime_ocamlopt" = xno; then : RUNTIME_OCAMLOPT_CMD=$OCAMLOPT elif test -n "$with_runtime_ocamlopt" -a "x$with_runtime_ocamlopt" != xyes; then : RUNTIME_OCAMLOPT_CMD="$with_runtime_ocamlopt" else RUNTIME_OCAMLOPT_CMD="ocamlopt" fi fi # Check whether --with-runtime-ocamldep was given. if test "${with_runtime_ocamldep+set}" = set; then : withval=$with_runtime_ocamldep; fi if test -z "$RUNTIME_OCAMLDEP_CMD"; then : if test "x$with_runtime_ocamldep" = xno; then : RUNTIME_OCAMLDEP_CMD=$OCAMLDEP elif test -n "$with_runtime_ocamldep" -a "x$with_runtime_ocamldep" != xyes; then : RUNTIME_OCAMLDEP_CMD="$with_runtime_ocamldep" else RUNTIME_OCAMLDEP_CMD="ocamldep" fi fi # Check whether --with-runtime-camlp4 was given. if test "${with_runtime_camlp4+set}" = set; then : withval=$with_runtime_camlp4; fi if test -z "$RUNTIME_CAMLP4_CMD"; then : if test "x$with_runtime_camlp4" = xno; then : RUNTIME_CAMLP4_CMD=$CAMLP4 elif test -n "$with_runtime_camlp4" -a "x$with_runtime_camlp4" != xyes; then : RUNTIME_CAMLP4_CMD="$with_runtime_camlp4" else RUNTIME_CAMLP4_CMD="camlp4" fi fi # Check whether --with-runtime-camlp4o was given. if test "${with_runtime_camlp4o+set}" = set; then : withval=$with_runtime_camlp4o; fi if test -z "$RUNTIME_CAMLP4O_CMD"; then : if test "x$with_runtime_camlp4o" = xno; then : RUNTIME_CAMLP4O_CMD=$CAMLP4O elif test -n "$with_runtime_camlp4o" -a "x$with_runtime_camlp4o" != xyes; then : RUNTIME_CAMLP4O_CMD="$with_runtime_camlp4o" else RUNTIME_CAMLP4O_CMD="camlp4o" fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: verifying basic ocaml modules" >&5 $as_echo "$as_me: verifying basic ocaml modules" >&6;} COCCI_OCAML_EXTERNAL="$COCCI_SRCDIR/bundles" { $as_echo "$as_me:${as_lineno-$LINENO}: coccinelle may use external ocaml libraries in $COCCI_OCAML_EXTERNAL" >&5 $as_echo "$as_me: coccinelle may use external ocaml libraries in $COCCI_OCAML_EXTERNAL" >&6;} FEATURE_menhirLib=0 LOCALLIB_menhirLib=0 FLAGS_menhirLib= MODULES_menhirLib= MODULESOPT_menhirLib= PATH_menhirLib= FEATURE_dynlink=0 LOCALLIB_dynlink=0 FLAGS_dynlink= MODULES_dynlink= MODULESOPT_dynlink= PATH_dynlink= FEATURE_pcre=0 LOCALLIB_pcre=0 FLAGS_pcre= MODULES_pcre= MODULESOPT_pcre= PATH_pcre= FEATURE_pycaml=0 LOCALLIB_pycaml=0 FLAGS_pycaml= MODULES_pycaml= MODULESOPT_pycaml= PATH_pycaml= FEATURE_camlp4=0 LOCALLIB_camlp4=0 FLAGS_camlp4= MODULES_camlp4= MODULESOPT_camlp4= PATH_camlp4= { $as_echo "$as_me:${as_lineno-$LINENO}: the following OCaml packages should be provided by your ocaml installation" >&5 $as_echo "$as_me: the following OCaml packages should be provided by your ocaml installation" >&6;} { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package unix" >&5 $as_echo_n "checking for OCaml findlib package unix... " >&6; } unset found unset pkg found=no for pkg in unix ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_unix=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_unix=no fi if test "x$OCAML_PKG_unix" != xno; then : PATH_unix=`$OCAMLFIND query unix 2>/dev/null` fi if test "x$OCAML_PKG_unix" = xno; then : as_fn_error $? "package unix is required. It should be part of your ocaml installation." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package bigarray" >&5 $as_echo_n "checking for OCaml findlib package bigarray... " >&6; } unset found unset pkg found=no for pkg in bigarray ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_bigarray=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_bigarray=no fi if test "x$OCAML_PKG_bigarray" != xno; then : PATH_bigarray=`$OCAMLFIND query bigarray 2>/dev/null` fi if test "x$OCAML_PKG_bigarray" = xno; then : as_fn_error $? "package bigarray is required. It should be part of your ocaml installation." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package num" >&5 $as_echo_n "checking for OCaml findlib package num... " >&6; } unset found unset pkg found=no for pkg in num ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_num=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_num=no fi if test "x$OCAML_PKG_num" != xno; then : PATH_num=`$OCAMLFIND query num 2>/dev/null` fi if test "x$OCAML_PKG_num" = xno; then : as_fn_error $? "package num is required. It should be part of your ocaml installation." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package str" >&5 $as_echo_n "checking for OCaml findlib package str... " >&6; } unset found unset pkg found=no for pkg in str ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_str=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_str=no fi if test "x$OCAML_PKG_str" != xno; then : PATH_str=`$OCAMLFIND query str 2>/dev/null` fi if test "x$OCAML_PKG_str" = xno; then : as_fn_error $? "package str is required. It should be part of your ocaml installation." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: configuring package dynlink" >&5 $as_echo "$as_me: configuring package dynlink" >&6;} # Check whether --enable-dynlink was given. if test "${enable_dynlink+set}" = set; then : enableval=$enable_dynlink; fi if test "x$enable_dynlink" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package dynlink" >&5 $as_echo_n "checking for OCaml findlib package dynlink... " >&6; } unset found unset pkg found=no for pkg in dynlink ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_dynlink=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_dynlink=no fi if test "x$OCAML_PKG_dynlink" != xno; then : PATH_dynlink=`$OCAMLFIND query dynlink 2>/dev/null` fi GLOBAL_dynlink=$OCAML_PKG_dynlink if test "x$GLOBAL_dynlink" != xno; then : enable_dynlink=yes else if test "x$enable_dynlink" = xyes; then : as_fn_error $? "OCaml package dynlink is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package dynlink is not available" >&5 $as_echo "$as_me: OCaml package dynlink is not available" >&6;} enable_dynlink=no fi fi if test "x$enable_dynlink" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/dynlink/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of dynlink" >&5 $as_echo_n "checking for a bundled substitute of dynlink... " >&6; } if test -d "$pkgdir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: using bundled substitute for dynlink in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for dynlink in $pkgdir" >&6;} enable_dynlink=local PATH_dynlink="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_dynlink" != xno; then : FEATURE_dynlink=1 FLAGS_dynlink='$(FLAGS_dynlink)' OPTFLAGS_dynlink='$(OPTFLAGS_dynlink)' if test "x$enable_dynlink" = xlocal; then : LOCALLIB_dynlink=1 MODULES_dynlink='$(LOCAL_dynlink)' MODULESOPT_dynlink='$(LOCALOPT_dynlink)' if test -f "$PATH_dynlink/Makefile"; then : MAKE_dynlink=$PATH_dynlink else MAKE_dynlink= fi else MODULES_dynlink='$(GLOBAL_dynlink)' MODULESOPT_dynlink='$(GLOBALOPT_dynlink)' fi fi if test "x$enable_dynlink" = xno; then : as_fn_error $? "OCaml package dynlink is required. Please make sure it is available." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: configuring package camlp4" >&5 $as_echo "$as_me: configuring package camlp4" >&6;} # Check whether --enable-camlp4 was given. if test "${enable_camlp4+set}" = set; then : enableval=$enable_camlp4; fi if test "x$enable_camlp4" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package camlp4" >&5 $as_echo_n "checking for OCaml findlib package camlp4... " >&6; } unset found unset pkg found=no for pkg in camlp4 ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_camlp4=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_camlp4=no fi if test "x$OCAML_PKG_camlp4" != xno; then : PATH_camlp4=`$OCAMLFIND query camlp4 2>/dev/null` fi GLOBAL_camlp4=$OCAML_PKG_camlp4 if test "x$GLOBAL_camlp4" != xno; then : enable_camlp4=yes else if test "x$enable_camlp4" = xyes; then : as_fn_error $? "OCaml package camlp4 is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package camlp4 is not available" >&5 $as_echo "$as_me: OCaml package camlp4 is not available" >&6;} enable_camlp4=no fi fi if test "x$enable_camlp4" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/camlp4/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of camlp4" >&5 $as_echo_n "checking for a bundled substitute of camlp4... " >&6; } if test -d "$pkgdir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: using bundled substitute for camlp4 in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for camlp4 in $pkgdir" >&6;} enable_camlp4=local PATH_camlp4="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_camlp4" != xno; then : FEATURE_camlp4=1 FLAGS_camlp4='$(FLAGS_camlp4)' OPTFLAGS_camlp4='$(OPTFLAGS_camlp4)' if test "x$enable_camlp4" = xlocal; then : LOCALLIB_camlp4=1 MODULES_camlp4='$(LOCAL_camlp4)' MODULESOPT_camlp4='$(LOCALOPT_camlp4)' if test -f "$PATH_camlp4/Makefile"; then : MAKE_camlp4=$PATH_camlp4 else MAKE_camlp4= fi else MODULES_camlp4='$(GLOBAL_camlp4)' MODULESOPT_camlp4='$(GLOBALOPT_camlp4)' fi fi if test "x$enable_camlp4" = xno; then : as_fn_error $? "OCaml package camlp4 is required. Please make sure it is available." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: configuring package menhirLib" >&5 $as_echo "$as_me: configuring package menhirLib" >&6;} # Check whether --enable-menhirLib was given. if test "${enable_menhirLib+set}" = set; then : enableval=$enable_menhirLib; fi if test "x$enable_menhirLib" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package menhirLib" >&5 $as_echo_n "checking for OCaml findlib package menhirLib... " >&6; } unset found unset pkg found=no for pkg in menhirLib ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_menhirLib=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_menhirLib=no fi if test "x$OCAML_PKG_menhirLib" != xno; then : PATH_menhirLib=`$OCAMLFIND query menhirLib 2>/dev/null` fi GLOBAL_menhirLib=$OCAML_PKG_menhirLib if test "x$GLOBAL_menhirLib" != xno; then : enable_menhirLib=yes else if test "x$enable_menhirLib" = xyes; then : as_fn_error $? "OCaml package menhirLib is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package menhirLib is not available" >&5 $as_echo "$as_me: OCaml package menhirLib is not available" >&6;} enable_menhirLib=no fi fi if test "x$enable_menhirLib" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/menhirLib/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of menhirLib" >&5 $as_echo_n "checking for a bundled substitute of menhirLib... " >&6; } if test -d "$pkgdir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: using bundled substitute for menhirLib in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for menhirLib in $pkgdir" >&6;} enable_menhirLib=local PATH_menhirLib="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_menhirLib" != xno; then : FEATURE_menhirLib=1 FLAGS_menhirLib='$(FLAGS_menhirLib)' OPTFLAGS_menhirLib='$(OPTFLAGS_menhirLib)' if test "x$enable_menhirLib" = xlocal; then : LOCALLIB_menhirLib=1 MODULES_menhirLib='$(LOCAL_menhirLib)' MODULESOPT_menhirLib='$(LOCALOPT_menhirLib)' if test -f "$PATH_menhirLib/Makefile"; then : MAKE_menhirLib=$PATH_menhirLib else MAKE_menhirLib= fi else MODULES_menhirLib='$(GLOBAL_menhirLib)' MODULESOPT_menhirLib='$(GLOBALOPT_menhirLib)' fi fi if test "x$enable_menhirLib" = xno; then : as_fn_error $? "OCaml package menhirLib is required. Please make sure it is available." "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: verifying optional features" >&5 $as_echo "$as_me: verifying optional features" >&6;} if test "x$OCAML_PKG_dynlink" != xno -a -f "$PATH_dynlink/dynlink.cmxa"; then : OPTIMIZED_dynlink=yes else OPTIMIZED_dynlink=no fi # Check whether --with-menhir was given. if test "${with_menhir+set}" = set; then : withval=$with_menhir; fi with_MENHIR="$with_menhir" if test -n "$with_MENHIR" -a "x$with_MENHIR" != xno -a "x$with_MENHIR" != xyes; then : MENHIR="$with_MENHIR" else MENHIR="menhir" fi if test "x$with_MENHIR" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: menhir is disabled explicitly" >&5 $as_echo "$as_me: menhir is disabled explicitly" >&6;} MENHIR=no else if test "x$MENHIR" = xpkg-config -a "xMENHIR" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$MENHIR" = xocamllex -a "xMENHIR" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$MENHIR" = xocamlyacc -a "xMENHIR" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]MENHIR", so it can be a program name with args. set dummy ${ac_tool_prefix}$MENHIR; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_MENHIR+:} false; then : $as_echo_n "(cached) " >&6 else case $MENHIR in [\\/]* | ?:[\\/]*) ac_cv_path_MENHIR="$MENHIR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_MENHIR="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi MENHIR=$ac_cv_path_MENHIR if test -n "$MENHIR"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MENHIR" >&5 $as_echo "$MENHIR" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_MENHIR"; then ac_pt_MENHIR=$MENHIR # Extract the first word of "[$]MENHIR", so it can be a program name with args. set dummy $MENHIR; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_MENHIR+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_MENHIR in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_MENHIR="$ac_pt_MENHIR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_MENHIR="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_MENHIR=$ac_cv_path_ac_pt_MENHIR if test -n "$ac_pt_MENHIR"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_MENHIR" >&5 $as_echo "$ac_pt_MENHIR" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_MENHIR" = x; then MENHIR="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac MENHIR=$ac_pt_MENHIR fi else MENHIR="$ac_cv_path_MENHIR" fi fi fi if test -z "$MENHIR" -o "x$MENHIR" = xno; then : if test "x$with_MENHIR" = xyes; then : as_fn_error $? "--with=menhir is given explicitly but not found" "$LINENO" 5 fi if test -n "$COCCI_SRCDIR/setup/fake-menhir.sh menhir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: menhir not found. Trying substitute $COCCI_SRCDIR/setup/fake-menhir.sh menhir." >&5 $as_echo "$as_me: menhir not found. Trying substitute $COCCI_SRCDIR/setup/fake-menhir.sh menhir." >&6;} MENHIR="$COCCI_SRCDIR/setup/fake-menhir.sh menhir" if test "xmenhir" = xpkg-config -a "xMENHIR" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xmenhir" = xocamllex -a "xMENHIR" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xmenhir" = xocamlyacc -a "xMENHIR" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}menhir", so it can be a program name with args. set dummy ${ac_tool_prefix}menhir; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_MENHIR+:} false; then : $as_echo_n "(cached) " >&6 else case $MENHIR in [\\/]* | ?:[\\/]*) ac_cv_path_MENHIR="$MENHIR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_MENHIR="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi MENHIR=$ac_cv_path_MENHIR if test -n "$MENHIR"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MENHIR" >&5 $as_echo "$MENHIR" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_MENHIR"; then ac_pt_MENHIR=$MENHIR # Extract the first word of "menhir", so it can be a program name with args. set dummy menhir; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_MENHIR+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_MENHIR in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_MENHIR="$ac_pt_MENHIR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_MENHIR="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_MENHIR=$ac_cv_path_ac_pt_MENHIR if test -n "$ac_pt_MENHIR"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_MENHIR" >&5 $as_echo "$ac_pt_MENHIR" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_MENHIR" = x; then MENHIR="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac MENHIR=$ac_pt_MENHIR fi else MENHIR="$ac_cv_path_MENHIR" fi fi SUBSTITUTED_MENHIR=yes fi fi if test -z "$MENHIR"; then : MENHIR=no fi if test "x$SUBSTITUTED_MENHIR" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: pregenerated parsers will be required as substitute for Menhir" >&5 $as_echo "$as_me: pregenerated parsers will be required as substitute for Menhir" >&6;} fi # Check whether --enable-ocaml was given. if test "${enable_ocaml+set}" = set; then : enableval=$enable_ocaml; fi if test "x$OCAML_PKG_dynlink" = xno; then : if test -z "$enable_ocaml"; then : enable_ocaml=no { $as_echo "$as_me:${as_lineno-$LINENO}: ocaml scripting is disabled because the 'dynlink' package is not installed" >&5 $as_echo "$as_me: ocaml scripting is disabled because the 'dynlink' package is not installed" >&6;} elif test "x$enable_ocaml" != xno; then : as_fn_error $? "the OCaml package dynlink is required for ocaml scripting" "$LINENO" 5 fi fi if test "x$OCAMLATLEAST311" = xno; then : if test -z "$enable_ocaml"; then : enable_ocaml=no { $as_echo "$as_me:${as_lineno-$LINENO}: ocaml scripting has been disabled by default because your OCaml version may not support dynamic linking properly" >&5 $as_echo "$as_me: ocaml scripting has been disabled by default because your OCaml version may not support dynamic linking properly" >&6;} elif test "x$enable_ocaml" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: warning: your ocaml version may be too old for dynamic linking, thus ocaml scripting may not work" >&5 $as_echo "$as_me: warning: your ocaml version may be too old for dynamic linking, thus ocaml scripting may not work" >&6;} fi fi if test "x$OPTIMIZED_dynlink" = xno; then : if test -z "$enable_ocaml"; then : enable_ocaml=no { $as_echo "$as_me:${as_lineno-$LINENO}: ocaml scripting has been disabled by default because the optimized version of dynlink is not available" >&5 $as_echo "$as_me: ocaml scripting has been disabled by default because the optimized version of dynlink is not available" >&6;} elif test "x$enable_ocaml" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: warning: the optimized version of dynlink is not available, thus ocaml scripting may not work" >&5 $as_echo "$as_me: warning: the optimized version of dynlink is not available, thus ocaml scripting may not work" >&6;} fi fi if test -n "$SUBSTITUTED_OCAMLFIND"; then : if test -z "$enable_ocaml"; then : enable_ocaml=no { $as_echo "$as_me:${as_lineno-$LINENO}: ocaml scripting is disabled because it depends on ocamlfind" >&5 $as_echo "$as_me: ocaml scripting is disabled because it depends on ocamlfind" >&6;} elif test "x$enable_ocaml" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ocamlfind is not found but may be required when ocaml scripts are used" >&5 $as_echo "$as_me: warning: ocamlfind is not found but may be required when ocaml scripts are used" >&6;} fi fi if test "x$CAMLP4" = xno; then : if test -z "$enable_ocaml"; then : enable_ocaml=no { $as_echo "$as_me:${as_lineno-$LINENO}: ocaml scripting is disabled because it requires camlp4 which is not available" >&5 $as_echo "$as_me: ocaml scripting is disabled because it requires camlp4 which is not available" >&6;} elif test "x$enable_ocaml" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: warning: camlp4 is not found but may be required when ocaml scripts are used" >&5 $as_echo "$as_me: warning: camlp4 is not found but may be required when ocaml scripts are used" >&6;} fi fi if test "x$enable_ocaml" = xno; then : FEATURE_dynlink=0 LOCALLIB_dynlink=0 FLAGS_dynlink= MODULES_dynlink= MODULESOPT_dynlink= PATH_dynlink= OCAMLCOCCI_MODULE=No_prepare_ocamlcocci OCAMLCOCCI_FILE=no_prepare_ocamlcocci.ml else enable_ocaml=yes OCAMLCOCCI_MODULE=Yes_prepare_ocamlcocci OCAMLCOCCI_FILE=yes_prepare_ocamlcocci.ml fi # Check whether --enable-python was given. if test "${enable_python+set}" = set; then : enableval=$enable_python; fi if test "x$enable_python" != xno; then : if test -n "$enable_python" -a -z "$enable_pycaml"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: skipped the selection of a global pycaml module because --enable-python is given explicitly but --enable-pycaml is not." >&5 $as_echo "$as_me: skipped the selection of a global pycaml module because --enable-python is given explicitly but --enable-pycaml is not." >&6;} enable_pycaml=no fi if test -z "$PYVER"; then : # Check whether --with-python was given. if test "${with_python+set}" = set; then : withval=$with_python; fi with_PYTHON="$with_python" if test -n "$with_PYTHON" -a "x$with_PYTHON" != xno -a "x$with_PYTHON" != xyes; then : PYTHON="$with_PYTHON" else PYTHON="python" fi if test "x$with_PYTHON" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: python is disabled explicitly" >&5 $as_echo "$as_me: python is disabled explicitly" >&6;} PYTHON=no else if test "x$PYTHON" = xpkg-config -a "xPYTHON" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$PYTHON" = xocamllex -a "xPYTHON" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$PYTHON" = xocamlyacc -a "xPYTHON" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]PYTHON", so it can be a program name with args. set dummy ${ac_tool_prefix}$PYTHON; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PYTHON+:} false; then : $as_echo_n "(cached) " >&6 else case $PYTHON in [\\/]* | ?:[\\/]*) ac_cv_path_PYTHON="$PYTHON" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PYTHON="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PYTHON=$ac_cv_path_PYTHON if test -n "$PYTHON"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYTHON" >&5 $as_echo "$PYTHON" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PYTHON"; then ac_pt_PYTHON=$PYTHON # Extract the first word of "[$]PYTHON", so it can be a program name with args. set dummy $PYTHON; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PYTHON+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PYTHON in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PYTHON="$ac_pt_PYTHON" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PYTHON="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PYTHON=$ac_cv_path_ac_pt_PYTHON if test -n "$ac_pt_PYTHON"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PYTHON" >&5 $as_echo "$ac_pt_PYTHON" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PYTHON" = x; then PYTHON="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PYTHON=$ac_pt_PYTHON fi else PYTHON="$ac_cv_path_PYTHON" fi fi fi if test -z "$PYTHON" -o "x$PYTHON" = xno; then : if test "x$with_PYTHON" = xyes; then : as_fn_error $? "--with=python is given explicitly but not found" "$LINENO" 5 fi if test -n ""; then : { $as_echo "$as_me:${as_lineno-$LINENO}: python not found. Trying substitute ." >&5 $as_echo "$as_me: python not found. Trying substitute ." >&6;} PYTHON="" if test "xpython" = xpkg-config -a "xPYTHON" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xpython" = xocamllex -a "xPYTHON" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xpython" = xocamlyacc -a "xPYTHON" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}python", so it can be a program name with args. set dummy ${ac_tool_prefix}python; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PYTHON+:} false; then : $as_echo_n "(cached) " >&6 else case $PYTHON in [\\/]* | ?:[\\/]*) ac_cv_path_PYTHON="$PYTHON" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PYTHON="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PYTHON=$ac_cv_path_PYTHON if test -n "$PYTHON"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYTHON" >&5 $as_echo "$PYTHON" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PYTHON"; then ac_pt_PYTHON=$PYTHON # Extract the first word of "python", so it can be a program name with args. set dummy python; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PYTHON+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PYTHON in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PYTHON="$ac_pt_PYTHON" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PYTHON="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PYTHON=$ac_cv_path_ac_pt_PYTHON if test -n "$ac_pt_PYTHON"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PYTHON" >&5 $as_echo "$ac_pt_PYTHON" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PYTHON" = x; then PYTHON="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PYTHON=$ac_pt_PYTHON fi else PYTHON="$ac_cv_path_PYTHON" fi fi SUBSTITUTED_PYTHON=yes fi fi if test -z "$PYTHON"; then : PYTHON=no fi if test "x$PYTHON" = xno -a -z "$with_python"; then : for ac_prog in python python3 python3.2 python3.1 python2 python2.7 python2.6 python2.5 do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PYTHON+:} false; then : $as_echo_n "(cached) " >&6 else case $PYTHON in [\\/]* | ?:[\\/]*) ac_cv_path_PYTHON="$PYTHON" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PYTHON="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PYTHON=$ac_cv_path_PYTHON if test -n "$PYTHON"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYTHON" >&5 $as_echo "$PYTHON" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$PYTHON" && break done if test -z "$PYTHON"; then : PYTHON=no fi fi if test "x$PYTHON" = xno -a -n "$with_python" -a "x$with_python" != xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: $with_python is not a found as tool, therefore interpreted as version" >&5 $as_echo "$as_me: $with_python is not a found as tool, therefore interpreted as version" >&6;} PYVER="$with_python" fi if test "x$PYTHON" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking python version" >&5 $as_echo_n "checking python version... " >&6; } PYVER=`$PYTHON -c "import sys; print(sys.version[:3])"` if test -n "$PYVER"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYVER found" >&5 $as_echo "$PYVER found" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 $as_echo "failed" >&6; } fi fi else { $as_echo "$as_me:${as_lineno-$LINENO}: python version assumed to be $PYVER" >&5 $as_echo "$as_me: python version assumed to be $PYVER" >&6;} fi PYVER_MAJOR=${PYVER%%.*} { $as_echo "$as_me:${as_lineno-$LINENO}: python major version: $PYVER_MAJOR" >&5 $as_echo "$as_me: python major version: $PYVER_MAJOR" >&6;} if test -z "$PYVER"; then : if test "x$enable_python" = xyes; then : as_fn_error $? "python scripting is enabled explicitly but the version of python could not be determined" "$LINENO" 5 fi else { $as_echo "$as_me:${as_lineno-$LINENO}: looking for the corresponding python library" >&5 $as_echo "$as_me: looking for the corresponding python library" >&6;} pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PYTHON" >&5 $as_echo_n "checking for PYTHON... " >&6; } if test -n "$PYTHON_CFLAGS"; then pkg_cv_PYTHON_CFLAGS="$PYTHON_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"python-\$PYVER\""; } >&5 ($PKG_CONFIG --exists --print-errors "python-$PYVER") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PYTHON_CFLAGS=`$PKG_CONFIG --cflags "python-$PYVER" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$PYTHON_LIBS"; then pkg_cv_PYTHON_LIBS="$PYTHON_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"python-\$PYVER\""; } >&5 ($PKG_CONFIG --exists --print-errors "python-$PYVER") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PYTHON_LIBS=`$PKG_CONFIG --libs "python-$PYVER" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then PYTHON_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "python-$PYVER" 2>&1` else PYTHON_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "python-$PYVER" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$PYTHON_PKG_ERRORS" >&5 HAVE_PYTHON=no elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } HAVE_PYTHON=no else PYTHON_CFLAGS=$pkg_cv_PYTHON_CFLAGS PYTHON_LIBS=$pkg_cv_PYTHON_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } HAVE_PYTHON=yes fi if test "x$HAVE_PYTHON" != xyes -a "x$enable_python" != xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: trying the default python library as fallback" >&5 $as_echo "$as_me: trying the default python library as fallback" >&6;} pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PYTHON" >&5 $as_echo_n "checking for PYTHON... " >&6; } if test -n "$PYTHON_CFLAGS"; then pkg_cv_PYTHON_CFLAGS="$PYTHON_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"python\""; } >&5 ($PKG_CONFIG --exists --print-errors "python") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PYTHON_CFLAGS=`$PKG_CONFIG --cflags "python" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$PYTHON_LIBS"; then pkg_cv_PYTHON_LIBS="$PYTHON_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"python\""; } >&5 ($PKG_CONFIG --exists --print-errors "python") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PYTHON_LIBS=`$PKG_CONFIG --libs "python" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then PYTHON_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "python" 2>&1` else PYTHON_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "python" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$PYTHON_PKG_ERRORS" >&5 HAVE_PYTHON=no elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } HAVE_PYTHON=no else PYTHON_CFLAGS=$pkg_cv_PYTHON_CFLAGS PYTHON_LIBS=$pkg_cv_PYTHON_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } HAVE_PYTHON=yes fi fi fi fi if test -z "$enable_python"; then : if test "x$HAVE_PYTHON" = xyes; then : enable_python=yes else enable_python=no fi fi if test "x$enable_python" != xno; then : if test "x$HAVE_PYTHON" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: support for python scripts is enabled" >&5 $as_echo "$as_me: support for python scripts is enabled" >&6;} else as_fn_error $? "the python scripts feature is enabled but the pkg-config python library is not found" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: configuring package pycaml" >&5 $as_echo "$as_me: configuring package pycaml" >&6;} # Check whether --enable-pycaml was given. if test "${enable_pycaml+set}" = set; then : enableval=$enable_pycaml; fi if test "x$enable_pycaml" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package pycaml" >&5 $as_echo_n "checking for OCaml findlib package pycaml... " >&6; } unset found unset pkg found=no for pkg in pycaml ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_pycaml=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_pycaml=no fi if test "x$OCAML_PKG_pycaml" != xno; then : PATH_pycaml=`$OCAMLFIND query pycaml 2>/dev/null` fi GLOBAL_pycaml=$OCAML_PKG_pycaml if test "x$GLOBAL_pycaml" != xno; then : enable_pycaml=yes else if test "x$enable_pycaml" = xyes; then : as_fn_error $? "OCaml package pycaml is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package pycaml is not available" >&5 $as_echo "$as_me: OCaml package pycaml is not available" >&6;} enable_pycaml=no fi fi if test "x$enable_pycaml" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/pycaml/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of pycaml" >&5 $as_echo_n "checking for a bundled substitute of pycaml... " >&6; } if test -d "$pkgdir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: using bundled substitute for pycaml in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for pycaml in $pkgdir" >&6;} enable_pycaml=local PATH_pycaml="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_pycaml" != xno; then : FEATURE_pycaml=1 FLAGS_pycaml='$(FLAGS_pycaml)' OPTFLAGS_pycaml='$(OPTFLAGS_pycaml)' if test "x$enable_pycaml" = xlocal; then : LOCALLIB_pycaml=1 MODULES_pycaml='$(LOCAL_pycaml)' MODULESOPT_pycaml='$(LOCALOPT_pycaml)' if test -f "$PATH_pycaml/Makefile"; then : MAKE_pycaml=$PATH_pycaml else MAKE_pycaml= fi else MODULES_pycaml='$(GLOBAL_pycaml)' MODULESOPT_pycaml='$(GLOBALOPT_pycaml)' fi fi if test "x$enable_pycaml" = xno; then : as_fn_error $? "OCaml package pycaml is required. Please make sure it is available." "$LINENO" 5 fi PYCOCCI_MODULE=Yes_pycocci PYCOCCI_FILE=yes_pycocci.ml else FEATURE_pycaml=0 LOCALLIB_pycaml=0 FLAGS_pycaml= MODULES_pycaml= MODULESOPT_pycaml= PATH_pycaml= PYCOCCI_MODULE=No_pycocci PYCOCCI_FILE=no_pycocci.ml fi # Check whether --enable-pcre-syntax was given. if test "${enable_pcre_syntax+set}" = set; then : enableval=$enable_pcre_syntax; fi if test "x$enable_pcre_syntax" != "xno"; then : pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PCRE" >&5 $as_echo_n "checking for PCRE... " >&6; } if test -n "$PCRE_CFLAGS"; then pkg_cv_PCRE_CFLAGS="$PCRE_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libpcre\""; } >&5 ($PKG_CONFIG --exists --print-errors "libpcre") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PCRE_CFLAGS=`$PKG_CONFIG --cflags "libpcre" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$PCRE_LIBS"; then pkg_cv_PCRE_LIBS="$PCRE_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libpcre\""; } >&5 ($PKG_CONFIG --exists --print-errors "libpcre") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PCRE_LIBS=`$PKG_CONFIG --libs "libpcre" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then PCRE_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libpcre" 2>&1` else PCRE_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libpcre" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$PCRE_PKG_ERRORS" >&5 HAVE_PCRE=no elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } HAVE_PCRE=no else PCRE_CFLAGS=$pkg_cv_PCRE_CFLAGS PCRE_LIBS=$pkg_cv_PCRE_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } HAVE_PCRE=yes fi if test -z "$enable_pcre_syntax" -a "x$HAVE_PCRE" != xyes; then : enable_pcre_syntax=no else { $as_echo "$as_me:${as_lineno-$LINENO}: configuring package pcre" >&5 $as_echo "$as_me: configuring package pcre" >&6;} # Check whether --enable-pcre was given. if test "${enable_pcre+set}" = set; then : enableval=$enable_pcre; fi if test "x$enable_pcre" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package pcre" >&5 $as_echo_n "checking for OCaml findlib package pcre... " >&6; } unset found unset pkg found=no for pkg in pcre ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 $as_echo "found" >&6; } OCAML_PKG_pcre=$pkg found=yes break fi done if test "$found" = "no" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 $as_echo "not found" >&6; } OCAML_PKG_pcre=no fi if test "x$OCAML_PKG_pcre" != xno; then : PATH_pcre=`$OCAMLFIND query pcre 2>/dev/null` fi GLOBAL_pcre=$OCAML_PKG_pcre if test "x$GLOBAL_pcre" != xno; then : enable_pcre=yes else if test "x$enable_pcre" = xyes; then : as_fn_error $? "OCaml package pcre is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package pcre is not available" >&5 $as_echo "$as_me: OCaml package pcre is not available" >&6;} enable_pcre=no fi fi if test "x$enable_pcre" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/pcre/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of pcre" >&5 $as_echo_n "checking for a bundled substitute of pcre... " >&6; } if test -d "$pkgdir"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: using bundled substitute for pcre in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for pcre in $pkgdir" >&6;} enable_pcre=local PATH_pcre="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_pcre" != xno; then : FEATURE_pcre=1 FLAGS_pcre='$(FLAGS_pcre)' OPTFLAGS_pcre='$(OPTFLAGS_pcre)' if test "x$enable_pcre" = xlocal; then : LOCALLIB_pcre=1 MODULES_pcre='$(LOCAL_pcre)' MODULESOPT_pcre='$(LOCALOPT_pcre)' if test -f "$PATH_pcre/Makefile"; then : MAKE_pcre=$PATH_pcre else MAKE_pcre= fi else MODULES_pcre='$(GLOBAL_pcre)' MODULESOPT_pcre='$(GLOBALOPT_pcre)' fi fi enable_pcre_syntax=$enable_pcre fi fi if test "x$enable_pcre_syntax" != xno; then : if test "x$HAVE_PCRE" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: support for pcre syntax is enabled" >&5 $as_echo "$as_me: support for pcre syntax is enabled" >&6;} else as_fn_error $? "the pcre feature is enabled but the pkg-config libpcre library is not found" "$LINENO" 5 fi REGEXP_MODULE=Regexp_pcre REGEXP_FILE=regexp_pcre.ml else FEATURE_pcre=0 LOCALLIB_pcre=0 FLAGS_pcre= MODULES_pcre= MODULESOPT_pcre= PATH_pcre= REGEXP_MODULE=Regexp_str REGEXP_FILE=regexp_str.ml fi if test "$prefix" = "NONE"; then : prefix=$ac_default_prefix fi SHAREDIR="${prefix}/share/coccinelle" if test "x$enable_python" != xno; then : FEATURE_PYTHON=1 else FEATURE_PYTHON=0 fi if test "x$enable_ocaml" != xno; then : FEATURE_OCAML=1 else FEATURE_OCAML=0 fi if test "x$OCAMLATLEAST311" = xyes -a "x$enable_ocaml" = xyes -a "x$OCAMLOPT" != xno; then : DYNLINK_IS_NATIVE=Dynlink.is_native else DYNLINK_IS_NATIVE=false fi # Check whether --with-pdflatex was given. if test "${with_pdflatex+set}" = set; then : withval=$with_pdflatex; fi with_PDFLATEX="$with_pdflatex" if test -n "$with_PDFLATEX" -a "x$with_PDFLATEX" != xno -a "x$with_PDFLATEX" != xyes; then : PDFLATEX="$with_PDFLATEX" else PDFLATEX="pdflatex" fi if test "x$with_PDFLATEX" = xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: pdflatex is disabled explicitly" >&5 $as_echo "$as_me: pdflatex is disabled explicitly" >&6;} PDFLATEX=no else if test "x$PDFLATEX" = xpkg-config -a "xPDFLATEX" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "x$PDFLATEX" = xocamllex -a "xPDFLATEX" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "x$PDFLATEX" = xocamlyacc -a "xPDFLATEX" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}[$]PDFLATEX", so it can be a program name with args. set dummy ${ac_tool_prefix}$PDFLATEX; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PDFLATEX+:} false; then : $as_echo_n "(cached) " >&6 else case $PDFLATEX in [\\/]* | ?:[\\/]*) ac_cv_path_PDFLATEX="$PDFLATEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PDFLATEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PDFLATEX=$ac_cv_path_PDFLATEX if test -n "$PDFLATEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PDFLATEX" >&5 $as_echo "$PDFLATEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PDFLATEX"; then ac_pt_PDFLATEX=$PDFLATEX # Extract the first word of "[$]PDFLATEX", so it can be a program name with args. set dummy $PDFLATEX; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PDFLATEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PDFLATEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PDFLATEX="$ac_pt_PDFLATEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PDFLATEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PDFLATEX=$ac_cv_path_ac_pt_PDFLATEX if test -n "$ac_pt_PDFLATEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PDFLATEX" >&5 $as_echo "$ac_pt_PDFLATEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PDFLATEX" = x; then PDFLATEX="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PDFLATEX=$ac_pt_PDFLATEX fi else PDFLATEX="$ac_cv_path_PDFLATEX" fi fi fi if test -z "$PDFLATEX" -o "x$PDFLATEX" = xno; then : if test "x$with_PDFLATEX" = xyes; then : as_fn_error $? "--with=pdflatex is given explicitly but not found" "$LINENO" 5 fi if test -n "$COCCI_SRCDIR/setup/fake-pdflatex.sh pdflatex"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: pdflatex not found. Trying substitute $COCCI_SRCDIR/setup/fake-pdflatex.sh pdflatex." >&5 $as_echo "$as_me: pdflatex not found. Trying substitute $COCCI_SRCDIR/setup/fake-pdflatex.sh pdflatex." >&6;} PDFLATEX="$COCCI_SRCDIR/setup/fake-pdflatex.sh pdflatex" if test "xpdflatex" = xpkg-config -a "xPDFLATEX" = xPKG_CONFIG; then : if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi elif test "xpdflatex" = xocamllex -a "xPDFLATEX" = xOCAMLLEX; then : # checking for ocamllex if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEX="$OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEX=$ac_cv_path_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEX"; then ac_pt_OCAMLLEX=$OCAMLLEX # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEX="$ac_pt_OCAMLLEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEX=$ac_cv_path_ac_pt_OCAMLLEX if test -n "$ac_pt_OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEX" >&5 $as_echo "$ac_pt_OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEX" = x; then OCAMLLEX="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEX=$ac_pt_OCAMLLEX fi else OCAMLLEX="$ac_cv_path_OCAMLLEX" fi if test "$OCAMLLEX" != "no"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamllex.opt", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLLEXDOTOPT=$ac_cv_path_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLLEXDOTOPT"; then ac_pt_OCAMLLEXDOTOPT=$OCAMLLEXDOTOPT # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLLEXDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLLEXDOTOPT in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$ac_pt_OCAMLLEXDOTOPT" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLLEXDOTOPT="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLLEXDOTOPT=$ac_cv_path_ac_pt_OCAMLLEXDOTOPT if test -n "$ac_pt_OCAMLLEXDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLLEXDOTOPT" >&5 $as_echo "$ac_pt_OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLLEXDOTOPT" = x; then OCAMLLEXDOTOPT="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLLEXDOTOPT=$ac_pt_OCAMLLEXDOTOPT fi else OCAMLLEXDOTOPT="$ac_cv_path_OCAMLLEXDOTOPT" fi if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi elif test "xpdflatex" = xocamlyacc -a "xPDFLATEX" = xOCAMLYACC; then : if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ocamlyacc", so it can be a program name with args. set dummy ${ac_tool_prefix}ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_OCAMLYACC="$OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi OCAMLYACC=$ac_cv_path_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_OCAMLYACC"; then ac_pt_OCAMLYACC=$OCAMLYACC # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_OCAMLYACC in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_OCAMLYACC="$ac_pt_OCAMLYACC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_OCAMLYACC="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_OCAMLYACC=$ac_cv_path_ac_pt_OCAMLYACC if test -n "$ac_pt_OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_OCAMLYACC" >&5 $as_echo "$ac_pt_OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_OCAMLYACC" = x; then OCAMLYACC="no" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac OCAMLYACC=$ac_pt_OCAMLYACC fi else OCAMLYACC="$ac_cv_path_OCAMLYACC" fi else if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pdflatex", so it can be a program name with args. set dummy ${ac_tool_prefix}pdflatex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PDFLATEX+:} false; then : $as_echo_n "(cached) " >&6 else case $PDFLATEX in [\\/]* | ?:[\\/]*) ac_cv_path_PDFLATEX="$PDFLATEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PDFLATEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PDFLATEX=$ac_cv_path_PDFLATEX if test -n "$PDFLATEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PDFLATEX" >&5 $as_echo "$PDFLATEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PDFLATEX"; then ac_pt_PDFLATEX=$PDFLATEX # Extract the first word of "pdflatex", so it can be a program name with args. set dummy pdflatex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PDFLATEX+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PDFLATEX in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PDFLATEX="$ac_pt_PDFLATEX" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PDFLATEX="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PDFLATEX=$ac_cv_path_ac_pt_PDFLATEX if test -n "$ac_pt_PDFLATEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PDFLATEX" >&5 $as_echo "$ac_pt_PDFLATEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PDFLATEX" = x; then PDFLATEX="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PDFLATEX=$ac_pt_PDFLATEX fi else PDFLATEX="$ac_cv_path_PDFLATEX" fi fi SUBSTITUTED_PDFLATEX=yes fi fi if test -z "$PDFLATEX"; then : PDFLATEX=no fi # Check whether --enable-release was given. if test "${enable_release+set}" = set; then : enableval=$enable_release; fi if test -z "$enable_release"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: choosing the development Makefile configuration because the release configuration is not explicitly requested." >&5 $as_echo "$as_me: choosing the development Makefile configuration because the release configuration is not explicitly requested." >&6;} enable_release=no fi if test "x$enable_release" = xyes; then : MAKETARGET_ALL=all-release elif test "x$enable_release" = xno; then : MAKETARGET_ALL=all-dev elif test "x$enable_release" = xprofile; then : if test -z "$OCAMLPROF" -o "x$OCAMLPROF" = xno; then : as_fn_error $? "ocamlprof is required for profiling, but is absent." "$LINENO" 5 fi MAKETARGET_ALL=all-dev OCAMLC="$COCCI_SRCDIR/setup/wrapper-ocamlcp.sh $OCAMLCORIG $OCAMLPROF" MODULES_profiling=profiling.cmo { $as_echo "$as_me:${as_lineno-$LINENO}: configured coccinelle for profiling" >&5 $as_echo "$as_me: configured coccinelle for profiling" >&6;} else MAKETARGET_ALL="$enable_release" fi # Check whether --enable-opt was given. if test "${enable_opt+set}" = set; then : enableval=$enable_opt; fi if test "x$OCAMLOPT" = xno -a "x$enable_opt" != xno; then : if test -n "$enable_release" -a "x$enable_release" != xyes -a "x$enable_release" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ensure that make target $enable_release does not depend on the unavailable ocamlopt" >&5 $as_echo "$as_me: warning: ensure that make target $enable_release does not depend on the unavailable ocamlopt" >&6;} elif test "x$enable_opt" = xyes; then : as_fn_error $? "the optimized version of coccinelle is requested explicitly, but ocamlopt is absent" "$LINENO" 5 else { $as_echo "$as_me:${as_lineno-$LINENO}: the optimized version of coccinelle will not be build because ocamlopt is not present" >&5 $as_echo "$as_me: the optimized version of coccinelle will not be build because ocamlopt is not present" >&6;} enable_opt=no fi fi if test "x$OCAMLVERSION" = x3.11.2 -a -z "$enable_opt"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: the optimized version of coccinelle will not be build by default due to OCaml version $OCAMLVERSION" >&5 $as_echo "$as_me: the optimized version of coccinelle will not be build by default due to OCaml version $OCAMLVERSION" >&6;} enable_opt=no fi if test "x$OPTIMIZED_dynlink" = xno -a "x$enable_ocaml" = xyes; then : if test -z "$enable_opt"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: the optimized version of coccinelle will not be build by default because ocaml scripting is enabled but the required optimized dynlink package is not present" >&5 $as_echo "$as_me: the optimized version of coccinelle will not be build by default because ocaml scripting is enabled but the required optimized dynlink package is not present" >&6;} enable_opt=no elif test "x$enable_opt" = xyes; then : as_fn_error $? "the optimized version of coccinelle in combination with ocaml scripting requires the optimized version of the dynlik package, which is not present" "$LINENO" 5 fi fi if test -z "$enable_opt"; then : if test "x$enable_release" = xyes -o "x$enable_release" = xno; then : enable_opt="$enable_release" fi fi if test "x$enable_opt" = xyes; then : SPATCHNAME=spatch.opt MAKETARGET_SPATCH=opt-only else SPATCHNAME=spatch MAKETARGET_SPATCH=byte-only fi # Check whether --enable-ocamlbuild was given. if test "${enable_ocamlbuild+set}" = set; then : enableval=$enable_ocamlbuild; fi if test "x$enable_ocamlbuild" = xyes; then : if test -z "$OCAMLBUILD" -o "x$OCAMLBUILD" = xno; then : as_fn_error $? "Ocamlbuild is required but is not installed." "$LINENO" 5 fi FEATURE_OCAMLBUILD=yes else FEATURE_OCAMLBUILD= fi ac_config_files="$ac_config_files Makefile.config version.ml commons/commands.ml globals/config.ml globals/regexp.ml python/pycocci.ml ocaml/prepare_ocamlcocci.ml scripts/spatch.sh docs/spatch.1 myocamlbuild.ml setup/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`$as_echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs { $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5 $as_echo_n "checking that generated files are newer than configure... " >&6; } if test -n "$am_sleep_pid"; then # Hide warnings about reused PIDs. wait $am_sleep_pid 2>/dev/null fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 $as_echo "done" >&6; } if test -n "$EXEEXT"; then am__EXEEXT_TRUE= am__EXEEXT_FALSE='#' else am__EXEEXT_TRUE='#' am__EXEEXT_FALSE= fi if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then as_fn_error $? "conditional \"AMDEP\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then as_fn_error $? "conditional \"am__fastdepCC\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 $as_echo "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by coccinelle $as_me 1.0.0-rc19, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" config_commands="$ac_config_commands" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Configuration commands: $config_commands Report bugs to . coccinelle home page: ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ coccinelle config.status 1.0.0-rc19 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' INSTALL='$INSTALL' MKDIR_P='$MKDIR_P' AWK='$AWK' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; --*=) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg= ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) $as_echo "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) $as_echo "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX $as_echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # # INIT-COMMANDS # AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; "Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;; "version.ml") CONFIG_FILES="$CONFIG_FILES version.ml" ;; "commons/commands.ml") CONFIG_FILES="$CONFIG_FILES commons/commands.ml" ;; "globals/config.ml") CONFIG_FILES="$CONFIG_FILES globals/config.ml" ;; "globals/regexp.ml") CONFIG_FILES="$CONFIG_FILES globals/regexp.ml" ;; "python/pycocci.ml") CONFIG_FILES="$CONFIG_FILES python/pycocci.ml" ;; "ocaml/prepare_ocamlcocci.ml") CONFIG_FILES="$CONFIG_FILES ocaml/prepare_ocamlcocci.ml" ;; "scripts/spatch.sh") CONFIG_FILES="$CONFIG_FILES scripts/spatch.sh" ;; "docs/spatch.1") CONFIG_FILES="$CONFIG_FILES docs/spatch.1" ;; "myocamlbuild.ml") CONFIG_FILES="$CONFIG_FILES myocamlbuild.ml" ;; "setup/Makefile") CONFIG_FILES="$CONFIG_FILES setup/Makefile" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= ac_tmp= trap 'exit_status=$? : "${ac_tmp:=$tmp}" { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove sole $(srcdir), # ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES :C $CONFIG_COMMANDS" shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 $as_echo "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`$as_echo "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # case $INSTALL in [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; esac ac_MKDIR_P=$MKDIR_P case $MKDIR_P in [\\/$]* | ?:[\\/]* ) ;; */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; esac _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 $as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t s&@INSTALL@&$ac_INSTALL&;t t s&@MKDIR_P@&$ac_MKDIR_P&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 $as_echo "$as_me: executing $ac_file commands" >&6;} ;; esac case $ac_file$ac_mode in "depfiles":C) test x"$AMDEP_TRUE" != x"" || { # Older Autoconf quotes --file arguments for eval, but not when files # are listed without --file. Let's play safe and only enable the eval # if we detect the quoting. case $CONFIG_FILES in *\'*) eval set x "$CONFIG_FILES" ;; *) set x $CONFIG_FILES ;; esac shift for mf do # Strip MF so we end up with the name of the file. mf=`echo "$mf" | sed -e 's/:.*$//'` # Check whether this is an Automake generated Makefile or not. # We used to match only the files named 'Makefile.in', but # some people rename them; so instead we look at the file content. # Grep'ing the first line is not enough: some people post-process # each Makefile.in and add a new line on top of each file to say so. # Grep'ing the whole file is not good either: AIX grep has a line # limit of 2048, but all sed's we know have understand at least 4000. if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then dirpart=`$as_dirname -- "$mf" || $as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$mf" : 'X\(//\)[^/]' \| \ X"$mf" : 'X\(//\)$' \| \ X"$mf" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$mf" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` else continue fi # Extract the definition of DEPDIR, am__include, and am__quote # from the Makefile without running 'make'. DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` test -z "$DEPDIR" && continue am__include=`sed -n 's/^am__include = //p' < "$mf"` test -z "$am__include" && continue am__quote=`sed -n 's/^am__quote = //p' < "$mf"` # Find all dependency output files, they are included files with # $(DEPDIR) in their names. We invoke sed twice because it is the # simplest approach to changing $(DEPDIR) to its actual value in the # expansion. for file in `sed -n " s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do # Make sure the directory exists. test -f "$dirpart/$file" && continue fdir=`$as_dirname -- "$file" || $as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$file" : 'X\(//\)[^/]' \| \ X"$file" : 'X\(//\)$' \| \ X"$file" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir=$dirpart/$fdir; as_fn_mkdir_p # echo "creating $dirpart/$file" echo '# dummy' > "$dirpart/$file" done done } ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi { $as_echo "$as_me:${as_lineno-$LINENO}: configuration completed" >&5 $as_echo "$as_me: configuration completed" >&6;} cat << EOF ------------------------------------------------------------------------------ Summary configure flags: $CONFIGURE_FLAGS findlib: $OCAMLFIND (an actual version is strongly recommended) menhir: $MENHIR (should be an optional tool) menhirLib module: $enable_menhirLib (for local package use --disable-menhirLib) ocaml scripting: $enable_ocaml (overridable with --enable-ocaml) python scripting: $enable_python (overridable with --enable-python) pycaml module: $enable_pycaml (for local package use --disable-pycaml) pcre regexes: $enable_pcre_syntax (overridable with --enable-pcre-syntax) pcre module: $enable_pcre (for local package use --disable-pcre) pcre library: $HAVE_PCRE (requires the dev version of libpcre) release config: $enable_release (strongly recommended to be 'yes', overridable with --enable-release) optimized spatch: $enable_opt (overridable with --disable-opt) ------------------------------------------------------------------------------ Coccinelle can now be compiled and installed. If you compile coccinelle again after source code changes or configuration changes, you may need to run first: \$ make clean To compile coccinelle, run: \$ make all To install coccinelle, run: \$ make install Then, to test coccinelle, run for example: \$ spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c Or when coccinelle is not installed yet: \$ COCCINELLE_HOME=$(pwd) ./scripts/spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c EOF if test "x$enable_python" != "xno"; then cat << EOF ------------------------------------------------------------------------------ You may need to set some environment variables so that the python libraries are found. The frontend 'spatch' sets the following variables: \$ export LD_LIBRARY_PATH=\$LD_LIBRARY_PATH:$prefix/lib \$ export PYTHONPATH=\$PYTHONPATH:$prefix/share/coccinelle/python EOF fi cat << EOF ------------------------------------------------------------------------------ EOF coccinelle-1.0.0-rc19/install.txt0000644000175000017500000001177512247437436015612 0ustar eugeneugen ** News ** - Coccinelle no longer needs ocaml-sexplib nor ocaml-extlib. - Parallel building is possible when you do not build the bytecode and native version of spatch simultaneously. ** Compilation ** You must first install a recent version of - OCaml (at least 3.10), see http://caml.inria.fr/download.en.html At least, OCaml 3.12 is required to use the OCaml scripting feature in the SmPL code. - The Menhir parser generator (at least 20080912), see http://cristal.inria.fr/~fpottier/menhir/ (unless you got a version of the coccinelle source with the SmPL parser pre-generated) - Python and its development files (python-dev) (unless you run configure with the --without-python option) On Debian/Ubuntu, install the following packages - pkg-config (optional, but strongly recommended) - ocaml-native-compilers (or alternatively ocaml) - ocaml-findlib - libpycaml-ocaml-dev - menhir and libmenhir-ocaml-dev On Fedora, install the following packages - pkgconfig (optional, but strongly recommended) - chrpath - ocaml - ocaml-findlib - ocaml-camlp4-devel - ocaml-findlib-devel - ocaml-ocamldoc - ocaml-pcre-devel Note that on Fedora, there is currently not a package for menhir and pycaml. However, coccinelle bundles the sources of these packages and will use them when needed. The bundled pycaml package has support for python 3. Then simply type ./configure --enable-release make make install Other configuration flags of interest: --prefix default: /usr/local --disable-opt build the bytecode version --with-python=PATH choose a specific python executable --without-python no python scripting --disable-ocaml no ocaml scripting --disable-pycaml uses the bundled pycaml package instead of a installed pycaml package. --disable-pcre-syntax no pcre regexp syntax --enable-release=world builds the optimized and unoptimized version of spatch See ./configure --help for more options When the --enable-release flag was given to ./configure, 'make' will build in release configuration (no debugging symbols, etc.). It defaults to the optimized version, unless --disable-opt is given to configure. You could use 'make opt-only' to compile the optimized version only. Similarly, you can use 'make byte-only' for the unoptimized version. 'make install' installs whichever version was compiled, and installs a script 'spatch' (the frontend) that invokes the 'best' one with proper environment variables. You can also use 'make world' to compile the bytecode and the optimized code version. Make targets of interest: opt-only, opt compiles just the optimized version byt-only, byte compiles just the bytecode version world compiles both + frontends + docs all-release compiles the optimized version + frontends + docs all-dev compiles the bytecode version + frontends all default target: alias for either all-dev or all-release all.opt compiles the optimized version + frontends check run tests (note: not all tests are expected to succeed) As these make targets may change in the future, it is preferred to set the appropriate default using the --enable-release flag. We provide the files generated by menhir in the tarball. However, 'make distclean' will remove them. You could either restore them from the tarball or install menhir. Using 'make clean' should be safe with regards to these files. Note: The test target is intended for developers. In particular, you should not expect that every test will pass. In order to use the OCaml scripting feature in SmPL, you must compile Coccinelle with at least OCaml version 3.11. An extra file, coccilib.cmi, is produced and installed in /usr/share/cocci/ocaml, which is needed for the compilation of ocaml scripts. ** Bash integration ** To have completion under Bash, you can execute the following command: make install-bash It will install the shell script 'scripts/spatch.bash_completion' in /etc/bash_completion.d/spatch You can manually copy that file elsewhere if you have a different bash_completion directory. ** Runtime dependencies ** - Basic shell commands: - ls, cat, cp, mv, rm, grep, mkdir, find - Developper tool: diff ** Optional runtime dependencies ** - To quickly apply the semantic patches - glimpse indexer - To use OCaml scripting feature in SmPL - ocaml-native-compilers or ocaml-nox - ocaml-findlib - To generate a PDF of the control flow graph with '-graphical_trace' - pdftk and graphviz (with PDF support) If runtime tools are not in $PATH, paths to some of them can be specified with 'configure' or via commandline parameters to spatch. ** Dependencies for additional tools ** git, pushd, popd, sed, diffstat, cpp ** Uninstall ** To uninstall Coccinelle, you should use the following command make uninstall To also remove the bash completion script, run make uninstall-bash coccinelle-1.0.0-rc19/empty.iso0000644000175000017500000000000012247437436015230 0ustar eugeneugencoccinelle-1.0.0-rc19/myocamlbuild.ml.in0000644000175000017500000002361212247437436017014 0ustar eugeneugen# 2 "myocamlbuild.ml.in" (* * This file is a plugin that provides the needed customization of * calls to the ocaml compiler needed for components of coccinelle. * The classification of particular components is done by tags, which * are specified in the _tags file. * * This file is also a compromise: some aspects of coccocinelle's * build process are somehwat complicated due to packaging some * bundled software, having no requirement on ocamlfind, etc. * We therefore let 'configure' find out the configuration and * paths to tools and libraries, and this plugin is transformed * by that configuration to customize ocamlbuild accordingly. *) (* Some useful commandline arguments to ocamlbuild are: * -yaccflag -v verbose ocamlyacc and menhir output * -classic-display see the individual build steps * -j 0 parallel building * -tag "-custom" pure bytecode building * -tag "-dtypes" no type annotation generation *) (* Configuration of this build plugin *) let ocamlc_path = "@OCAMLC@" let ocamlopt_path = "@OCAMLOPT@" let ocamldep_path = "@OCAMLDEP@" let ocamldoc_path = "@OCAMLDOC@" let ocamlyacc_path = "@OCAMLYACC@" let ocamllex_path = "@OCAMLLEX@" let ocamlmklib_path = "@OCAMLMKLIB@" let ocamlmktop_path = "@OCAMLMKTOP@" let camlp4o_path = "@CAMLP4O@" let menhir_path = "@MENHIR@" let pycaml_path = "@PATH_pycaml@" let pcre_path = "@PATH_pcre@" let menhirLib_path = "@PATH_menhirLib@" let dynlink_path = "@PATH_dynlink@" let pcre_cflags = "@PCRE_CFLAGS@" let pcre_ldflags = "@PCRE_LIBS@" let python_cflags = "@PYTHON_CFLAGS@" let python_ldflags = "@PYTHON_LIBS@" let python_major_version = "@PYVER_MAJOR@" let profiling_modules = "@MODULES_profiling@" (* The plugin code starts here. *) open Ocamlbuild_plugin open Command (* Removes double separators and single dots from * a path. It does not resolve symlinks or turn * relative paths in absolute paths. *) let rec normalize_path path = let parent = Pathname.dirname path in if Pathname.equal path "/" || Pathname.equal parent "/" || Pathname.equal parent path then path else let name = Pathname.basename path in if Pathname.equal name "." then normalize_path parent else normalize_path parent / name (* Makes path relative and implicit, if it is a child of the * current directory. Relative paths are a must when dealing * with the build directory. * Todo: find out if there is a library function for * exactly this purpose. *) let relative_path path = let current = normalize_path Pathname.pwd in let target = normalize_path path in if Pathname.is_prefix current target then let len_current = String.length current in let len_target = String.length target in if len_current == len_target then "." else let len_tail = len_target - len_current - 1 in let ind_tail = len_current + 1 in String.sub target ind_tail len_tail else target let add_flags flag_ref flags = flag_ref := List.append flags !flag_ref let mk_use_tag name = "use_" ^ name (* Sets up a tag for compiling c and library files against * an external c library. *) let setup_clib name compile_flags link_flags = let tag = mk_use_tag name in flag [tag; "c"; "compile"] (S[A "-ccopt"; A compile_flags]); flag [tag; "c"; "ocamlmklib"] (S[A "-ldopt"; A link_flags]); flag [tag; "ocaml"; "link"] (S[A "-ccopt"; A compile_flags]); flag [tag; "ocaml"; "link"] (S[A "-ccopt"; A link_flags]) (* Sets up a tag for declaring a dependency on a stubs library, * and linking it in. The dependency includes both a .a archive * and a .so dll. *) let setup_stubs name stubs_dir = let tag = mk_use_tag name in let path_a = Printf.sprintf "%s/lib%s_stubs.a" stubs_dir name in if not (Pathname.exists path_a) then dep [tag; "link"; "ocaml"] [path_a]; let stubs_arg = Printf.sprintf "-l%s_stubs" name in flag [tag; "ocaml"; "link"; "byte"] (S[A "-I"; P stubs_dir; A "-dllib"; A stubs_arg; A "-cclib"; A stubs_arg]); flag [tag; "ocaml"; "link"; "native"] (S[A "-I"; P stubs_dir; A "-cclib"; A stubs_arg]); flag [tag; "ocaml"; "doc"] (S[A "-I"; P stubs_dir]) (* The use of bundled software is simply the * inclusion of the appropriate source directory. * The build system can find automatically how to * deal with the bundled sources. *) let setup_bundle rootdir = tag_file rootdir ["include"; "traverse"] (* Sets up a tag that adds the given module directory and module * as additional argument to ocaml when it processes a * file with that tag. * Todo: it may be beneficial to add a dependency on the target * module. *) let setup_module name modname rootdir = let tag = mk_use_tag name in let link_args isNative = S [A "-I"; P rootdir; A (modname isNative) ] in let compile_args = S [A "-I"; P rootdir] in flag [tag; "ocaml"; "compile"] compile_args; flag [tag; "ocaml"; "byte"; "link"; "program"] (link_args false); flag [tag; "ocaml"; "native"; "link"; "program"] (link_args true); flag [tag; "ocaml"; "doc"] (S[A "-I"; P rootdir]) (* Sets up the use of either a bundled source package or precompiled module. *) let setup_package name modname rootdir = let exists_path isNative = Pathname.exists (rootdir / modname isNative) in let is_binary = exists_path false || exists_path true in if is_binary then setup_module name modname rootdir else setup_bundle rootdir (* Most files depend on these standard modules, hence we setup a * single tag for them. * This setup routine should be called before the others to ensure * that these modules appear first on the ocaml commandlines. *) let setup_basic_libs use_dynlink = ocaml_lib ~extern:true ~tag_name:"use_base" "unix"; ocaml_lib ~extern:true ~tag_name:"use_base" "str"; ocaml_lib ~extern:true ~tag_name:"use_base" "nums"; ocaml_lib ~extern:true ~tag_name:"use_base" "bigarray"; if use_dynlink then ocaml_lib ~extern:true ~tag_name:"use_base" "dynlink"; () (* The menhir package provides individual object files * instead of an archive. *) let setup_menhirLib () = let menhirLib_dir = relative_path menhirLib_path in let modname isNative = match isNative with true -> "menhirLib.cmx" | false -> "menhirLib.cmo" in setup_package "menhirLib" modname menhirLib_dir (* Pycaml is a stubs library with some conditional * code that depends on the python version. We * additionally introduce a tag pp_pycaml which * runs the appropriate preprocessors. *) let setup_pycaml () = let pycaml_dir = relative_path pycaml_path in let modname isNative = match isNative with true -> "pycaml.cmxa" | false -> "pycaml.cma" in setup_package "pycaml" modname pycaml_dir; setup_stubs "pycaml" pycaml_dir; setup_clib "pycaml" python_cflags python_ldflags; let macrodef = Printf.sprintf "-D PYMAJOR%s" python_major_version in flag ["pp_pycaml"; "c"; "compile"] (S[A "-ccopt"; A macrodef]); let camlp4cmd = Printf.sprintf "%s -parser Camlp4MacroParser -D PYMAJOR%s" camlp4o_path python_major_version in flag ["pp_pycaml"; "ocaml"; "pp"] (Sh camlp4cmd) (* Pcre is a standard stub library. *) let setup_pcre () = let pcre_dir = relative_path pcre_path in let modname isNative = match isNative with true -> "pcre.cmxa" | false -> "pcre.cma" in setup_package "pcre" modname pcre_dir; setup_stubs "pcre" pcre_dir; setup_clib "pcre" pcre_cflags pcre_ldflags (* Some utility code on strings and paths. *) let any_non_space str = let have_non_space = ref false in String.iter begin fun c -> match c with ' ' -> () | '\t' -> () | _ -> have_non_space := true end str; !have_non_space let not_empty str = String.length str > 0 && any_non_space str let is_path_configured path = not_empty path && Pathname.exists path (* Note: the setup of the modules is done before the hygiene phase * in order to benefit from additional "include" tags that may be * given to directories. *) let _ = dispatch begin function | Before_options -> Options.hygiene := true; Options.sanitize := true; Options.make_links := false; Options.catch_errors := true; Options.use_menhir := true; let menhir_wrapper = Printf.sprintf "%s/setup/wrapper-menhir.sh" Pathname.pwd in Options.ocamlc := Sh ocamlc_path; Options.ocamlopt := Sh ocamlopt_path; Options.ocamldep := Sh ocamldep_path; Options.ocamldoc := Sh ocamldoc_path; Options.ocamlyacc := S[P menhir_wrapper; P ocamlyacc_path; P menhir_path]; Options.ocamllex := Sh ocamllex_path; Options.ocamlmklib := Sh ocamlmklib_path; Options.ocamlmktop := Sh ocamlmktop_path; () | Before_hygiene -> let use_dynlink = is_path_configured dynlink_path in setup_basic_libs use_dynlink; if is_path_configured menhirLib_path then setup_menhirLib (); if is_path_configured pcre_path then setup_pcre (); if is_path_configured pycaml_path then setup_pycaml (); () | After_rules -> (* produces a slightly faster native version *) (* flag ["ocaml"; "compile"; "native"] (A "-unsafe"); *) (* adds debugging info (including exception backtraces) *) flag ["ocaml"; "compile"] (A "-g"); (* flags to parameterize ocamldoc to produce web pages *) flag ["gen_html"; "ocaml"; "doc"] (S [A "-colorize-code"; A "-short-functors"; A "-all-params"]); flag ["gen_man"; "ocaml"; "doc"] (S [A "-man"; A "-man-mini"]); (* when profiling, link with profiling.cmo *) if not_empty profiling_modules then flag ["ocaml"; "link"; "byte"] (S [A profiling_modules]); (* the warning about unused function arguments are disabled * for files with this tag. *) flag ["nowarn20"; "ocaml"; "compile"] (S [A "-w"; A "-20"]); (* adds the custom option, unless 'nocustom' is given as a tag *) if not (Tags.mem "nocustom" (tags_of_pathname "myocamlbuild.ml")) then flag ["ocaml"; "link"; "byte"] (A "-custom"); () | _ -> () end coccinelle-1.0.0-rc19/license.txt0000644000175000017500000004307012247437436015557 0ustar eugeneugen GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. coccinelle-1.0.0-rc19/parsing_c/0000755000175000017500000000000012247442646015334 5ustar eugeneugencoccinelle-1.0.0-rc19/parsing_c/control_flow_c.mli0000644000175000017500000000571612247437436021062 0ustar eugeneugenopen Ast_c type node = node1 * string (* For debugging. Used by print_graph *) and node1 = node2 * nodeinfo and nodeinfo = { labels: int list; (* Labels. Trick used for CTL engine *) bclabels: int list; (* parent of a break or continue node *) is_loop: bool; is_fake: bool; } and node2 = | TopNode | EndNode | FunHeader of definition (* but empty body *) | Decl of declaration | SeqStart of statement * int * info | SeqEnd of int * info | ExprStatement of statement * (expression option) wrap | IfHeader of statement * expression wrap | Else of info | WhileHeader of statement * expression wrap | DoHeader of statement * info | DoWhileTail of expression wrap | ForHeader of statement * (declOrExpr * exprStatement wrap * exprStatement wrap) wrap | SwitchHeader of statement * expression wrap | MacroIterHeader of statement * (string * argument wrap2 list) wrap | EndStatement of info option | Return of statement * unit wrap | ReturnExpr of statement * expression wrap (* ------------------------ *) | IfdefHeader of ifdef_directive | IfdefElse of ifdef_directive | IfdefEndif of ifdef_directive (* ------------------------ *) | DefineHeader of string wrap * define_kind | DefineExpr of expression | DefineType of fullType | DefineDoWhileZeroHeader of unit wrap | DefineTodo | Include of includ | PragmaHeader of string wrap * pragmainfo | MacroTop of string * argument wrap2 list * il (* ------------------------ *) | Case of statement * expression wrap | Default of statement * unit wrap | Continue of statement * unit wrap | Break of statement * unit wrap (* no counter part in cocci *) | CaseRange of statement * (expression * expression) wrap | Label of statement * name * unit wrap | Goto of statement * name * unit wrap | Asm of statement * asmbody wrap | MacroStmt of statement * unit wrap (* ------------------------ *) | Enter | Exit | Fake | CaseNode of int (* ------------------------ *) (* for ctl: *) | TrueNode | FalseNode | InLoopNode | AfterNode | FallThroughNode | LoopFallThroughNode | ErrorExit type edge = Direct type cflow = (node, edge) Ograph_extended.ograph_mutable val unwrap : node -> node2 val rewrap : node -> node2 -> node val extract_labels : node -> int list val extract_bclabels : node -> int list val extract_fullstatement : node -> Ast_c.statement option val extract_is_loop : node -> bool val extract_is_fake : node -> bool val mk_node: node2 -> int list -> int list -> string -> node val mk_fake_node: node2 -> int list -> int list -> string -> node val first_node : cflow -> Ograph_extended.nodei val find_node : (node2 -> bool) -> cflow -> Ograph_extended.nodei (* remove an intermediate node and redirect the connexion *) val remove_one_node : Ograph_extended.nodei -> cflow -> unit coccinelle-1.0.0-rc19/parsing_c/sexp_ast_c.mli0000644000175000017500000000035112247437436020167 0ustar eugeneugenval string_of_toplevel: Ast_c.toplevel -> string val string_of_expression: Ast_c.expression -> string val string_of_program: Ast_c.program -> string val show_info: bool ref val show_qualifier: bool ref val show_expr_info: bool ref coccinelle-1.0.0-rc19/parsing_c/parsing_consistency_c.ml0000644000175000017500000001302212247437436022253 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2_err, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Consistency checking *) (*****************************************************************************) (* todo: * could check that an ident has always the same class, be it a typedef * (but sometimes do 'acpi_val acpi_val;'), an ident, a TMacroStatement, * etc. *) type class_ident = | CIdent (* can be var, func, field, tag, enum constant *) | CTypedef let str_of_class_ident = function | CIdent -> "Ident" | CTypedef -> "Typedef" (* | CMacro | CMacroString | CMacroStmt | CMacroDecl | CMacroIterator | CAttr (* but take care that must still be able to use '=' *) type context = InFunction | InEnum | InStruct | InInitializer | InParams type class_token = | CIdent of class_ident | CComment | CSpace | CCommentCpp of cppkind | CCommentMisc | CCppDirective | COPar | CCPar | COBrace | CCBrace | CSymbol | CReservedKwd (type | decl | qualif | flow | misc | attr) *) let ident_to_typename ident : Ast_c.fullType = Ast_c.mk_ty (Ast_c.TypeName (ident, Ast_c.noTypedefDef())) Ast_c.noii (* parse_typedef_fix4 *) let consistency_checking2 xs = (* first phase, gather data *) let stat = Hashtbl.create 101 in (* default value for hash *) let v1 () = Hashtbl.create 101 in let v2 () = ref 0 in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kexpr = (fun (k,bigf) x -> match Ast_c.unwrap_expr x with | Ast_c.Ident (id) -> let s = Ast_c.str_of_name id in stat +> Common.hfind_default s v1 +> Common.hfind_default CIdent v2 +> (fun aref -> incr aref) | _ -> k x ); Visitor_c.ktype = (fun (k,bigf) t -> match Ast_c.unwrap_typeC t with | Ast_c.TypeName (name,_typ) -> let s = Ast_c.str_of_name name in stat +> Common.hfind_default s v1 +> Common.hfind_default CTypedef v2 +> (fun aref -> incr aref) | _ -> k t ); } in xs +> List.iter (fun (p) -> Visitor_c.vk_toplevel bigf p); let ident_to_type = ref [] in (* second phase, analyze data *) stat +> Hashtbl.iter (fun k v -> let xs = Common.hash_to_list v in if List.length xs >= 2 then begin pr2_err ("TYPEDEF CONFLICT:" ^ k); let sorted = xs +> List.sort (fun (ka,va) (kb,vb) -> if !va =|= !vb then (match ka, kb with | CTypedef, _ -> 1 (* first is smaller *) | _, CTypedef -> -1 | _ -> 0 ) else compare !va !vb ) in let sorted = List.rev sorted in match sorted with | [CTypedef, i1;CIdent, i2] -> pr2_err ("transforming some ident in typedef"); push2 k ident_to_type; | [CIdent, i1;CTypedef, i2] -> pr2_err ("TODO:typedef now used as an identifier"); | _ -> pr2_err ("TODO:other transforming?"); end ); (* third phase, update ast. * todo? but normally should try to handle correctly scope ? maybe sometime * sizeof(id) and even if id was for a long time an identifier, maybe * a few time, because of the scope it's actually really a type. *) if (null !ident_to_type) then xs else let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kdefineval_s = (fun (k,bigf) x -> match x with | Ast_c.DefineExpr e -> (match Ast_c.unwrap_expr e with | Ast_c.Ident (ident) -> let s = Ast_c.str_of_name ident in if List.mem s !ident_to_type then let t = ident_to_typename ident in Ast_c.DefineType t else k x | _ -> k x ) | _ -> k x ); Visitor_c.kexpr_s = (fun (k, bigf) x -> match Ast_c.get_e_and_ii x with | (Ast_c.SizeOfExpr e, tref), isizeof -> let i1 = tuple_of_list1 isizeof in (match Ast_c.get_e_and_ii e with | (Ast_c.ParenExpr e, _), iiparen -> let (i2, i3) = tuple_of_list2 iiparen in (match Ast_c.get_e_and_ii e with | (Ast_c.Ident (ident), _), _ii -> let s = Ast_c.str_of_name ident in if List.mem s !ident_to_type then let t = ident_to_typename ident in (Ast_c.SizeOfType t, tref),[i1;i2;i3] else k x | _ -> k x ) | _ -> k x ) | _ -> k x ); } in xs +> List.map (fun (p) -> Visitor_c.vk_toplevel_s bigf p ) let consistency_checking a = Common.profile_code "C consistencycheck" (fun () -> consistency_checking2 a) coccinelle-1.0.0-rc19/parsing_c/parsing_stat.ml0000644000175000017500000002255412247437436020375 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2008, 2009 University of Urbana Champaign * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (* if do .mli: val print_parsing_stat_list: parsing_stat list -> unit *) (*****************************************************************************) (* Stat *) (*****************************************************************************) type parsing_stat = { filename: filename; mutable have_timeout: bool; mutable correct: int; mutable bad: int; mutable commentized: int; (* by our cpp commentizer *) (* if want to know exactly what was passed through, uncomment: * * mutable passing_through_lines: int; * * it differs from bad by starting from the error to * the synchro point instead of starting from start of * function to end of function. *) mutable problematic_lines: (string list (* ident in error line *) * int (* line_error *)) list; } let default_stat file = { filename = file; have_timeout = false; correct = 0; bad = 0; commentized = 0; problematic_lines = []; } (* todo: stat per dir ? give in terms of func_or_decl numbers: * nbfunc_or_decl pbs / nbfunc_or_decl total ?/ * * note: cela dit si y'a des fichiers avec des #ifdef dont on connait pas les * valeurs alors on parsera correctement tout le fichier et pourtant y'aura * aucune def et donc aucune couverture en fait. * ==> TODO evaluer les parties non parsé ? *) let print_parsing_stat_list ?(verbose=false) = fun statxs -> let total = List.length statxs in let perfect = statxs +> List.filter (function {have_timeout = false; bad = 0} -> true | _ -> false) +> List.length in if verbose then begin pr "\n\n\n---------------------------------------------------------------"; pr "pbs with files:"; statxs +> List.filter (function | {have_timeout = true} -> true | {bad = n} when n > 0 -> true | _ -> false) +> List.iter (function {filename = file; have_timeout = timeout; bad = n} -> pr (file ^ " " ^ (if timeout then "TIMEOUT" else i_to_s n)); ); pr "\n\n\n"; pr "files with lots of tokens passed/commentized:"; let threshold_passed = 100 in statxs +> List.filter (function | {commentized = n} when n > threshold_passed -> true | _ -> false) +> List.iter (function {filename = file; commentized = n} -> pr (file ^ " " ^ (i_to_s n)); ); pr "\n\n\n---------------------------------------------------------------"; end; pr ( (sprintf "NB total files = %d; " total) ^ (sprintf "perfect = %d; " perfect) ^ (sprintf "pbs = %d; " (statxs +> List.filter (function {have_timeout = b; bad = n} when n > 0 -> true | _ -> false) +> List.length)) ^ (sprintf "timeout = %d; " (statxs +> List.filter (function {have_timeout = true; bad = n} -> true | _ -> false) +> List.length)) ^ (sprintf "=========> %d" ((100 * perfect) / total)) ^ "%" ); let good = statxs +> List.fold_left (fun acc {correct = x} -> acc+x) 0 in let bad = statxs +> List.fold_left (fun acc {bad = x} -> acc+x) 0 in let passed = statxs +> List.fold_left (fun acc {commentized = x} -> acc+x) 0 in let gf, badf = float_of_int good, float_of_int bad in let passedf = float_of_int passed in pr ( (sprintf "nb good = %d, nb passed = %d " good passed) ^ (sprintf "=========> %f" (100.0 *. (passedf /. gf)) ^ "% passed") ); pr ( (sprintf "nb good = %d, nb bad = %d " good bad) ^ (sprintf "=========> %f" (100.0 *. (gf /. (gf +. badf))) ^ "% good" ) ) (*****************************************************************************) (* Recurring error diagnostic *) (*****************************************************************************) (* asked/inspired by reviewer of CC'09 *) let lines_around_error_line ~context (file, line) = let arr = Common.cat_array file in let startl = max 0 (line - context) in let endl = min (Array.length arr) (line + context) in let res = ref [] in for i = startl to endl -1 do Common.push2 arr.(i) res done; List.rev !res let print_recurring_problematic_tokens xs = let h = Hashtbl.create 101 in xs +> List.iter (fun x -> let file = x.filename in x.problematic_lines +> List.iter (fun (xs, line_error) -> xs +> List.iter (fun s -> Common.hupdate_default s (fun (old, example) -> old + 1, example) (fun() -> 0, (file, line_error)) h; ))); pr2_xxxxxxxxxxxxxxxxx(); pr2 ("maybe 10 most problematic tokens"); pr2_xxxxxxxxxxxxxxxxx(); Common.hash_to_list h +> List.sort (fun (k1,(v1,_)) (k2,(v2,_)) -> compare v2 v1) +> Common.take_safe 10 +> List.iter (fun (k,(i, (file_ex, line_ex))) -> pr2 (spf "%s: present in %d parsing errors" k i); pr2 ("example: "); let lines = lines_around_error_line ~context:2 (file_ex, line_ex) in lines +> List.iter (fun s -> pr2 (" " ^ s)); ); pr2_xxxxxxxxxxxxxxxxx(); () (*****************************************************************************) (* Stat *) (*****************************************************************************) (* Those variables were written for CC09, to evaluate the need for * some of our heuristics and extensions. * * coupling: if you add a new var, modify also assoc_stat_number below *) let nTypedefInfer = ref 0 let nIncludeGrammar = ref 0 let nIncludeHack = ref 0 let nIteratorGrammar = ref 0 let nIteratorHeuristic = ref 0 let nMacroTopDecl = ref 0 let nMacroStructDecl = ref 0 let nMacroDecl = ref 0 let nMacroStmt = ref 0 let nMacroString = ref 0 let nMacroHigherOrder = ref 0 (* actions *) let nMacrohigherTypeGrammar = ref 0 let nMacroAttribute = ref 0 let nIfdefTop = ref 0 let nIfdefStmt = ref 0 let nIfdefStruct = ref 0 let nIfdefInitializer = ref 0 (* nIfdefExpr, nIfdefType *) let nIfdefFunheader = ref 0 let nIfdefExprPassing = ref 0 let nIfdefPassing = ref 0 let nIncludePassing = ref 0 let nUndefPassing = ref 0 let nDefinePassing = ref 0 let nIfdefZero = ref 0 let nIfdefVersion = ref 0 let nGccTypeof = ref 0 let nGccLongLong = ref 0 let nGccAsm = ref 0 let nGccInline = ref 0 let nGccAttribute = ref 0 let nGccCaseRange = ref 0 let nGccMixDecl = ref 0 let nGccDesignator = ref 0 let nGccStmtExpr = ref 0 let nGccConstructor = ref 0 let nGccEmptyStruct = ref 0 let nGccNestedFunc = ref 0 let nGccMisc = ref 0 let nDefineHack = ref 0 let nDefineConstant = ref 0 let nDefineStmt = ref 0 let nDefineExpr = ref 0 (* both below require some heuristic support *) let nDefineWhile0 = ref 0 let nDefineInit = ref 0 let nDefineOther = ref 0 let nUndef = ref 0 let nOtherDirective = ref 0 (* let nDirectiveTop = ref 0 *) let nDirectiveStmt = ref 0 let nDirectiveStruct = ref 0 let nDirectiveInitializer = ref 0 (* from standard.h *) let nMacroHint = ref 0 let nMacroExpand = ref 0 let nNotParsedCorrectly = ref 0 let assoc_stat_number = [ "nTypedefInfer", nTypedefInfer; "nIteratorHeuristic", nIteratorHeuristic; "nMacroTopDecl", nMacroTopDecl; "nMacroStructDecl", nMacroStructDecl; "nMacroDecl", nMacroDecl; "nMacroStmt", nMacroStmt; "nMacroString", nMacroString; "nMacroHigherOrder", nMacroHigherOrder; "nMacroAttribute", nMacroAttribute; "nMacrohigherTypeGrammar", nMacrohigherTypeGrammar; "nIfdefTop", nIfdefTop; "nIfdefStmt", nIfdefStmt; "nIfdefStruct", nIfdefStruct; "nIfdefInitializer", nIfdefInitializer; "nIfdefFunheader", nIfdefFunheader; "nIfdefZero", nIfdefZero; "nIfdefVersion", nIfdefVersion; "nIfdefExprPassing", nIfdefExprPassing; "nIfdefPassing", nIfdefPassing; "nIncludePassing", nIncludePassing; "nDefinePassing", nDefinePassing; "nUndefPassing", nUndefPassing; "nMacroExpand", nMacroExpand; "nMacroHint", nMacroHint; "nGccTypeof", nGccTypeof; "nGccLongLong", nGccLongLong; "nGccAsm", nGccAsm; "nGccInline", nGccInline; "nGccAttribute", nGccAttribute; "nGccCaseRange", nGccCaseRange; "nGccMixDecl", nGccMixDecl; "nGccDesignator", nGccDesignator; "nGccStmtExpr", nGccStmtExpr; "nGccConstructor", nGccConstructor; "nGccEmptyStruct", nGccEmptyStruct; "nGccNestedFunc", nGccNestedFunc; "nGccMisc", nGccMisc; "nDefineHack", nDefineHack; "nDefineConstant", nDefineConstant; "nDefineStmt", nDefineStmt; "nDefineExpr", nDefineExpr; "nDefineInit", nDefineInit; "nDefineOther", nDefineOther; "nUndef", nUndef; "nOtherDirective", nOtherDirective; "nDirectiveStmt", nDirectiveStmt; "nDirectiveStruct", nDirectiveStruct; "nDirectiveInitializer", nDirectiveInitializer; "nNotParsedCorrectly", nNotParsedCorrectly; (* less *) "nIncludeGrammar", nIncludeGrammar; "nIncludeHack", nIncludeHack; "nIteratorGrammar", nIteratorGrammar; ] let print_stat_numbers () = assoc_stat_number +> List.iter (fun (k, vref) -> pr2 (spf "%-30s -> %d" k !vref); ) coccinelle-1.0.0-rc19/parsing_c/parsing_hacks.ml0000644000175000017500000022407512247437436020515 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common module TH = Token_helpers module TV = Token_views_c module LP = Lexer_parser module Stat = Parsing_stat open Parser_c open TV (*****************************************************************************) (* Some debugging functions *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing let pr2_cpp s = if !Flag_parsing_c.debug_cpp then Common.pr2_once ("CPP-" ^ s) let msg_gen cond is_known printer s = if cond then if not (!Flag_parsing_c.filter_msg) then printer s else if not (is_known s) then printer s (* In the following, there are some harcoded names of types or macros * but they are not used by our heuristics! They are just here to * enable to detect false positive by printing only the typedef/macros * that we don't know yet. If we print everything, then we can easily * get lost with too much verbose tracing information. So those * functions "filter" some messages. So our heuristics are still good, * there is no more (or not that much) hardcoded linux stuff. *) let is_known_typdef = (fun s -> (match s with | "u_char" | "u_short" | "u_int" | "u_long" | "u8" | "u16" | "u32" | "u64" | "s8" | "s16" | "s32" | "s64" | "__u8" | "__u16" | "__u32" | "__u64" -> true | "acpi_handle" | "acpi_status" -> true | "FILE" | "DIR" -> true | s when s =~ ".*_t$" -> true | _ -> false ) ) (* note: cannot use partial application with let msg_typedef = * because it would compute msg_typedef at compile time when * the flag debug_typedef is always false *) let msg_typedef s ii n = incr Stat.nTypedefInfer; msg_gen (!Flag_parsing_c.debug_typedef) is_known_typdef (fun s -> pr2_cpp (Printf.sprintf "TYPEDEF: promoting:(%d) %s on line %d" n s (Ast_c.line_of_info ii)) (*(Printf.sprintf "TYPEDEF: promoting: %s on line %d" s (Ast_c.line_of_info ii))*) ) s let msg_maybe_dangereous_typedef s = if not (is_known_typdef s) then pr2 ("PB MAYBE: dangerous typedef inference, maybe not a typedef: " ^ s) let msg_declare_macro s = incr Stat.nMacroDecl; msg_gen (!Flag_parsing_c.debug_cpp) (fun s -> (match s with | "DECLARE_MUTEX" | "DECLARE_COMPLETION" | "DECLARE_RWSEM" | "DECLARE_WAITQUEUE" | "DECLARE_WAIT_QUEUE_HEAD" | "DEFINE_SPINLOCK" | "DEFINE_TIMER" | "DEVICE_ATTR" | "CLASS_DEVICE_ATTR" | "DRIVER_ATTR" | "SENSOR_DEVICE_ATTR" | "LIST_HEAD" | "DECLARE_WORK" | "DECLARE_TASKLET" | "PORT_ATTR_RO" | "PORT_PMA_ATTR" | "DECLARE_BITMAP" -> true (* | s when s =~ "^DECLARE_.*" -> true | s when s =~ ".*_ATTR$" -> true | s when s =~ "^DEFINE_.*" -> true *) | _ -> false ) ) (fun s -> pr2_cpp ("MACRO: found declare-macro: " ^ s)) s let msg_foreach s = incr Stat.nIteratorHeuristic; pr2_cpp ("MACRO: found foreach: " ^ s) (* ?? let msg_debug_macro s = pr2_cpp ("MACRO: found debug-macro: " ^ s) *) let msg_macro_noptvirg s = incr Stat.nMacroStmt; pr2_cpp ("MACRO: found macro with param noptvirg: " ^ s) let msg_macro_toplevel_noptvirg s = incr Stat.nMacroStmt; pr2_cpp ("MACRO: found toplevel macro noptvirg: " ^ s) let msg_macro_noptvirg_single s = incr Stat.nMacroStmt; pr2_cpp ("MACRO: found single-macro noptvirg: " ^ s) let msg_macro_higher_order s = incr Stat.nMacroHigherOrder; msg_gen (!Flag_parsing_c.debug_cpp) (fun s -> (match s with | "DBGINFO" | "DBGPX" | "DFLOW" -> true | _ -> false ) ) (fun s -> pr2_cpp ("MACRO: found higher ordre macro : " ^ s)) s let msg_stringification s = incr Stat.nMacroString; msg_gen (!Flag_parsing_c.debug_cpp) (fun s -> (match s with | "REVISION" | "UTS_RELEASE" | "SIZE_STR" | "DMA_STR" -> true (* s when s =~ ".*STR.*" -> true *) | _ -> false ) ) (fun s -> pr2_cpp ("MACRO: found string-macro " ^ s)) s let msg_stringification_params s = incr Stat.nMacroString; pr2_cpp ("MACRO: string-macro with params : " ^ s) let msg_apply_known_macro s = incr Stat.nMacroExpand; pr2_cpp ("MACRO: found known macro = " ^ s) let msg_apply_known_macro_hint s = incr Stat.nMacroHint; pr2_cpp ("MACRO: found known macro hint = " ^ s) let msg_ifdef_bool_passing is_ifdef_positif = incr Stat.nIfdefZero; (* of Version ? *) if is_ifdef_positif then pr2_cpp "commenting parts of a #if 1 or #if LINUX_VERSION" else pr2_cpp "commenting a #if 0 or #if LINUX_VERSION or __cplusplus" let msg_ifdef_mid_something () = incr Stat.nIfdefExprPassing; pr2_cpp "found ifdef-mid-something" let msg_ifdef_funheaders () = incr Stat.nIfdefFunheader; () let msg_ifdef_cparen_else () = incr Stat.nIfdefPassing; pr2_cpp("found ifdef-cparen-else") let msg_attribute s = incr Stat.nMacroAttribute; pr2_cpp("ATTR:" ^ s) (*****************************************************************************) (* The regexp and basic view definitions *) (*****************************************************************************) (* opti: better to built then once and for all, especially regexp_foreach *) let regexp_macro = Str.regexp "^[A-Z_][A-Z_0-9]*$" (* linuxext: *) let regexp_annot = Str.regexp "^__.*$" (* linuxext: *) let regexp_declare = Str.regexp ".*DECLARE.*" (* linuxext: *) let regexp_foreach = Str.regexp_case_fold ".*\\(for_?each\\|for_?all\\|iterate\\|loop\\|walk\\|scan\\|each\\|for\\)" let regexp_typedef = Str.regexp ".*_t$" let false_typedef = [ "printk"; ] let ok_typedef s = not (List.mem s false_typedef) let not_annot s = not (s ==~ regexp_annot) let is_macro s = s ==~ regexp_macro let not_macro s = not (is_macro s) (*****************************************************************************) (* Helpers *) (*****************************************************************************) (* ------------------------------------------------------------------------- *) (* the pair is the status of '()' and '{}', ex: (-1,0) * if too much ')' and good '{}' * could do for [] too ? * could do for ',' if encounter ',' at "toplevel", not inside () or {} * then if have ifdef, then certainly can lead to a problem. *) let (count_open_close_stuff_ifdef_clause: TV.ifdef_grouped list -> (int * int))= fun xs -> let cnt_paren, cnt_brace = ref 0, ref 0 in xs +> TV.iter_token_ifdef (fun x -> (match x.tok with | x when TH.is_opar x -> incr cnt_paren | TOBrace _ -> incr cnt_brace | x when TH.is_cpar x -> decr cnt_paren | TCBrace _ -> decr cnt_brace | _ -> () ) ); !cnt_paren, !cnt_brace (* ------------------------------------------------------------------------- *) let forLOOKAHEAD = 30 (* look if there is a '{' just after the closing ')', and handling the * possibility to have nested expressions inside nested parenthesis * * todo: use indentation instead of premier(statement) ? *) let rec is_really_foreach xs = let rec is_foreach_aux = function | [] -> false, [] | TCPar _::TOBrace _::xs -> true, xs (* the following attempts to handle the cases where there is a single statement in the body of the loop. undoubtedly more cases are needed. todo: premier(statement) - suivant(funcall) *) | TCPar _::TIdent _::xs -> true, xs | TCPar _::Tif _::xs -> true, xs | TCPar _::Twhile _::xs -> true, xs | TCPar _::Tfor _::xs -> true, xs | TCPar _::Tswitch _::xs -> true, xs | TCPar _::Treturn _::xs -> true, xs | TCPar _::xs -> false, xs | TOPar _::xs -> let (_, xs') = is_foreach_aux xs in is_foreach_aux xs' | x::xs -> is_foreach_aux xs in is_foreach_aux xs +> fst (* ------------------------------------------------------------------------- *) let set_ifdef_token_parenthize_info cnt x = match x with | TIfdef (tag, _) | TIfdefelse (tag, _) | TIfdefelif (tag, _) | TEndif (tag, _) | TIfdefBool (_, tag, _) | TIfdefMisc (_, tag, _) | TIfdefVersion (_, tag, _) -> tag := Some cnt; | _ -> raise (Impossible 89) let ifdef_paren_cnt = ref 0 let rec set_ifdef_parenthize_info xs = xs +> List.iter (function | NotIfdefLine xs -> () | Ifdefbool (_, xxs, info_ifdef) | Ifdef (xxs, info_ifdef) -> incr ifdef_paren_cnt; let total_directives = List.length info_ifdef in info_ifdef +> List.iter (fun x -> set_ifdef_token_parenthize_info (!ifdef_paren_cnt, total_directives) x.tok); xxs +> List.iter set_ifdef_parenthize_info ) (*****************************************************************************) (* The parsing hack for #define *) (*****************************************************************************) (* To parse macro definitions I need to do some tricks * as some information can be get only at the lexing level. For instance * the space after the name of the macro in '#define foo (x)' is meaningful * but the grammar can not get this information. So define_ident below * look at such space and generate a special TOpardefine. In a similar * way macro definitions can contain some antislash and newlines * and the grammar need to know where the macro ends (which is * a line-level and so low token-level information). Hence the * function 'define_line' below and the TDefEol. * * update: TDefEol is handled in a special way at different places, * a little bit like EOF, especially for error recovery, so this * is an important token that should not be retagged! * * * ugly hack, a better solution perhaps would be to erase TDefEOL * from the Ast and list of tokens in parse_c. * * note: I do a +1 somewhere, it's for the unparsing to correctly sync. * * note: can't replace mark_end_define by simply a fakeInfo(). The reason * is where is the \n TCommentSpace. Normally there is always a last token * to synchronize on, either EOF or the token of the next toplevel. * In the case of the #define we got in list of token * [TCommentSpace "\n"; TDefEOL] but if TDefEOL is a fakeinfo then we will * not synchronize on it and so we will not print the "\n". * A solution would be to put the TDefEOL before the "\n". * (jll: tried to do this, see the comment "Put end of line..." below) * * todo?: could put a ExpandedTok for that ? *) let mark_end_define ii = let ii' = { Ast_c.pinfo = Ast_c.OriginTok { (Ast_c.parse_info_of_info ii) with Common.str = ""; Common.charpos = Ast_c.pos_of_info ii + 1 }; cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref Ast_c.emptyComments; } in TDefEOL (ii') (* put the TDefEOL at the good place *) let rec define_line_1 acc xs = match xs with | [] -> List.rev acc | TDefine ii::xs -> let line = Ast_c.line_of_info ii in let acc = (TDefine ii) :: acc in define_line_2 acc line ii xs | TUndef ii::xs -> let line = Ast_c.line_of_info ii in let acc = (TUndef ii) :: acc in define_line_2 acc line ii xs | TPragma ii::xs -> let line = Ast_c.line_of_info ii in let acc = (TPragma ii) :: acc in define_line_2 acc line ii xs | TCppEscapedNewline ii::xs -> pr2 ("SUSPICIOUS: a \\ character appears outside of a #define at"); pr2 (Ast_c.strloc_of_info ii); let acc = (TCommentSpace ii) :: acc in define_line_1 acc xs | x::xs -> define_line_1 (x::acc) xs and define_line_2 acc line lastinfo xs = match xs with | [] -> (* should not happened, should meet EOF before *) pr2 "PB: WEIRD"; List.rev (mark_end_define lastinfo::acc) | x::xs -> let line' = TH.line_of_tok x in let info = TH.info_of_tok x in (match x with | EOF ii -> let acc = (mark_end_define lastinfo) :: acc in let acc = (EOF ii) :: acc in define_line_1 acc xs | TCppEscapedNewline ii -> if (line' <> line) then pr2 "PB: WEIRD: not same line number"; let acc = (TCommentSpace ii) :: acc in define_line_2 acc (line+1) info xs | x -> if line' =|= line then define_line_2 (x::acc) (end_line_of_tok line' x) info xs else (* Put end of line token before the newline. A newline at least must be there because the line changed and because we saw a #define previously to get to this function at all *) define_line_1 ((List.hd acc)::(mark_end_define lastinfo::(List.tl acc))) (x::xs) ) (* for a comment, the end line is not the same as line_of_tok *) and end_line_of_tok default = function (TComment _) as t -> let line_fragments = Str.split_delim (Str.regexp "\n") (TH.str_of_tok t) in (match List.rev line_fragments with _::front_fragments -> (* no need for backslash at the end of these lines... *) TH.line_of_tok t + (List.length front_fragments) | _ -> failwith (Printf.sprintf "bad comment: %d" (TH.line_of_tok t))) | t -> default let rec define_ident acc xs = match xs with | [] -> List.rev acc | TUndef ii::xs -> let acc = TUndef ii :: acc in (match xs with TCommentSpace i1::TIdent (s,i2)::xs -> let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,i2)) :: acc in define_ident acc xs | _ -> pr2 "WEIRD: weird #define body"; define_ident acc xs ) | TDefine ii::xs -> let acc = TDefine ii :: acc in (match xs with | TCommentSpace i1::TIdent (s,i2)::TOPar (i3)::xs -> (* Change also the kind of TIdent to avoid bad interaction * with other parsing_hack tricks. For instant if keep TIdent then * the stringication algo can believe the TIdent is a string-macro. * So simpler to change the kind of the ident too. *) (* if TOParDefine sticked to the ident, then * it's a macro-function. Change token to avoid ambiguity * between #define foo(x) and #define foo (x) *) let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,i2)) :: acc in let acc = (TOParDefine i3) :: acc in define_ident acc xs | TCommentSpace i1::TIdent (s,i2)::xs -> let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,i2)) :: acc in define_ident acc xs (* bugfix: ident of macro (as well as params, cf below) can be tricky * note, do we need to subst in the body of the define ? no cos * here the issue is the name of the macro, as in #define inline, * so obviously the name of this macro will not be used in its * body (it would be a recursive macro, which is forbidden). *) | TCommentSpace i1::t::xs when TH.str_of_tok t ==~ Common.regexp_alpha -> let s = TH.str_of_tok t in let ii = TH.info_of_tok t in pr2 (spf "remapping: %s to an ident in macro name" s); let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,ii)) :: acc in define_ident acc xs | TCommentSpace _::_::xs | xs -> pr2 "WEIRD: weird #define body"; define_ident acc xs ) | TPragma ii::xs -> let acc = TPragma ii :: acc in let rec loop acc = function ((TDefEOL i1) as x) :: xs -> define_ident (x::acc) xs | TCommentSpace i1::TIdent (s,i2)::xs -> let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,i2)) :: acc in loop acc xs (* bugfix: ident of macro (as well as params, cf below) can be tricky * note, do we need to subst in the body of the define ? no cos * here the issue is the name of the macro, as in #define inline, * so obviously the name of this macro will not be used in its * body (it would be a recursive macro, which is forbidden). *) | TCommentSpace i1::t::xs when TH.str_of_tok t ==~ Common.regexp_alpha -> let s = TH.str_of_tok t in let ii = TH.info_of_tok t in pr2 (spf "remapping: %s to an ident in pragma" s); let acc = (TCommentSpace i1) :: acc in let acc = (TIdentDefine (s,ii)) :: acc in define_ident acc xs | xs -> pr2 "WEIRD: weird #pragma"; define_ident acc xs in loop acc xs | x::xs -> let acc = x :: acc in define_ident acc xs let fix_tokens_define2 xs = define_ident [] (define_line_1 [] xs) let fix_tokens_define a = Common.profile_code "C parsing.fix_define" (fun () -> fix_tokens_define2 a) (* ------------------------------------------------------------------------- *) (* Other parsing hacks related to cpp, Include/Define hacks *) (* ------------------------------------------------------------------------- *) (* Sometimes I prefer to generate a single token for a list of things in the * lexer so that if I have to passed them, like for passing TInclude then * it's easy. Also if I don't do a single token, then I need to * parse the rest which may not need special stuff, like detecting * end of line which the parser is not really ready for. So for instance * could I parse a #include as 2 or more tokens ? just * lex #include ? so then need recognize as one token ? * but this kind of token is valid only after a #include and the * lexing and parsing rules are different for such tokens so not that * easy to parse such things in parser_c.mly. Hence the following hacks. * * less?: maybe could get rid of this like I get rid of some of fix_define. *) (* helpers *) (* used to generate new token from existing one *) let new_info posadd str ii = { Ast_c.pinfo = Ast_c.OriginTok { (Ast_c.parse_info_of_info ii) with charpos = Ast_c.pos_of_info ii + posadd; str = str; column = Ast_c.col_of_info ii + posadd; }; (* must generate a new ref each time, otherwise share *) cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref Ast_c.emptyComments; } let rec comment_until_defeol xs = match xs with | [] -> (* job not done in Cpp_token_c.define_parse ? *) failwith "cant find end of define token TDefEOL" | x::xs -> (match x with | Parser_c.TDefEOL i -> Parser_c.TCommentCpp (Token_c.CppDirective, TH.info_of_tok x) ::xs | _ -> let x' = (* bugfix: otherwise may lose a TComment token *) if TH.is_real_comment x then x else Parser_c.TCommentCpp (Token_c.CppPassingNormal (*good?*), TH.info_of_tok x) in x'::comment_until_defeol xs ) let drop_until_defeol xs = List.tl (Common.drop_until (function Parser_c.TDefEOL _ -> true | _ -> false) xs) (* ------------------------------------------------------------------------- *) (* returns a pair (replaced token, list of next tokens) *) (* ------------------------------------------------------------------------- *) let tokens_include (info, includes, filename, inifdef) = Parser_c.TIncludeStart (Ast_c.rewrap_str includes info, inifdef), [Parser_c.TIncludeFilename (filename, (new_info (String.length includes) filename info)) ] (*****************************************************************************) (* CPP handling: macros, ifdefs, macros defs *) (*****************************************************************************) (* ------------------------------------------------------------------------- *) (* special skip_start skip_end handling *) (* ------------------------------------------------------------------------- *) (* note: after this normally the token list should not contain any more the * TCommentSkipTagStart and End tokens. *) let rec commentize_skip_start_to_end xs = match xs with | [] -> () | x::xs -> (match x with | {tok = TCommentSkipTagStart info} -> (try let (before, x2, after) = xs +> Common.split_when (function | {tok = TCommentSkipTagEnd _ } -> true | _ -> false ) in let topass = x::x2::before in topass +> List.iter (fun tok -> TV.set_as_comment Token_c.CppPassingExplicit tok ); commentize_skip_start_to_end after with Not_found -> failwith "could not find end of skip_start special comment" ) | {tok = TCommentSkipTagEnd info} -> failwith "found skip_end comment but no skip_start" | _ -> commentize_skip_start_to_end xs ) (* ------------------------------------------------------------------------- *) (* ifdef keeping/passing *) (* ------------------------------------------------------------------------- *) (* #if 0, #if 1, #if LINUX_VERSION handling *) let rec find_ifdef_bool xs = xs +> List.iter (function | NotIfdefLine _ -> () | Ifdefbool (is_ifdef_positif, xxs, info_ifdef_stmt) -> msg_ifdef_bool_passing is_ifdef_positif; (match xxs with | [] -> raise (Impossible 90) | firstclause::xxs -> info_ifdef_stmt +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); if is_ifdef_positif then xxs +> List.iter (iter_token_ifdef (TV.set_as_comment Token_c.CppPassingNormal)) else begin firstclause +> iter_token_ifdef (TV.set_as_comment Token_c.CppPassingNormal); (match List.rev xxs with (* keep only last *) | last::startxs -> startxs +> List.iter (iter_token_ifdef (TV.set_as_comment Token_c.CppPassingNormal)) | [] -> (* not #else *) () ); end ); | Ifdef (xxs, info_ifdef_stmt) -> xxs +> List.iter find_ifdef_bool ) let thresholdIfdefSizeMid = 6 (* infer ifdef involving not-closed expressions/statements *) let rec find_ifdef_mid xs = xs +> List.iter (function | NotIfdefLine _ -> () | Ifdef (xxs, info_ifdef_stmt) -> (match xxs with | [] -> raise (Impossible 91) | [first] -> () | first::second::rest -> (* don't analyse big ifdef *) if xxs +> List.for_all (fun xs -> List.length xs <= thresholdIfdefSizeMid) && (* don't want nested ifdef *) xxs +> List.for_all (fun xs -> xs +> List.for_all (function NotIfdefLine _ -> true | _ -> false) ) then let counts = xxs +> List.map count_open_close_stuff_ifdef_clause in let cnt1, cnt2 = List.hd counts in if cnt1 <> 0 || cnt2 <> 0 && counts +> List.for_all (fun x -> x =*= (cnt1, cnt2)) (* if counts +> List.exists (fun (cnt1, cnt2) -> cnt1 <> 0 || cnt2 <> 0 ) *) then begin msg_ifdef_mid_something(); (* keep only first, treat the rest as comment *) info_ifdef_stmt +> List.iter (TV.save_as_comment (function x -> Token_c.CppIfDirective x)); (second::rest) +> List.iter (iter_token_ifdef (TV.set_as_comment Token_c.CppPassingCosWouldGetError)); end ); List.iter find_ifdef_mid xxs (* no need complex analysis for ifdefbool *) | Ifdefbool (_, xxs, info_ifdef_stmt) -> List.iter find_ifdef_mid xxs ) let thresholdFunheaderLimit = 4 (* ifdef defining alternate function header, type *) let rec find_ifdef_funheaders = function | [] -> () | NotIfdefLine _::xs -> find_ifdef_funheaders xs (* ifdef-funheader if ifdef with 2 lines and a '{' in next line *) | Ifdef ([(NotIfdefLine (({col = 0} as _xline1)::line1))::ifdefblock1; (NotIfdefLine (({col = 0} as xline2)::line2))::ifdefblock2 ], info_ifdef_stmt ) ::NotIfdefLine (({tok = TOBrace i; col = 0})::line3) ::xs when List.length ifdefblock1 <= thresholdFunheaderLimit && List.length ifdefblock2 <= thresholdFunheaderLimit -> find_ifdef_funheaders xs; msg_ifdef_funheaders (); info_ifdef_stmt +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); let all_toks = [xline2] @ line2 in all_toks +> List.iter (TV.set_as_comment Token_c.CppPassingCosWouldGetError) ; ifdefblock2 +> iter_token_ifdef (TV.set_as_comment Token_c.CppPassingCosWouldGetError); (* ifdef with nested ifdef *) | Ifdef ([[NotIfdefLine (({col = 0} as _xline1)::line1)]; [Ifdef ([[NotIfdefLine (({col = 0} as xline2)::line2)]; [NotIfdefLine (({col = 0} as xline3)::line3)]; ], info_ifdef_stmt2 ) ] ], info_ifdef_stmt ) ::NotIfdefLine (({tok = TOBrace i; col = 0})::line4) ::xs -> find_ifdef_funheaders xs; msg_ifdef_funheaders (); info_ifdef_stmt +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); info_ifdef_stmt2 +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); let all_toks = [xline2;xline3] @ line2 @ line3 in all_toks +> List.iter (TV.set_as_comment Token_c.CppPassingCosWouldGetError); (* ifdef with elseif *) | Ifdef ([[NotIfdefLine (({col = 0} as _xline1)::line1)]; [NotIfdefLine (({col = 0} as xline2)::line2)]; [NotIfdefLine (({col = 0} as xline3)::line3)]; ], info_ifdef_stmt ) ::NotIfdefLine (({tok = TOBrace i; col = 0})::line4) ::xs -> find_ifdef_funheaders xs; msg_ifdef_funheaders (); info_ifdef_stmt +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); let all_toks = [xline2;xline3] @ line2 @ line3 in all_toks +> List.iter (TV.set_as_comment Token_c.CppPassingCosWouldGetError) (* recurse *) | Ifdef (xxs,info_ifdef_stmt)::xs | Ifdefbool (_, xxs,info_ifdef_stmt)::xs -> List.iter find_ifdef_funheaders xxs; find_ifdef_funheaders xs (* ?? *) let rec adjust_inifdef_include xs = xs +> List.iter (function | NotIfdefLine _ -> () | Ifdef (xxs, info_ifdef_stmt) | Ifdefbool (_, xxs, info_ifdef_stmt) -> xxs +> List.iter (iter_token_ifdef (fun tokext -> match tokext.tok with | Parser_c.TInclude (s1, s2, inifdef_ref, ii) -> inifdef_ref := true; | _ -> () )); ) let rec find_ifdef_cparen_else xs = let rec aux xs = xs +> List.iter (function | NotIfdefLine _ -> () | Ifdef (xxs, info_ifdef_stmt) -> (match xxs with | [] -> raise (Impossible 92) | [first] -> () | first::second::rest -> (* found a closing ')' just after the #else *) (* Too bad ocaml does not support better list pattern matching * a la Prolog-III where can match the end of lists. *) let condition = if List.length first = 0 then false else let last_line = Common.last first in match last_line with | NotIfdefLine xs -> if List.length xs = 0 then false else let last_tok = Common.last xs in TH.is_cpar last_tok.tok | Ifdef _ | Ifdefbool _ -> false in if condition then begin msg_ifdef_cparen_else(); (* keep only first, treat the rest as comment *) info_ifdef_stmt +> List.iter (TV.save_as_comment (fun x -> Token_c.CppIfDirective x)); (second::rest) +> List.iter (iter_token_ifdef (TV.set_as_comment Token_c.CppPassingCosWouldGetError)); end ); List.iter aux xxs (* no need complex analysis for ifdefbool *) | Ifdefbool (_, xxs, info_ifdef_stmt) -> List.iter aux xxs ) in aux xs (* ------------------------------------------------------------------------- *) (* cpp-builtin part2, macro, using standard.h or other defs *) (* ------------------------------------------------------------------------- *) (* now in cpp_token_c.ml *) (* ------------------------------------------------------------------------- *) (* stringification *) (* ------------------------------------------------------------------------- *) let rec find_string_macro_paren xs = match xs with | [] -> () | Parenthised(xxs, info_parens)::xs -> xxs +> List.iter (fun xs -> if xs +> List.exists (function PToken({tok = (TString _| TMacroString _)}) -> true | _ -> false) && xs +> List.for_all (function PToken({tok = (TString _| TMacroString _)}) | PToken({tok = TIdent _}) -> true | _ -> false) then xs +> List.iter (fun tok -> match tok with | PToken({tok = TIdent (s,_)} as id) -> msg_stringification s; id.tok <- TMacroString (s, TH.info_of_tok id.tok); | _ -> () ) else find_string_macro_paren xs ); find_string_macro_paren xs | PToken(tok)::xs -> find_string_macro_paren xs (* ------------------------------------------------------------------------- *) (* format strings *) (* ------------------------------------------------------------------------- *) (* can't just expand all strings, because string followed by another string will turn into a MultiString. *) let fix_tokens_strings toks = let comments x = TH.is_comment x in let strings_and_comments = function TString _ -> true | x -> TH.is_comment x in let rec skip acc fn = function x :: xs when fn x -> skip (x :: acc) fn xs | xs -> (List.rev acc, xs) and out_strings = function [] -> [] | ((TString(str_isW,info)) as a)::rest -> let (front,rest) = skip [] comments rest in (match rest with ((TString _) as b) :: rest -> let (front2,rest) = skip [] strings_and_comments rest in a :: front @ b :: front2 @ out_strings rest | _ -> (Parse_string_c.parse_string str_isW info) @ front @ out_strings rest) | x :: rest -> x :: out_strings rest in out_strings toks (* ------------------------------------------------------------------------- *) (* macro2 *) (* ------------------------------------------------------------------------- *) (* don't forget to recurse in each case *) let rec find_macro_paren xs = match xs with | [] -> () (* attribute *) | PToken ({tok = Tattribute _} as id) ::Parenthised (xxs,info_parens) ::xs -> pr2_cpp ("MACRO: __attribute detected "); [Parenthised (xxs, info_parens)] +> iter_token_paren (TV.set_as_comment Token_c.CppAttr); TV.set_as_comment Token_c.CppAttr id; find_macro_paren xs | PToken ({tok = TattributeNoarg _} as id) ::xs -> pr2_cpp ("MACRO: __attributenoarg detected "); TV.set_as_comment Token_c.CppAttr id; find_macro_paren xs (* (* attribute cpp, __xxx id *) | PToken ({tok = TIdent (s,i1)} as id) ::PToken ({tok = TIdent (s2, i2)} as id2) ::xs when s ==~ regexp_annot -> msg_attribute s; id.tok <- TMacroAttr (s, i1); find_macro_paren ((PToken id2)::xs); (* recurse also on id2 ? *) (* attribute cpp, id __xxx *) | PToken ({tok = TIdent (s,i1)} as _id) ::PToken ({tok = TIdent (s2, i2)} as id2) ::xs when s2 ==~ regexp_annot && (not (s ==~ regexp_typedef)) -> msg_attribute s2; id2.tok <- TMacroAttr (s2, i2); find_macro_paren xs | PToken ({tok = (Tstatic _ | Textern _)} as tok1) ::PToken ({tok = TIdent (s,i1)} as attr) ::xs when s ==~ regexp_annot -> pr2_cpp ("storage attribute: " ^ s); attr.tok <- TMacroAttrStorage (s,i1); (* recurse, may have other storage attributes *) find_macro_paren (PToken (tok1)::xs) *) (* storage attribute *) | PToken ({tok = (Tstatic _ | Textern _)} as tok1) ::PToken ({tok = TMacroAttr (s,i1)} as attr)::xs -> pr2_cpp ("storage attribute: " ^ s); attr.tok <- TMacroAttrStorage (s,i1); (* recurse, may have other storage attributes *) find_macro_paren (PToken (tok1)::xs) (* stringification * * the order of the matching clause is important * *) (* string macro with params, before case *) | PToken ({tok = (TString _| TMacroString _)})::PToken ({tok = TIdent (s,_)} as id) ::Parenthised (xxs, info_parens) ::xs -> msg_stringification_params s; id.tok <- TMacroString (s, TH.info_of_tok id.tok); [Parenthised (xxs, info_parens)] +> iter_token_paren (TV.set_as_comment Token_c.CppMacro); find_macro_paren xs (* after case *) | PToken ({tok = TIdent (s,_)} as id) ::Parenthised (xxs, info_parens) ::PToken ({tok = (TString _ | TMacroString _)}) ::xs -> msg_stringification_params s; id.tok <- TMacroString (s, TH.info_of_tok id.tok); [Parenthised (xxs, info_parens)] +> iter_token_paren (TV.set_as_comment Token_c.CppMacro); find_macro_paren xs (* for the case where the string is not inside a funcall, but * for instance in an initializer. *) (* string macro variable, before case *) | PToken ({tok = (TString _ | TMacroString _)})::PToken ({tok = TIdent (s,_)} as id) ::xs when not !Flag.c_plus_plus -> msg_stringification s; id.tok <- TMacroString (s, TH.info_of_tok id.tok); find_macro_paren xs (* after case *) | PToken ({tok = TIdent (s,_)} as id) ::PToken ({tok = (TString _ | TMacroString _)}) ::xs -> msg_stringification s; id.tok <- TMacroString (s, TH.info_of_tok id.tok); find_macro_paren xs (* recurse *) | (PToken x)::xs -> find_macro_paren xs | (Parenthised (xxs, info_parens))::xs -> xxs +> List.iter find_macro_paren; find_macro_paren xs (* don't forget to recurse in each case *) let rec find_macro_lineparen xs = match xs with | [] -> () (* linuxext: ex: static [const] DEVICE_ATTR(); *) | (Line ( [PToken ({tok = Tstatic _}); PToken ({tok = TIdent (s,_)} as macro); Parenthised (xxs,info_parens); PToken ({tok = TPtVirg _}); ] )) ::xs when (s ==~ regexp_macro) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); find_macro_lineparen (xs) (* the static const case *) | (Line ( [PToken ({tok = Tstatic _}); PToken ({tok = Tconst _} as const); PToken ({tok = TIdent (s,_)} as macro); Parenthised (xxs,info_parens); PToken ({tok = TPtVirg _}); ] (*as line1*) )) ::xs when (s ==~ regexp_macro) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); (* need retag this const, otherwise ambiguity in grammar 21: shift/reduce conflict (shift 121, reduce 137) on Tconst decl2 : Tstatic . TMacroDecl TOPar argument_list TCPar ... decl2 : Tstatic . Tconst TMacroDecl TOPar argument_list TCPar ... storage_class_spec : Tstatic . (137) *) const.tok <- TMacroDeclConst (TH.info_of_tok const.tok); find_macro_lineparen (xs) (* same but without trailing ';' * * I do not put the final ';' because it can be on a multiline and * because of the way mk_line is coded, we will not have access to * this ';' on the next line, even if next to the ')' *) | (Line ([PToken ({tok = Tstatic _}); PToken ({tok = TIdent (s,_)} as macro); Parenthised (xxs,info_parens); ] )) ::xs when s ==~ regexp_macro -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); find_macro_lineparen (xs) (* on multiple lines *) | (Line ( (PToken ({tok = Tstatic _})::[] ))) ::(Line ( [PToken ({tok = TIdent (s,_)} as macro); Parenthised (xxs,info_parens); PToken ({tok = TPtVirg _}); ] ) ) ::xs when (s ==~ regexp_macro) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); find_macro_lineparen (xs) | (Line (* initializer case *) ( PToken ({tok = Tstatic _}) :: PToken ({tok = TIdent (s,_)} as macro) :: Parenthised (xxs,info_parens) :: PToken ({tok = TEq _}) :: rest )) ::xs when (s ==~ regexp_macro) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); (* continue with the rest of the line *) find_macro_lineparen ((Line(rest))::xs) | (Line (* multi-line initializer case *) ( (PToken ({tok = Tstatic _})::[] ))) ::(Line ( PToken ({tok = Tstatic _}) :: PToken ({tok = TIdent (s,_)} as macro) :: Parenthised (xxs,info_parens) :: PToken ({tok = TEq _}) :: rest )) ::xs when (s ==~ regexp_macro) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); (* continue with the rest of the line *) find_macro_lineparen ((Line(rest))::xs) (* linuxext: ex: DECLARE_BITMAP(); * * Here I use regexp_declare and not regexp_macro because * Sometimes it can be a FunCallMacro such as DEBUG(foo()); * Here we don't have the preceding 'static' so only way to * not have positive is to restrict to .*DECLARE.* macros. * * but there is a grammar rule for that, so don't need this case anymore * unless the parameter of the DECLARE_xxx are weird and can not be mapped * on a argument_list *) | (Line ([PToken ({tok = TIdent (s,_)} as macro); Parenthised (xxs,info_parens); PToken ({tok = TPtVirg _}); ] )) ::xs when (s ==~ regexp_declare) -> msg_declare_macro s; let info = TH.info_of_tok macro.tok in macro.tok <- TMacroDecl (Ast_c.str_of_info info, info); find_macro_lineparen (xs) (* toplevel macros. * module_init(xxx) * * Could also transform the TIdent in a TMacroTop but can have false * positive, so easier to just change the TCPar and so just solve * the end-of-stream pb of ocamlyacc *) | (Line ([PToken ({tok = TIdent (s,ii); col = col1; where = ctx} as _macro); Parenthised (xxs,info_parens); ] as _line1 )) ::xs when col1 =|= 0 -> let condition = (* to reduce number of false positive *) (match xs with | (Line (PToken ({col = col2 } as other)::restline2))::_ -> TH.is_eof other.tok || (col2 =|= 0 && (match other.tok with | TOBrace _ -> false (* otherwise would match funcdecl *) | TCBrace _ when ctx <> InFunction -> false | TPtVirg _ | TDotDot _ -> false | tok when TH.is_binary_operator tok -> false | _ -> true ) ) | _ -> false ) in if condition then begin msg_macro_toplevel_noptvirg s; (* just to avoid the end-of-stream pb of ocamlyacc *) let tcpar = Common.last info_parens in tcpar.tok <- TCParEOL (TH.info_of_tok tcpar.tok); (*macro.tok <- TMacroTop (s, TH.info_of_tok macro.tok);*) end; find_macro_lineparen (xs) (* macro with parameters * ex: DEBUG() * return x; *) | (Line ([PToken ({tok = TIdent (s,ii); col = col1; where = ctx} as macro); Parenthised (xxs,info_parens); ] as _line1 )) ::(Line (PToken ({col = col2 } as other)::restline2 ) as line2) ::xs (* when s ==~ regexp_macro *) -> (* This can give a false positive for K&R functions if the function name is in the same column as the first parameter declaration. *) let condition = (col1 =|= col2 && (match other.tok with | TOBrace _ -> false (* otherwise would match funcdecl *) | TCBrace _ when ctx <> InFunction -> false | TPtVirg _ | TDotDot _ -> false | tok when TH.is_binary_operator tok -> false | _ -> true ) ) || (col2 <= col1 && (match other.tok, restline2 with | TCBrace _, _ when ctx =*= InFunction -> true | Treturn _, _ -> true | Tif _, _ -> true | Telse _, _ -> true (* case of label, usually put in first line *) | TIdent _, (PToken ({tok = TDotDot _}))::_ -> true | _ -> false ) ) in if condition then if col1 =|= 0 then () else begin msg_macro_noptvirg s; macro.tok <- TMacroStmt (s, TH.info_of_tok macro.tok); [Parenthised (xxs, info_parens)] +> iter_token_paren (TV.set_as_comment Token_c.CppMacro); end; find_macro_lineparen (line2::xs) (* linuxext:? single macro * ex: LOCK * foo(); * UNLOCK * * todo: factorize code with previous rule ? *) | (Line ([PToken ({tok = TIdent (s,ii); col = col1; where = ctx} as macro); ] as _line1 )) ::(Line (PToken ({col = col2 } as other)::restline2 ) as line2) ::xs -> (* when s ==~ regexp_macro *) let condition = (col1 =|= col2 && col1 <> 0 && (* otherwise can match typedef of fundecl*) (match other.tok with | TPtVirg _ -> false | TOr _ -> false | TCBrace _ when ctx <> InFunction -> false | tok when TH.is_binary_operator tok -> false | _ -> true )) || (col2 <= col1 && (match other.tok with | TCBrace _ when ctx =*= InFunction -> true | Treturn _ -> true | Tif _ -> true | Telse _ -> true | _ -> false )) in if condition then begin msg_macro_noptvirg_single s; macro.tok <- TMacroStmt (s, TH.info_of_tok macro.tok); end; find_macro_lineparen (line2::xs) | x::xs -> find_macro_lineparen xs (* ------------------------------------------------------------------------- *) (* define tobrace init *) (* ------------------------------------------------------------------------- *) let rec find_define_init_brace_paren xs = let rec aux xs = match xs with | [] -> () (* mainly for firefox *) | (PToken {tok = TDefine _}) ::(PToken {tok = TIdentDefine (s,_)}) ::(PToken ({tok = TOBrace i1} as tokbrace)) ::(PToken tok2) ::(PToken tok3) ::xs -> let is_init = match tok2.tok, tok3.tok with | TInt _, TComma _ -> true | TString _, TComma _ -> true | TIdent _, TComma _ -> true | _ -> false in if is_init then begin pr2_cpp("found define initializer: " ^s); tokbrace.tok <- TOBraceDefineInit i1; end; aux xs (* mainly for linux, especially in sound/ *) | (PToken {tok = TDefine _}) ::(PToken {tok = TIdentDefine (s,_)}) ::(Parenthised(xxx, info_parens)) ::(PToken ({tok = TOBrace i1} as tokbrace)) ::(PToken tok2) ::(PToken tok3) ::xs -> let is_init = match tok2.tok, tok3.tok with | TInt _, TComma _ -> true | TDot _, TIdent _ -> true | TIdent _, TComma _ -> true | _ -> false in if is_init then begin pr2_cpp("found define initializer with param: " ^ s); tokbrace.tok <- TOBraceDefineInit i1; end; aux xs (* recurse *) | (PToken x)::xs -> aux xs | (Parenthised (xxs, info_parens))::xs -> (* not need for tobrace init: * xxs +> List.iter aux; *) aux xs in aux xs (* ------------------------------------------------------------------------- *) (* action *) (* ------------------------------------------------------------------------- *) (* obsolete now with macro expansion ? get some regression if comment. * todo: if do bad decision here, then it can influence other phases * and make it hard to parse. So maybe when have a parse error, should * undo some of the guess those heuristics have done, and restore * the original token value. *) let rec find_actions = function | [] -> () | PToken ({tok = TIdent (s,ii)}) ::Parenthised (xxs,info_parens) ::xs -> find_actions xs; xxs +> List.iter find_actions; let modified = find_actions_params xxs in if modified then msg_macro_higher_order s | x::xs -> find_actions xs and find_actions_params xxs = xxs +> List.fold_left (fun acc xs -> let toks = tokens_of_paren xs in if toks +> List.exists (fun x -> TH.is_statement x.tok) (* undo: && List.length toks > 1 * good for sparse, not good for linux *) then begin xs +> iter_token_paren (fun x -> if TH.is_eof x.tok then (* certainly because paren detection had a pb because of * some ifdef-exp. Do similar additional checking than * what is done in TV.set_as_comment. *) pr2 "PB: weird, I try to tag an EOF token as an action" else (* cf tests-bis/no_cpar_macro.c *) if TH.is_eom x.tok then pr2 "PB: weird, I try to tag an EOM token as an action" else x.tok <- TAction (TH.info_of_tok x.tok); ); true (* modified *) end else acc ) false (* ------------------------------------------------------------------------- *) (* main fix cpp function *) (* ------------------------------------------------------------------------- *) let filter_cpp_stuff xs = List.filter (function x -> (match x.tok with | tok when TH.is_comment tok -> false (* don't want drop the define, or if drop, have to drop * also its body otherwise the line heuristics may be lost * by not finding the TDefine in column 0 but by finding * a TDefineIdent in a column > 0 *) | Parser_c.TDefine _ -> true | tok when TH.is_cpp_instruction tok -> false | _ -> true )) xs let insert_virtual_positions l = let strlen x = String.length (Ast_c.str_of_info x) in let rec loop prev offset acc = function [] -> List.rev acc | x::xs -> let ii = TH.info_of_tok x in let inject pi = TH.visitor_info_of_tok (function ii -> Ast_c.rewrap_pinfo pi ii) x in match Ast_c.pinfo_of_info ii with Ast_c.OriginTok pi -> let prev = Ast_c.parse_info_of_info ii in loop prev (strlen ii) (x::acc) xs | Ast_c.ExpandedTok (pi,_) -> let x' = inject (Ast_c.ExpandedTok (pi,(prev,offset))) in loop prev (offset + (strlen ii)) (x'::acc) xs | Ast_c.FakeTok (s,_) -> let x' = inject (Ast_c.FakeTok (s,(prev,offset))) in loop prev (offset + (strlen ii)) (x'::acc) xs | Ast_c.AbstractLineTok _ -> failwith "abstract not expected" in let rec skip_fake = function | [] -> [] | x::xs -> let ii = TH.info_of_tok x in match Ast_c.pinfo_of_info ii with | Ast_c.OriginTok pi -> let prev = Ast_c.parse_info_of_info ii in let res = loop prev (strlen ii) [] xs in x::res | _ -> x::skip_fake xs in skip_fake l (* ------------------------------------------------------------------------- *) let fix_tokens_cpp2 ~macro_defs tokens = let tokens2 = ref (tokens +> Common.acc_map TV.mk_token_extended) in begin (* the order is important, if you put the action heuristic first, * then because of ifdef, can have not closed paren * and so may believe that higher order macro * and it will eat too much tokens. So important to do * first the ifdef. * * I recompute multiple times cleaner cos the mutable * can have be changed and so may have more comments * in the token original list. * *) commentize_skip_start_to_end !tokens2; (* ifdef *) let cleaner = !tokens2 +> List.filter (fun x -> (* is_comment will also filter the TCommentCpp created in * commentize_skip_start_to_end *) not (TH.is_comment x.tok) (* could filter also #define/#include *) ) in let ifdef_grouped = TV.mk_ifdef cleaner in set_ifdef_parenthize_info ifdef_grouped; find_ifdef_funheaders ifdef_grouped; find_ifdef_bool ifdef_grouped; find_ifdef_mid ifdef_grouped; (* change order ? maybe cparen_else heuristic make some of the funheaders * heuristics irrelevant ? *) find_ifdef_cparen_else ifdef_grouped; adjust_inifdef_include ifdef_grouped; (* macro 1 *) let cleaner = !tokens2 +> filter_cpp_stuff in let paren_grouped = TV.mk_parenthised cleaner in Cpp_token_c.apply_macro_defs ~msg_apply_known_macro ~msg_apply_known_macro_hint macro_defs paren_grouped; (* because the before field is used by apply_macro_defs *) tokens2 := TV.rebuild_tokens_extented !tokens2; (* tagging contextual info (InFunc, InStruct, etc). Better to do * that after the "ifdef-simplification" phase. *) let cleaner = !tokens2 +> List.filter (fun x -> not (TH.is_comment x.tok) (* could filter also #define/#include *) ) in let brace_grouped = TV.mk_braceised cleaner in set_context_tag brace_grouped; (* macro *) let cleaner = !tokens2 +> filter_cpp_stuff in let paren_grouped = TV.mk_parenthised cleaner in let line_paren_grouped = TV.mk_line_parenthised paren_grouped in find_define_init_brace_paren paren_grouped; find_string_macro_paren paren_grouped; find_macro_lineparen line_paren_grouped; find_macro_paren paren_grouped; (* obsolete: actions ? not yet *) let cleaner = !tokens2 +> filter_cpp_stuff in let paren_grouped = TV.mk_parenthised cleaner in find_actions paren_grouped; insert_virtual_positions (!tokens2 +> Common.acc_map (fun x -> x.tok)) end let time_hack1 ~macro_defs a = Common.profile_code_exclusif "HACK" (fun () -> fix_tokens_cpp2 ~macro_defs a) let fix_tokens_cpp ~macro_defs a = Common.profile_code "C parsing.fix_cpp" (fun () -> time_hack1 ~macro_defs a) let can_be_on_top_level tl = match tl with | Tstruct _ | Ttypedef _ | TDefine _ | TIfdef _ | TIfdefelse _ | TIfdefelif _ | TIfdefBool _ | TIfdefMisc _ | TIfdefVersion _ | TEndif _ -> true | _ -> false (*****************************************************************************) (* Lexing with lookahead *) (*****************************************************************************) (* Why using yet another parsing_hack technique ? The fix_xxx where do * some pre-processing on the full list of tokens is not enough ? * No cos sometimes we need more contextual info, and even if * set_context() tries to give some contextual info, it's not completely * accurate so the following code give yet another alternative, yet another * chance to transform some tokens. * * todo?: maybe could try to get rid of this technique. Maybe a better * set_context() would make possible to move this code using a fix_xx * technique. * * LALR(k) trick. We can do stuff by adding cases in lexer_c.mll, but * it is more general to do it via my LALR(k) tech. Because here we can * transform some token give some context information. So sometimes it * makes sense to transform a token in one context, sometimes not, and * lex can not provide us this context information. Note that the order * in the pattern matching in lookahead is important. Do not cut/paste. * * Note that in next there is only "clean" tokens, there is no comment * or space tokens. This is done by the caller. * *) open Lexer_parser (* for the fields of lexer_hint type *) let not_struct_enum = function | (Parser_c.Tstruct _ | Parser_c.Tunion _ | Parser_c.Tenum _)::_ -> false | _ -> true let pointer ?(followed_by=fun _ -> true) ?(followed_by_more=fun _ -> true) ts = let rec loop ts = match ts with | TMul _ :: rest -> loop rest | TAnd _ :: rest when !Flag.c_plus_plus -> loop rest | t :: ts' -> followed_by t && followed_by_more ts' | [] -> failwith "unexpected end of token stream" in match ts with | TMul _ :: rest -> loop rest | TAnd _ :: rest when !Flag.c_plus_plus -> loop rest | _ -> false let ident = function TIdent _ -> true | _ -> false let is_type = function | TypedefIdent _ | Tvoid _ | Tchar _ | Tfloat _ | Tdouble _ | Tsize_t _ | Tssize_t _ | Tptrdiff_t _ | Tint _ | Tlong _ | Tshort _ -> true | _ -> false let is_cparen = function (TCPar _) -> true | _ -> false let is_oparen = function (TOPar _) -> true | _ -> false let rec not_has_type_before f xs = match xs with | [] -> raise (Impossible 666) | x :: xs -> if f x then true else if is_type x then false else not_has_type_before f xs (* This function is inefficient, because it will look over a K&R header, or function prototype multiple times. At least when we see a , and are in a parameter list, we know we will eventually see a close paren, and it should come fairly soon. *) let k_and_r l = let l1 = drop_until is_cparen l in match l1 with (TCPar _) :: (TOCro _) :: _ -> false | (TCPar _) :: _ -> true | _ -> false (* (a)(b) is ambiguous, because (a) could be a function name or a cast. At this point, we just see an ident for a; we don't know if it is eg a local variable. This function sees at least if b is the only argument, ie there are no commas at top level *) let paren_before_comma l = let rec loop level = function [] -> false | (TComma _)::_ when level = 1 -> false | (TCPar _)::_ when level = 1 -> true | (TCPar _)::rest -> loop (level-1) rest | (TOPar _)::rest -> loop (level+1) rest | x::rest -> loop level rest in loop 0 l let lookahead2 ~pass next before = match (next, before) with (* c++ hacks *) (* yy xx( and in function *) | TOPar i1::_, TIdent(s,i2)::TypedefIdent _::_ when !Flag.c_plus_plus && (LP.current_context () = (LP.InFunction)) -> pr2_cpp("constructed_object: " ^s); TOParCplusplusInit i1 | TOPar i1::_, TIdent(s,i2)::ptr when !Flag.c_plus_plus && pointer ~followed_by:(function TypedefIdent _ -> true | _ -> false) ptr && (LP.current_context () = (LP.InFunction)) -> pr2_cpp("constructed_object: " ^s); TOParCplusplusInit i1 | TypedefIdent(s,i)::TOPar i1::_,_ when !Flag.c_plus_plus && (LP.current_context () = (LP.InFunction)) -> TIdent(s,i) (*-------------------------------------------------------------*) (* typedef inference, parse_typedef_fix3 *) (*-------------------------------------------------------------*) (* xx xx *) | (TIdent(s,i1)::TIdent(s2,i2)::_ , _) when not_struct_enum before && s =$= s2 && ok_typedef s (* (take_safe 1 !passed_tok <> [TOPar]) -> *) -> (* parse_typedef_fix3: * acpi_object acpi_object; * etait mal parsé, car pas le temps d'appeler dt() dans le type_spec. * Le parser en interne a deja appelé le prochain token pour pouvoir * decider des choses. * => special case in lexer_heuristic, again *) if !Flag_parsing_c.debug_typedef then pr2 ("TYPEDEF: disable typedef cos special case: " ^ s); LP.disable_typedef(); msg_typedef s i1 1; LP.add_typedef_root s; TypedefIdent (s, i1) (* christia *) (* delete[] *) | (TOCro i1 :: _, Tdelete _ :: _) when !Flag.c_plus_plus -> TCommentCpp (Token_c.CppDirective, i1) (* delete[] *) | (TCCro i1 :: _, Tdelete _ :: _) when !Flag.c_plus_plus -> TCommentCpp (Token_c.CppDirective, i1) (* extern "_" tt *) | ((TString ((s, _), i1) | TMacroString (s, i1)) :: _ , Textern _ :: _) when !Flag.c_plus_plus -> TCommentCpp (Token_c.CppDirective, i1) (* ) const { *) | (Tconst i1 :: TOBrace _ :: _ , TCPar _ :: _) when !Flag.c_plus_plus -> TCommentCpp (Token_c.CppDirective, i1) (* xx const tt *) | (TIdent (s, i1)::(Tconst _|Tvolatile _|Trestrict _)::type_::_ , _) when not_struct_enum before && is_type type_ -> TCommentCpp (Token_c.CppDirective, i1) (* xx struct *) | (TIdent (s, i1)::Tstruct _::_ , _) when not_struct_enum before -> TCommentCpp (Token_c.CppDirective, i1) (* xx tt *) | (TIdent (s, i1)::type_::_ , _) when not_struct_enum before && is_type type_ -> TCommentCpp (Token_c.CppDirective, i1) (* tt xx yy *) | (TIdent (s, i1)::TIdent (s2, i2)::_ , seen::_) when not_struct_enum before && is_type seen -> if is_macro s2 then TIdent (s, i1) else TCommentCpp (Token_c.CppDirective, i1) | (TIdent (s2, i2)::_ , TIdent (s, i1)::seen::_) when not_struct_enum before && is_macro s2 && is_type seen -> TCommentCpp (Token_c.CppDirective, i2) (* tt xx * *) | (TIdent (s, i1)::ptr , seen::_) when not_struct_enum before && pointer ptr && is_type seen -> TCommentCpp (Token_c.CppDirective, i1) (* tt * xx yy *) | (TIdent (s, i1)::TIdent(s2, i2)::_ , ptr) when not_struct_enum before && pointer ptr -> if is_macro s2 then TIdent (s, i1) else TCommentCpp (Token_c.CppDirective, i1) (* tt * xx yy *) | (TIdent(s2, i2)::_ , TIdent (s, i1)::ptr) when not_struct_enum before && is_macro s2 && pointer ptr -> TCommentCpp (Token_c.CppDirective, i2) (* exception to next rule *) | (TIdent(s2, i2)::TOPar _ :: _ , TIdent(s, i1)::seen::_) when not_struct_enum before && is_macro s2 && is_type seen -> TIdent(s2, i2) (* tt xx yy *) | (TIdent(s2, i2)::_ , TIdent(s, i1)::seen::_) when not_struct_enum before && is_macro s2 && is_type seen -> TCommentCpp (Token_c.CppDirective, i2) (* xx * yy AND in paramdecl *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.current_context() =*= LP.InParameter) && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ptr && ok_typedef s -> msg_typedef s i1 14; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx MM ( *) | (TIdent (s, i1)::TIdent (s2, i2)::TOPar _::_ , type_::_) when not_struct_enum before && ok_typedef s && is_macro s2 && is_type type_ -> TIdent (s, i1) (* xx yy *) | (TIdent (s, i1)::TIdent (s2, i2)::_ , _) when not_struct_enum before && ok_typedef s -> (* && not_annot s2 BUT lead to false positive*) msg_typedef s i1 2; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx inline *) | (TIdent (s, i1)::Tinline i2::_ , _) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 3; LP.add_typedef_root s; TypedefIdent (s, i1) (* [,(] xx [,)] AND param decl *) | (TIdent (s, i1)::(((TComma _|TCPar _)::_) as rest) , ((TComma _ |TOPar _)::_ as bef)) when not_struct_enum before && (LP.current_context() =*= LP.InParameter) && k_and_r rest && not_has_type_before is_cparen rest && not_has_type_before is_oparen bef -> TKRParam(s,i1) | (TIdent (s, i1)::((TComma _|TCPar _)::_) , (TComma _ |TOPar _)::_ ) when not_struct_enum before && (LP.current_context() =*= LP.InParameter) && ok_typedef s -> msg_typedef s i1 4; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx* [,)] *) (* specialcase: [,(] xx* [,)] *) | (TIdent (s, i1)::ptr , (*(TComma _|TOPar _)::*)_ ) when pointer ~followed_by:(function TComma _ |TCPar _ -> true | _ -> false) ptr && not_struct_enum before (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) && ok_typedef s -> msg_typedef s i1 5; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx** [,)] *) (* specialcase: [,(] xx** [,)] *) | (TIdent (s, i1)::TMul _::TMul _::(TComma _|TCPar _)::_ , (*(TComma _|TOPar _)::*)_ ) when not_struct_enum before (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) && ok_typedef s -> msg_typedef s i1 6; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx const * USELESS because of next rule ? *) | (TIdent (s, i1)::(Tconst _|Tvolatile _|Trestrict _)::TMul _::_ , _ ) when not_struct_enum before (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) && ok_typedef s -> msg_typedef s i1 7; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx const *) | (TIdent (s, i1)::(Tconst _|Tvolatile _|Trestrict _)::_ , _ ) when not_struct_enum before && ok_typedef s (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) -> msg_typedef s i1 8; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * const *) | (TIdent (s, i1)::ptr , _ ) when pointer ~followed_by:(function Tconst _ | Tvolatile _ | Trestrict _ -> true | _ -> false) ptr && not_struct_enum before && ok_typedef s -> (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) msg_typedef s i1 9; LP.add_typedef_root s; TypedefIdent (s, i1) (* ( const xx) *) | (TIdent (s, i1)::TCPar _::_, (Tconst _ | Tvolatile _|Trestrict _)::TOPar _::_) when ok_typedef s -> msg_typedef s i1 10; LP.add_typedef_root s; TypedefIdent (s, i1) (* ( xx ) [sizeof, ~] *) | (TIdent (s, i1)::TCPar _::(Tsizeof _|TTilde _)::_ , TOPar _::_ ) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 11; LP.add_typedef_root s; TypedefIdent (s, i1) (* [(,] xx [ AND parameterdeclaration *) | (TIdent (s, i1)::TOCro _::_, (TComma _ |TOPar _)::_) when (LP.current_context() =*= LP.InParameter) && ok_typedef s -> msg_typedef s i1 12; LP.add_typedef_root s; TypedefIdent (s, i1) (*------------------------------------------------------------*) (* if 'x*y' maybe an expr, maybe just a classic multiplication *) (* but if have a '=', or ',' I think not *) (*------------------------------------------------------------*) (* static xx * yy *) | (TIdent (s, i1)::ptr , (Tregister _|Tstatic _ |Tvolatile _|Tconst _|Trestrict _)::_) when pointer ~followed_by:(function TIdent _ -> true | _ -> false) ptr && ok_typedef s -> msg_typedef s i1 13; LP.add_typedef_root s; TypedefIdent (s, i1) (* TODO xx * yy ; AND in start of compound element *) (* xx * yy, AND in paramdecl *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.current_context() =*= LP.InParameter) && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TComma _ :: _ -> true | _ -> false) ptr && ok_typedef s -> msg_typedef s i1 14; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy ; AND in Toplevel, except when have = before *) | (TIdent (s, i1)::TMul _::TIdent (s2, i2)::TPtVirg _::_ , TEq _::_) -> TIdent (s, i1) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TPtVirg _ :: _ -> true | _ -> false) ptr && (LP.is_top_or_struct (LP.current_context ())) -> msg_typedef s i1 15; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy , AND in Toplevel *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.current_context () =*= LP.InTopLevel) && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TComma _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 16; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy ( AND in Toplevel *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.is_top_or_struct (LP.current_context ())) && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TOPar _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 17; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy [ *) (* todo? enough ? cos in struct def we can have some expression ! *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.is_top_or_struct (LP.current_context ())) && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TOCro _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 18; LP.add_typedef_root s; TypedefIdent (s, i1) (* u16: 10; in struct *) | (TIdent (s, i1)::TDotDot _::_ , (TOBrace _ | TPtVirg _)::_) when (LP.is_top_or_struct (LP.current_context ())) && ok_typedef s -> msg_typedef s i1 19; LP.add_typedef_root s; TypedefIdent (s, i1) (* why need TOPar condition as stated in preceding rule ? really needed ? *) (* YES cos at toplevel can have some expression !! for instance when *) (* enter in the dimension of an array *) (* | (TIdent s::TMul::TIdent s2::_ , _) when (take_safe 1 !passed_tok <> [Tstruct] && (take_safe 1 !passed_tok <> [Tenum])) && !LP._lexer_hint = Some LP.Toplevel -> msg_typedef s 20; LP.add_typedef_root s; TypedefIdent s *) (* xx * yy = *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TEq _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 21; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy) AND in paramdecl *) | (TIdent (s, i1)::ptr , _) when not_struct_enum before && (LP.current_context () =*= LP.InParameter) && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TCPar _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 22; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx * yy; *) (* wrong ? *) | (TIdent (s, i1)::ptr , (TOBrace _| TPtVirg _)::_) when not_struct_enum before && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TPtVirg _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 23; LP.add_typedef_root s; msg_maybe_dangereous_typedef s; TypedefIdent (s, i1) (* xx * yy, and ';' before xx *) (* wrong ? *) | (TIdent (s, i1)::ptr , (TOBrace _| TPtVirg _)::_) when ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ~followed_by_more:(function TComma _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 24; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx_t * yy *) | (TIdent (s, i1)::ptr , _) when s ==~ regexp_typedef && not_struct_enum before (* struct user_info_t sometimes *) && ok_typedef s && pointer ~followed_by:(function TIdent _ -> true | _ -> false) ptr -> msg_typedef s i1 25; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx ** yy *) (* wrong ? *) | (TIdent (s, i1)::TMul _::TMul _::TIdent (s2, i2)::_ , _) when not_struct_enum before && (LP.current_context() =*= LP.InParameter) && ok_typedef s -> msg_typedef s i1 26; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx ** yy *) (* wrong ? *) | (TIdent (s, i1)::TMul _::TMul _::TIdent (s2, i2)::_ , (TOBrace _ | TPtVirg _)::_) when not_struct_enum before (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) && ok_typedef s (* christia : this code catches 'a * *b' which is wrong *) -> msg_typedef s i1 26; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx *** yy *) | (TIdent (s, i1)::TMul _::TMul _::TMul _::TIdent (s2, i2)::_ , _) when not_struct_enum before && ok_typedef s (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) -> msg_typedef s i1 27; LP.add_typedef_root s; TypedefIdent (s, i1) (* xx ** ) *) | (TIdent (s, i1)::TMul _::TMul _::TCPar _::_ , _) when not_struct_enum before (* && !LP._lexer_hint = Some LP.ParameterDeclaration *) && ok_typedef s -> msg_typedef s i1 28; LP.add_typedef_root s; TypedefIdent (s, i1) (* ----------------------------------- *) (* old: why not do like for other rules and start with TIdent ? * why do TOPar :: TIdent :: ..., _ and not TIdent :: ..., TOPAr::_ ? * new: prefer now start with TIdent because otherwise the add_typedef_root * may have no effect if in second pass or if have disable the add_typedef. *) (* (xx) yy *) | (TIdent (s, i1)::TCPar i2::(TIdent (_,i3)|TInt (_,i3))::_ , (TOPar info)::x::_) when not (TH.is_stuff_taking_parenthized x) (* && Ast_c.line_of_info i2 =|= Ast_c.line_of_info i3 - why useful? *) && ok_typedef s && not (ident x) (* possible K&R declaration *) -> msg_typedef s i1 29; LP.add_typedef_root s; (*TOPar info*) TypedefIdent (s, i1) (* (xx) ( yy) * but false positif: typedef int (xxx_t)(...), so do specialisation below. *) (* | (TIdent (s, i1)::TCPar _::TOPar _::_ , (TOPar info)::x::_) when not (TH.is_stuff_taking_parenthized x) && ok_typedef s -> msg_typedef s 30; LP.add_typedef_root s; (* TOPar info *) TypedefIdent (s, i1) *) (* special case: = (xx) ( yy) *) | (TIdent (s, i1)::TCPar _::((TOPar _::_) as rest) , (TOPar info)::(TEq _ |TEqEq _)::_) when ok_typedef s && paren_before_comma rest -> msg_typedef s i1 31; LP.add_typedef_root s; (* TOPar info *) TypedefIdent (s, i1) (* (xx * ) yy *) | (TIdent (s, i1)::ptr, (TOPar info)::_) when ok_typedef s && pointer ~followed_by:(function TCPar _ -> true | _ -> false) ~followed_by_more:(function TIdent _ :: _ -> true | _ -> false) ptr -> msg_typedef s i1 32; LP.add_typedef_root s; (*TOPar info*) TypedefIdent (s,i1) (* (xx){ ... } constructor *) | (TIdent (s, i1)::TCPar _::TOBrace _::_ , TOPar _::x::_) when (*s ==~ regexp_typedef && *) not (TH.is_stuff_taking_parenthized x) && ok_typedef s -> msg_typedef s i1 33; LP.add_typedef_root s; TypedefIdent (s, i1) (* can have sizeof on expression | (Tsizeof::TOPar::TIdent s::TCPar::_, _) -> msg_typedef s; LP.add_typedef_root s; Tsizeof *) (* ----------------------------------- *) (* x ( *y )(params), function pointer *) | (TIdent (s, i1)::TOPar _::TMul _::TIdent _::TCPar _::TOPar _::_, _) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 34; LP.add_typedef_root s; TypedefIdent (s, i1) (* x* ( *y )(params), function pointer 2 *) | (TIdent (s, i1)::TMul _::TOPar _::TMul _::TIdent _::TCPar _::TOPar _::_, _) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 35; LP.add_typedef_root s; TypedefIdent (s, i1) (*-------------------------------------------------------------*) (* CPP *) (*-------------------------------------------------------------*) | ((TIfdef (_,ii) |TIfdefelse (_,ii) |TIfdefelif (_,ii) |TEndif (_,ii) | TIfdefBool (_,_,ii)|TIfdefMisc(_,_,ii)|TIfdefVersion(_,_,ii)) as x) ::_, _ -> (* if not !Flag_parsing_c.ifdef_to_if then TCommentCpp (Ast_c.CppIfDirective, ii) else *) (* not !LP._lexer_hint.toplevel *) if !Flag_parsing_c.ifdef_directive_passing || (pass >= 2) then begin if (LP.current_context () =*= LP.InInitializer) then begin pr2_cpp "In Initializer passing"; (* cheat: don't count in stat *) incr Stat.nIfdefInitializer; end else begin pr2_cpp("IFDEF: or related inside function. I treat it as comment"); incr Stat.nIfdefPassing; end; let x = match x with TIfdef _ | TIfdefMisc _ | TIfdefVersion _ -> Token_c.IfDef | TIfdefBool _ -> Token_c.IfDef0 | TIfdefelse _ | TIfdefelif _ -> Token_c.Else | TEndif _ -> Token_c.Endif | _ -> Token_c.Other in (* not possible here *) TCommentCpp (Token_c.CppIfDirective x, ii) end else x | (TUndef (ii) as x)::_, _ -> if (pass >= 2) then begin pr2_cpp("UNDEF: I treat it as comment"); TCommentCpp (Token_c.CppDirective, ii) end else x | (TCppDirectiveOther (ii) as x)::_, _ -> if (pass >= 2) then begin pr2_cpp ("OTHER directive: I treat it as comment"); TCommentCpp (Token_c.CppDirective, ii) end else x (* If ident contain a for_each, then certainly a macro. But to be * sure should look if there is a '{' after the ')', but it requires * to count the '('. Because this can be expensive, we do that only * when the token contains "for_each". *) | (TIdent (s, i1)::TOPar _::rest, _) when not (LP.current_context () =*= LP.InTopLevel) (* otherwise a function such as static void loopback_enable(int i) { * will be considered as a loop *) -> if s ==~ regexp_foreach && is_really_foreach (Common.take_safe forLOOKAHEAD rest) then begin msg_foreach s; TMacroIterator (s, i1) end else TIdent (s, i1) (* (* christia: here insert support for macros on top level *) | TIdent (s, ii) :: tl :: _, _ when can_be_on_top_level tl && LP.current_context () = InTopLevel -> pr2_cpp ("'" ^ s ^ "' looks like a macro, I treat it as comment"); TCommentCpp (Token_c.CppDirective, ii) *) (*-------------------------------------------------------------*) | v::xs, _ -> v | _ -> raise (Impossible 93) let lookahead ~pass a b = Common.profile_code "C parsing.lookahead" (fun () -> lookahead2 ~pass a b) coccinelle-1.0.0-rc19/parsing_c/test_parsing_c.mli0000644000175000017500000000126612247437436021051 0ustar eugeneugenopen Common.BasicType val test_tokens_c : filename -> unit val get_files : string -> string list (* parse and handle some regression information when called with dirmode *) val test_parse_c : filename list -> unit val test_parse_h : filename list -> unit val test_parse_ch : filename list -> unit val test_parse_unparse : filename -> unit val test_cfg : filename (* foo.c or foo.c:main *) -> unit val test_type_c : filename -> unit val test_comment_annotater : filename -> unit val test_compare_c : filename -> filename -> unit (* result is in unix code *) val test_compare_c_hardcoded : unit -> unit val test_xxx : string list -> unit val actions: unit -> Common.cmdline_actions coccinelle-1.0.0-rc19/parsing_c/comment_annotater_c.ml0000644000175000017500000001103012247437436021701 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2009, University of Urbana Champaign. * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common module T = Token_c (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* A trimmed down version of my comment_annotater of CComment. In CComment * I was also trying to associate the comment to the relevant entity, not * just the closest token (e.g. a function comment is not placed next to the * identifier of the function but before its return type or storage). *) (*****************************************************************************) (* Helpers *) (*****************************************************************************) let is_comment_or_space_or_stuff tok = Token_helpers.is_not_in_ast tok && Token_helpers.is_origin tok (* coupling with token_helpers.is_not_in_ast, and of course with tokens_c.ml *) let convert_relevant_tokens x = assert (Token_helpers.is_origin x); match x with | Parser_c.TCommentSpace info -> Token_c.TCommentSpace, (Ast_c.parse_info_of_info info) | Parser_c.TCommentNewline info -> Token_c.TCommentNewline, (Ast_c.parse_info_of_info info) | Parser_c.TComment info -> Token_c.TComment, (Ast_c.parse_info_of_info info) (* the passed tokens because of our limited handling of cpp *) | Parser_c.TCommentCpp(cppcommentkind, info) -> Token_c.TCommentCpp cppcommentkind, (Ast_c.parse_info_of_info info) | _ -> raise (Impossible 61) (*****************************************************************************) (* Main entry *) (*****************************************************************************) (* right now we just add comment-like and origin-tok tokens, * as explained in token_c.ml. * * This simplified comment_annotater (compared to CComment) is really * simple as the tokens and the Ast_c.info in the asts actually share * the same refs. * So, modifying fields in the tokens will also modify the info in * the ast. Sometimes side effects simplify programming ... * We use similar tricks in unparse_c.ml. So really the asts argument * is not needed. * * ex: C1 C2 T1 T2 C3 C4 T3 C5 T4. * => infoT1(-C1C2,+), infoT2(-,+C3C4), infoT3(-C3C4,+C5), infoT4(-C5,+) *) (* let (agglomerate_either: ('a, 'a) Common.either list -> ('a list, 'a list) Common.either list) = fun xs -> raise Todo let (span_and_pack: ('a -> ('a, 'a) Common.either) -> 'a list -> ('a list, 'a list) Common.either list) = fun f_either xs -> let xs' = List.map f_either xs in agglomerate_either xs' *) (* the asts is not really used, we do all via side effect on the tokens, * which share the info reference with the elements in the ast. *) let annotate_program toks asts = (* Common.exclude_but_keep_attached gather all comments before a * token and then associates to this token those comments. Note that * if reverse the list of tokens then this function can also be used * to gather all the comments after a token :) *) (* before phase *) let toks_with_before = Common.exclude_but_keep_attached is_comment_or_space_or_stuff toks in (* after phase. trick: reverse the tokens and reuse previous func *) let toks_with_after = List.rev (List.map (function (x,l) -> (x,List.rev l)) (Common.exclude_but_keep_attached is_comment_or_space_or_stuff (List.rev toks))) in (* merge *) assert(List.length toks_with_after =|= List.length toks_with_before); Common.zip toks_with_before toks_with_after +> List.iter (fun ((t1, before), (t2, after)) -> assert(t1 =*= t2); let before' = before +> List.map convert_relevant_tokens in let after' = after +> List.map convert_relevant_tokens in let info = Token_helpers.info_of_tok t1 in info.Ast_c.comments_tag := { Ast_c.mbefore = before'; Ast_c.mafter = after'; mbefore2 = []; mafter2 = []; }; ); (* modified via side effect. I return it just to have a * clean signature. *) asts coccinelle-1.0.0-rc19/parsing_c/flag_parsing_c.ml0000644000175000017500000002132312247437436020626 0ustar eugeneugen(*****************************************************************************) (* convenient globals. *) (*****************************************************************************) let path = ref (try (Sys.getenv "YACFE_HOME") with Not_found-> "/home/pad/c-yacfe" ) (*****************************************************************************) (* macros *) (*****************************************************************************) let macro_dir = "config/macros/" let mk_macro_path ~cocci_path file = Filename.concat cocci_path (macro_dir ^ file) (* to pass to parse_c.init_defs *) let std_h = ref (mk_macro_path ~cocci_path:!path "standard.h") let common_h = ref (mk_macro_path ~cocci_path:!path "common_macros.h") let cmdline_flags_macrofile () = [ "--macro-file-builtins", Arg.Set_string std_h, " (default=" ^ !std_h ^ ")"; ] (*****************************************************************************) (* used only by cpp_ast_c, not by the parser *) (*****************************************************************************) let cpp_i_opts = ref [] let cpp_d_opts = ref [] let cmdline_flags_cpp () = [ "-D", Arg.String (fun s -> Common.push2 s cpp_d_opts), " "; "-I", Arg.String (fun s -> Common.push2 s cpp_i_opts), " " ] (*****************************************************************************) (* types *) (*****************************************************************************) let std_envir = ref (Filename.concat !path "config/envos/environment_splint.h") let cmdline_flags_envfile () = [ "--env-file", Arg.Set_string std_envir, " (default=" ^ !std_envir ^ ")"; ] (*****************************************************************************) (* show *) (*****************************************************************************) let show_parsing_error = ref true (*****************************************************************************) (* verbose *) (*****************************************************************************) let verbose_lexing = ref true let verbose_parsing = ref true let verbose_type = ref true let verbose_cfg = ref true let verbose_annotater = ref true let verbose_unparsing = ref true let verbose_visit = ref true let verbose_cpp_ast = ref true let filter_msg = ref false let filter_msg_define_error = ref false let filter_define_error = ref false let filter_passed_level = ref 0 let pretty_print_type_info = ref false let pretty_print_comment_info = ref false let pretty_print_typedef_value = ref false (* cocci specific *) let show_flow_labels = ref true let cmdline_flags_verbose () = [ "--no-verbose-parsing", Arg.Clear verbose_parsing , " "; "--no-verbose-lexing", Arg.Clear verbose_lexing , " "; "--no-verbose-annotater", Arg.Clear verbose_annotater , " "; "--no-parse-error-msg", Arg.Clear verbose_parsing, " "; "--no-type-error-msg", Arg.Clear verbose_type, " "; "--filter-msg", Arg.Set filter_msg , " filter some cpp message when the macro is a \"known\" cpp construct"; "--filter-msg-define-error",Arg.Set filter_msg_define_error, " filter the error msg"; "--filter-define-error",Arg.Set filter_define_error, " filter the error, which will not be added in the stat"; "--filter-passed-level",Arg.Set_int filter_passed_level," "; ] (*****************************************************************************) (* debugging *) (*****************************************************************************) let debug_lexer = ref false let debug_etdt = ref false let debug_typedef = ref false let debug_cpp = ref false let debug_cpp_ast = ref false let debug_unparsing = ref false let debug_cfg = ref false (* "debug C parsing/unparsing", "" *) let cmdline_flags_debugging () = [ "--debug-cpp", Arg.Set debug_cpp, " "; "--debug-lexer", Arg.Set debug_lexer , " "; "--debug-etdt", Arg.Set debug_etdt , " "; "--debug-typedef", Arg.Set debug_typedef, " "; "--debug-cfg", Arg.Set debug_cfg , " "; "--debug-unparsing", Arg.Set debug_unparsing, " "; ] (*****************************************************************************) (* checks *) (*****************************************************************************) let check_annotater = ref true let cmdline_flags_checks () = [ "--disable-check-annotater", Arg.Clear check_annotater, " "; "--enable-check-annotater", Arg.Set check_annotater, " "; ] (*****************************************************************************) (* change algorithm *) (*****************************************************************************) (* cocci specific *) let label_strategy_2 = ref false let cmdline_flags_algos () = [ "--l1", Arg.Clear label_strategy_2, " "; ] (*****************************************************************************) (* Disable parsing feature (for CC09 and also to see if useful) *) (*****************************************************************************) let cpp_directive_passing = ref false let ifdef_directive_passing = ref false let disable_multi_pass = ref false let disable_add_typedef = ref false let if0_passing = ref true let add_typedef_root = ref true (* defined and undefined constants *) let add c s = c := (Str.split (Str.regexp ",") s) @ !c let defined = ref ([] : string list) let undefined = ref ([] : string list) let cmdline_flags_parsing_algos () = [ "--directive-passing", Arg.Set cpp_directive_passing, " pass most cpp directives, especially when inside function"; "--ifdef-passing", Arg.Set ifdef_directive_passing, " pass ifdef directives "; "--noif0-passing", Arg.Clear if0_passing, " "; "--noadd-typedef-root", Arg.Clear add_typedef_root, " "; "--noadd-typedef", Arg.Set disable_add_typedef, " "; "--disable-multi-pass", Arg.Set disable_multi_pass, " "; ] (*****************************************************************************) (* other *) (*****************************************************************************) (* for compare_c *) let diff_lines = ref (None : string option) (* number of lines of context *) (* for parse_c *) let use_cache = ref false let cache_prefix = ref (None : string option) let cache_limit = ref (None : int option) let cmdline_flags_other () = [ "-U", Arg.Int (fun n -> diff_lines := Some (Common.i_to_s n)), " set number of diff context lines"; "--use-cache", Arg.Set use_cache, " use .ast_raw pre-parsed cached C file"; ] (*****************************************************************************) (* for lexing of integer constants *) (*****************************************************************************) let int_thresholds = ref (None : (int (*int_sz*) * int (*long_sz*) * Big_int.big_int (*uint threshold*) * Big_int.big_int (*long threshold*) * Big_int.big_int (*ulong threshold*)) option) let set_int_bits n = match !int_thresholds with None -> (*assume long is 2*int; this can be corrected by a subsequent long_bits*) let uint_threshold = Big_int.power_int_positive_int 2 (n-1) in let long_threshold = Big_int.power_int_positive_int 2 n in let ulong_threshold = Big_int.power_int_positive_int 2 ((2*n)-1) in int_thresholds := Some (n,2*n,uint_threshold,long_threshold,ulong_threshold) | Some(int_sz,long_sz,uint_threshold,long_threshold,ulong_threshold) -> let uint_threshold = Big_int.power_int_positive_int 2 (n-1) in let long_threshold = Big_int.power_int_positive_int 2 n in int_thresholds := Some (n,long_sz,uint_threshold,long_threshold,ulong_threshold) let set_long_bits n = match !int_thresholds with None -> (*assume int is 1/2*int; this can be corrected by a subsequent int_bits*) set_int_bits (n/2) | Some(int_sz,long_sz,uint_threshold,long_threshold,ulong_threshold) -> let ulong_threshold = Big_int.power_int_positive_int 2 (n-1) in int_thresholds := Some (int_sz,n,uint_threshold,long_threshold,ulong_threshold) (*****************************************************************************) (* unparsing strategy *) (*****************************************************************************) type spacing = LINUX | SMPL let spacing = ref LINUX let set_linux_spacing _ = spacing := LINUX (*follow the conventions of Linux*) let set_smpl_spacing _ = spacing := SMPL (*use spacing from the SP*) let max_width = 78 (*****************************************************************************) (* drop back edges made by proper loop constructs - unsafe but more efficient *) let no_loops = ref false let no_gotos = ref false let keep_comments = ref false (* unparsing *) coccinelle-1.0.0-rc19/parsing_c/type_c.ml0000644000175000017500000004151012247437436017153 0ustar eugeneugen(* Yoann Padioleau, Julia Lawall * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008, 2009 University of Urbana Champaign and DIKU * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_type (*****************************************************************************) (* Types *) (*****************************************************************************) (* What info do we want in a clean C type ? Normally it would help * if we remove some of the complexity of C with for instance typedefs * by expanding those typedefs or structname and enumname to their * final value. Then, when we do pattern matching we can conveniently forget * to handle the typedef, enumname and similar cases. But sometimes, * in coccinelle for instance, we want to keep some of those original * info. So right now we have a in-the-middle solution by keeping * the original typename in the ast and expanding some of them * in the type_annotation phase. We don't do this expansion for * structname because usually when we have a struct we actually * prefer to just have the structname. It's only when we access * field that we need that information, but the type_annotater has * already done this job so no need in the parent expression to know * the full definition of the structure. But for typedef, this is different. * * So really the finalType we want, the completed_type notion below, * corresponds to a type we think is useful enough to work on, to do * pattern matching on, and one where we have all the needed information * and we don't need to look again somewhere else to get the information. * * * * * todo? define a new clean fulltype ? as julia did with type_cocci.ml * without the parsing info, with some normalization (for instance have * only structUnionName and enumName, and remove the ParenType), some * abstractions (don't care for instance about name in parameters of * functionType, or size of array), and with new types such as Unknown * or PartialFunctionType (when don't have type of return when infer * the type of function call not based on type of function but on the * type of its arguments). * * * *) type finalType = Ast_c.fullType type completed_and_simplified = Ast_c.fullType type completed_typedef = Ast_c.fullType type removed_typedef = Ast_c.fullType (* move in ast_c ? * use Ast_c.nQ, Ast_c.defaultInt, Ast_c.emptyAnnotCocci, * Ast_c.emptyMetavarsBinding, Ast_c.emptyComments *) let mk_fulltype bt str = Ast_c.mk_ty (Ast_c.BaseType bt) [Ast_c.al_info 0 (* al *) {Ast_c.pinfo = Ast_c.OriginTok {Common.str = str; Common.charpos = 0; Common.line = -1; Common.column = -1; Common.file = ""}; Ast_c.cocci_tag = {contents = Some (Ast_cocci.CONTEXT (Ast_cocci.NoPos, Ast_cocci.NOTHING), [])}; Ast_c.annots_tag = Token_annot.empty; Ast_c.comments_tag = {contents = {Ast_c.mbefore = []; Ast_c.mafter = []; Ast_c.mbefore2 = []; Ast_c.mafter2 = [] }}}] let (int_type: Ast_c.fullType) = (* Lib_parsing_c.al_type (Parse_c.type_of_string "int")*) mk_fulltype (Ast_c.IntType (Ast_c.Si (Ast_c.Signed, Ast_c.CInt))) "int" let (ptr_diff_type: Ast_c.fullType) = (* Lib_parsing_c.al_type (Parse_c.type_of_string "int")*) mk_fulltype Ast_c.PtrDiffType "ptrdiff_t" (* normally if the type annotated has done a good job, this should always * return true. Cf type_annotater_c.typedef_fix. *) let rec is_completed_and_simplified ty = match Ast_c.unwrap_typeC ty with | NoType -> true | BaseType x -> true | Pointer t -> is_completed_and_simplified t | Array (e, t) -> is_completed_and_simplified t | Decimal (len, prec_opt) -> true | StructUnion (su, sopt, fields) -> (* recurse fields ? Normally actually don't want, * prefer to have a StructUnionName when it's possible *) (match sopt with | None -> true | Some _ -> false (* should have transformed it in a StructUnionName *) ) | FunctionType ft -> (* todo? return type is completed ? params completed ? *) true | Enum (s, enumt) -> true | EnumName s -> true (* we prefer StructUnionName to StructUnion when it comes to typed metavar *) | StructUnionName (su, s) -> true (* should have completed with more information *) | TypeName (_name, typ) -> (match typ with | None -> false | Some t -> (* recurse cos what if it's an alias of an alias ? *) is_completed_and_simplified t ) (* should have removed paren, for better matching with typed metavar. * kind of iso again *) | ParenType t -> false (* same *) | TypeOfType t -> false | TypeOfExpr e -> true (* well we don't handle it, so can't really say it's completed *) let is_completed_typedef_fullType x = raise Todo let is_removed_typedef_fullType x = raise Todo (*****************************************************************************) (* more "virtual" fulltype, the fullType_with_no_typename *) (*****************************************************************************) let remove_typedef x = raise Todo (*****************************************************************************) (* expression exp_info annotation vs finalType *) (*****************************************************************************) (* builders, needed because julia added gradually more information in * the expression reference annotation in ast_c. *) let make_info x = (Some x, Ast_c.NotTest) let make_exp_type t = (t, Ast_c.NotLocalVar) let make_info_def t = make_info (make_exp_type t) let noTypeHere = (None, Ast_c.NotTest) let do_with_type f (t,_test) = match t with | None -> noTypeHere | Some (t,_local) -> f t let get_opt_type e = match Ast_c.get_type_expr e with | Some (t,_), _test -> Some t | None, _test -> None (*****************************************************************************) (* Normalizers *) (*****************************************************************************) let structdef_to_struct_name ty = let (qu, tybis) = ty in match Ast_c.unwrap_typeC ty with | (StructUnion (su, sopt, fields)) -> let iis = Ast_c.get_ii_typeC_take_care tybis in (match sopt, iis with (* todo? but what if correspond to a nested struct def ? *) | Some s , [i1;i2;i3;i4] -> qu, Ast_c.mk_tybis (StructUnionName (su, s)) [i1;i2] | None, _ -> ty | x -> raise (Impossible 126) ) | _ -> raise (Impossible 127) (*****************************************************************************) (* Helpers *) (*****************************************************************************) let type_of_function (def,ii) = let ftyp = def.f_type in (* could use the info in the 'ii' ? *) let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake_oparen = Ast_c.rewrap_str "(" fake in let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake_cparen = Ast_c.rewrap_str ")" fake in Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen] (* pre: only a single variable *) let type_of_decl decl = match decl with | Ast_c.DeclList (xs,ii1) -> (match xs with | [] -> raise (Impossible 128) (* todo? for other xs ? *) | (x,ii2)::xs -> let {v_namei = _var; v_type = v_type; v_storage = (_storage,_inline)} = x in (* TODO normalize ? what if nested structure definition ? *) v_type ) | Ast_c.MacroDecl _ | Ast_c.MacroDeclInit _ -> pr2_once "not handling MacroDecl type yet"; raise Todo (* pre: it is indeed a struct def decl, and only a single variable *) let structdef_of_decl decl = match decl with | Ast_c.DeclList (xs,ii1) -> (match xs with | [] -> raise (Impossible 129) (* todo? for other xs ? *) | (x,ii2)::xs -> let {v_namei = var; v_type = v_type; v_storage = (storage,inline)} = x in (match Ast_c.unwrap_typeC v_type with | Ast_c.StructUnion (su, _must_be_some, fields) -> (su, fields) | _ -> raise (Impossible 130) ) ) | Ast_c.MacroDecl _ | Ast_c.MacroDeclInit _ -> raise (Impossible 131) (*****************************************************************************) (* Type builder *) (*****************************************************************************) let (fake_function_type: fullType option -> argument wrap2 list -> fullType option) = fun rettype args -> let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake_oparen = Ast_c.rewrap_str "(" fake in let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake_cparen = Ast_c.rewrap_str ")" fake in let (tyargs: parameterType wrap2 list) = args +> Common.map_filter (fun (arg,ii) -> match arg with | Left e -> (match Ast_c.get_onlytype_expr e with | Some ft -> let paramtype = { Ast_c.p_namei = None; p_register = false, Ast_c.noii; p_type = ft; } in Some (paramtype, ii) | None -> None ) | Right _ -> None ) in if List.length args <> List.length tyargs then None else rettype +> Common.map_option (fun rettype -> let (ftyp: functionType) = (rettype, (tyargs, (false,[]))) in let (t: fullType) = Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen] in t ) (*****************************************************************************) (* Typing rules *) (*****************************************************************************) (* todo: the rules are far more complex, but I prefer to simplify for now. * todo: should take operator as a parameter. * * todo: Also need handle pointer arithmetic! the type of 'pt + 2' * is still the type of pt. cf parsing_cocci/type_infer.ml * * (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *) * | (T.Pointer(ty1),T.Pointer(ty2)) -> * T.Pointer(loop(ty1,ty2)) * | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2) * | (T.Pointer(ty1),ty2) -> T.Pointer(ty1) * *) let lub op t1 t2 = let ftopt = match t1, t2 with | None, None -> None | Some t, None -> Some t | None, Some t -> Some t (* check equal ? no cos can have pointer arithmetic so t2 can be <> t1 * * todo: right now I favor the first term because usually pointer * arithmetic are written with the pointer in the first position. * * Also when an expression contain a typedef, as in * 'dma_addr + 1' where dma_addr was declared as a variable * of type dma_addr_t, then again I want to have in the lub * the typedef and it is often again in the first position. * *) | Some t1, Some t2 -> let t1bis = Ast_c.unwrap_typeC t1 in let t2bis = Ast_c.unwrap_typeC t2 in (* a small attempt to do better, no consideration of typedefs *) (match op, t1bis, t2bis with (* these rules follow ANSI C. See eg: http://flexor.uwaterloo.ca/library/SGI_bookshelves/SGI_Developer/books/CLanguageRef/sgi_html/ch05.html *) _,Ast_c.BaseType(bt1),Ast_c.BaseType(bt2) -> (match bt1,bt2 with Ast_c.Void,_ -> Some t2 (* something has gone wrong *) | _,Ast_c.Void -> Some t1 (* something has gone wrong *) | Ast_c.FloatType(Ast_c.CLongDouble),_ -> Some t1 | _,Ast_c.FloatType(Ast_c.CLongDouble) -> Some t2 | Ast_c.FloatType(Ast_c.CDouble),_ -> Some t1 | _,Ast_c.FloatType(Ast_c.CDouble) -> Some t2 | Ast_c.FloatType(Ast_c.CFloat),_ -> Some t1 | _,Ast_c.FloatType(Ast_c.CFloat) -> Some t2 | Ast_c.PtrDiffType,_ -> Some t1 | _,Ast_c.PtrDiffType -> Some t2 | Ast_c.SSizeType,_ -> Some t1 | _,Ast_c.SSizeType -> Some t2 | Ast_c.SizeType,_ -> Some t1 | _,Ast_c.SizeType -> Some t2 | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLongLong)),_ -> Some t1 | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLongLong)) -> Some t2 | Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLongLong)),_ -> Some t1 | _,Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLongLong)) -> Some t2 | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLong)),_ -> Some t1 | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLong)) -> Some t2 | Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLong)),_ -> Some t1 | _,Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLong)) -> Some t2 | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CInt)),_ -> Some t1 | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CInt)) -> Some t2 | _ -> Some int_type) | Ast_c.Plus,Ast_c.Pointer _,Ast_c.BaseType(Ast_c.IntType _) -> Some t1 | Ast_c.Plus,Ast_c.BaseType(Ast_c.IntType _),Ast_c.Pointer _ -> Some t2 | Ast_c.Minus,Ast_c.Pointer _,Ast_c.BaseType(Ast_c.IntType _) -> Some t1 | Ast_c.Minus,Ast_c.BaseType(Ast_c.IntType _),Ast_c.Pointer _ -> Some t2 | Ast_c.Minus,(Ast_c.Pointer _ | Ast_c.Array _), (Ast_c.Pointer _ | Ast_c.Array _) -> Some ptr_diff_type (* todo, Pointer, Typedef, etc *) | _, _, _ -> Some t1 ) in match ftopt with | None -> None, Ast_c.NotTest | Some ft -> Some (ft, Ast_c.NotLocalVar), Ast_c.NotTest (*****************************************************************************) (* type lookup *) (*****************************************************************************) (* old: was using some nested find_some, but easier use ref * update: handling union (used a lot in sparse) * note: it is independent of the environment. *) let (type_field: string -> (Ast_c.structUnion * Ast_c.structType) -> Ast_c.fullType) = fun fld (su, fields) -> let res = ref [] in let rec aux_fields fields = fields +> List.iter (fun x -> match x with | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) -> onefield_multivars +> List.iter (fun (fieldkind, iicomma) -> match fieldkind with | Simple (Some name, t) | BitField (Some name, t, _, _) -> let s = Ast_c.str_of_name name in if s =$= fld then Common.push2 t res else () | Simple (None, t) -> (match Ast_c.unwrap_typeC t with (* union *) | StructUnion (Union, _, fields) -> aux_fields fields (* Special case of nested structure definition inside * structure without associated field variable as in * struct top = { ... struct xx { int subfield1; ... }; ... } * cf sparse source, where can access subfields directly. * It can also be used in conjunction with union. *) | StructUnion (Struct, _, fields) -> aux_fields fields | _ -> () ) | _ -> () ) | EmptyField info -> () | MacroDeclField _ -> pr2_once "DeclTodo"; () | CppDirectiveStruct _ | IfdefStruct _ -> pr2_once "StructCpp"; ) in aux_fields fields; match !res with | [t] -> t | [] -> raise Not_found | x::y::xs -> pr2 ("MultiFound field: " ^ fld) ; x (*****************************************************************************) (* helpers *) (*****************************************************************************) (* was in aliasing_function_c.ml before*) (* assume normalized/completed ? so no ParenType handling to do ? *) let rec is_function_type x = match Ast_c.unwrap_typeC x with | FunctionType _ -> true | _ -> false (* assume normalized/completed ? so no ParenType handling to do ? *) let rec function_pointer_type_opt x = match Ast_c.unwrap_typeC x with | Pointer y -> (match Ast_c.unwrap_typeC y with | FunctionType ft -> Some ft (* fix *) | TypeName (_name, Some ft2) -> (match Ast_c.unwrap_typeC ft2 with | FunctionType ft -> Some ft | _ -> None ) | _ -> None ) (* bugfix: for many fields in structure, the field is a typename * like irq_handler_t to a function pointer *) | TypeName (_name, Some ft) -> function_pointer_type_opt ft (* bugfix: in field, usually it has some ParenType *) | ParenType ft -> function_pointer_type_opt ft | _ -> None coccinelle-1.0.0-rc19/parsing_c/cpp_analysis_c.ml0000644000175000017500000003412312247437436020661 0ustar eugeneugenopen Common open Oset open Parser_c (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* * Is this module make all the tricks used in parsing_hacks and * most definitions in standard.h obsolete ? It depends. In a * static analysis context we want to be accurate, and so expand * all the code that will make our type/callgraph analysis simpler. * So we want to expand many macros, based on heuristics in this file. * In a transformation context, we want to let the programmer * match over certain constructs such as declarator, iterator, * macro_field, etc, and in this case we want to parse as-is. * * What could be done is that some of the analysis performed in this * file could then be injected in parsing_hacks, for instance via * hints, to make the parse as-is job easier too. * * * * todo: right now I find dangerous macro based on ## and go upward * to also include calling macros. But this dangerous macro itself * may use other macros that looks ok but that should also be expanded * because it defines some entities. So also recurse downward ? * * todo? do analysis a la Astec ? try infer the meaning of the macro * from its body but also from its context of use ? Can then * do a taxonomy of macro ? not just foreach or declarator but * polymorphic function (e.g. MAX), type generator, etc. Cf astec paper * or Ernst cpp study paper ? * *) (*****************************************************************************) (* Types *) (*****************************************************************************) (* callgraph of macros *) type key = string type node = (Common.filename * Cpp_token_c.define_def) list ref type edge = Direct type callgraph_macros = (key, node, edge) Ograph_simple.ograph_mutable let rootname = "__ROOT__" (*****************************************************************************) (* Helpers *) (*****************************************************************************) let bodytoks_of_body body = match body with | Cpp_token_c.DefineHint _ -> pr2 "weird, hint in cpp_analysis_c"; [] | Cpp_token_c.DefineBody xs -> xs let build_empty_set () = new Osetb.osetb Setb.empty (*****************************************************************************) (* Builder *) (*****************************************************************************) let build_callgraph_macros xs = let (g: callgraph_macros) = new Ograph_simple.ograph_mutable in g#add_node rootname (ref []); (* build nodes *) xs +> List.iter (fun (file, (x, def)) -> (* todo? if exist already ? *) g#add_node x (ref []); g#add_arc (rootname, x) Direct; ); xs +> List.iter (fun (file, (x, def)) -> let node = g#nodes#find x in Common.push2 (file, def) node; ); (* build edges *) xs +> List.iter (fun (file, (x, def)) -> let (s, params, body) = def in let toks = bodytoks_of_body body in toks +> List.iter (fun tok -> match tok with | TIdent (x2,ii) -> (try let _ = g#nodes#find x2 in g#add_arc (x, x2) Direct; with Not_found -> () ) | _ -> () ); ); g (* ---------------------------------------------------------------------- *) let check_no_loop_graph g = let self_referential = ref [] in let macros_in_loop_with_path = ref [] in let already = Hashtbl.create 101 in let already_error_msg = Hashtbl.create 101 in let rec aux_dfs path xi = if Hashtbl.mem already xi && List.mem xi path then begin let node = g#nodes#find xi in let file = match !node with | (file, _)::xs -> file | [] -> raise (Impossible 74) in (* in apache/srclib/apr/include/arch/win32/apr_dbg_win32_handles.h * we get some __ROOT__ -> CreateMutexA -> CreateMutexA because * the macro is self referential. Probably cpp has * some special handling of such case and does not expand * recursively. * *) let is_self_reference = match xi::path with | x::y::z -> x = y | _ -> false in if not is_self_reference && not (Hashtbl.mem already_error_msg xi) then begin Hashtbl.add already_error_msg xi true; pr2 (spf "PB: loop in macro %s of file %s" xi file); pr2 (spf "path is: %s" (Common.join " -> " (List.rev (xi::path)))); Common.push2 (xi, path) macros_in_loop_with_path; end else begin Common.push2 xi self_referential; end end else begin Hashtbl.add already xi true; (* f xi path; *) let succ = g#successors xi in let succ' = succ#tolist +> List.map fst in succ' +> List.iter (fun yi -> aux_dfs (xi::path) yi ); end in aux_dfs [] rootname; !self_referential, !macros_in_loop_with_path (* ---------------------------------------------------------------------- *) let slice_of_callgraph_macros (g: callgraph_macros) goodnodes = let (g': callgraph_macros) = new Ograph_simple.ograph_mutable in goodnodes#tolist +> List.iter (fun k -> let v = g#nodes#find k in g'#add_node k v; ); goodnodes#tolist +> List.iter (fun k -> let succ = g#successors k in let succ = Oset.mapo (fun (k', edge) -> k') (build_empty_set()) succ in let inter = succ $**$ goodnodes in inter#tolist +> List.iter (fun k' -> g'#add_arc (k, k') Direct; ) ); g' (*****************************************************************************) (* Macros expansion *) (*****************************************************************************) (* get the longuest one ? or the one that contains the dangerous macro ? *) let get_single_file_and_def_of_node k v = match !v with | [] -> raise (Impossible 75) | [file, def] -> file, def | (file, def)::y::ys -> pr2 (spf "multiple def for %s but I kept only one" k); file, def module TV = Token_views_c let (macro_expand: (string, Cpp_token_c.define_def) Hashtbl.t -> Cpp_token_c.define_def -> Cpp_token_c.define_def) = fun current_def def -> let (s, params, body) = def in let body' = match body with | Cpp_token_c.DefineHint _ -> body | Cpp_token_c.DefineBody xs -> (* bugfix: we dont want to evalute the x ## b at this moment. * so can not use fix_tokens_cpp in the same we use it * to parse C code. let xs' = Parsing_hacks.fix_tokens_cpp ~macro_defs:current_def xs in *) let tokens = xs in let tokens2 = ref (tokens +> Common.acc_map TV.mk_token_extended) in let cleaner = !tokens2 +> Parsing_hacks.filter_cpp_stuff in let paren_grouped = TV.mk_parenthised cleaner in Cpp_token_c.apply_macro_defs ~msg_apply_known_macro:(fun s2 -> pr2 (spf "APPLYING: %s in definition of %s" s2 s)) ~msg_apply_known_macro_hint:(fun s -> pr2 "hint") ~evaluate_concatop:false ~inplace_when_single:false current_def paren_grouped; (* because the before field is used by apply_macro_defs *) tokens2 := TV.rebuild_tokens_extented !tokens2; (* bugfix *) let cleaner = !tokens2 +> Parsing_hacks.filter_cpp_stuff in let xs' = Parsing_hacks.insert_virtual_positions (cleaner +> Common.acc_map (fun x -> x.TV.tok)) in Cpp_token_c.DefineBody xs' in (s, params, body') (* work by side effect as both the binding and callgraph are mutable * data structure *) let no_inlining = ref false let rec (recurse_expand_macro_topological_order: int -> (string, Cpp_token_c.define_def) Hashtbl.t -> callgraph_macros -> unit) = fun depth current_def g -> (* naive: *) if !no_inlining then g#nodes#tolist +> List.iter (fun (k, v) -> if k =$= rootname then () else let def = get_single_file_and_def_of_node k v +> snd in Hashtbl.add current_def k def ) else let remaining = g#nodes#tolist in (match remaining with | [] -> () (* christia: commented this out: raise (Impossible 76) * This seems to be the case when there are no * problematic macros. Which is possible. *) | [(k,n)] -> assert (k = rootname); (* end recursion *) () | (k, v)::y::xs -> let leafs = (g#leaf_nodes ())#tolist in pr2 (spf "step: %d, %s" depth (leafs +> Common.join " ")); Ograph_simple.print_ograph_generic ~str_of_key:(fun k -> k) ~str_of_node:(fun k node -> k) (spf "/tmp/graph-%d.dot" depth) g; assert(not (null leafs)); (* little specialisation to avoid useless work *) if depth = 0 then begin leafs +> List.iter (fun k -> let node = g#nodes#find k in let def = get_single_file_and_def_of_node k node +> snd in Hashtbl.add current_def k def ) end else begin let new_defs = leafs +> List.map (fun k -> let node = g#nodes#find k in let def = get_single_file_and_def_of_node k node +> snd in let def' = macro_expand current_def def in k, def' ) in new_defs +> List.iter (fun (k,def) -> Hashtbl.add current_def k def); end; leafs +> List.iter (fun k -> g#del_leaf_node_and_its_edges k); recurse_expand_macro_topological_order (depth+1) current_def g; ) (*****************************************************************************) (* Macros def analysis *) (*****************************************************************************) let is_dangerous_macro def = let (s, params, body) = def in let toks = bodytoks_of_body body in (match params, body with (* ex: APU_DECLARE_DATA *) | Cpp_token_c.NoParam, Cpp_token_c.DefineBody [] -> if s =~ ".*_H_*" then false else true (* ex: AP_DECLARE(x) x *) | Cpp_token_c.Params([s1]), Cpp_token_c.DefineBody [TIdent (s2,i1)] -> (match s1 with Cpp_token_c.FixedArg s1 -> s1 =$= s2 | Cpp_token_c.VariadicArg _ -> false) (* keyword aliases. eg: APR_inline __inline__ *) | Cpp_token_c.NoParam, Cpp_token_c.DefineBody [x] -> (match x with | Tinline _ -> true | Tconst _ -> true | Tstatic _ -> true | Textern _ -> true | _ -> false ) | _ , Cpp_token_c.DefineBody xs -> (match List.rev xs with (* make extract_macros looping on apache, get some infinite "step x" *) | TPtVirg _::_ -> true | _ -> false ) | _ -> false ) || (toks +> List.exists (fun tok -> match tok with | TCppConcatOp _ -> true | Tattribute (ii) -> true | TattributeNoarg (ii) -> true (* FP with local variable. | TIdent (s,ii) -> s ==~ Parsing_hacks.regexp_annot && not (List.mem s ["__FILE__";"__LINE__";"__FUNCTION__"]) *) | _ -> false )) let is_trivial_macro def = let (s, params, body) = def in match params, body with | Cpp_token_c.NoParam, Cpp_token_c.DefineBody [Parser_c.TInt _] (* no!!! those are not trivial macro, they are dangerous too. | Cpp_token_c.NoParam, Cpp_token_c.DefineBody [] -> true *) | _ -> false (* | () when s ==~ Parsing_hacks.regexp_annot -> true | () when List.exists (function (*| Parser_c.Tattribute _ -> true*) | Parser_c.TCppConcatOp _ -> true | _ -> false) bodytoks -> true | () -> false in *) (*****************************************************************************) (* Main entry point *) (*****************************************************************************) let extract_dangerous_macros xs = (* prepare initial set of macro definitions to work on *) let all_macros = xs +> List.map (fun (file, defs) -> defs +> List.map (fun def -> file, def) ) +> List.flatten in let macros = all_macros +> Common.exclude(fun (file,(x,def)) -> is_trivial_macro def) in (* initial set of problematic macros *) let problematic_macros = macros +> Common.filter (fun (file, (x, def)) -> is_dangerous_macro def) in (* include the ancestors of problematic macros *) let g = build_callgraph_macros macros in let self_referiential, macros_in_loop_with_path = check_no_loop_graph g in Ograph_simple.print_ograph_generic ~str_of_key:(fun k -> k) ~str_of_node:(fun k node -> k) "/tmp/graph.dot" g; let start = problematic_macros +> List.map (fun (file, (x, def)) -> x) +> Common.nub in let finalset = start +> List.fold_left (fun acc x -> if List.exists (fun y -> fst y = x) macros_in_loop_with_path || List.mem x self_referiential then begin pr2 (spf "PB: ignoring %s macro as it is in a loop" x); acc end else let acc = acc#add x in let ancestors = g#ancestors x in acc $++$ ancestors ) (build_empty_set ()) in (* Now prepare for fixpoint expansion of macros to avoid doing * the work in cpp_engine. *) let sliced_g = slice_of_callgraph_macros g finalset in Ograph_simple.print_ograph_generic ~str_of_key:(fun k -> k) ~str_of_node:(fun k node -> k) "/tmp/graph2.dot" sliced_g; (* do fixpoint expansion *) let (binding: (string, Cpp_token_c.define_def) Hashtbl.t) = Hashtbl.create 101 in (* work by side effects on the hashtbl and graph *) recurse_expand_macro_topological_order 0 binding sliced_g; (* prepare final result *) let final_macros = binding +> Common.hash_to_list +> List.map (fun (x, def) -> let node = g#nodes#find x in let file = get_single_file_and_def_of_node x node +> fst in (file, (x, def)) ) in pr2 (spf "total macros numbers: %d" (List.length all_macros)); pr2 (spf "problematic macros numbers: %d" (List.length problematic_macros)); pr2 (spf "final (after closure) problematic macros numbers: %d" (List.length final_macros)); let grouped = Common.group_assoc_bykey_eff final_macros in grouped coccinelle-1.0.0-rc19/parsing_c/unparse_hrule.ml0000644000175000017500000004516712247437436020560 0ustar eugeneugen(* * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007 Julia Lawall * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. * * This file was part of Coccinelle. *) module Ast = Ast_cocci module V = Visitor_ast let error x s = failwith (Printf.sprintf "unparse_hrule: line: %d, %s" (Ast.get_line x) s) let names = ref ([] : (string * int ref) list) let started_files = ref ([] : (string * bool) list) let typedefs = ref ([] : (string * string list ref) list) let current_outfile = ref "" let prefix = "_cocci_" (* ----------------------------------------------------------------------- *) (* Create rule to check for header include *) let print_header_rule pr srcfile = match Str.split (Str.regexp "/") srcfile with [x] -> pr "@header@\n@@\n\n#include \""; pr x; pr "\"\n\n"; true | l -> let rec loop = function [] -> false | [x] -> pr "@header@\n@@\n\n#include \""; pr x; pr "\"\n\n"; true | "include"::(x::xs) -> pr "@header@\n@@\n\n#include <"; let x = if Str.string_match (Str.regexp "asm-") x 0 then "asm" else x in pr (String.concat "/" (x::xs)); pr ">\n\n"; true | x::xs -> loop xs in loop l (* ----------------------------------------------------------------------- *) (* Print check that we are not in the defining function *) let print_check_rule pr function_name function_name_count header_req = (if header_req then pr (Printf.sprintf "@same_%s depends on header@\n" function_name_count) else pr (Printf.sprintf "@same_%s@\n" function_name_count)); pr "position p;\n"; pr "@@\n\n"; pr function_name; pr "@p(...) { ... }\n\n" (* ----------------------------------------------------------------------- *) (* get parameters of the matched function *) let rec env_lookup fn = function [] -> failwith "no binding" | (nm,vl)::rest when fn nm -> vl | _::rest -> env_lookup fn rest let get_paramst env = let argname = ref ("","") in let fn ((_,nm) as name) = if nm = "ARGS" then (argname := name; true) else false in match env_lookup fn env with Ast_c.MetaParamListVal(paramst) -> (paramst,!argname) | _ -> failwith "not possible" let get_function_name rule env = let donothing r k e = k e in let option_default = [] in let bind = Common.union_set in let do_any_list_list r any_list_list = List.fold_left (List.fold_left (function prev -> function cur -> bind (r.V.combiner_anything cur) prev)) [] any_list_list in let mcode r mc = match Ast.get_mcodekind mc with Ast.MINUS(_,_,_,any_list_list) -> (match any_list_list with Ast.NOREPLACEMENT -> [] | Ast.REPLACEMENT(any_list_list,_) -> do_any_list_list r any_list_list) | Ast.CONTEXT(_,any_befaft) -> (match any_befaft with Ast.BEFORE(any_list_list,_) | Ast.AFTER(any_list_list,_) -> do_any_list_list r any_list_list | Ast.BEFOREAFTER(ba,aa,_) -> bind (do_any_list_list r ba) (do_any_list_list r aa) | Ast.NOTHING -> []) | Ast.PLUS _ -> [] in let expression r k e = bind (k e) (match Ast.unwrap e with Ast.FunCall(fn,lp,args,rp) -> (match Ast.undots args with [e] -> (match Ast.unwrap e with Ast.MetaExprList(nm,_,_,_) -> (match (Ast.unwrap_mcode nm,Ast.get_mcodekind nm) with ((_,"ARGS"), Ast.PLUS _) -> (match Ast.unwrap fn with Ast.Ident(id) -> (match Ast.unwrap id with Ast.MetaId(nm,_,_,_) | Ast.MetaFunc(nm,_,_,_) | Ast.MetaLocalFunc(nm,_,_,_) -> [Ast.unwrap_mcode nm] | _ -> []) | _ -> []) | _ -> []) | _ -> []) | _ -> []) | _ -> []) in let names = (V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing expression donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing).V.combiner_top_level rule in match names with [name] -> (match env_lookup (function nm -> nm = name) env with Ast_c.MetaIdVal(s,_) | Ast_c.MetaFuncVal(s) | Ast_c.MetaLocalFuncVal(s) -> s | _ -> error rule "not possible") | _ -> error rule "inconsistent rule generation" (* ----------------------------------------------------------------------- *) (* Print metavariable declarations *) let rec print_typedef pr = function (Ast_c.TypeName(name,_),_) -> let s = Ast_c.str_of_name name in let typedefs = try List.assoc !current_outfile !typedefs with Not_found -> let td = ref [] in typedefs := (!current_outfile,td)::!typedefs; td in if not (List.mem s !typedefs) then (typedefs := s::!typedefs; pr "typedef "; pr s; pr ";\n") | (Ast_c.Pointer(_,ty),_) -> print_typedef pr ty | _ -> () let rewrap_str s ii = {ii with Ast_c.pinfo = (match ii.Ast_c.pinfo with Ast_c.OriginTok pi -> Ast_c.OriginTok { pi with Common.str = s;} | Ast_c.ExpandedTok (pi,vpi) -> Ast_c.ExpandedTok ({ pi with Common.str = s;},vpi) | Ast_c.FakeTok (_,vpi) -> Ast_c.FakeTok (s,vpi) | Ast_c.AbstractLineTok pi -> Ast_c.AbstractLineTok { pi with Common.str = s;})} let rewrap_prefix_name prefix name = match name with | Ast_c.RegularName (s, iiname) -> let iis = Common.tuple_of_list1 iiname in let iis' = rewrap_str (prefix^s) iis in Ast_c.RegularName (prefix ^ s, [iis']) | Ast_c.CppConcatenatedName _ | Ast_c.CppVariadicName _ | Ast_c.CppIdentBuilder _ -> raise Common.Todo let print_metavar pr = function | {Ast_c.p_namei = Some name; p_type = (_,(Ast_c.Pointer(_,(Ast_c.BaseType(Ast_c.Void),_)),_)); } -> let param = Ast_c.str_of_name name in pr ("expression "^prefix); pr param | ({Ast_c.p_namei = Some name; p_type = (_,ty)} : Ast_c.parameterType) -> let name' = rewrap_prefix_name prefix name in print_typedef pr ty; Pretty_print_c.pp_param_gen (function x -> let str = Ast_c.str_of_info x in if not (List.mem str ["const";"volatile"]) then pr str) (function _ -> pr " ") {Ast_c.p_register = (false,[]); p_namei = Some name'; p_type = (({Ast_c.const = false; Ast_c.volatile = false},[]),ty) } | _ -> failwith "function must have named parameters" let make_exp = function ({Ast_c.p_namei = Some name; p_type = ty}, comma_ii) -> let no_info = (None,Ast_c.NotTest) in let name' = rewrap_prefix_name prefix name in let exp = ((Ast_c.Ident (name'),ref no_info),Ast_c.noii) in (name,(Common.Left exp,comma_ii)) | _ -> failwith "bad parameter" let print_extra_typedefs pr env = let bigf = { Visitor_c.default_visitor_c with Visitor_c.ktype = (fun (k, bigf) ty -> match ty with (_,((Ast_c.TypeName(_,_),_) as ty)) -> print_typedef pr ty | _ -> k ty) } in List.iter (function (_,vl) -> match vl with Ast_c.MetaIdVal(_) | Ast_c.MetaFuncVal(_) | Ast_c.MetaLocalFuncVal(_) -> () | Ast_c.MetaExprVal(exp,_) -> Visitor_c.vk_expr bigf exp | Ast_c.MetaExprListVal(args) -> Visitor_c.vk_argument_list bigf args | Ast_c.MetaParamVal(param) -> Visitor_c.vk_param bigf param | Ast_c.MetaParamListVal(params) -> Visitor_c.vk_param_list bigf params | Ast_c.MetaTypeVal(ty) -> Visitor_c.vk_type bigf ty | Ast_c.MetaInitVal(ty) -> Visitor_c.vk_ini bigf ty | Ast_c.MetaInitListVal(ty) -> Visitor_c.vk_ini_list bigf ty | Ast_c.MetaDeclVal(decl) -> Visitor_c.vk_decl bigf decl | Ast_c.MetaFieldVal(field) -> Visitor_c.vk_struct_field bigf field | Ast_c.MetaFieldListVal(fields) -> Visitor_c.vk_struct_fields bigf fields | Ast_c.MetaFmtVal(fmt) -> Visitor_c.vk_string_format bigf fmt | Ast_c.MetaFragListVal(frags) -> Visitor_c.vk_string_fragments bigf frags | Ast_c.MetaStmtVal(stm) -> Visitor_c.vk_statement bigf stm | Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _ | Ast_c.MetaListlenVal _ -> ()) env let rename argids env = let argenv = List.map (function name -> let arg = Ast_c.str_of_name name in (arg,prefix^arg) ) argids in let lookup x = try List.assoc x argenv with Not_found -> x in let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kexpr_s = (fun (k,bigf) e -> match e with ((Ast_c.Ident (name), info), []) -> (* pad: assert is_regular_ident ? *) let s = Ast_c.str_of_name name in let ii = Ast_c.info_of_name name in let new_name = lookup s in let new_id = Ast_c.RegularName (new_name, [rewrap_str new_name ii]) in ((Ast_c.Ident (new_id), info), Ast_c.noii) | _ -> k e) } in List.map (function (x,vl) -> (x, match vl with Ast_c.MetaIdVal(_) | Ast_c.MetaFuncVal(_) | Ast_c.MetaLocalFuncVal(_) -> vl | Ast_c.MetaExprVal(exp,c) -> Ast_c.MetaExprVal(Visitor_c.vk_expr_s bigf exp,c) | Ast_c.MetaExprListVal(args) -> Ast_c.MetaExprListVal(Visitor_c.vk_arguments_s bigf args) | Ast_c.MetaParamVal(param) -> Ast_c.MetaParamVal(Visitor_c.vk_param_s bigf param) | Ast_c.MetaParamListVal(params) -> Ast_c.MetaParamListVal(Visitor_c.vk_params_s bigf params) | Ast_c.MetaTypeVal(ty) -> Ast_c.MetaTypeVal(Visitor_c.vk_type_s bigf ty) | Ast_c.MetaInitVal(ini) -> Ast_c.MetaInitVal(Visitor_c.vk_ini_s bigf ini) | Ast_c.MetaInitListVal(ini) -> Ast_c.MetaInitListVal(Visitor_c.vk_inis_s bigf ini) | Ast_c.MetaDeclVal(stm) -> Ast_c.MetaDeclVal(Visitor_c.vk_decl_s bigf stm) | Ast_c.MetaFieldVal(stm) -> Ast_c.MetaFieldVal(Visitor_c.vk_struct_field_s bigf stm) | Ast_c.MetaFieldListVal(stm) -> Ast_c.MetaFieldListVal(Visitor_c.vk_struct_fields_s bigf stm) | Ast_c.MetaFmtVal(fmt) -> Ast_c.MetaFmtVal(Visitor_c.vk_string_format_s bigf fmt) | Ast_c.MetaFragListVal(frags) -> Ast_c.MetaFragListVal(Visitor_c.vk_string_fragments_s bigf frags) | Ast_c.MetaStmtVal(stm) -> Ast_c.MetaStmtVal(Visitor_c.vk_statement_s bigf stm) | Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _ | Ast_c.MetaListlenVal _ -> vl)) env let print_one_type pr env = function (Type_cocci.MetaType(name,keep,inherited)) as ty -> (try match List.assoc name env with Ast_c.MetaTypeVal ty -> Pretty_print_c.pp_type_gen (function x -> pr (Ast_c.str_of_info x)) (function _ -> pr " ") ty | _ -> failwith "impossible" with Not_found -> pr (Type_cocci.type2c ty)) | ty -> pr (Type_cocci.type2c ty) let print_types pr env = function None -> () | Some [ty] -> print_one_type pr env ty | Some types -> pr "{"; Common.print_between (function _ -> pr ", ") (print_one_type pr env) types; pr "}" let pp_len pr len = let pp_name (_,n) = pr n in match len with Ast.AnyLen -> () | Ast.MetaLen len -> pr "["; pp_name len; pr "]" | Ast.CstLen len -> pr "["; pr (string_of_int len); pr "]" let pp_meta_decl pr env decl = let no_arity = function Ast.NONE -> () | _ -> failwith "no arity allowed" in let pp_name (_,n) = pr n in match decl with Ast.MetaMetaDecl(ar, name) -> (* ignore virtual *) no_arity ar; pr "metavariable "; pp_name name; pr ";\n" | Ast.MetaIdDecl(ar, name) -> (* ignore virtual *) no_arity ar; pr "identifier "; pp_name name; pr ";\n" | Ast.MetaFreshIdDecl(name, Ast.NoVal) -> pr "fresh identifier "; pp_name name; pr ";\n" | Ast.MetaFreshIdDecl(name, Ast.StringSeed x) -> pr "fresh identifier "; pp_name name; pr " = \""; pr x; pr "\";\n" | Ast.MetaFreshIdDecl(name, Ast.ListSeed x) -> failwith "unparse_hrule: not supported" | Ast.MetaTypeDecl(ar, name) -> no_arity ar; pr "type "; pp_name name; pr ";\n" | Ast.MetaInitDecl(ar, name) -> no_arity ar; pr "initialiser "; pp_name name; pr ";\n" | Ast.MetaInitListDecl(ar, name, len) -> no_arity ar; pr "initialiser list "; pp_name name; pp_len pr len; pr ";\n" | Ast.MetaListlenDecl(name) -> () | Ast.MetaParamDecl(ar, name) -> no_arity ar; pr "parameter "; pp_name name; pr ";\n" | Ast.MetaParamListDecl(ar, name, len) -> no_arity ar; pr "parameter list "; pp_name name; pp_len pr len; pr ";\n" | Ast.MetaConstDecl(ar, name, types) -> no_arity ar; pr "constant "; print_types pr env types; pp_name name; pr ";\n" | Ast.MetaErrDecl(ar, name) -> no_arity ar; pr "error "; pp_name name; pr ";\n" | Ast.MetaExpDecl(ar, name, None) -> no_arity ar; pr "expression "; pp_name name; pr ";\n" | Ast.MetaExpDecl(ar, name, types) -> no_arity ar; print_types pr env types; pp_name name; pr ";\n" | Ast.MetaIdExpDecl(ar, name, types) -> no_arity ar; pr "idexpression "; print_types pr env types; pp_name name; pr ";\n" | Ast.MetaLocalIdExpDecl(ar, name, types) -> no_arity ar; pr "local idexpression "; print_types pr env types; pp_name name; pr ";\n" | Ast.MetaExpListDecl(ar, name, len) -> no_arity ar; pr "parameter list "; pp_name name; pp_len pr len; pr ";\n" | Ast.MetaDeclDecl(ar, name) -> no_arity ar; pr "declaration "; pp_name name; pr ";\n" | Ast.MetaFieldDecl(ar, name) -> no_arity ar; pr "field "; pp_name name; pr ";\n" | Ast.MetaFieldListDecl(ar, name, len) -> no_arity ar; pr "field list "; pp_name name; pp_len pr len; pr ";\n" | Ast.MetaStmDecl(ar, name) -> no_arity ar; pr "statement "; pp_name name; pr ";\n" | Ast.MetaStmListDecl(ar, name) -> no_arity ar; pr "statement list "; pp_name name; pr ";\n" | Ast.MetaFuncDecl(ar, name) -> no_arity ar; pr "function "; pp_name name; pr ";\n" | Ast.MetaLocalFuncDecl(ar, name) -> no_arity ar; pr "local function "; pp_name name; pr ";\n" | Ast.MetaPosDecl(ar, name) -> no_arity ar; pr "position "; pp_name name; pr ";\n" | Ast.MetaFmtDecl(ar, name) -> no_arity ar; pr "format "; pp_name name; pr ";\n" | Ast.MetaFragListDecl(ar, name, len) -> no_arity ar; pr "format list "; pp_name name; pp_len pr len; pr ";\n" | Ast.MetaAnalysisDecl(code, name) -> pr "analysis"; pr code; pr " "; pp_name name; pr ";\n" | Ast.MetaDeclarerDecl(ar, name) -> no_arity ar; pr "declarer "; pp_name name; pr ";\n" | Ast.MetaIteratorDecl(ar, name) -> no_arity ar; pr "iterator "; pp_name name; pr ";\n" let print_metavariables pr local_metas paramst env header_req function_name = (if header_req then pr "@depends on header@\n" else pr "@@\n"); pr (Printf.sprintf "position _p!=same_%s.p;\n" function_name); pr "identifier _f;\n"; let rec loop = function [] | [{Ast_c.p_type =(_,(Ast_c.BaseType(Ast_c.Void),_))},_] -> [] | ((first,_) as f)::rest -> print_metavar pr first; pr ";\n"; (make_exp f) :: loop rest in let args = loop paramst in print_extra_typedefs pr env; List.iter (pp_meta_decl pr env) local_metas; pr "@@\n\n"; args (* ----------------------------------------------------------------------- *) (* print_start/end *) let print_start pr = pr "_f@_p(...) { <+...\n" let print_end pr = pr "\n...+> }\n" (* ----------------------------------------------------------------------- *) (* Print call to the defined function *) let print_param_name pr = function {Ast_c.p_namei = Some name} -> pr (Ast_c.str_of_name name) | _ -> failwith "function must have named parameters" let pp_def_gen pr defn isexp = let {Ast_c.f_name = name; f_type = (_, (paramst, (b, iib))); } = defn in pr (Ast_c.str_of_name name); pr "("; (if b then failwith "not handling variable argument functions"); (match paramst with [] | [{Ast_c.p_type = (_,(Ast_c.BaseType(Ast_c.Void),_))},_] -> () | (first,_)::rest -> print_param_name pr first; List.iter (function (x,_) -> pr ", "; print_param_name pr x) rest); pr ")"; if not isexp then pr ";" (* ----------------------------------------------------------------------- *) (* Entry point *) let pp_rule local_metas ast env srcfile = let (paramst,args_name) = get_paramst env in (* get rule information *) let (rule,printable) = match ast with Ast.CocciRule(_,_,[body],_,_) -> (* could extend to use attributes *) (body, match Ast.unwrap body with Ast.NONDECL(s) -> [[Ast.StatementTag s]] | Ast.CODE(ss) -> [[Ast.StmtDotsTag ss]] | _ -> error body "bad rule body") | _ -> failwith "bad rule" in (* create the output file *) let outdir = match !Flag.make_hrule with Some outdir -> outdir | None -> error rule "not possible" in let function_name = get_function_name rule env in let function_name_count = try let cell = List.assoc function_name !names in let ct = !cell in cell := ct + 1; function_name ^ (string_of_int ct) with Not_found -> let cell = ref 1 in names := (function_name,cell) :: !names; function_name in let outfile = outdir ^ "/" ^ (if !Flag.hrule_per_file then Filename.chop_extension (Filename.basename srcfile) else function_name_count) in let escape_re = Str.regexp_string "/" in let dir = if !Flag.dir = "" then Filename.dirname srcfile else !Flag.dir in let outdirfile = Str.global_replace escape_re "_"dir in let outfile = outfile ^ outdirfile ^ ".cocci" in let saved_header_req = try let res = List.assoc outfile !started_files in Some res with Not_found -> None in current_outfile := outfile; Common.with_open_outfile_append outfile (fun (pr,chan) -> let header_req = match saved_header_req with Some x -> x | None -> let res = print_header_rule pr srcfile in started_files := (outfile,res)::!started_files; res in print_check_rule pr function_name function_name_count header_req; let args = print_metavariables pr local_metas paramst env header_req function_name_count in let (argids,args) = List.split args in let env = rename argids env in let env = (args_name,Ast_c.MetaExprListVal args)::env in print_start pr; (* for printing C tokens *) let pr_c info = match Ast_c.pinfo_of_info info with Ast_c.AbstractLineTok _ -> pr (Ast_c.str_of_info info) | Ast_c.FakeTok (s,_) -> pr s | _ -> Printf.printf "line: %s\n" (Dumper.dump info); error rule "not an abstract line" in let pr_space _ = pr " " in Unparse_cocci.pp_list_list_any ([env], (fun s _ _ _ _ -> pr s), pr_c, pr_space, pr_space, pr, (fun _ _ -> ()), (function _ -> ()), (function _ -> ()), (function _ -> ())) true printable Unparse_cocci.InPlace; print_end pr; pr "\n") coccinelle-1.0.0-rc19/parsing_c/lexer_c.mll0000644000175000017500000011041412247437436017465 0ustar eugeneugen{ (* Yoann Padioleau * * Copyright (C) 2002, 2006, 2007, 2008, 2009, Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Parser_c open Ast_c (* to factorise tokens, OpAssign, ... *) (*****************************************************************************) (* * subtil: ocamllex use side effect on lexbuf, so must take care. * For instance must do * * let info = tokinfo lexbuf in * TComment (info +> tok_add_s (comment lexbuf)) * * and not * * TComment (tokinfo lexbuf +> tok_add_s (comment lexbuf)) * * because of the "wierd" order of evaluation of OCaml. * * * * note: can't use Lexer_parser._lexer_hint here to do different * things, because now we call the lexer to get all the tokens * (tokens_all), and then we parse. So we can't have the _lexer_hint * info here. We can have it only in parse_c. For the same reason, the * typedef handling here is now useless. *) (*****************************************************************************) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_lexing (*****************************************************************************) exception Lexical of string let tok lexbuf = Lexing.lexeme lexbuf let tokinfo lexbuf = { pinfo = Ast_c.OriginTok { Common.charpos = Lexing.lexeme_start lexbuf; Common.str = Lexing.lexeme lexbuf; (* info filled in a post-lexing phase *) Common.line = -1; Common.column = -1; Common.file = ""; }; (* must generate a new ref each time, otherwise share *) cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref Ast_c.emptyComments; } (* cppext: must generate a new ref each time, otherwise share *) let no_ifdef_mark () = ref (None: (int * int) option) let tok_add_s s ii = Ast_c.rewrap_str ((Ast_c.str_of_info ii) ^ s) ii (* opti: less convenient, but using a hash is faster than using a match *) let keyword_table = Common.hash_of_list [ (* c: *) "void", (fun ii -> Tvoid ii); "char", (fun ii -> Tchar ii); "short", (fun ii -> Tshort ii); "int", (fun ii -> Tint ii); "long", (fun ii -> Tlong ii); "float", (fun ii -> Tfloat ii); "double", (fun ii -> Tdouble ii); "size_t", (fun ii -> Tsize_t ii); "ssize_t", (fun ii -> Tssize_t ii); "ptrdiff_t", (fun ii -> Tptrdiff_t ii); "unsigned", (fun ii -> Tunsigned ii); "signed", (fun ii -> Tsigned ii); "auto", (fun ii -> Tauto ii); "register", (fun ii -> Tregister ii); "extern", (fun ii -> Textern ii); "static", (fun ii -> Tstatic ii); "const", (fun ii -> Tconst ii); "volatile", (fun ii -> Tvolatile ii); "struct", (fun ii -> Tstruct ii); "union", (fun ii -> Tunion ii); "enum", (fun ii -> Tenum ii); "typedef", (fun ii -> Ttypedef ii); "if", (fun ii -> Tif ii); "else", (fun ii -> Telse ii); "break", (fun ii -> Tbreak ii); "continue", (fun ii -> Tcontinue ii); "switch", (fun ii -> Tswitch ii); "case", (fun ii -> Tcase ii); "default", (fun ii -> Tdefault ii); "for", (fun ii -> Tfor ii); "do", (fun ii -> Tdo ii); "while", (fun ii -> Twhile ii); "return", (fun ii -> Treturn ii); "goto", (fun ii -> Tgoto ii); "sizeof", (fun ii -> Tsizeof ii); (* gccext: cppext: linuxext: synonyms *) "asm", (fun ii -> Tasm ii); "__asm__", (fun ii -> Tasm ii); "__asm", (fun ii -> Tasm ii); "inline", (fun ii -> Tinline ii); "__inline__", (fun ii -> Tinline ii); "__inline", (fun ii -> Tinline ii); "__attribute__", (fun ii -> Tattribute ii); "__attribute", (fun ii -> Tattribute ii); "typeof", (fun ii -> Ttypeof ii); "__typeof__", (fun ii -> Ttypeof ii); "__typeof", (fun ii -> Ttypeof ii); (* found a lot in expanded code *) "__extension__", (fun ii -> TattributeNoarg ii); (* gccext: alias *) "__signed__", (fun ii -> Tsigned ii); "__const__", (fun ii -> Tconst ii); "__const", (fun ii -> Tconst ii); "__volatile__", (fun ii -> Tvolatile ii); "__volatile", (fun ii -> Tvolatile ii); (* windowsext: *) "__declspec", (fun ii -> Tattribute ii); "__stdcall", (fun ii -> TattributeNoarg ii); "__cdecl", (fun ii -> TattributeNoarg ii); "WINAPI", (fun ii -> TattributeNoarg ii); "APIENTRY", (fun ii -> TattributeNoarg ii); "CALLBACK", (fun ii -> TattributeNoarg ii); (* c99: *) (* no just "restrict" ? maybe for backward compatibility they avoided * to use restrict which people may have used in their program already *) "__restrict", (fun ii -> Trestrict ii); "__restrict__", (fun ii -> Trestrict ii); ] let cpp_keyword_table = Common.hash_of_list [ "namespace", (fun ii -> Tnamespace ii); "new", (fun ii -> Tnew ii); "delete", (fun ii -> Tdelete ii); "using", (fun ii -> TComment ii) ] let ibm_keyword_table = Common.hash_of_list [ "decimal", (fun ii -> Tdecimal ii); ] let error_radix s = ("numeric " ^ s ^ " constant contains digits beyond the radix:") (* julia: functions for figuring out the type of integers *) let is_long_dec s int uint long ulong = match !Flag_parsing_c.int_thresholds with None -> int | Some (_,_,uint_threshold,long_threshold,ulong_threshold) -> let bn = Big_int.big_int_of_string s in if Big_int.ge_big_int bn ulong_threshold then ulong else if Big_int.ge_big_int bn long_threshold then long else if Big_int.ge_big_int bn uint_threshold then long else int let is_long_ho s int uint long ulong drop bpd count = match !Flag_parsing_c.int_thresholds with None -> int | Some (uint_sz,ulong_sz,_,_,_) -> let len = String.length s in (* this assumes that all of the hex/oct digits are significant *) (* drop is 2 for hex (0x) and 1 for oct (0) *) let s = String.sub s drop (len - drop) in let len = ((len-drop) * bpd) - (count (int_of_string("0x"^(String.sub s 0 1)))) in if len < uint_sz then int else if len = uint_sz then uint else if len < ulong_sz then long else ulong let is_long_oct s int uint long ulong = is_long_ho s int uint long ulong 1 3 (* stupid, but probably more efficient than taking logs *) (function 0 -> 3 | 1 -> 2 | n when n < 4 -> 1 | _ -> 0) let is_long_hex s int uint long ulong = is_long_ho s int uint long ulong 2 4 (* stupid, but probably more efficient than taking logs *) (function 0 -> 4 | 1 -> 3 | n when n < 4 -> 2 | n when n < 8 -> 1 | _ -> 0) let sint = (Signed,CInt) let uint = (UnSigned,CInt) let slong = (Signed,CLong) let ulong = (UnSigned,CLong) } (*****************************************************************************) let letter = ['A'-'Z' 'a'-'z' '_'] let extended_letter = ['A'-'Z' 'a'-'z' '_' ':' '<' '>' '~'](*for c++, not used*) let digit = ['0'-'9'] let cplusplus_ident = (letter | '$') (letter | digit | '$') * let cplusplus_ident_ext = (letter | '~' | '$') (letter | digit | '~' | '$') * (* not used for the moment *) let punctuation = ['!' '\"' '#' '%' '&' '\'' '(' ')' '*' '+' ',' '-' '.' '/' ':' ';' '<' '=' '>' '?' '[' '\\' ']' '^' '{' '|' '}' '~'] let space = [' ' '\t' '\n' '\r' '\011' '\012' ] let additionnal = [ ' ' '\b' '\t' '\011' '\n' '\r' '\007' ] (* 7 = \a = bell in C. this is not the only char allowed !! * ex @ and $ ` are valid too *) let cchar = (letter | digit | punctuation | additionnal) let sp = [' ' '\t']+ let spopt = [' ' '\t']* let dec = ['0'-'9'] let oct = ['0'-'7'] let hex = ['0'-'9' 'a'-'f' 'A'-'F'] let decimal = ('0' | (['1'-'9'] dec*)) let octal = ['0'] oct+ let hexa = ("0x" |"0X") hex+ let pent = dec+ let pfract = dec+ let sign = ['-' '+'] let exp = ['e''E'] sign? dec+ let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?) let ddecimal = ((pent? '.' pfract | pent '.' pfract? )) let id = letter (letter | digit) * (*****************************************************************************) rule token = parse (* ----------------------------------------------------------------------- *) (* spacing/comments *) (* ----------------------------------------------------------------------- *) (* note: this lexer generate tokens for comments!! so can not give * this lexer as-is to the parsing function. The caller must preprocess * it, e.g. by using techniques like cur_tok ref in parse_c.ml. * * update: we now also generate a separate token for newlines, so now * the caller may also have to reagglomerate all those commentspace * tokens if he was assuming that spaces were agglomerate in a single * token. *) | ['\n'] [' ' '\t' '\r' '\011' '\012' ]* (* starting a new line; the newline character followed by whitespace *) { TCommentNewline (tokinfo lexbuf) } | [' ' '\t' '\r' '\011' '\012' ]+ { TCommentSpace (tokinfo lexbuf) } | "/*" { let info = tokinfo lexbuf in let com = comment lexbuf in let info' = info +> tok_add_s com in let s = Ast_c.str_of_info info' in (* could be more flexible, use [\t ]* instead of hardcoded * single space. *) match s with | "/* {{coccinelle:skip_start}} */" -> TCommentSkipTagStart (info') | "/* {{coccinelle:skip_end}} */" -> TCommentSkipTagEnd (info') | _ -> TComment(info') } (* C++ comment are allowed via gccext, but normally they are deleted by cpp. * So need this here only when dont call cpp before. * note that we don't keep the trailing \n; it will be in another token. *) | "//" [^'\r' '\n' '\011']* { TComment (tokinfo lexbuf) } (* ----------------------------------------------------------------------- *) (* cpp *) (* ----------------------------------------------------------------------- *) (* old: * | '#' { endline lexbuf} // should be line, and not endline * and endline = parse | '\n' { token lexbuf} * | _ { endline lexbuf} *) (* less?: * have found a # #else in "newfile-2.6.c", legal ? and also a #/* ... * => just "#" -> token {lexbuf} (that is ignore) * il y'a 1 #elif sans rien apres * il y'a 1 #error sans rien apres * il y'a 2 mov dede, #xxx qui genere du coup exn car * entour par des #if 0 * => make as for comment, call a comment_cpp that when #endif finish the * comment and if other cpp stuff raise exn * il y'a environ 10 #if(xxx) ou le ( est coll direct * il y'a des include"" et include< * il y'a 1 ` (derriere un #ifndef linux) *) (* ---------------------- *) (* misc *) (* ---------------------- *) (* bugfix: I want now to keep comments for the cComment study * so cant do: sp [^'\n']+ '\n' * http://gcc.gnu.org/onlinedocs/gcc/Pragmas.html *) | "#" spopt "ident" sp [^'\n' '\r']* ('\n' | "\r\n") | "#" spopt "line" sp [^'\n' '\r']* ('\n' | "\r\n") | "#" spopt "error" sp [^'\n' '\r']* ('\n' | "\r\n") | "#" spopt "warning" sp [^'\n' '\r']* ('\n' | "\r\n") | "#" spopt "abort" sp [^'\n' '\r']* ('\n' | "\r\n") { TCppDirectiveOther (tokinfo lexbuf) } | "#" [' ' '\t']* ('\n' | "\r\n") { TCppDirectiveOther (tokinfo lexbuf) } (* only after cpp, ex: # 1 "include/linux/module.h" 1 *) | "#" sp pent sp '\"' [^ '\"']* '\"' (spopt pent)* spopt ('\n' | "\r\n") { TCppDirectiveOther (tokinfo lexbuf) } (* ------------------------ *) (* #define, #undef, #pragma *) (* ------------------------ *) (* the rest of the lexing/parsing of define is done in fix_tokens_define * where we parse until a TCppEscapedNewline and generate a TDefEol *) | "#" [' ' '\t']* "define" { TDefine (tokinfo lexbuf) } (* note: in some cases can have stuff after the ident as in #undef XXX 50, * but I currently don't handle it cos I think it's bad code. *) | "#" [' ' '\t']* "undef" { TUndef (tokinfo lexbuf) } (* note: in some cases can have stuff after the ident as in #undef XXX 50, * but I currently don't handle it cos I think it's bad code. *) | ("#" [' ' '\t']* "pragma") { TPragma (tokinfo lexbuf) } (* ---------------------- *) (* #include *) (* ---------------------- *) (* The difference between a local "" and standard <> include is computed * later in parser_c.mly. So redo a little bit of lexing there; ugly but * simpler to generate a single token here. *) | (("#" [' ''\t']* "include" [' ' '\t']*) as includes) (('\"' ([^ '\"']+) '\"' | '<' [^ '>']+ '>' | ['A'-'Z''_']+ ) as filename) { let info = tokinfo lexbuf in TInclude (includes, filename, Ast_c.noInIfdef(), info) } (* gccext: found in glibc *) | (("#" [' ''\t']* "include_next" [' ' '\t']*) as includes) (('\"' ([^ '\"']+) '\"' | '<' [^ '>']+ '>' | ['A'-'Z''_']+ ) as filename) { let info = tokinfo lexbuf in TInclude (includes, filename, Ast_c.noInIfdef(), info) } (* ---------------------- *) (* #ifdef *) (* ---------------------- *) (* The ifdef_mark will be set later in Parsing_hacks.set_ifdef_parenthize_info * when working on the ifdef view. *) (* '0'+ because sometimes it is a #if 000 *) | "#" [' ' '\t']* "if" [' ' '\t']* '0'+ (* [^'\n']* '\n' *) { let info = tokinfo lexbuf in TIfdefBool (false, no_ifdef_mark(), info) (* +> tok_add_s (cpp_eat_until_nl lexbuf)*) } | "#" [' ' '\t']* "if" [' ' '\t']* '1' (* [^'\n']* '\n' *) { let info = tokinfo lexbuf in TIfdefBool (true, no_ifdef_mark(), info) } (* DO NOT cherry pick to lexer_cplusplus !!! often used for the extern "C" { *) | "#" [' ' '\t']* "if" sp "defined" sp "(" spopt "__cplusplus" spopt ")" [^'\n' '\r']* ('\n' | "\r\n") { let info = tokinfo lexbuf in TIfdefMisc (false, no_ifdef_mark(), info) } (* DO NOT cherry pick to lexer_cplusplus !!! *) | "#" [' ' '\t']* "ifdef" [' ' '\t']* "__cplusplus" [^'\n']* '\n' { let info = tokinfo lexbuf in TIfdefMisc (false, no_ifdef_mark(), info) } (* in glibc *) | "#" spopt ("ifdef"|"if") sp "__STDC__" { let info = tokinfo lexbuf in TIfdefVersion (true, no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } (* linuxext: different possible variations (we do not manage all of them): #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,0) #if LINUX_VERSION_CODE <= KERNEL_VERSION(2,4,2) #if LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0) #if LINUX_VERSION_CODE > KERNEL_VERSION(2,3,0) #if LINUX_VERSION_CODE < 0x020600 #if LINUX_VERSION_CODE >= 0x2051c #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) #if !(LINUX_VERSION_CODE > KERNEL_VERSION(2,5,73)) #if STREAMER_IOCTL && (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,20) && LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0) #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,20) && \ # if defined(MODULE) && LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,30) #if LINUX_VERSION_CODE > LinuxVersionCode(2,3,12) #elif LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) #ifndef LINUX_VERSION_CODE #if LINUX_VERSION_CODE < ASC_LINUX_VERSION(2,2,0) || \ (LINUX_VERSION_CODE > ASC_LINUX_VERSION(2,3,0) && \ LINUX_VERSION_CODE < ASC_LINUX_VERSION(2,4,0)) #if (KERNEL_VERSION(2,4,0) > LINUX_VERSION_CODE) #if LINUX_VERSION_CODE >= ASC_LINUX_VERSION(1,3,0) # if defined(MODULE) && LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,30) *) (* linuxext: must be before the generic rules for if and ifdef *) | "#" spopt "if" sp "("? "LINUX_VERSION_CODE" sp (">=" | ">") sp { let info = tokinfo lexbuf in TIfdefVersion (true, no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } (* linuxext: *) | "#" spopt "if" sp "!" "("? "LINUX_VERSION_CODE" sp (">=" | ">") sp | "#" spopt "if" sp ['(']? "LINUX_VERSION_CODE" sp ("<=" | "<") sp { let info = tokinfo lexbuf in TIfdefVersion (false, no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } (* can have some ifdef 0 hence the letter|digit even at beginning of word *) | "#" [' ''\t']* "ifdef" [' ''\t']+ (((letter|digit) ((letter|digit)*)) as x) [' ''\t']* { if List.mem x !Flag_parsing_c.undefined then TIfdefBool (false, no_ifdef_mark(), tokinfo lexbuf) else if List.mem x !Flag_parsing_c.defined then TIfdefBool (true, no_ifdef_mark(), tokinfo lexbuf) else TIfdef (no_ifdef_mark(), tokinfo lexbuf) } | "#" [' ''\t']* "ifndef" [' ''\t']+ (((letter|digit) ((letter|digit)*)) as x) [' ''\t']* { if List.mem x !Flag_parsing_c.defined then TIfdefBool (false, no_ifdef_mark(), tokinfo lexbuf) else if List.mem x !Flag_parsing_c.undefined then TIfdefBool (true, no_ifdef_mark(), tokinfo lexbuf) else TIfdef (no_ifdef_mark(), tokinfo lexbuf) } | "#" [' ''\t']* "if" [' ' '\t']+ { let info = tokinfo lexbuf in TIfdef (no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } | "#" [' ' '\t']* "if" '(' { let info = tokinfo lexbuf in TIfdef (no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } | "#" [' ' '\t']* "elif" [' ' '\t']+ { let info = tokinfo lexbuf in TIfdefelif (no_ifdef_mark(), info +> tok_add_s (cpp_eat_until_nl lexbuf)) } | "#" [' ''\t']* "endif" [' ''\t']+ (letter|digit) ((letter|digit)*) [' ''\t']* { TEndif (no_ifdef_mark(), tokinfo lexbuf) } (* bugfix: can have #endif LINUX but at the same time if I eat everything * until next line, I may miss some TComment which for some tools * are important such as aComment *) | "#" [' ' '\t']* "endif" (*[^'\n']* '\n'*) { TEndif (no_ifdef_mark(), tokinfo lexbuf) } (* can be at eof *) (*| "#" [' ' '\t']* "endif" { TEndif (tokinfo lexbuf) }*) | "#" [' ' '\t']* "else" ([' ' '\t' '\n'] | "\r\n") { TIfdefelse (no_ifdef_mark(), tokinfo lexbuf) } (* ---------------------- *) (* #define body *) (* ---------------------- *) (* only in cpp directives normally *) | "\\" ('\n' | "\r\n") { TCppEscapedNewline (tokinfo lexbuf) } (* We must generate separate tokens for #, ## and extend the grammar. * Note there can be "elaborated" idents in many different places, in * expression but also in declaration, in function name. So having 3 tokens * for an ident does not work well with how we add info in * ast_c. Was easier to generate just one token, just one info, * even if have later to reanalyse those tokens and unsplit. But then, * handling C++ lead to having not just a string for ident but something * more complex. Also when we want to parse elaborated function headers * (e.g. void METH(foo)(int x)), we need anyway to go from a string * to something more. So having also for C something more than just * string for ident is natural. * * todo: our heuristics in parsing_hacks rely on TIdent. So maybe * an easier solution would be to augment the TIdent type such as * TIdent of string * info * cpp_ident_additionnal_info * * old: * | id ([' ''\t']* "##" [' ''\t']* id)+ * { let info = tokinfo lexbuf in * TIdent (tok lexbuf, info) * } * | "##" spopt id * { let info = tokinfo lexbuf in * TIdent (tok lexbuf, info) * } * *) (* cppext: string concatenation of idents, also ##args for variadic macro. *) | "##" { TCppConcatOp (tokinfo lexbuf) } (* cppext: stringification. * bugfix: this case must be after the other cases such as #endif * otherwise take precedent. *) | "#" spopt id { let info = tokinfo lexbuf in TIdent (tok lexbuf, info) } (* the ... next to id, e.g. arg..., works with ##, e.g. ##arg *) | ((id as s) "...") { TDefParamVariadic (s, tokinfo lexbuf) } (* ----------------------------------------------------------------------- *) (* C symbols *) (* ----------------------------------------------------------------------- *) (* stdC: ... && -= >= ~ + ; ] <<= &= -> >> % , < ^ >>= *= /= ^= & - = { != ++ << |= ( . > | %= += <= || ) / ? } -- == ! * : [ recent addition: <: :> <% %> only at processing: %: %:%: # ## *) | '[' { TOCro(tokinfo lexbuf) } | ']' { TCCro(tokinfo lexbuf) } | '(' { TOPar(tokinfo lexbuf) } | ')' { TCPar(tokinfo lexbuf) } | '{' { TOBrace(tokinfo lexbuf) } | '}' { TCBrace(tokinfo lexbuf) } | '+' { TPlus(tokinfo lexbuf) } | '*' { TMul(tokinfo lexbuf) } | '-' { TMinus(tokinfo lexbuf) } | '/' { TDiv(tokinfo lexbuf) } | '%' { TMod(tokinfo lexbuf) } | ">?" { TMax(tokinfo lexbuf) } | ">=" {TAssign (OpAssign DecRight, (tokinfo lexbuf))} | ">?=" { TAssign(OpAssign Max, (tokinfo lexbuf))} | "=" { TSupEq(tokinfo lexbuf) } | "<=" { TInfEq(tokinfo lexbuf) } | "<" { TInf(tokinfo lexbuf) } | ">" { TSup(tokinfo lexbuf) } | "&&" { TAndLog(tokinfo lexbuf) } | "||" { TOrLog(tokinfo lexbuf) } | ">>" { TShr(tokinfo lexbuf) } | "<<" { TShl(tokinfo lexbuf) } | "&" { TAnd(tokinfo lexbuf) } | "|" { TOr(tokinfo lexbuf) } | "^" { TXor(tokinfo lexbuf) } | "..." { TEllipsis(tokinfo lexbuf) } | "->" { TPtrOp(tokinfo lexbuf) } | '.' { TDot(tokinfo lexbuf) } | ',' { TComma(tokinfo lexbuf) } | ";" { TPtVirg(tokinfo lexbuf) } | "?" { TWhy(tokinfo lexbuf) } | ":" { TDotDot(tokinfo lexbuf) } | "!" { TBang(tokinfo lexbuf) } | "~" { TTilde(tokinfo lexbuf) } | "<:" { TOCro(tokinfo lexbuf) } | ":>" { TCCro(tokinfo lexbuf) } | "<%" { TOBrace(tokinfo lexbuf) } | "%>" { TCBrace(tokinfo lexbuf) } (* ----------------------------------------------------------------------- *) (* C keywords and ident *) (* ----------------------------------------------------------------------- *) (* StdC: must handle at least name of length > 509, but can * truncate to 31 when compare and truncate to 6 and even lowerise * in the external linkage phase *) | letter (letter | digit) * { let info = tokinfo lexbuf in let s = tok lexbuf in Common.profile_code "C parsing.lex_ident" (fun () -> let tok = if !Flag.c_plus_plus then Common.optionise (fun () -> Hashtbl.find cpp_keyword_table s) else None in match tok with Some f -> f info | None -> let tok = if !Flag.ibm then Common.optionise (fun () -> Hashtbl.find ibm_keyword_table s) else None in match tok with Some f -> f info | None -> let tok = Common.optionise (fun () -> Hashtbl.find keyword_table s) in match tok with | Some f -> f info (* parse_typedef_fix. * if Lexer_parser.is_typedef s * then TypedefIdent (s, info) * else TIdent (s, info) * * update: now this is no more useful, cos * as we use tokens_all, it first parse all as an ident and * later transform an indent in a typedef. so the typedef job is * now done in parse_c.ml. *) | None -> TIdent (s, info) ) } (* gccext: apparently gcc allows dollar in variable names. found such * thing a few time in linux and in glibc. No need look in keyword_table * here. *) | (cplusplus_ident "::")+ "operator new" { let info = tokinfo lexbuf in let s = tok lexbuf in TIdent (s, info) } | cplusplus_ident { let info = tokinfo lexbuf in let s = tok lexbuf in pr2 ("LEXER: identifier with dollar: " ^ s); TIdent (s, info) } | cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ? ("::~" cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ?) + { let info = tokinfo lexbuf in let s = tok lexbuf in if !Flag.c_plus_plus then Tconstructorname (s, info) else begin pr2_once "~ and :: not allowed in C identifiers, try -c++ option"; TIdent (s, info) end } | cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') { let info = tokinfo lexbuf in let s = tok lexbuf in if !Flag.c_plus_plus then TypedefIdent (s, info) else begin pr2_once "<> detected, try -c++ option"; TIdent (s, info) end } | (cplusplus_ident as first) ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ? "::" (cplusplus_ident as second) ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ? ("::" cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ?) * { let info = tokinfo lexbuf in let s = tok lexbuf in if !Flag.c_plus_plus then begin if first = second then Tconstructorname (s, info) else TIdent (s, info) end else begin pr2_once "~ and :: not allowed in C identifiers, try -c++ option"; TIdent (s, info) end } | "::" cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ? ("::" cplusplus_ident ('<' "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* (", " "const "? cplusplus_ident_ext ("::" cplusplus_ident_ext) * '*'* ) * '>') ?) * { let info = tokinfo lexbuf in let s = tok lexbuf in (if not !Flag.c_plus_plus then pr2_once "~ and :: not allowed in C identifiers, try -c++ option"); TIdent (s, info) } (* ----------------------------------------------------------------------- *) (* C constant *) (* ----------------------------------------------------------------------- *) | "'" { let info = tokinfo lexbuf in let s = char lexbuf in TChar ((s, IsChar), (info +> tok_add_s (s ^ "'"))) } | '\"' { let info = tokinfo lexbuf in let s = string lexbuf in TString ((s, IsChar), (info +> tok_add_s (s ^ "\""))) } (* wide character encoding, TODO L'toto' valid ? what is allowed ? *) | 'L' "'" { let info = tokinfo lexbuf in let s = char lexbuf in TChar ((s, IsWchar), (info +> tok_add_s (s ^ "'"))) } | 'L' '\"' { let info = tokinfo lexbuf in let s = string lexbuf in TString ((s, IsWchar), (info +> tok_add_s (s ^ "\""))) } (* Take care of the order ? No because lex tries the longest match. The * strange diff between decimal and octal constant semantic is not * understood too by refman :) refman:11.1.4, and ritchie. *) | decimal as x { TInt ((x, is_long_dec x sint slong slong ulong), tokinfo lexbuf) } | hexa as x { TInt ((x, is_long_hex x sint uint slong ulong), tokinfo lexbuf) } | octal as x { TInt ((x, is_long_oct x sint uint slong ulong), tokinfo lexbuf) } | ((decimal as s) ['u' 'U']) as x { TInt ((x, is_long_dec s uint uint ulong ulong), tokinfo lexbuf) } | ((hexa as s) ['u' 'U']) as x { TInt ((x, is_long_hex s uint uint ulong ulong), tokinfo lexbuf) } | ((octal as s) ['u' 'U']) as x { TInt ((x, is_long_oct s uint uint ulong ulong), tokinfo lexbuf) } | (( decimal as s) ['l' 'L']) as x { TInt ((x, is_long_dec s slong slong slong ulong), tokinfo lexbuf) } | ((hexa as s) ['l' 'L']) as x { TInt ((x, is_long_hex s slong slong slong ulong), tokinfo lexbuf) } | ((octal as s) ['l' 'L']) as x { TInt ((x, is_long_oct s slong slong slong ulong), tokinfo lexbuf) } | ((( decimal | hexa | octal) ['l' 'L'] ['u' 'U']) | (( decimal | hexa | octal) ['u' 'U'] ['l' 'L'])) as x { TInt ((x, (UnSigned,CLong)), tokinfo lexbuf) } | (( decimal | hexa | octal) ['l' 'L'] ['l' 'L']) as x { TInt ((x, (Signed,CLongLong)), tokinfo lexbuf) } | (( decimal | hexa | octal) ['u' 'U'] ['l' 'L'] ['l' 'L']) as x { TInt ((x, (UnSigned,CLongLong)), tokinfo lexbuf) } | (decimal ['d' 'D']) as x { if !Flag.ibm then let len = string_of_int(String.length x - 1) in TDecimal ((x,len,"0"), tokinfo lexbuf) else failwith "unrecognized constant modifier d/D" } | (real ['f' 'F']) as x { TFloat ((x, CFloat), tokinfo lexbuf) } | (real ['l' 'L']) as x { TFloat ((x, CLongDouble), tokinfo lexbuf) } | (real as x) { TFloat ((x, CDouble), tokinfo lexbuf) } (* How to make the following only available if !Flag.ibm *) | (ddecimal ['d' 'D']) as x { match Str.split_delim (Str.regexp_string ".") x with [before;after] -> let lena = String.length after - 1 in let n = string_of_int (String.length before + lena) in let p = string_of_int lena in TDecimal ((x,n,p), tokinfo lexbuf) | _ -> failwith "bad decimal" } | ['0'] ['0'-'9']+ { pr2 ("LEXER: " ^ error_radix "octal" ^ tok lexbuf); TUnknown (tokinfo lexbuf) } | ("0x" |"0X") ['0'-'9' 'a'-'z' 'A'-'Z']+ { pr2 ("LEXER: " ^ error_radix "hexa" ^ tok lexbuf); TUnknown (tokinfo lexbuf) } (* !!! to put after other rules !!! otherwise 0xff * will be parsed as an ident. *) | ['0'-'9']+ letter (letter | digit) * { pr2 ("LEXER: ZARB integer_string, certainly a macro:" ^ tok lexbuf); TIdent (tok lexbuf, tokinfo lexbuf) } (* gccext: http://gcc.gnu.org/onlinedocs/gcc/Binary-constants.html *) (* | "0b" ['0'-'1'] { TInt (((tok lexbuf)(??,??)) +> int_of_stringbits) } | ['0'-'1']+'b' { TInt (((tok lexbuf)(0,-2)) +> int_of_stringbits) } *) (*------------------------------------------------------------------------ *) | eof { EOF (tokinfo lexbuf +> Ast_c.rewrap_str "") } | _ { if !Flag_parsing_c.verbose_lexing then pr2_once ("LEXER:unrecognised symbol, in token rule:"^tok lexbuf); TUnknown (tokinfo lexbuf) } (*****************************************************************************) and char = parse | (_ as x) { String.make 1 x ^ restchars lexbuf } (* todo?: as for octal, do exception beyond radix exception ? *) | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf } (* this rule must be after the one with octal, lex try first longest * and when \7 we want an octal, not an exn. *) | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf } | (("\\" (_ as v)) as x ) { (match v with (* Machine specific ? *) | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () (* linuxext: ? *) | _ -> pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); ); x ^ restchars lexbuf } | _ { pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); tok lexbuf ^ restchars lexbuf } and restchars = parse | "'" { "" } | (_ as x) { String.make 1 x ^ restchars lexbuf } (* todo?: as for octal, do exception beyond radix exception ? *) | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf } (* this rule must be after the one with octal, lex try first longest * and when \7 we want an octal, not an exn. *) | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf } | (("\\" (_ as v)) as x ) { (match v with (* Machine specific ? *) | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () (* linuxext: ? *) | _ -> pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); ); x ^ restchars lexbuf } | _ { pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); tok lexbuf ^ restchars lexbuf } (*****************************************************************************) (* todo? factorise code with char ? but not same ending token so hard. *) and string = parse | '\"' { "" } | (_ as x) { string_of_char x^string lexbuf} | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf } | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf } | ("\\" (_ as v)) as x { (match v with (* Machine specific ? *) | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () (* linuxext: ? *) (* old: "x" -> 10 gccext ? todo ugly, I put a fake value *) (* cppext: can have \ for multiline in string too *) | '\n' -> () | _ -> pr2 ("LEXER: unrecognised symbol in string:"^tok lexbuf); ); x ^ string lexbuf } | eof { pr2 "LEXER: WIERD end of file in string"; ""} (* Bug if add following code, cos match also the '"' that is needed * to finish the string, and so go until end of file. *) (* | [^ '\\']+ { let cs = lexbuf +> tok +> list_of_string +> List.map Char.code in cs ++ string lexbuf } *) (*****************************************************************************) (* less: allow only char-'*' ? *) and comment = parse | "*/" { tok lexbuf } (* noteopti: *) | [^ '*']+ { let s = tok lexbuf in s ^ comment lexbuf } | [ '*'] { let s = tok lexbuf in s ^ comment lexbuf } | eof { pr2 "LEXER: end of file in comment"; "*/"} | _ { let s = tok lexbuf in pr2 ("LEXER: unrecognised symbol in comment:"^s); s ^ comment lexbuf } (*****************************************************************************) (* cpp recognize C comments, so when #define xx (yy) /* comment \n ... */ * then he has already erased the /* comment. So: * - dont eat the start of the comment otherwise afterwards we are in the middle * of a comment and so will problably get a parse error somewhere. * - have to recognize comments in cpp_eat_until_nl. *) and cpp_eat_until_nl = parse (* bugfix: *) | "/*" { let s = tok lexbuf in let s2 = comment lexbuf in let s3 = cpp_eat_until_nl lexbuf in s ^ s2 ^ s3 } | '\\' "\n" { let s = tok lexbuf in s ^ cpp_eat_until_nl lexbuf } | "\n" { tok lexbuf } (* noteopti: * update: need also deal with comments chars now *) | [^ '\n' '\r' '\\' '/' '*' ]+ { let s = tok lexbuf in s ^ cpp_eat_until_nl lexbuf } | eof { pr2 "LEXER: end of file in cpp_eat_until_nl"; ""} | _ { let s = tok lexbuf in s ^ cpp_eat_until_nl lexbuf } coccinelle-1.0.0-rc19/parsing_c/cpp_ast_c.ml0000644000175000017500000003226712247437436017634 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2008, 2009 University of Urbana Champaign * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_cpp_ast let pr2_debug,pr2_debug_once = Common.mk_pr2_wrappers Flag_parsing_c.debug_cpp_ast (*****************************************************************************) (* Cpp Ast Manipulations *) (*****************************************************************************) (* * cpp-include-expander-builtin. * * alternative1: parse and call cpp tour a tour. So let cpp work at * the token level. That's what most tools do. * alternative2: apply cpp at the very end. Process that go through ast * and do the stuff such as #include, macro expand, * ifdef but on the ast! * * But need keep those info in ast at least, even bad * macro for instance, and for parse error region ? maybe can * get another chance ? * I think it's better to do the cpp-include-expander in a different step * rather than embedding it in the parser. The parser is already too complex. * Also keep with the tradition to try to parse as-is. * * todo? but maybe could discover new info that could help reparse * the ParseError in original file. Try again parsing it by * putting it in a minifile ? * * * todo? maybe can do some pass that work at the ifdef level and for instance * try to paren them, so have in Ast some stuff that are not * present at parsing time but that can then be constructed after * some processing (a little bit like my type for expression filler, * or position info filler, or include relative position filler). * * ??add such info about what was done somewhere ? could build new * ??ast each time but too tedious (maybe need delta-programming!) * * todo? maybe change cpp_ast_c to go deeper on local "" ? * * * TODO: macro expand, * TODO: handle ifdef * * * * cpp_ifdef_statementize: again better to separate concern and in parser * just add the directives in a flat way (IfdefStmt) and later do more * processing and transform them in a tree with some IfdefStmt2. *) (*****************************************************************************) (* Types *) (*****************************************************************************) type cpp_option = | I of Common.dirname | D of string * string option let i_of_cpp_options xs = xs +> Common.map_filter (function | I f -> Some f | D _ -> None ) let cpp_option_of_cmdline (xs, ys) = (xs +> List.map (fun s -> I s)) ++ (ys +> List.map (fun s -> if s =~ "\\([A-Z][A-Z0-9_]*\\)=\\(.*\\)" then let (def, value) = matched2 s in D (def, Some value) else D (s, None) )) (*****************************************************************************) (* Debug *) (*****************************************************************************) let (show_cpp_i_opts: string list -> unit) = fun xs -> if not (null xs) then begin pr2 "-I"; xs +> List.iter pr2 end let (show_cpp_d_opts: string list -> unit) = fun xs -> if not (null xs) then begin pr2 "-D"; xs +> List.iter pr2 end (* ---------------------------------------------------------------------- *) let trace_cpp_process depth mark inc_file = pr2_debug (spf "%s>%s %s" (Common.repeat "-" depth +> Common.join "") mark (s_of_inc_file_bis inc_file)); () (*****************************************************************************) (* Helpers *) (*****************************************************************************) let _hcandidates = Hashtbl.create 101 let init_adjust_candidate_header_files dir = let ext = "[h]" in let files = Common.files_of_dir_or_files ext [dir] in files +> List.iter (fun file -> let base = Filename.basename file in pr2_debug file; Hashtbl.add _hcandidates base file; ); () (* may return a list of match ? *) let find_header_file1 cppopts dirname inc_file = match inc_file with | Local f -> let finalfile = Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in if Sys.file_exists finalfile then [finalfile] else [] | NonLocal f -> i_of_cpp_options cppopts +> Common.map_filter (fun dirname -> let finalfile = Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in if Sys.file_exists finalfile then Some finalfile else None ) | Weird s -> pr2 ("CPPAST: weird include not handled:" ^ s); [] (* todo? can try find most precise ? first just use basename but * then maybe look if have also some dir in common ? *) let find_header_file2 inc_file = match inc_file with | Local f | NonLocal f -> let s = (Ast_c.s_of_inc_file inc_file) in let base = Filename.basename s in let res = Hashtbl.find_all _hcandidates base in (match res with | [file] -> pr2_debug ("CPPAST: find header in other dir: " ^ file); res | [] -> [] | x::y::xs -> res ) | Weird s -> [] let find_header_file cppopts dirname inc_file = let res1 = find_header_file1 cppopts dirname inc_file in match res1 with | [file] -> res1 | [] -> find_header_file2 inc_file | x::y::xs -> res1 (* ---------------------------------------------------------------------- *) let _headers_hash = Hashtbl.create 101 (* On freebsd ocaml is trashing, use up to 1.6Go of memory and then * building the database_c takes ages. * * So just limit with following threshold to avoid this trashing, simple. * * On netbsd, got a Out_of_memory exn on this file; * /home/pad/software-os-src2/netbsd/dev/microcode/cyclades-z/ * even if the cache is small. That's because huge single * ast element and probably the ast marshalling fail. *) let default_threshold_cache_nb_files = 200 let parse_c_and_cpp_cache ?(threshold_cache_nb_files= default_threshold_cache_nb_files) file = if Hashtbl.length _headers_hash > threshold_cache_nb_files then Hashtbl.clear _headers_hash; Common.memoized _headers_hash file (fun () -> Parse_c.parse_c_and_cpp false file (* no need to parse strings *) ) (*****************************************************************************) (* Main entry *) (*****************************************************************************) let (cpp_expand_include2: ?depth_limit:int option -> ?threshold_cache_nb_files:int -> cpp_option list -> Common.dirname -> Ast_c.program -> Ast_c.program) = fun ?(depth_limit=None) ?threshold_cache_nb_files iops dirname ast -> if !Flag_parsing_c.debug_cpp_ast then pr2_xxxxxxxxxxxxxxxxx(); let already_included = ref [] in let rec aux stack dirname ast = let depth = List.length stack in ast +> Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with Visitor_c.kcppdirective_s = (fun (k, bigf) cpp -> match cpp with | Include {i_include = (inc_file, ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = copt; } -> (match depth_limit with | Some limit when depth >= limit -> cpp | _ -> (match find_header_file iops dirname inc_file with | [file] -> if List.mem file !already_included then begin (* pr2 ("already included: " ^ file); *) trace_cpp_process depth "*" inc_file; k cpp end else begin trace_cpp_process depth "" inc_file; Common.push2 file already_included; (* CONFIG *) Flag_parsing_c.verbose_parsing := false; Flag_parsing_c.verbose_lexing := false; let (ast2, _stat) = parse_c_and_cpp_cache ?threshold_cache_nb_files file in let ast = Parse_c.program_of_program2 ast2 in let dirname' = Filename.dirname file in (* recurse *) let ast' = aux (file::stack) dirname' ast in Include {i_include = (inc_file, ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = Some (file, ast'); } end | [] -> trace_cpp_process depth "!!" inc_file; pr2 "CPPAST: file not found"; k cpp | x::y::zs -> trace_cpp_process depth "!!" inc_file; pr2 "CPPAST: too much candidates"; k cpp ) ) | _ -> k cpp ); } in aux [] dirname ast let cpp_expand_include ?depth_limit ?threshold_cache_nb_files a b c = Common.profile_code "cpp_expand_include" (fun () -> cpp_expand_include2 ?depth_limit ?threshold_cache_nb_files a b c) (* let unparse_showing_include_content ? *) (*****************************************************************************) (* Ifdef-statementize *) (*****************************************************************************) let is_ifdef_and_same_tag tag x = match x with | IfdefStmt (IfdefDirective ((_, tag2),_)) -> tag =*= tag2 | StmtElem _ | CppDirectiveStmt _ -> false | IfdefStmt2 _ -> raise (Impossible 77) (* What if I skipped in the parser only some of the ifdef elements * of the same tag. Once I passed one, I should pass all of them and so * at least should detect here that one tag is not "valid". Maybe in the parser * can return or marked some tags as "partially_passed_ifdef_tag". * Maybe could do in ast_c a MatchingTag of int * bool ref (* one_was_passed *) * where the ref will be shared by the ifdefs with the same matching tag * indice. Or simply count the number of directives with the same tag and * put this information in the tag. Hence the total_with_this_tag below. *) let should_ifdefize (tag,ii) ifdefs_directives xxs = let IfdefTag (_tag, total_with_this_tag) = tag in if total_with_this_tag <> List.length ifdefs_directives then begin let strloc = Ast_c.strloc_of_info (List.hd ii) in pr2 (spf "CPPASTC: can not ifdefize ifdef at %s" strloc); pr2 "CPPASTC: some of its directives were passed"; false end else (* todo? put more condition ? don't ifdefize declaration ? *) true (* return a triple, (ifdefs directive * grouped xs * remaining sequencable) * XXX1 XXX2 elsif YYY1 else ZZZ1 endif WWW1 WWW2 * => [elsif, else, endif], [XXX1 XXX2; YYY1; ZZZ1], [WWW1 WWW2] *) let group_ifdef tag xs = let (xxs, xs) = group_by_post (is_ifdef_and_same_tag tag) xs in xxs +> List.map snd +> List.map (fun x -> match x with | IfdefStmt y -> y | StmtElem _ | CppDirectiveStmt _ | IfdefStmt2 _ -> raise (Impossible 78) ), xxs +> List.map fst, xs let rec cpp_ifdef_statementize ast = Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with Visitor_c.kstatementseq_list_s = (fun (k, bigf) xs -> let rec aux xs = match xs with | [] -> [] | stseq::xs -> (match stseq with | StmtElem st -> Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs | CppDirectiveStmt directive -> Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs | IfdefStmt ifdef -> (match ifdef with | IfdefDirective ((Ifdef,tag),ii) -> let (restifdefs, xxs, xs') = group_ifdef tag xs in if should_ifdefize (tag,ii) (ifdef::restifdefs) xxs then let res = IfdefStmt2 (ifdef::restifdefs, xxs) in Visitor_c.vk_statement_sequencable_s bigf res::aux xs' else Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs | IfdefDirective (((IfdefElseif|IfdefElse|IfdefEndif),b),ii) -> pr2 "weird: first directive is not a ifdef"; (* maybe not weird, just that should_ifdefize * returned false *) Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs ) | IfdefStmt2 (ifdef, xxs) -> failwith "already applied cpp_ifdef_statementize" ) in aux xs ); } ast (*****************************************************************************) (* Macro *) (*****************************************************************************) let (cpp_expand_macro_expr: Ast_c.define_kind -> Ast_c.argument Ast_c.wrap2 list -> Ast_c.expression option) = fun defkind args -> raise Todo coccinelle-1.0.0-rc19/parsing_c/cpp_token_c.ml0000644000175000017500000004755112247437436020167 0ustar eugeneugenopen Common module TH = Token_helpers open Parser_c open Token_views_c (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* cpp functions working at the token level. Cf cpp_ast_c for cpp functions * working at the AST level (which is very unusual but makes sense in * the coccinelle context for instance). * * Note that as I use a single lexer to work both at the C and cpp level * there are some inconveniencies. * For instance 'for' is a valid name for a macro parameter and macro * body, but is interpreted in a special way by our single lexer, and * so at some places where I expect a TIdent I need also to * handle special cases and accept Tfor, Tif, etc at those places. * * There are multiple issues related to those keywords incorrect tokens. * Those keywords can be: * - (1) in the name of the macro as in #define inline * - (2) in a parameter of the macro as in #define foo(char) char x; * - (3) in an argument to a macro call as in IDENT(if); * Case 1 is easy to fix in define_ident. * Case 2 is easy to fix in define_parse where detect such toks in * the parameter and then replace their occurrence in the body in a Tident. * Case 3 is only an issue when the expanded token is not really use * as usual but use for instance in concatenation as in a ## if * when expanded. In the case the grammar this time will not be happy * so this is also easy to fix in cpp_engine. * *) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Types *) (*****************************************************************************) (* ------------------------------------------------------------------------- *) (* mimic standard.h *) (* ------------------------------------------------------------------------- *) type define_def = string * define_param * define_body and define_param = | NoParam | Params of define_arg list and define_arg = FixedArg of string | VariadicArg of string and define_body = | DefineBody of Parser_c.token list | DefineHint of parsinghack_hint and parsinghack_hint = | HintIterator | HintDeclarator | HintMacroString | HintMacroStatement | HintAttribute | HintMacroIdentBuilder (*****************************************************************************) (* Parsing and helpers of hints *) (*****************************************************************************) (* cf also data/test.h *) let assoc_hint_string = [ "YACFE_ITERATOR" , HintIterator; "YACFE_DECLARATOR" , HintDeclarator; "YACFE_STRING" , HintMacroString; "YACFE_STATEMENT" , HintMacroStatement; "YACFE_ATTRIBUTE" , HintAttribute; "YACFE_IDENT_BUILDER" , HintMacroIdentBuilder; "MACROSTATEMENT" , HintMacroStatement; (* backward compatibility *) ] let (parsinghack_hint_of_string: string -> parsinghack_hint option) = fun s -> Common.assoc_option s assoc_hint_string let (string_of_parsinghack_hint: parsinghack_hint -> string) = fun hint -> let assoc' = assoc_hint_string +> List.map (fun (a,b) -> (b,a) ) in Common.assoc hint assoc' let (is_parsinghack_hint: string -> bool) = fun s -> parsinghack_hint_of_string s <> None let (token_from_parsinghack_hint: (string * Ast_c.info) -> parsinghack_hint -> Parser_c.token) = fun (s,ii) hint -> match hint with | HintIterator -> Parser_c.TMacroIterator (s, ii) | HintDeclarator -> Parser_c.TMacroDecl (s, ii) | HintMacroString -> Parser_c.TMacroString (s, ii) | HintMacroStatement -> Parser_c.TMacroStmt (s, ii) | HintAttribute -> Parser_c.TMacroAttr (s, ii) | HintMacroIdentBuilder -> Parser_c.TMacroIdentBuilder (s, ii) (* used in extract_macros for example *) let string_of_define_def (s, params, body) = let s1 = match params with | NoParam -> spf "#define %s " s | Params xs -> let xs = List.map (function FixedArg s -> s | VariadicArg s -> s) xs in spf "#define %s(%s) " s (Common.join "," xs) in let s2 = match body with | DefineHint hint -> string_of_parsinghack_hint hint | DefineBody xs -> Common.join " " (xs +> List.map Token_helpers.str_of_tok) in s1 ^ s2 (*****************************************************************************) (* Expansion helpers *) (*****************************************************************************) (* In some cases we can have macros like IDENT(if) that expands to some * 'int xxx_if(void)', but as the lexer will currently generate a Tif for * the expanded code, that may not be accepted as a token after a ## * in the grammar. Hence this function to remap some tokens. This is because * we should not use a single lexer for both working at the C level and * cpp level. * * update: it can also rename some TypedefIdent into TIdent, possibly * because of bad interaction with add_typedef_root in parsing_hacks. *) let rec remap_keyword_tokens xs = match xs with | [] -> [] | [x] -> [x] | x::y::xs -> (match x, y with | Parser_c.TCppConcatOp _, Parser_c.TIdent _ -> x::y::remap_keyword_tokens xs | Parser_c.TIdent _, Parser_c.TCppConcatOp _ -> x::y::remap_keyword_tokens xs | Parser_c.TCppConcatOp (i1), y -> let s = TH.str_of_tok y in let ii = TH.info_of_tok y in if s ==~ Common.regexp_alpha then begin pr2 (spf "remapping: %s to an ident in expanded code" s); x::(Parser_c.TIdent (s, ii))::remap_keyword_tokens xs end else x::y::remap_keyword_tokens xs | x, Parser_c.TCppConcatOp (i1) -> let s = TH.str_of_tok x in let ii = TH.info_of_tok x in if s ==~ Common.regexp_alpha then begin pr2 (spf "remapping: %s to an ident in expanded code" s); (Parser_c.TIdent (s, ii))::remap_keyword_tokens (y::xs) end else x::y::remap_keyword_tokens xs | _, _ -> x::remap_keyword_tokens (y::xs) ) (* works with agglomerate_concat_op_ident below *) let rec get_ident_in_concat_op xs = match xs with | [] -> pr2 "weird: ident after ## operator not found"; "", [] | [x] -> (match x with | Parser_c.TIdent (s, i1) -> s, [] | _ -> pr2 "weird: ident after ## operator not found"; "", [x] ) | x::y::xs -> (match x, y with | Parser_c.TIdent (s,i1), Parser_c.TCppConcatOp (i2) -> let (s2, rest) = get_ident_in_concat_op xs in s ^ s2, rest | Parser_c.TIdent (s, i1), _ -> s, (y::xs) | _ -> pr2 "weird: ident after ## operator not found"; "", x::y::xs ) (* must be run after the expansion has been done for the parameter so * that all idents are actually ident, not macro parameter names. *) let rec agglomerate_concat_op_ident xs = match xs with | [] -> [] | [x] -> [x] | x::y::xs -> (* can we have ## id, and so ## as first token ? yes * but the semantic is different as it represents variadic * names so this must be handled elsewhere. *) (match x, y with | Parser_c.TIdent (s,i1), Parser_c.TCppConcatOp (i2) -> let (all_str_ident, rest_toks) = get_ident_in_concat_op xs in let new_s = s ^ all_str_ident in let i1' = Ast_c.rewrap_str new_s i1 in Parser_c.TIdent (new_s, i1')::agglomerate_concat_op_ident rest_toks | Parser_c.TCppConcatOp _, _ -> pr2 "weird, ## alone"; x::agglomerate_concat_op_ident (y::xs) | _ -> x::agglomerate_concat_op_ident (y::xs) ) (* To expand the parameter of the macro. The env corresponds to the actual * code that is binded to the parameters of the macro. * Recurse ? fixpoint ? the expansion may also contain macro. * Or to macro expansion in a strict manner, that is process first * the parameters, expands macro in params, and then process enclosing * macro call. * * note: do the concatenation job of a##b here ? * normally this should be done in the grammar. Here just expand * tokens. The only thing we handle here is we may have to remap * some tokens. * * todo: handle stringification here ? if #n * * todo? but could parsing_hacks then pass over the remapped tokens, * for instance transform some of the back into some TypedefIdent * so cpp_engine may be fooled? *) let rec (cpp_engine: ?evaluate_concatop:bool -> (string , Parser_c.token list) assoc -> Parser_c.token list -> Parser_c.token list) = fun ?(evaluate_concatop=true) env xs -> xs +> List.map (fun tok -> (* expand only TIdent ? no cos the parameter of the macro * can actually be some 'register' so may have to look for * any tokens candidates for the expansion. * Only subtelity is maybe don't expand the TDefineIdent. * * update: in fact now the caller (define_parse) will have done * the job right and already replaced the macro parameter with a TIdent. *) match tok with | TIdent (s,i1) when List.mem_assoc s env -> Common.assoc s env | x -> [x] ) +> List.flatten +> remap_keyword_tokens +> (fun xs -> if evaluate_concatop then agglomerate_concat_op_ident xs else xs ) (* ------------------------------------------------------------------------- *) (* apply macro, using standard.h or other defs *) (* ------------------------------------------------------------------------- *) (* Thanks to this function many stuff are not anymore hardcoded in ocaml code. * At some point there were hardcoded in a standard.h file but now I * can even generate them on the fly on demand when there is actually * a parsing problem. * * No need to take care to not substitute the macro name itself * that occurs in the macro definition because the macro name is * after fix_token_define a TDefineIdent, no more a TIdent. *) let rec apply_macro_defs ~msg_apply_known_macro ~msg_apply_known_macro_hint ?evaluate_concatop ?(inplace_when_single=true) defs xs = let rec apply_macro_defs xs = match xs with | [] -> () (* old: "but could do more, could reuse same original token * so that have in the Ast a Dbg, not a MACROSTATEMENT" * * | PToken ({tok = TIdent (s,i1)} as id)::xs * when s = "MACROSTATEMENT" -> * * msg_macro_statement_hint s; * id.tok <- TMacroStmt(TH.info_of_tok id.tok); * find_macro_paren xs * * let msg_macro_statement_hint s = * incr Stat.nMacroHint; * () * *) (* recognized macro of standard.h (or other) *) | PToken ({tok = TIdent (s,i1)} as id)::Parenthised (xxs,info_parens)::xs when Hashtbl.mem defs s -> msg_apply_known_macro s; let (s, params, body) = Hashtbl.find defs s in (match params with | NoParam -> pr2 ("WEIRD: macro without param used before parenthize: " ^ s); (* ex: PRINTP("NCR53C400 card%s detected\n" ANDP(((struct ... *) (match body with | DefineBody bodymacro -> set_as_comment (Token_c.CppMacro) id; id.new_tokens_before <- bodymacro; | DefineHint hint -> msg_apply_known_macro_hint s; id.tok <- token_from_parsinghack_hint (s,i1) hint; ) | Params params -> (match body with | DefineBody bodymacro -> (* bugfix: better to put this that before the match body, * cos our macrostatement hint can have variable number of * arguments and so it's ok if it does not match exactly * the number of arguments. *) let build_binder params xxs = let rec loop = function ([],[]) -> Some (function [] -> [] | _ -> failwith "bad") | ([],[[]]) -> Some (function [[]] -> [] | _ -> failwith "bad") | ([],l) -> None | ([(VariadicArg s)],l) -> Some (function l -> List.map (function a -> (s,a)) l) | ((VariadicArg _)::_,l) -> None | ((FixedArg _)::_,[]) -> None | ((FixedArg s)::rest,x::xs) -> (match loop (rest,xs) with Some k -> Some (function l -> (s,(List.hd l)) :: k (List.tl l)) | None -> None) in loop (params, xxs) in (match build_binder params xxs with None -> pr2_once ("WEIRD: macro with wrong number of arguments: " ^ s); (* old: id.new_tokens_before <- bodymacro; *) (* update: if wrong number, then I just pass this macro *) [Parenthised (xxs, info_parens)] +> iter_token_paren (set_as_comment Token_c.CppMacro); set_as_comment Token_c.CppMacro id | Some bind -> let xxs' = xxs +> List.map (fun x -> (tokens_of_paren_ordered x) +> List.map (fun x -> TH.visitor_info_of_tok Ast_c.make_expanded x.tok ) ) in id.new_tokens_before <- (* !!! cpp expansion job here !!! *) cpp_engine ?evaluate_concatop (bind xxs') bodymacro; (* important to do that after have apply the macro, otherwise will pass as argument to the macro some tokens that are all TCommentCpp *) [Parenthised (xxs, info_parens)] +> iter_token_paren (set_as_comment Token_c.CppMacro); set_as_comment Token_c.CppMacro id) | DefineHint (HintMacroStatement as hint) -> (* important to do that after have apply the macro, otherwise * will pass as argument to the macro some tokens that * are all TCommentCpp * * note: such macrostatement can have a variable number of * arguments but here we don't care, we just pass all the * parameters. *) (match xs with | PToken ({tok = TPtVirg _} as id2)::_ -> pr2_once ("macro stmt with trailing ';', passing also ';' for: "^ s); (* sometimes still want pass its params ... as in * DEBUGPOLL(static unsigned int prev_mask = 0); *) msg_apply_known_macro_hint s; id.tok <- token_from_parsinghack_hint (s,i1) hint; [Parenthised (xxs, info_parens)] +> iter_token_paren (set_as_comment Token_c.CppMacro); set_as_comment Token_c.CppMacro id2; | _ -> msg_apply_known_macro_hint s; id.tok <- token_from_parsinghack_hint (s,i1) hint; [Parenthised (xxs, info_parens)] +> iter_token_paren (set_as_comment Token_c.CppMacro); ) | DefineHint hint -> msg_apply_known_macro_hint s; id.tok <- token_from_parsinghack_hint (s,i1) hint; ) ); apply_macro_defs xs | PToken ({tok = TIdent (s,i1)} as id)::xs when Hashtbl.mem defs s -> msg_apply_known_macro s; let (_s, params, body) = Hashtbl.find defs s in (match params with | Params _ -> pr2 ("WEIRD: macro with params but no parens found: " ^ s); (* don't apply the macro, perhaps a redefinition *) () | NoParam -> (match body with (* bugfix: we prefer not using this special case when we come * from extract_macros context *) | DefineBody [newtok] when inplace_when_single -> (* special case when 1-1 substitution, we reuse the token *) id.tok <- (newtok +> TH.visitor_info_of_tok (fun _ -> TH.info_of_tok id.tok)) | DefineBody bodymacro -> set_as_comment Token_c.CppMacro id; id.new_tokens_before <- bodymacro; | DefineHint hint -> msg_apply_known_macro_hint s; id.tok <- token_from_parsinghack_hint (s,i1) hint; ) ); apply_macro_defs xs (* recurse *) | (PToken x)::xs -> apply_macro_defs xs | (Parenthised (xxs, info_parens))::xs -> xxs +> List.iter apply_macro_defs; apply_macro_defs xs in apply_macro_defs xs (*****************************************************************************) (* extracting define_def from a standard.h *) (*****************************************************************************) (* was the cpp-builtin, standard.h, part 0 *) let macro_body_to_maybe_hint body = match body with | [] -> DefineBody body | [TIdent (s,i1)] -> (match parsinghack_hint_of_string s with | Some hint -> DefineHint hint | None -> DefineBody body ) | xs -> DefineBody body exception Bad_param let rec (define_parse: Parser_c.token list -> (string * define_def) list) = fun xs -> match xs with | [] -> [] | TDefine i1::TIdentDefine (s,i2)::TOParDefine i3::xs -> (* note: the macro could be badly written and have no closing ')' for * its param, which would make us go too far away, but I don't think * it's important to handle such an error *) let def = try let (tokparams, _, xs) = xs +> Common.split_when (function TCPar _ -> true | _ -> false) in let (body, _, xs) = xs +> Common.split_when (function TDefEOL _ -> true | _ -> false) in let params = tokparams +> Common.map_filter (function | TComma _ -> None | TIdent (s, _) -> Some (FixedArg s) (* TODO *) | TDefParamVariadic (s, _) -> Some (VariadicArg s) (* TODO *) | TEllipsis _ -> Some (VariadicArg "...") | x -> (* bugfix: param of macros can be tricky *) let s = TH.str_of_tok x in if s ==~ Common.regexp_alpha then begin pr2 (spf "remapping: %s to a macro parameter" s); Some (FixedArg s) end else begin pr2 (spf "bad character %s in macro parameter list" s); raise Bad_param end) in (* bugfix: also substitute to ident in body so cpp_engine will * have an easy job. *) let body = body +> List.map (fun tok -> match tok with | TIdent _ -> tok | _ -> let s = TH.str_of_tok tok in let ii = TH.info_of_tok tok in let params = List.map (function FixedArg s -> s | VariadicArg s -> s) params in if s ==~ Common.regexp_alpha && List.mem s params then begin pr2 (spf "remapping: %s to an ident in macro body" s); TIdent (s, ii) end else tok) +> List.map (TH.visitor_info_of_tok Ast_c.make_expanded) in Some (s, (s, Params params, macro_body_to_maybe_hint body)) with Bad_param -> None in (match def with Some def -> def::define_parse xs | None -> define_parse xs) | TDefine i1::TIdentDefine (s,i2)::xs -> let (body, _, xs) = xs +> Common.split_when (function TDefEOL _ -> true | _ -> false) in let body = body +> List.map (TH.visitor_info_of_tok Ast_c.make_expanded) in let def = (s, (s, NoParam, macro_body_to_maybe_hint body)) in def::define_parse xs (* cf tests-bis/define_plus.c *) | TDefine i1::xs -> let line = Ast_c.line_of_info i1 in pr2 (spf "WEIRD: no ident in define at line %d" line); define_parse xs | x::xs -> define_parse xs let extract_macros xs = let cleaner = xs +> List.filter (fun x -> not (TH.is_comment x) ) in define_parse cleaner coccinelle-1.0.0-rc19/parsing_c/compare_c.mli0000644000175000017500000000114712247437436017773 0ustar eugeneugentype compare_result = | Correct | Pb of string | PbOnlyInNotParsedCorrectly of string (* the string list is the output of diff *) val compare_ast : Common.filename -> Common.filename -> compare_result * string list val compare_default : (* compare to a res file *) Common.filename -> Common.filename -> compare_result * string list val compare_to_original : (* compare to the source of the transformation *) Common.filename -> Common.filename -> compare_result * string list val compare_result_to_string : compare_result * string list -> string val compare_result_to_bool : compare_result -> bool coccinelle-1.0.0-rc19/parsing_c/orig.mly0000644000175000017500000002237512247437436017031 0ustar eugeneugen%{ (* src: ocamlyaccified from * http://www.lysator.liu.se/c/ANSI-C-grammar-y.html *) open Common open AbstractSyntax exception Parsing of string %} %token TString %token TIdent %token TInt %token TFloat /*(* conflicts *)*/ %token TypedefIdent %token TOPar TCPar TOBrace TCBrace TOCro TCCro %token TDot TComma TPtrOp %token TInc TDec %token TAssign %token TEq %token TWhy TDotDot TPtVirg TTilde TBang %token TEllipsis %token TOrLog TAndLog TOrIncl TOrExcl TAnd TEqEq TNotEq TInf TSup TInfEq TSupEq TShl TShr TPlus TMinus TMul TDiv TMod TMax TMin %token Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid Tauto Tregister Textern Tstatic Tconst Tvolatile Tstruct Tenum Ttypedef Tunion Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif Twhile Treturn Tgoto Tdefault Tsizeof %token EOF %left TOrLog %left TAndLog %left TOrIncl %left TOrExcl %left TAnd %left TEqEq TNotEq %left TInf TSup TInfEq TSupEq %left TShl TShr %left TPlus TMinus <<<<<<< HEAD %left TMul TDiv TMod TMin TMax ======= %left TMul TDiv TMod TMax TMin >>>>>>> f34e373405e4b42e2905216142a30f4f96a0a053 %start main %type main %% main: translation_unit EOF { [] } /********************************************************************************/ /* expression statement declaration main */ /********************************************************************************/ expr: assign_expr { } | expr TComma assign_expr { } assign_expr: cond_expr { } | unary_expr TAssign assign_expr { } | unary_expr TEq assign_expr { } cond_expr: arith_expr {} | arith_expr TWhy expr TDotDot cond_expr {} arith_expr: cast_expr {} | arith_expr TMul arith_expr {} | arith_expr TDiv arith_expr {} | arith_expr TMin arith_expr {} | arith_expr TMax arith_expr {} | arith_expr TMod arith_expr {} | arith_expr TPlus arith_expr {} | arith_expr TMinus arith_expr {} | arith_expr TShl arith_expr {} | arith_expr TShr arith_expr {} | arith_expr TInf arith_expr {} | arith_expr TSup arith_expr {} | arith_expr TInfEq arith_expr {} | arith_expr TSupEq arith_expr {} | arith_expr TEqEq arith_expr {} | arith_expr TNotEq arith_expr {} | arith_expr TAnd arith_expr {} | arith_expr TOrExcl arith_expr {} | arith_expr TOrIncl arith_expr {} | arith_expr TAndLog arith_expr {} | arith_expr TOrLog arith_expr {} cast_expr: unary_expr {} | TOPar type_name TCPar cast_expr {} unary_expr: postfix_expr {} | TInc unary_expr {} | TDec unary_expr {} | unary_op cast_expr {} | Tsizeof unary_expr {} | Tsizeof TOPar type_name TCPar {} unary_op: TAnd {} | TMul {} | TPlus {} | TMinus{} | TTilde{} | TBang {} postfix_expr: primary_expr {} | postfix_expr TOCro expr TCCro {} | postfix_expr TOPar argument_expr_list TCPar {} | postfix_expr TOPar TCPar {} | postfix_expr TDot TIdent {} | postfix_expr TPtrOp TIdent {} | postfix_expr TInc {} | postfix_expr TDec {} argument_expr_list: assign_expr { } | argument_expr_list TComma assign_expr {} primary_expr: TIdent {} | TInt {} | TFloat {} | TString {} | TOPar expr TCPar {} const_expr: cond_expr {} /********************************************************************************/ statement: labeled {} | compound {} | expr_statement {} | selection {} | iteration {} | jump TPtVirg {} labeled: TIdent TDotDot statement {} | Tcase const_expr TDotDot statement {} | Tdefault TDotDot statement {} compound: TOBrace TCBrace {} | TOBrace statement_list TCBrace {} | TOBrace decl_list TCBrace {} | TOBrace decl_list statement_list TCBrace {} decl_list: decl {} | decl decl_list {} statement_list: statement {} | statement statement_list {} expr_statement: TPtVirg {} | expr TPtVirg {} selection: Tif TOPar expr TCPar statement {} | Tif TOPar expr TCPar statement Telse statement {} | Tswitch TOPar expr TCPar statement {} iteration: Twhile TOPar expr TCPar statement {} | Tdo statement Twhile TOPar expr TCPar TPtVirg {} | Tfor TOPar expr_statement expr_statement TCPar statement {} | Tfor TOPar expr_statement expr_statement expr TCPar statement {} jump: Tgoto TIdent {} | Tcontinue {} | Tbreak {} | Treturn {} | Treturn expr {} /********************************************************************************/ /*------------------------------------------------------------------------------*/ decl: decl_spec TPtVirg {} | decl_spec init_declarator_list TPtVirg {} /*------------------------------------------------------------------------------*/ decl_spec: storage_class_spec {} | storage_class_spec decl_spec {} | type_spec {} | type_spec decl_spec {} | type_qualif {} | type_qualif decl_spec {} storage_class_spec: Tstatic {} | Textern {} | Tauto {} | Tregister {} | Ttypedef {} type_spec: Tvoid {} | Tchar {} | Tshort {} | Tint {} | Tlong {} | Tfloat {} | Tdouble {} | Tsigned {} | Tunsigned {} | struct_or_union_spec {} | enum_spec {} /*TODO | TIdent {} */ | TypedefIdent {} type_qualif: Tconst {} | Tvolatile {} /*------------------------------------------------------------------------------*/ struct_or_union_spec: struct_or_union TIdent TOBrace struct_decl_list TCBrace {} | struct_or_union TOBrace struct_decl_list TCBrace {} | struct_or_union TIdent {} struct_or_union: Tstruct {} | Tunion {} struct_decl_list: struct_decl {} | struct_decl_list struct_decl {} struct_decl: spec_qualif_list struct_declarator_list TPtVirg {} spec_qualif_list: type_spec {} | type_spec spec_qualif_list {} | type_qualif {} | type_qualif spec_qualif_list {} struct_declarator_list: struct_declarator {} | struct_declarator_list TComma struct_declarator {} struct_declarator: declarator {} | TDotDot const_expr {} | declarator TDotDot const_expr {} /*------------------------------------------------------------------------------*/ enum_spec: Tenum TOBrace enumerator_list TCBrace {} | Tenum TIdent TOBrace enumerator_list TCBrace {} | Tenum TIdent {} enumerator_list: enumerator {} | enumerator_list TComma enumerator {} enumerator: TIdent {} | TIdent TEq const_expr {} /*------------------------------------------------------------------------------*/ init_declarator_list: init_declarator {} | init_declarator_list TComma init_declarator {} init_declarator: declarator {} | declarator TEq initialize {} /*------------------------------------------------------------------------------*/ declarator: pointer direct_declarator {} | direct_declarator {} pointer: TMul {} | TMul type_qualif_list {} | TMul pointer {} | TMul type_qualif_list pointer {} direct_declarator: TIdent {} | TOPar declarator TCPar {} | direct_declarator TOCro const_expr TCCro {} | direct_declarator TOCro TCCro {} | direct_declarator TOPar TCPar {} | direct_declarator TOPar parameter_type_list TCPar {} | direct_declarator TOPar identifier_list TCPar {} type_qualif_list: type_qualif {} | type_qualif_list type_qualif {} parameter_type_list: parameter_list {} | parameter_list TComma TEllipsis {} parameter_list: parameter_decl {} | parameter_list TComma parameter_decl {} parameter_decl: decl_spec declarator {} | decl_spec abstract_declarator {} | decl_spec {} identifier_list: TIdent {} | identifier_list TComma TIdent {} /*------------------------------------------------------------------------------*/ type_name: spec_qualif_list {} | spec_qualif_list abstract_declarator {} abstract_declarator: pointer {} | direct_abstract_declarator {} | pointer direct_abstract_declarator {} direct_abstract_declarator: TOPar abstract_declarator TCPar {} | TOCro TCCro {} | TOCro const_expr TCCro {} | direct_abstract_declarator TOCro TCCro {} | direct_abstract_declarator TOCro const_expr TCCro {} | TOPar TCPar {} | TOPar parameter_type_list TCPar {} | direct_abstract_declarator TOPar TCPar {} | direct_abstract_declarator TOPar parameter_type_list TCPar {} /*------------------------------------------------------------------------------*/ initialize: assign_expr {} | TOBrace initialize_list TCBrace {} | TOBrace initialize_list TComma TCBrace {} initialize_list: initialize {} | initialize_list TComma initialize {} /********************************************************************************/ translation_unit: external_declaration {} | translation_unit external_declaration {} external_declaration: function_definition {} | decl {} function_definition: decl_spec declarator decl_list compound {} | decl_spec declarator compound {} | declarator decl_list compound {} | declarator compound {} coccinelle-1.0.0-rc19/parsing_c/type_annoter_c.mli0000644000175000017500000000172712247437436021060 0ustar eugeneugentype namedef = | VarOrFunc of string * Ast_c.exp_type | EnumConstant of string * string option | TypeDef of string * Ast_c.fullType | StructUnionNameDef of string * (Ast_c.structUnion * Ast_c.structType) Ast_c.wrap | Macro of string * (Ast_c.define_kind * Ast_c.define_val) (* have nested scope, so nested list*) type environment = namedef list list (* can be set with init_env *) val initial_env : environment ref (* ex: config/envos/environment_unix.h, seems to be unused *) val init_env_unused : Common.filename -> unit val annotate_type_and_localvar : environment -> Ast_c.toplevel list -> (Ast_c.toplevel * environment Common.pair) list (* julia: cocci *) val annotate_test_expressions : Ast_c.toplevel list -> unit (* !!Annotate via side effects!!. Fill in the type * information that was put to None during parsing. *) val annotate_program : environment -> Ast_c.toplevel list -> (Ast_c.toplevel * environment Common.pair) list coccinelle-1.0.0-rc19/parsing_c/lexer_parser.ml0000644000175000017500000000771512247437436020374 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2002, 2006 Yoann Padioleau * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (* Tricks used to handle the ambiguity in the grammar with the typedef * which impose a cooperation between the lexer and the parser. * * An example by hughes casse: "in the symbol table, local * definition must replace type definition in order to correctly parse * local variable in functions body. This is the only way to correctly * handle this kind of exception, that is, * * typedef ... ID; int f(int *p) {int ID; return (ID) * *p;} If ID * isn't overload, last expression is parsed as a type cast, if it * isn't, this a multiplication." * * Why parse_typedef_fix2 ? Cos when introduce new variable, for * instance when declare parameters for a function such as int var_t, * then the var_t must not be lexed as a typedef, so we must disable * temporaly the typedef mechanism to allow variable with same name as * a typedef. *) (* parse_typedef_fix *) let _handle_typedef = ref true let _always_look_typedef = ref false (* parse_typedef_fix2 *) let enable_typedef () = _handle_typedef := true let disable_typedef () = _handle_typedef := false let is_enabled_typedef () = !_handle_typedef type identkind = TypeDefI | IdentI (* Ca marche ce code ? on peut avoir un typedef puis un ident puis * un typedef nested ? oui car Hashtbl (dans scoped_h_env) gere l'historique. * * oldsimple: but slow, take 2 secondes on some C files * let (typedef: typedef list list ref) = ref [[]] *) let (_typedef : (string, identkind) Common.scoped_h_env ref) = ref (Common.empty_scoped_h_env ()) let is_typedef s = if !_handle_typedef || !_always_look_typedef then (match (Common.optionise (fun () -> Common.lookup_h_env s !_typedef)) with | Some TypeDefI -> true | Some IdentI -> false | None -> false ) else false let new_scope() = Common.new_scope_h _typedef let del_scope() = Common.del_scope_h _typedef let add_typedef s = Common.add_in_scope_h _typedef (s, TypeDefI) let add_ident s = Common.add_in_scope_h _typedef (s, IdentI) let add_typedef_root s = if !Flag_parsing_c.add_typedef_root then Hashtbl.add !_typedef.scoped_h s TypeDefI else add_typedef s (* have far more .failed without this *) (* Used by parse_c when do some error recovery. The parse error may * have some bad side effects on typedef hash, so recover this. *) let _old_state = ref (Common.clone_scoped_h_env !_typedef) let save_typedef_state () = _old_state := Common.clone_scoped_h_env !_typedef let restore_typedef_state () = _typedef := !_old_state type context = | InTopLevel | InFunction | InStruct | InParameter | InInitializer | InEnum (* InExpr ? but then orthogonal to InFunction. Could assign InExpr for * instance after a '=' as in 'a = (irq_t) b;' *) let is_top_or_struct = function | InTopLevel | InStruct -> true | _ -> false type lexer_hint = { mutable context_stack: context Common.stack; } let default_hint () = { context_stack = [InTopLevel]; } let _lexer_hint = ref (default_hint()) let current_context () = List.hd !_lexer_hint.context_stack let push_context ctx = !_lexer_hint.context_stack <- ctx::!_lexer_hint.context_stack let pop_context () = !_lexer_hint.context_stack <- List.tl !_lexer_hint.context_stack let lexer_reset_typedef saved_typedefs = begin _handle_typedef := true; (match saved_typedefs with None -> _typedef := Common.empty_scoped_h_env () | Some t -> _typedef := t); _lexer_hint := (default_hint ()); end coccinelle-1.0.0-rc19/parsing_c/visitor_c.mli0000644000175000017500000001715112247437436020046 0ustar eugeneugenopen Ast_c type visitor_c = { kexpr : (expression -> unit) * visitor_c -> expression -> unit; kstatement : (statement -> unit) * visitor_c -> statement -> unit; ktype : (fullType -> unit) * visitor_c -> fullType -> unit; kdecl : (declaration -> unit) * visitor_c -> declaration -> unit; konedecl : (onedecl -> unit) * visitor_c -> onedecl -> unit; kparam : (parameterType -> unit) * visitor_c -> parameterType -> unit; kdef : (definition -> unit) * visitor_c -> definition -> unit; kname : (name -> unit) * visitor_c -> name -> unit; kini : (initialiser -> unit) * visitor_c -> initialiser -> unit; kfield : (field -> unit) * visitor_c -> field -> unit; kcppdirective: (cpp_directive -> unit) * visitor_c -> cpp_directive -> unit; kdefineval : (define_val -> unit) * visitor_c -> define_val -> unit; kstatementseq: (statement_sequencable -> unit) * visitor_c -> statement_sequencable -> unit; knode: (Control_flow_c.node -> unit) * visitor_c -> Control_flow_c.node -> unit; ktoplevel: (toplevel -> unit) * visitor_c -> toplevel -> unit; kfragment: (string_fragment -> unit) * visitor_c -> string_fragment -> unit; kformat: (string_format -> unit) * visitor_c -> string_format -> unit; kinfo : (info -> unit) * visitor_c -> info -> unit; } val default_visitor_c : visitor_c val vk_expr : visitor_c -> expression -> unit val vk_statement : visitor_c -> statement -> unit val vk_statement_sequencable : visitor_c -> statement_sequencable -> unit val vk_type : visitor_c -> fullType -> unit val vk_decl : visitor_c -> declaration -> unit val vk_decl_list : visitor_c -> declaration list -> unit val vk_onedecl : visitor_c -> onedecl -> unit val vk_ini : visitor_c -> initialiser -> unit val vk_ini_list : visitor_c -> initialiser wrap2 list -> unit val vk_inis_splitted : visitor_c -> (initialiser, il) Common.either list -> unit val vk_name : visitor_c -> name -> unit val vk_def : visitor_c -> definition -> unit val vk_node : visitor_c -> Control_flow_c.node -> unit val vk_string_fragment : visitor_c -> string_fragment -> unit val vk_string_fragments : visitor_c -> string_fragment list -> unit val vk_string_fragments_splitted : visitor_c -> (string_fragment, il) Common.either list -> unit val vk_string_format : visitor_c -> string_format -> unit val vk_info : visitor_c -> info -> unit val vk_toplevel : visitor_c -> toplevel -> unit val vk_program : visitor_c -> program -> unit val vk_argument : visitor_c -> argument -> unit val vk_argument_list : visitor_c -> argument wrap2 list -> unit val vk_args_splitted : visitor_c -> (argument, il) Common.either list -> unit val vk_param : visitor_c -> parameterType -> unit val vk_param_list : visitor_c -> parameterType wrap2 list -> unit val vk_params_splitted : visitor_c -> (parameterType, il) Common.either list -> unit val vk_struct_field : visitor_c -> field -> unit val vk_struct_fields : visitor_c -> field list -> unit val vk_struct_fieldkinds : visitor_c -> fieldkind wrap list -> unit val vk_enum_fields : visitor_c -> enumType -> unit val vk_enum_fields_splitted : visitor_c -> (oneEnumType, il) Common.either list -> unit val vk_cst : visitor_c -> ((constant, string) Common.either wrap) -> unit val vk_define_params_splitted : visitor_c -> (string Ast_c.wrap, il) Common.either list -> unit val vk_pragmainfo : visitor_c -> pragmainfo -> unit val vk_ident_list_splitted : visitor_c -> (name, il) Common.either list -> unit (* ------------------------------------------------------------------------ *) type 'a inout = 'a -> 'a type visitor_c_s = { kexpr_s : expression inout * visitor_c_s -> expression inout; kstatement_s : statement inout * visitor_c_s -> statement inout; ktype_s : fullType inout * visitor_c_s -> fullType inout; kdecl_s : declaration inout * visitor_c_s -> declaration inout; kdef_s : definition inout * visitor_c_s -> definition inout; kname_s : name inout * visitor_c_s -> name inout; kini_s : initialiser inout * visitor_c_s -> initialiser inout; kcppdirective_s : (cpp_directive inout * visitor_c_s) -> cpp_directive inout; kdefineval_s : (define_val inout * visitor_c_s) -> define_val inout; kstatementseq_s: (statement_sequencable inout * visitor_c_s) -> statement_sequencable inout; kstatementseq_list_s: (statement_sequencable list inout * visitor_c_s) -> statement_sequencable list inout; knode_s : Control_flow_c.node inout * visitor_c_s -> Control_flow_c.node inout; ktoplevel_s : toplevel inout * visitor_c_s -> toplevel inout; kfragment_s : string_fragment inout * visitor_c_s -> string_fragment inout; kformat_s : string_format inout * visitor_c_s -> string_format inout; kinfo_s : info inout * visitor_c_s -> info inout; } val default_visitor_c_s : visitor_c_s val vk_expr_s : visitor_c_s -> expression -> expression val vk_argument_s : visitor_c_s -> argument -> argument val vk_statement_s : visitor_c_s -> statement -> statement val vk_statement_sequencable_s : visitor_c_s -> statement_sequencable -> statement_sequencable val vk_type_s : visitor_c_s -> fullType -> fullType val vk_decl_s : visitor_c_s -> declaration -> declaration val vk_decl_list_s : visitor_c_s -> declaration list -> declaration list val vk_ini_s : visitor_c_s -> initialiser -> initialiser val vk_inis_splitted_s : visitor_c_s -> (initialiser, il) Common.either list -> (initialiser, il) Common.either list val vk_def_s : visitor_c_s -> definition -> definition val vk_name_s : visitor_c_s -> name -> name val vk_toplevel_s : visitor_c_s -> toplevel -> toplevel val vk_string_fragment_s : visitor_c_s -> string_fragment -> string_fragment val vk_string_fragments_s : visitor_c_s -> string_fragment list -> string_fragment list val vk_string_fragments_splitted_s : visitor_c_s -> (string_fragment, il) Common.either list -> (string_fragment, il) Common.either list val vk_string_format_s : visitor_c_s -> string_format -> string_format val vk_info_s : visitor_c_s -> info -> info val vk_ii_s : visitor_c_s -> info list -> info list val vk_node_s : visitor_c_s -> Control_flow_c.node -> Control_flow_c.node val vk_program_s : visitor_c_s -> program -> program val vk_arguments_s : visitor_c_s -> argument wrap2 list -> argument wrap2 list val vk_inis_s : visitor_c_s -> initialiser wrap2 list -> initialiser wrap2 list val vk_args_splitted_s : visitor_c_s -> (argument, il) Common.either list -> (argument, il) Common.either list val vk_params_s : visitor_c_s -> parameterType wrap2 list -> parameterType wrap2 list val vk_params_splitted_s : visitor_c_s -> (parameterType, il) Common.either list -> (parameterType, il) Common.either list val vk_param_s : visitor_c_s -> parameterType -> parameterType val vk_define_params_splitted_s : visitor_c_s -> (string Ast_c.wrap, il) Common.either list -> (string Ast_c.wrap, il) Common.either list val vk_pragmainfo_s : visitor_c_s -> pragmainfo -> pragmainfo val vk_ident_list_splitted_s : visitor_c_s -> (name, il) Common.either list -> (name, il) Common.either list val vk_enum_fields_s : visitor_c_s -> enumType -> enumType val vk_enum_fields_splitted_s : visitor_c_s -> (oneEnumType, il) Common.either list -> (oneEnumType, il) Common.either list val vk_struct_field_s : visitor_c_s -> field -> field val vk_struct_fields_s : visitor_c_s -> field list -> field list val vk_cst_s : visitor_c_s -> ((constant, string) Common.either wrap) inout coccinelle-1.0.0-rc19/parsing_c/control_flow_c_build.ml0000644000175000017500000014523212247437436022066 0ustar eugeneugen(* Yoann Padioleau, extensions by Julia Lawall * * Copyright (C) 2011, 2012, 2013, INRIA. * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c open Control_flow_c open Ograph_extended open Oassoc open Oassocb module Lib = Lib_parsing_c (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_cfg (*****************************************************************************) (* todo?: compute target level with goto (but rare that different I think) * ver1: just do init, * ver2: compute depth of label (easy, intercept compound in the visitor) * * checktodo: after a switch, need check that all the st in the * compound start with a case: ? * * checktodo: how ensure that when we call aux_statement recursively, we * pass it xi_lbl and not just auxinfo ? how enforce that ? * in fact we must either pass a xi_lbl or a newxi * * todo: can have code (and so nodes) in many places, in the size of an * array, in the init of initializer, but also in StatementExpr, ... * * todo?: steal code from CIL ? (but seems complicated ... again) *) (*****************************************************************************) (*****************************************************************************) (* Types *) (*****************************************************************************) type error = | DeadCode of Common.parse_info option | CaseNoSwitch of Common.parse_info | OnlyBreakInSwitch of Common.parse_info | WeirdSwitch of Common.parse_info | NoEnclosingLoop of Common.parse_info | GotoCantFindLabel of string * Common.parse_info | NoExit of Common.parse_info | DuplicatedLabel of string | NestedFunc | ComputedGoto | Define of Common.parse_info exception Error of error (*****************************************************************************) (* Helpers *) (*****************************************************************************) let add_node node labels nodestr g = g#add_node (Control_flow_c.mk_node node labels [] nodestr) let add_bc_node node labels parent_labels nodestr g = g#add_node (Control_flow_c.mk_node node labels parent_labels nodestr) let add_arc_opt (starti, nodei) g = starti +> do_option (fun starti -> g#add_arc ((starti, nodei), Direct)) let lbl_0 = [] let pinfo_of_ii ii = Ast_c.get_opi (List.hd ii).Ast_c.pinfo (*****************************************************************************) (* Contextual information passed in aux_statement *) (*****************************************************************************) (* Sometimes have a continue/break and we must know where we must jump. * * ctl_brace: The node list in context_info record the number of '}' at the * context point, for instance at the switch point. So that when deeper, * we can compute the difference between the number of '}' from root to * the context point to close the good number of '}' . For instance * where there is a 'continue', we must close only until the for. *) type context_info = | NoInfo | LoopInfo of nodei * nodei (* start, end *) * node list * int list | SwitchInfo of nodei * nodei (* start, end *) * node list * int list (* for the Compound case I need to do different things depending if * the compound is the compound of the function definition, the compound of * a switch, so this type allows to specify this and enable to factorize * code for the Compound *) and compound_caller = FunctionDef | Statement | Switch of (nodei -> xinfo -> xinfo) (* other information used internally in ast_to_flow and passed recursively *) and xinfo = { ctx: context_info; (* cf above *) ctx_stack: context_info list; (* are we under a ifthen[noelse]. Used for ErrorExit *) under_ifthen: bool; compound_caller: compound_caller; (* does not change recursively. Some kind of globals. *) labels_assoc: (string, nodei) oassoc; exiti: nodei option; errorexiti: nodei option; (* ctl_braces: the nodei list is to handle current imbrication depth. * It contains the must-close '}'. * update: now it is instead a node list. *) braces: node list; (* ctl: *) labels: int list; } let initial_info = { ctx = NoInfo; ctx_stack = []; under_ifthen = false; compound_caller = Statement; braces = []; labels = []; (* don't change when recurse *) labels_assoc = new oassocb []; exiti = None; errorexiti = None; } (*****************************************************************************) (* (Semi) Globals, Julia's style. *) (*****************************************************************************) (* global graph *) let g = ref (new ograph_mutable) let counter_for_labels = ref 0 let counter_for_braces = ref 0 (* For switch we use compteur too (or pass int ref) cos need know order of the * case if then later want to go from CFG to (original) AST. * update: obsolete now I think *) let counter_for_switch = ref 0 (*****************************************************************************) (* helpers *) (*****************************************************************************) (* alt: do via a todo list, so can do all in one pass (but more complex) * todo: can also count the depth level and associate it to the node, for * the ctl_braces: *) let compute_labels_and_create_them st = (* map C label to index number in graph *) let (h: (string, nodei) oassoc ref) = ref (new oassocb []) in begin st +> Visitor_c.vk_statement { Visitor_c.default_visitor_c with Visitor_c.kstatement = (fun (k, bigf) st -> match Ast_c.unwrap_st st with | Labeled (Ast_c.Label (name, _st)) -> let ii = Ast_c.get_ii_st_take_care st in (* at this point I put a lbl_0, but later I will put the * good labels. *) let s = Ast_c.str_of_name name in let newi = !g +> add_node (Label (st,name, ((),ii))) lbl_0 (s^":") in begin (* the C label already exists ? *) if (!h#haskey s) then raise (Error (DuplicatedLabel s)); h := !h#add (s, newi); (* not k _st !!! otherwise in lbl1: lbl2: i++; we miss lbl2 *) k st; end | _st -> k st ) }; !h; end (* ctl_braces: *) let insert_all_braces xs starti = xs +> List.fold_left (fun acc node -> (* Have to build a new node (clone), cos cannot share it. * update: This is now done by the caller. The clones are in xs. *) let newi = !g#add_node node in !g#add_arc ((acc, newi), Direct); newi ) starti (*****************************************************************************) (* Statement *) (*****************************************************************************) (* Take in a (optional) start node, return an (optional) end node. * * history: * * ver1: old code was returning an nodei, but goto has no end, so * aux_statement should return nodei option. * * ver2: old code was taking a nodei, but should also take nodei * option. * * ver3: deadCode detection. What is dead code ? When there is no * starti to start from ? So make starti an option too ? Si on arrive * sur un label: au moment d'un deadCode, on peut verifier les * predecesseurs de ce label, auquel cas si y'en a, ca veut dire * qu'en fait c'est pas du deadCode et que donc on peut se permettre * de partir d'un starti à None. Mais si on a xx; goto far:; near: * yy; zz; far: goto near:. Bon ca doit etre un cas tres tres rare, * mais a cause de notre parcours, on va rejeter ce programme car au * moment d'arriver sur near: on n'a pas encore de predecesseurs pour * ce label. De meme, meme le cas simple ou la derniere instruction * c'est un return, alors ca va generer un DeadCode :( * * So make a first pass where dont launch exn at all. Create nodes, * if starti is None then dont add arc. Then make a second pass that * just checks that all nodes (except enter) have predecessors. * So make starti an option too. So type is now * * nodei option -> statement -> nodei option. * * todo?: if the pb is at a fake node, then try first successos that * is non fake. * * ver4: because of special needs of coccinelle, need pass more info, cf * type additionnal_info defined above. * * - to complete (break, continue (and enclosing loop), switch (and * associated case, casedefault)) we need to pass additional info. * The start/exit when enter in a loop, to know the current 'for'. * * - to handle the braces, need again pass additional info. * * - need pass the labels. * * convention: xi for the auxinfo passed recursively * *) let rec (aux_statement: (nodei option * xinfo) -> statement -> nodei option) = fun (starti, xi) stmt -> if not !Flag_parsing_c.label_strategy_2 then incr counter_for_labels; let lbl = if !Flag_parsing_c.label_strategy_2 then xi.labels else xi.labels @ [!counter_for_labels] in (* Normally the new auxinfo to pass recursively to the next aux_statement. * But in some cases we add additional stuff in which case we don't use * this 'xi_lbl' but a 'newxi' specially built. *) let xi_lbl = if !Flag_parsing_c.label_strategy_2 then { xi with compound_caller = Statement; } else { xi with labels = xi.labels @ [ !counter_for_labels ]; compound_caller = Statement; } in let ii = Ast_c.get_ii_st_take_care stmt in (* ------------------------- *) match Ast_c.unwrap_st stmt with (* coupling: the Switch case copy paste parts of the Compound case *) | Ast_c.Compound statxs -> (* flow_to_ast: *) let (i1, i2) = tuple_of_list2 ii in (* ctl_braces: *) incr counter_for_braces; let brace = !counter_for_braces in let s1 = "{" ^ i_to_s brace in let s2 = "}" ^ i_to_s brace in let lbl = match xi.compound_caller with | FunctionDef -> xi.labels (* share label with function header *) | Statement -> xi.labels @ [!counter_for_labels] | Switch _ -> xi.labels in let newi = !g +> add_node (SeqStart (stmt, brace, i1)) lbl s1 in let endnode = mk_node (SeqEnd (brace, i2)) lbl [] s2 in let endnode_dup = mk_fake_node (SeqEnd (brace, i2)) lbl [] s2 in (* let _endnode_dup = mk_node (SeqEnd (brace, Ast_c.fakeInfo())) lbl [] s2 in *) let newxi = { xi_lbl with braces = endnode_dup:: xi_lbl.braces } in let newxi = match xi.compound_caller with | Switch todo_in_compound -> (* note that side effect in todo_in_compound *) todo_in_compound newi newxi | FunctionDef | Statement -> newxi in !g +> add_arc_opt (starti, newi); let finishi = Some newi in aux_statement_list finishi (xi, newxi) statxs (* braces: *) +> Common.fmap (fun finishi -> (* subtil: not always return a Some. * Note that if finishi is None, alors forcement ca veut dire * qu'il y'a eu un return (ou goto), et donc forcement les * braces auront au moins ete crée une fois, et donc flow_to_ast * marchera. * Sauf si le goto revient en arriere ? mais dans ce cas * ca veut dire que le programme boucle. Pour qu'il boucle pas * il faut forcement au moins un return. *) let endi = !g#add_node endnode in if xi.compound_caller = Statement then (* Problem! This edge is only created if the block does not have return on all execution paths. *) (let afteri = !g +> add_node AfterNode lbl "[after]" in !g#add_arc ((newi, afteri), Direct); !g#add_arc ((afteri, endi), Direct)); !g#add_arc ((finishi, endi), Direct); endi ) (* ------------------------- *) | Labeled (Ast_c.Label (name, st)) -> let s = Ast_c.str_of_name name in let ilabel = xi.labels_assoc#find s in let node = mk_node (unwrap (!g#nodes#find ilabel)) lbl [] (s ^ ":") in !g#replace_node (ilabel, node); !g +> add_arc_opt (starti, ilabel); aux_statement (Some ilabel, xi_lbl) st | Jump (Ast_c.Goto name) -> let s = Ast_c.str_of_name name in (* special_cfg_ast: *) let newi = !g +> add_node (Goto (stmt, name, ((),ii))) lbl ("goto "^s^":") in !g +> add_arc_opt (starti, newi); if !Flag_parsing_c.no_gotos then Some newi else begin let ilabel = try xi.labels_assoc#find s with Not_found -> (* jump vers ErrorExit a la place ? * pourquoi tant de "cant jump" ? pas detecté par gcc ? *) raise (Error (GotoCantFindLabel (s, pinfo_of_ii ii))) in (* !g +> add_arc_opt (starti, ilabel); * todo: special_case: suppose that always goto to toplevel of * function, hence the Common.init * todo?: can perhaps report when a goto is not a classic error_goto ? * that is when it does not jump to the toplevel of the function. *) let newi = insert_all_braces (Common.list_init xi.braces) newi in !g#add_arc ((newi, ilabel), Direct); None end | Jump (Ast_c.GotoComputed e) -> raise (Error (ComputedGoto)) (* ------------------------- *) | Ast_c.ExprStatement opte -> (* flow_to_ast: old: when opte = None, then do not add in CFG. *) let s = match opte with | None -> "empty;" | Some e -> (match Ast_c.unwrap_expr e with | FunCall (e, _args) -> (match Ast_c.unwrap_expr e with | Ident namef -> Ast_c.str_of_name namef ^ "(...)" | _ -> "statement" ) | Assignment (e1, SimpleAssign, e2) -> (match Ast_c.unwrap_expr e1 with | Ident namevar -> Ast_c.str_of_name namevar ^ " = ... ;" | RecordAccess(e, field) -> (match Ast_c.unwrap_expr e with | Ident namevar -> let sfield = Ast_c.str_of_name field in Ast_c.str_of_name namevar ^ "." ^ sfield ^ " = ... ;" | _ -> "statement" ) | _ -> "statement" ) | _ -> "statement" ) in let newi = !g +> add_node (ExprStatement (stmt, (opte, ii))) lbl s in !g +> add_arc_opt (starti, newi); Some newi (* ------------------------- *) | Selection (Ast_c.If (e, st1, st2)) -> let iist2 = Ast_c.get_ii_st_take_care st2 in (match Ast_c.unwrap_st st2 with | Ast_c.ExprStatement (None) when null iist2 -> (* sometime can have ExprStatement None but it is a if-then-else, * because something like if() xx else ; * so must force to have [] in the ii associated with ExprStatement *) let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in let ii = [i1;i2;i3] in (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti * | | * |-> newfakeelse -> ... -> finalelse -| * update: there is now also a link directly to lasti. * * because of CTL, now do different things if we are in a ifthen or * ifthenelse. *) let newi = !g +> add_node (IfHeader (stmt, (e, ii))) lbl ("if") in !g +> add_arc_opt (starti, newi); let newfakethen = !g +> add_node TrueNode lbl "[then]" in let newfakeelse = !g +> add_node FallThroughNode lbl "[fallthrough]" in let afteri = !g +> add_node AfterNode lbl "[after]" in let lasti = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endif]" in (* for ErrorExit heuristic *) let newxi = { xi_lbl with under_ifthen = true; } in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newi, newfakeelse), Direct); !g#add_arc ((newi, afteri), Direct); !g#add_arc ((afteri, lasti), Direct); !g#add_arc ((newfakeelse, lasti), Direct); let finalthen = aux_statement (Some newfakethen, newxi) st1 in !g +> add_arc_opt (finalthen, lasti); Some lasti | _unwrap_st2 -> (* starti -> newi ---> newfakethen -> ... -> finalthen --> lasti * | | * |-> newfakeelse -> ... -> finalelse -| * update: there is now also a link directly to lasti. *) let (iiheader, iielse, iifakeend) = match ii with | [i1;i2;i3;i4;i5] -> [i1;i2;i3], i4, i5 | _ -> raise (Impossible 62) in let newi = !g +> add_node (IfHeader (stmt, (e, iiheader))) lbl "if" in !g +> add_arc_opt (starti, newi); let newfakethen = !g +> add_node TrueNode lbl "[then]" in let newfakeelse = !g +> add_node FalseNode lbl "[else]" in let elsenode = !g +> add_node (Else iielse) lbl "else" in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newi, newfakeelse), Direct); !g#add_arc ((newfakeelse, elsenode), Direct); let finalthen = aux_statement (Some newfakethen, xi_lbl) st1 in let finalelse = aux_statement (Some elsenode, xi_lbl) st2 in (match finalthen, finalelse with | (None, None) -> None | _ -> let lasti = !g +> add_node (EndStatement(Some iifakeend)) lbl "[endif]" in let afteri = !g +> add_node AfterNode lbl "[after]" in !g#add_arc ((newi, afteri), Direct); !g#add_arc ((afteri, lasti), Direct); begin !g +> add_arc_opt (finalthen, lasti); !g +> add_arc_opt (finalelse, lasti); Some lasti end) ) (* ------------------------- *) | Selection (Ast_c.Switch (e, st)) -> let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in let ii = [i1;i2;i3] in (* The newswitchi is for the labels to know where to attach. * The newendswitch (endi) is for the 'break'. *) let newswitchi= !g +> add_node (SwitchHeader(stmt,(e,ii))) lbl "switch" in let newendswitch = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endswitch]" in !g +> add_arc_opt (starti, newswitchi); (* call compound case. Need special info to pass to compound case * because we need to build a context_info that need some of the * information build inside the compound case: the nodei of { *) let finalthen = match Ast_c.unwrap_st st with | Ast_c.Compound statxs -> let statxs = Lib.stmt_elems_of_sequencable statxs in (* todo? we should not allow to match a stmt that corresponds * to a compound of a switch, so really SeqStart (stmt, ...) * here ? so maybe should change the SeqStart labeling too. * So need pass a todo_in_compound2 function. *) let todo_in_compound newi newxi = let newxi' = { newxi with ctx = SwitchInfo (newi(*!!*), newendswitch, xi.braces, lbl); ctx_stack = newxi.ctx::newxi.ctx_stack } in !g#add_arc ((newswitchi, newi), Direct); (* new: if have not a default case, then must add an edge * between start to end. * todo? except if the case[range] coverthe whole spectrum *) if not (statxs +> List.exists (fun x -> match Ast_c.unwrap_st x with | Labeled (Ast_c.Default _) -> true | _ -> false )) then begin (* when there is no default, then a valid path is * from the switchheader to the end. In between we * add a Fallthrough. *) let newafter = !g+>add_node FallThroughNode lbl "[switchfall]" in !g#add_arc ((newafter, newendswitch), Direct); !g#add_arc ((newswitchi, newafter), Direct); (* old: !g#add_arc ((newswitchi, newendswitch), Direct) +> adjust_g; *) end; newxi' in let newxi = { xi_lbl with compound_caller = (* was xi *) Switch todo_in_compound } in aux_statement (None (* no starti *), newxi) st | _x -> (* apparently gcc allows some switch body such as * switch (i) case 0 : printf("here\n"); * cf tests-bis/switch_no_body.c * but I don't think it's worthwhile to handle * such pathological and rare case. Not worth * the complexity. Safe to assume a coumpound. *) raise (Error (WeirdSwitch (pinfo_of_ii [i1]))) in !g +> add_arc_opt (finalthen, newendswitch); (* what if has only returns inside. We must try to see if the * newendswitch has been used via a 'break;' or because no * 'default:') *) let res = (match finalthen with | Some finalthen -> let afteri = !g +> add_node AfterNode lbl "[after]" in !g#add_arc ((newswitchi, afteri), Direct); !g#add_arc ((afteri, newendswitch), Direct); !g#add_arc ((finalthen, newendswitch), Direct); Some newendswitch | None -> if (!g#predecessors newendswitch)#null then begin assert ((!g#successors newendswitch)#null); !g#del_node newendswitch; None end else begin let afteri = !g +> add_node AfterNode lbl "[after]" in !g#add_arc ((newswitchi, afteri), Direct); !g#add_arc ((afteri, newendswitch), Direct); Some newendswitch end ) in res | Labeled (Ast_c.Case (_, _)) | Labeled (Ast_c.CaseRange (_, _, _)) -> incr counter_for_switch; let switchrank = !counter_for_switch in let node, st = match Ast_c.get_st_and_ii stmt with | Labeled (Ast_c.Case (e, st)), ii -> (Case (stmt, (e, ii))), st | Labeled (Ast_c.CaseRange (e, e2, st)), ii -> (CaseRange (stmt, ((e, e2), ii))), st | _ -> raise (Impossible 63) in let newi = !g +> add_node node lbl "case:" in (match Common.optionise (fun () -> (* old: xi.ctx *) (xi.ctx::xi.ctx_stack) +> Common.find_some (function | SwitchInfo (a, b, c, _) -> Some (a, b, c) | _ -> None )) with | Some (startbrace, switchendi, _braces) -> (* no need to attach to previous for the first case, cos would be * redundant. *) starti +> do_option (fun starti -> if starti <> startbrace then !g +> add_arc_opt (Some starti, newi); ); let s = ("[casenode] " ^ i_to_s switchrank) in let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in !g#add_arc ((startbrace, newcasenodei), Direct); !g#add_arc ((newcasenodei, newi), Direct); | None -> raise (Error (CaseNoSwitch (pinfo_of_ii ii))) ); aux_statement (Some newi, xi_lbl) st | Labeled (Ast_c.Default st) -> incr counter_for_switch; let switchrank = !counter_for_switch in let newi = !g +> add_node (Default(stmt, ((),ii))) lbl "case default:" in !g +> add_arc_opt (starti, newi); (match xi.ctx with | SwitchInfo (startbrace, switchendi, _braces, _parent_lbl) -> let s = ("[casenode] " ^ i_to_s switchrank) in let newcasenodei = !g +> add_node (CaseNode switchrank) lbl s in !g#add_arc ((startbrace, newcasenodei), Direct); !g#add_arc ((newcasenodei, newi), Direct); | _ -> raise (Error (CaseNoSwitch (pinfo_of_ii ii))) ); aux_statement (Some newi, xi_lbl) st (* ------------------------- *) | Iteration (Ast_c.While (e, st)) -> (* starti -> newi ---> newfakethen -> ... -> finalthen - * |---|-----------------------------------| * |-> newfakelse *) let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in let ii = [i1;i2;i3] in let newi = !g +> add_node (WhileHeader (stmt, (e,ii))) lbl "while" in !g +> add_arc_opt (starti, newi); let newfakethen = !g +> add_node InLoopNode lbl "[whiletrue]" in (* let newfakeelse = !g +> add_node FalseNode lbl "[endwhile]" in *) let newafter = !g +> add_node LoopFallThroughNode lbl "[whilefall]" in let newfakeelse = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endwhile]" in let newxi = { xi_lbl with ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack } in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newafter, newfakeelse), Direct); !g#add_arc ((newi, newafter), Direct); let finalthen = aux_statement (Some newfakethen, newxi) st in !g +> add_arc_opt (finalthen, if !Flag_parsing_c.no_loops then newafter else newi); Some newfakeelse (* This time, may return None, for instance if goto in body of dowhile * (whereas While cannot return None). But if return None, certainly * some deadcode. *) | Iteration (Ast_c.DoWhile (st, e)) -> (* starti -> doi ---> ... ---> finalthen (opt) ---> whiletaili * |--------- newfakethen ---------------| |---> newfakelse *) let is_zero = match Ast_c.unwrap_expr e with | Constant (Int ("0",_)) -> true | _ -> false in let (iido, iiwhiletail, iifakeend) = match ii with | [i1;i2;i3;i4;i5;i6] -> i1, [i2;i3;i4;i5], i6 | _ -> raise (Impossible 64) in let doi = !g +> add_node (DoHeader (stmt, iido)) lbl "do" in !g +> add_arc_opt (starti, doi); let taili = !g +> add_node (DoWhileTail (e, iiwhiletail)) lbl "whiletail" in (*let newfakeelse = !g +> add_node FalseNode lbl "[enddowhile]" in *) let newafter = !g +> add_node FallThroughNode lbl "[dowhilefall]" in let newfakeelse = !g +> add_node (EndStatement (Some iifakeend)) lbl "[enddowhile]" in let afteri = !g +> add_node AfterNode lbl "[after]" in !g#add_arc ((doi,afteri), Direct); !g#add_arc ((afteri,newfakeelse), Direct); let newxi = { xi_lbl with ctx = LoopInfo (taili, newfakeelse, xi_lbl.braces, lbl); ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack } in if not is_zero && (not !Flag_parsing_c.no_loops) then begin let newfakethen = !g +> add_node InLoopNode lbl "[dowhiletrue]" in !g#add_arc ((taili, newfakethen), Direct); !g#add_arc ((newfakethen, doi), Direct); end; !g#add_arc ((newafter, newfakeelse), Direct); !g#add_arc ((taili, newafter), Direct); let finalthen = aux_statement (Some doi, newxi) st in (match finalthen with | None -> if (!g#predecessors taili)#null then raise (Error (DeadCode (Some (pinfo_of_ii ii)))) else Some newfakeelse | Some finali -> !g#add_arc ((finali, taili), Direct); Some newfakeelse ) | Iteration (Ast_c.For (e1opt, e2opt, e3opt, st)) -> let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in let ii = [i1;i2;i3] in let newi = !g+>add_node(ForHeader(stmt,((e1opt,e2opt,e3opt),ii))) lbl "for" in !g +> add_arc_opt (starti, newi); let newfakethen = !g +> add_node InLoopNode lbl "[fortrue]" in (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*) let newafter = !g +> add_node LoopFallThroughNode lbl "[forfall]" in let newfakeelse = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endfor]" in let newxi = { xi_lbl with ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack } in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newafter, newfakeelse), Direct); !g#add_arc ((newi, newafter), Direct); let finalthen = aux_statement (Some newfakethen, newxi) st in !g +> add_arc_opt (finalthen, if !Flag_parsing_c.no_loops then newafter else newi); Some newfakeelse (* to generate less exception with the breakInsideLoop, analyse * correctly the loop deguisé comme list_for_each. Add a case ForMacro * in ast_c (and in lexer/parser), and then do code that imitates the * code for the For. * update: the list_for_each was previously converted into Tif by the * lexer, now they are returned as Twhile so less pbs. But not perfect. * update: now I recognize the list_for_each macro so no more problems. *) | Iteration (Ast_c.MacroIteration (s, es, st)) -> let (i1,i2,i3, iifakeend) = tuple_of_list4 ii in let ii = [i1;i2;i3] in let newi = !g+>add_node(MacroIterHeader(stmt,((s,es),ii))) lbl "foreach" in !g +> add_arc_opt (starti, newi); let newfakethen = !g +> add_node InLoopNode lbl "[fortrue]" in (*let newfakeelse = !g +> add_node FalseNode lbl "[endfor]" in*) let newafter = !g +> add_node LoopFallThroughNode lbl "[foreachfall]" in let newfakeelse = !g +> add_node (EndStatement (Some iifakeend)) lbl "[endforeach]" in let newxi = { xi_lbl with ctx = LoopInfo (newi, newfakeelse, xi_lbl.braces, lbl); ctx_stack = xi_lbl.ctx::xi_lbl.ctx_stack } in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newafter, newfakeelse), Direct); !g#add_arc ((newi, newafter), Direct); let finalthen = aux_statement (Some newfakethen, newxi) st in !g +> add_arc_opt (finalthen, if !Flag_parsing_c.no_loops then newafter else newi); Some newfakeelse (* ------------------------- *) | Jump ((Ast_c.Continue|Ast_c.Break) as x) -> let context_info = match xi.ctx with SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> if x =*= Ast_c.Break then xi.ctx else (try xi.ctx_stack +> Common.find_some (function LoopInfo (_,_,_,_) as c -> Some c | _ -> None) with Not_found -> raise (Error (OnlyBreakInSwitch (pinfo_of_ii ii)))) | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> xi.ctx | NoInfo -> raise (Error (NoEnclosingLoop (pinfo_of_ii ii))) in let parent_label = match context_info with LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> parent_lbl | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> parent_lbl | NoInfo -> raise (Impossible 65) in (* flow_to_ast: *) let (node_info, string) = let parent_string = String.concat "," (List.map string_of_int parent_label) in (match x with | Ast_c.Continue -> (Continue (stmt, ((), ii)), Printf.sprintf "continue; [%s]" parent_string) | Ast_c.Break -> (Break (stmt, ((), ii)), Printf.sprintf "break; [%s]" parent_string) | _ -> raise (Impossible 66) ) in (* idea: break or continue records the label of its parent loop or switch *) let newi = !g +> add_bc_node node_info lbl parent_label string in !g +> add_arc_opt (starti, newi); (* let newi = some starti in *) (match context_info with | LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> let desti = (match x with | Ast_c.Break -> loopendi | Ast_c.Continue -> (* if no loops, then continue behaves like break - just one iteration *) if !Flag_parsing_c.no_loops then loopendi else loopstarti | x -> raise (Impossible 67) ) in let difference = List.length xi.braces - List.length braces in assert (difference >= 0); let toend = take difference xi.braces in let newi = insert_all_braces toend newi in !g#add_arc ((newi, desti), Direct); None | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> assert (x =*= Ast_c.Break); let difference = List.length xi.braces - List.length braces in assert (difference >= 0); let toend = take difference xi.braces in let newi = insert_all_braces toend newi in !g#add_arc ((newi, loopendi), Direct); None | NoInfo -> raise (Impossible 68) ) | Jump ((Ast_c.Return | Ast_c.ReturnExpr _) as kind) -> (match xi.exiti, xi.errorexiti with | None, None -> raise (Error (NoExit (pinfo_of_ii ii))) | Some exiti, Some errorexiti -> (* flow_to_ast: *) let s = match kind with | Ast_c.Return -> "return" | Ast_c.ReturnExpr _ -> "return ..." | _ -> raise (Impossible 69) in let newi = !g +> add_node (match kind with | Ast_c.Return -> Return (stmt, ((),ii)) | Ast_c.ReturnExpr e -> ReturnExpr (stmt, (e, ii)) | _ -> raise (Impossible 70) ) lbl s in !g +> add_arc_opt (starti, newi); let newi = insert_all_braces xi.braces newi in if xi.under_ifthen then !g#add_arc ((newi, errorexiti), Direct) else !g#add_arc ((newi, exiti), Direct) ; None | _ -> raise (Impossible 71) ) (* ------------------------- *) | Ast_c.Decl decl -> let s = match decl with | (Ast_c.DeclList ([{v_namei = Some (name, _); v_type = typ; v_storage = sto}, _], _)) -> "decl:" ^ Ast_c.str_of_name name | _ -> "decl_novar_or_multivar" in let newi = !g +> add_node (Decl (decl)) lbl s in !g +> add_arc_opt (starti, newi); Some newi (* ------------------------- *) | Ast_c.Asm body -> let newi = !g +> add_node (Asm (stmt, ((body,ii)))) lbl "asm;" in !g +> add_arc_opt (starti, newi); Some newi | Ast_c.MacroStmt -> let newi = !g +> add_node (MacroStmt (stmt, ((),ii))) lbl "macro;" in !g +> add_arc_opt (starti, newi); Some newi (* ------------------------- *) | Ast_c.NestedFunc def -> raise (Error NestedFunc) and aux_statement_list starti (xi, newxi) statxs = statxs +> List.fold_left (fun starti statement_seq -> if !Flag_parsing_c.label_strategy_2 then incr counter_for_labels; let newxi' = if !Flag_parsing_c.label_strategy_2 then { newxi with labels = xi.labels @ [ !counter_for_labels ] } else newxi in match statement_seq with | Ast_c.StmtElem statement -> aux_statement (starti, newxi') statement | Ast_c.CppDirectiveStmt directive -> pr2_once ("ast_to_flow: filter a directive"); starti | Ast_c.IfdefStmt ifdef -> pr2_once ("ast_to_flow: filter a directive"); starti | Ast_c.IfdefStmt2 (ifdefs, xxs) -> let (head, body, tail) = Common.head_middle_tail ifdefs in let newi = !g +> add_node (IfdefHeader (head)) newxi'.labels "[ifdef]" in let taili = !g +> add_node (IfdefEndif (tail)) newxi'.labels "[endif]" in (* do like for a close brace, see endi.{c,cocci} *) let taili_dup = mk_fake_node (IfdefEndif (tail)) newxi'.labels [] "[endif]" in !g +> add_arc_opt (starti, newi); let elsenodes = body +> List.map (fun elseif -> let elsei = !g +> add_node (IfdefElse (elseif)) newxi'.labels "[elseif]" in !g#add_arc ((newi, elsei), Direct); elsei ) in let _finalxs = Common.zip (newi::elsenodes) xxs +> List.map (fun (start_nodei, xs)-> (* not sure if this is correct... newxi seems to relate to the assigned level number *) let newerxi = { newxi with braces = taili_dup:: newxi.braces } in let finalthen = aux_statement_list (Some start_nodei) (newxi, newerxi) xs in !g +> add_arc_opt (finalthen, taili); ) in (* This is an attempt to let a statement metavariable match this construct, but it doesn't work because #ifdef is not a statement. Not sure if this is a good or bad thing, at least if there is no else because then no statement might be there. let afteri = !g +> add_node AfterNode newxi'.labels "[after]" in !g#add_arc ((newi, afteri), Direct); !g#add_arc ((afteri, taili), Direct); *) Some taili ) starti (*****************************************************************************) (* Definition of function *) (*****************************************************************************) let (aux_definition: nodei -> definition -> unit) = fun topi funcdef -> let lbl_start = [!counter_for_labels] in let ({f_name = namefuncs; f_type = functype; f_storage= sto; f_body= compound; f_attr= attrs; f_old_c_style = oldstyle; }, ii) = funcdef in let iifunheader, iicompound = (match ii with | ioparen::icparen::iobrace::icbrace::iifake::isto -> ioparen::icparen::iifake::isto, [iobrace;icbrace] | _ -> raise (Impossible 72) ) in let topstatement = Ast_c.mk_st (Ast_c.Compound compound) iicompound in let headi = !g +> add_node (FunHeader ({ Ast_c.f_name = namefuncs; f_type = functype; f_storage = sto; f_attr = attrs; f_body = [] (* empty body *); f_old_c_style = oldstyle; }, iifunheader)) lbl_start ("function " ^ Ast_c.str_of_name namefuncs) in let enteri = !g +> add_node Enter lbl_0 "[enter]" in let exiti = !g +> add_node Exit lbl_0 "[exit]" in let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in !g#add_arc ((topi, headi), Direct); !g#add_arc ((headi, enteri), Direct); (* ---------------------------------------------------------------- *) (* todocheck: assert ? such as we have "consommer" tous les labels *) let info = { initial_info with labels = lbl_start; labels_assoc = compute_labels_and_create_them topstatement; exiti = Some exiti; errorexiti = Some errorexiti; compound_caller = FunctionDef; } in let lasti = aux_statement (Some enteri, info) topstatement in !g +> add_arc_opt (lasti, exiti) (*****************************************************************************) (* Entry point *) (*****************************************************************************) (* Helpers for SpecialDeclMacro. * * could also force the coccier to define * the toplevel macro statement as in @@ toplevel_declarator MACRO_PARAM;@@ * and so I would not need this hack and instead I would to a cleaner * match in cocci_vs_c_3.ml of a A.MacroTop vs B.MacroTop * * todo: update: now I do what I just described, so can remove this code ? *) let specialdeclmacro_to_stmt (s, args, ii) = let (iis, iiopar, iicpar, iiptvirg) = tuple_of_list4 ii in let ident = Ast_c.RegularName (s, [iis]) in let identfinal = Ast_c.mk_e (Ast_c.Ident (ident)) Ast_c.noii in let f = Ast_c.mk_e (Ast_c.FunCall (identfinal, args)) [iiopar;iicpar] in let stmt = Ast_c.mk_st (Ast_c.ExprStatement (Some f)) [iiptvirg] in stmt, (f, [iiptvirg]) let rec ast_to_control_flow e = (* globals (re)initialialisation *) g := (new ograph_mutable); counter_for_labels := 1; counter_for_braces := 0; counter_for_switch := 0; let topi = !g +> add_node TopNode lbl_0 "[top]" in match e with | Ast_c.Namespace (defs, _) -> (* todo: incorporate the other defs *) let rec loop defs = match defs with | [] -> None | def :: defs -> match ast_to_control_flow def with | None -> loop defs | x -> x in loop defs | Ast_c.Definition ((defbis,_) as def) -> let _funcs = defbis.f_name in let _c = defbis.f_body in (* if !Flag.show_misc then pr2 ("build info function " ^ funcs); *) aux_definition topi def; Some !g | Ast_c.Declaration _ | Ast_c.CppTop (Ast_c.Include _) | Ast_c.MacroTop _ -> let (elem, str) = match e with | Ast_c.Declaration decl -> (Control_flow_c.Decl decl), "decl" | Ast_c.CppTop (Ast_c.Include inc) -> (Control_flow_c.Include inc), "#include" | Ast_c.MacroTop (s, args, ii) -> let (st, (e, ii)) = specialdeclmacro_to_stmt (s, args, ii) in (Control_flow_c.ExprStatement (st, (Some e, ii))), "macrotoplevel" (*(Control_flow_c.MacroTop (s, args,ii), "macrotoplevel") *) | _ -> raise (Impossible 73) in let ei = !g +> add_node elem lbl_0 str in let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((topi, ei),Direct); !g#add_arc ((ei, endi),Direct); Some !g | Ast_c.CppTop (Ast_c.Define ((id,ii), (defkind, defval))) -> let s = match defkind with Ast_c.Undef -> "#undef " ^ id | _ -> "#define " ^ id in let headeri = !g+>add_node (DefineHeader ((id, ii), defkind)) lbl_0 s in !g#add_arc ((topi, headeri),Direct); (match defval with | Ast_c.DefineExpr e -> let ei = !g +> add_node (DefineExpr e) lbl_0 "defexpr" in let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, ei) ,Direct); !g#add_arc ((ei, endi) ,Direct); | Ast_c.DefineType ft -> let ei = !g +> add_node (DefineType ft) lbl_0 "deftyp" in let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, ei) ,Direct); !g#add_arc ((ei, endi) ,Direct); | Ast_c.DefineStmt st -> (* can have some return; inside the statement *) let exiti = !g +> add_node Exit lbl_0 "[exit]" in let errorexiti = !g +> add_node ErrorExit lbl_0 "[errorexit]" in let goto_labels = compute_labels_and_create_them st in let info = { initial_info with labels_assoc = goto_labels; exiti = Some exiti; errorexiti = Some errorexiti; } in let lasti = aux_statement (Some headeri , info) st in lasti +> do_option (fun lasti -> (* todo? if don't have a lasti ? no EndNode ? CTL will work ? *) let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((lasti, endi), Direct) ) | Ast_c.DefineDoWhileZero ((st,_e), ii) -> let goto_labels = compute_labels_and_create_them st in let info = { initial_info with labels_assoc = goto_labels } in let headerdoi = !g +> add_node (DefineDoWhileZeroHeader ((),ii)) lbl_0 "do0" in !g#add_arc ((headeri, headerdoi), Direct); let lasti = aux_statement (Some headerdoi , info) st in lasti +> do_option (fun lasti -> let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((lasti, endi), Direct) ) | Ast_c.DefineFunction def -> aux_definition headeri def; | Ast_c.DefineText (s, s_ii) -> raise (Error(Define(pinfo_of_ii ii))) | Ast_c.DefineEmpty -> let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, endi),Direct); | Ast_c.DefineInit _ -> raise (Error(Define(pinfo_of_ii ii))) | Ast_c.DefineMulti sts -> (* christia: todo *) raise (Error(Define(pinfo_of_ii ii))) | Ast_c.DefineTodo -> raise (Error(Define(pinfo_of_ii ii))) (* old: | Ast_c.DefineText (s, ii) -> let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, endi),Direct); | Ast_c.DefineInit _ -> let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, endi),Direct); | Ast_c.DefineTodo -> let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((headeri, endi),Direct); *) ); Some !g | Ast_c.CppTop (Ast_c.Pragma ((id,ii), pragmainfo)) -> let elem = PragmaHeader ((id,ii), pragmainfo) in let str = "#pragma " ^ id in let ei = !g +> add_node elem lbl_0 str in let endi = !g +> add_node EndNode lbl_0 "[end]" in !g#add_arc ((topi, ei),Direct); !g#add_arc ((ei, endi),Direct); Some !g | _ -> None (*****************************************************************************) (* CFG loop annotation *) (*****************************************************************************) let annotate_loop_nodes g = let firsti = Control_flow_c.first_node g in (* just for opti a little *) let already = Hashtbl.create 101 in g +> Ograph_extended.dfs_iter_with_path firsti (fun xi path -> Hashtbl.add already xi true; let succ = g#successors xi in let succ = succ#tolist in succ +> List.iter (fun (yi,_edge) -> if Hashtbl.mem already yi && List.mem yi (xi::path) then let node = g#nodes#find yi in let ((node2, nodeinfo), nodestr) = node in let node' = ((node2, {nodeinfo with is_loop = true}), (nodestr ^ "*")) in g#replace_node (yi, node'); ); ); g (*****************************************************************************) (* CFG checks *) (*****************************************************************************) (* the second phase, deadcode detection. Old code was raising DeadCode if * lasti = None, but maybe not. In fact if have 2 return in the then * and else of an if ? * * alt: but can assert that at least there exist * a node to exiti, just check #pred of exiti. * * Why so many deadcode in Linux ? Ptet que le label est utilisé * mais dans le corps d'une macro et donc on le voit pas :( * *) let deadcode_detection g = g#nodes#iter (fun (k, node) -> let pred = g#predecessors k in if pred#null then (match unwrap node with (* old: * | Enter -> () * | EndStatement _ -> pr2 "deadcode sur fake node, pas grave"; *) | TopNode -> () | FunHeader _ -> () | ErrorExit -> () | Exit -> () (* if have 'loop: if(x) return; i++; goto loop' *) | SeqEnd _ -> () (* todo?: certaines '}' deviennent orphelins *) | x -> (match Control_flow_c.extract_fullstatement node with | Some st -> let ii = Ast_c.get_ii_st_take_care st in raise (Error (DeadCode (Some (pinfo_of_ii ii)))) | _ -> pr2 "CFG: orphelin nodes, maybe something weird happened" ) ) ) (*------------------------------------------------------------------------*) (* special_cfg_braces: the check are really specific to the way we * have build our control_flow, with the { } in the graph so normally * all those checks here are useless. * * ver1: to better error reporting, to report earlier the message, pass * the list of '{' (containing morover a brace_identifier) instead of * just the depth. *) let (check_control_flow: cflow -> unit) = fun g -> let nodes = g#nodes in let starti = first_node g in let visited = ref (new oassocb []) in let print_trace_error xs = pr2 "PB with flow:"; Common.pr2_gen xs; in let rec dfs (nodei, (* Depth depth,*) startbraces, trace) = let trace2 = nodei::trace in if !visited#haskey nodei then (* if loop back, just check that go back to a state where have same depth number *) let (*(Depth depth2)*) startbraces2 = !visited#find nodei in if (*(depth = depth2)*) startbraces <> startbraces2 then begin pr2 (sprintf "PB with flow: the node %d has not same braces count" nodei); print_trace_error trace2 end else let children = g#successors nodei in let _ = visited := !visited#add (nodei, (* Depth depth*) startbraces) in (* old: good, but detect a missing } too late, only at the end let newdepth = (match fst (nodes#find nodei) with | StartBrace i -> Depth (depth + 1) | EndBrace i -> Depth (depth - 1) | _ -> Depth depth ) in *) let newdepth = (match unwrap (nodes#find nodei), startbraces with | SeqStart (_,i,_), xs -> i::xs | SeqEnd (i,_), j::xs -> if i =|= j then xs else begin pr2 (sprintf ("PB with flow: not corresponding match between }%d and excpeted }%d at node %d") i j nodei); print_trace_error trace2; xs end | SeqEnd (i,_), [] -> pr2 (sprintf "PB with flow: too much } at }%d " i); print_trace_error trace2; [] | _, xs -> xs ) in if null children#tolist then if (* (depth = 0) *) startbraces <> [] then print_trace_error trace2 else children#tolist +> List.iter (fun (nodei,_) -> dfs (nodei, newdepth, trace2) ) in dfs (starti, (* Depth 0*) [], []) (*****************************************************************************) (* Error report *) (*****************************************************************************) let report_error error = let error_from_info info = Common.error_message_short info.file ("", info.charpos) in match error with | DeadCode infoopt -> (match infoopt with | None -> pr2 "FLOW: deadcode detected, but cant trace back the place" | Some info -> pr2 ("FLOW: deadcode detected: " ^ error_from_info info) ) | CaseNoSwitch info -> pr2 ("FLOW: case without corresponding switch: " ^ error_from_info info) | OnlyBreakInSwitch info -> pr2 ("FLOW: only break are allowed in switch: " ^ error_from_info info) | WeirdSwitch info -> pr2 ("FLOW: weird switch: " ^ error_from_info info) | NoEnclosingLoop (info) -> pr2 ("FLOW: can't find enclosing loop: " ^ error_from_info info) | GotoCantFindLabel (s, info) -> pr2 ("FLOW: cant jump to " ^ s ^ ": because we can't find this label") | NoExit info -> pr2 ("FLOW: can't find exit or error exit: " ^ error_from_info info) | DuplicatedLabel s -> pr2 ("FLOW: duplicate label " ^ s) | NestedFunc -> pr2 ("FLOW: not handling yet nested function") | ComputedGoto -> pr2 ("FLOW: not handling computed goto yet") | Define info -> pr2 ("Unsupported form of #define: " ^ error_from_info info) coccinelle-1.0.0-rc19/parsing_c/comment_annotater_c.mli0000644000175000017500000000032212247437436022054 0ustar eugeneugen(* !!Annotate via side effects!!. Fill in the comments_around * information that was put to empty during parsing. *) val annotate_program : Parser_c.token list -> Ast_c.toplevel list -> Ast_c.toplevel list coccinelle-1.0.0-rc19/parsing_c/test_parsing_c.ml0000644000175000017500000004265112247437436020703 0ustar eugeneugenopen Common open Ast_c let score_path = "/home/pad/c-yacfe/tmp" let tmpfile = "/tmp/output.c" module Ast_to_flow = Control_flow_c_build (*****************************************************************************) (* Subsystem testing *) (*****************************************************************************) let test_tokens_c file = if not (file =~ ".*\\.c") then pr2 "warning: seems not a .c file"; Flag_parsing_c.debug_lexer := true; Flag_parsing_c.verbose_lexing := true; Flag_parsing_c.verbose_parsing := true; Parse_c.tokens file +> List.iter (fun x -> pr2_gen x); () (* ---------------------------------------------------------------------- *) (* Was in main, but using it in test_parsing_c *) let get_files path = let ch = cmd_to_list (* same as "true, "", _" case *) (if !Flag.include_headers (* FIXME : Could we remove xs ? -use_glimpse requires a singleton. This is checked some lines before. then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"") else ("find "^(join " " (x::xs))^" -name \"*.c\"") *) then ("find "^ path ^" -name \"*.[ch]\"") else ("find "^ path ^" -name \"*.c\"")) in let cpp = if !Flag.c_plus_plus then cmd_to_list ("find "^ path ^" -name \"*.cpp\"") else [] in cpp @ ch let new_test_parse_gen xs = Flag_parsing_c.debug_typedef := true; Flag_parsing_c.debug_cpp := true; Flag_parsing_c.debug_etdt := false; Flag_parsing_c.filter_msg := true; (*let dirname_opt = match xs with | [x] when is_directory x -> Some x | _ -> None in*) (* old: let xs = if !Flag.dir then process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in *) let fullxs = xs +> List.map get_files +> List.concat in let stat_list = ref [] in let newscore = Common.empty_score () in Common.check_stack_nbfiles (List.length fullxs); fullxs +> List.iter (fun file -> pr2 ""; pr2 ("PARSING: " ^ file); (* test parsing of format strings as well *) let (xs, stat) = Parse_c.parse_c_and_cpp true file in xs +> List.iter (fun (ast, (s, toks)) -> Parse_c.print_commentized toks ); Common.push2 stat stat_list; let s = sprintf "bad = %d, timeout = %B" stat.Parsing_stat.bad stat.Parsing_stat.have_timeout in if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout then Hashtbl.add newscore file (Common.Ok) else Hashtbl.add newscore file (Common.Pb s) ); (* uses an explicit path; to fix dirname_opt +> Common.do_option (fun dirname -> pr2_xxxxxxxxxxxxxxxxx(); pr2 "regression testing information"; pr2_xxxxxxxxxxxxxxxxx(); let str = Str.global_replace (Str.regexp "/") "__" dirname in let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in let ext = if ext =$= "c" then "" else ext in let filename = "score_parsing__" ^str ^ def ^ ext ^ ".marshalled" in if Sys.file_exists filename then Common.regression_testing newscore (Filename.concat score_path ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) ); *) if not (null !stat_list) then begin Parsing_stat.print_recurring_problematic_tokens !stat_list; Parsing_stat.print_parsing_stat_list !stat_list; end; () (* ---------------------------------------------------------------------- *) let test_parse_gen xs ext = Flag_parsing_c.debug_typedef := true; Flag_parsing_c.debug_cpp := true; Flag_parsing_c.debug_etdt := false; Flag_parsing_c.filter_msg := true; (*let dirname_opt = match xs with | [x] when is_directory x -> Some x | _ -> None in*) (* old: let xs = if !Flag.dir then process_output_to_list ("find " ^ x ^" -name \"*.c\"") else x::xs in *) let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in let stat_list = ref [] in let newscore = Common.empty_score () in Common.check_stack_nbfiles (List.length fullxs); fullxs +> List.iter (fun file -> if not (file =~ (".*\\."^ext)) then pr2 ("warning: seems not a ."^ext^" file"); pr2 ""; pr2 ("PARSING: " ^ file); (* test parsing of format strings as well *) let (xs, stat) = Parse_c.parse_c_and_cpp true file in xs +> List.iter (fun (ast, (s, toks)) -> Parse_c.print_commentized toks ); Common.push2 stat stat_list; let s = sprintf "bad = %d, timeout = %B" stat.Parsing_stat.bad stat.Parsing_stat.have_timeout in if stat.Parsing_stat.bad =|= 0 && not stat.Parsing_stat.have_timeout then Hashtbl.add newscore file (Common.Ok) else Hashtbl.add newscore file (Common.Pb s) ); (* uses an explicit path; to fix dirname_opt +> Common.do_option (fun dirname -> pr2_xxxxxxxxxxxxxxxxx(); pr2 "regression testing information"; pr2_xxxxxxxxxxxxxxxxx(); let str = Str.global_replace (Str.regexp "/") "__" dirname in let def = if !Flag_parsing_c.filter_define_error then "_def_" else "" in let ext = if ext =$= "c" then "" else ext in let filename = "score_parsing__" ^str ^ def ^ ext ^ ".marshalled" in if Sys.file_exists filename then Common.regression_testing newscore (Filename.concat score_path ("score_parsing__" ^str ^ def ^ ext ^ ".marshalled")) ); *) if not (null !stat_list) then begin Parsing_stat.print_recurring_problematic_tokens !stat_list; Parsing_stat.print_parsing_stat_list !stat_list; end; () let test_parse_c xs = test_parse_gen xs "c" let test_parse_h xs = test_parse_gen xs "h" let test_parse_ch xs = test_parse_gen xs "[ch]" (* could use a simpler parser than heavy parse_c_and_cpp here as there * is no more cpp stuff in the .i files *) let test_parse_i xs = test_parse_gen xs "i" (* ---------------------------------------------------------------------- *) (* file can be "foo.c" or "foo.c:main" *) (* local function that is parametrized by whether to launch gv *) let local_test_cfg launchgv file = let (file, specific_func) = if file =~ "\\(.*\\.c\\):\\(.*\\)" then let (a,b) = matched2 file in a, Some b else file, None in if not (file =~ ".*\\.c") then pr2 "warning: seems not a .c file"; (* no point to parse format strings *) let (program, _stat) = Parse_c.parse_c_and_cpp false file in program +> List.iter (fun (e,_) -> let toprocess = match specific_func, e with | None, Ast_c.Definition (defbis,_) -> Some (Ast_c.str_of_name (defbis.Ast_c.f_name)) | Some s, Ast_c.Definition (defbis,_) -> let nm = Ast_c.str_of_name (defbis.Ast_c.f_name) in if s =$= nm then Some nm else None | _, _ -> None in match toprocess with None -> () | Some fn -> (* old: Flow_to_ast.test !Flag.show_flow def *) try let flow = Ast_to_flow.ast_to_control_flow e in flow +> do_option (fun flow -> Ast_to_flow.deadcode_detection flow; let flow = Ast_to_flow.annotate_loop_nodes flow in let flow' = (* if !Flag_cocci.show_before_fixed_flow then flow else Ctlcocci_integration.fix_flow_ctl flow *) flow in let filename = if launchgv then Filename.temp_file "output" ".dot" else let fl = Filename.chop_extension (Filename.basename file) in fl^":"^fn^".dot" in Ograph_extended.print_ograph_mutable flow' (filename) launchgv ) with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x ) let test_cfg = local_test_cfg true let test_cfg_ifdef file = (* no point to parse format strings *) let (ast2, _stat) = Parse_c.parse_c_and_cpp false file in let ast = Parse_c.program_of_program2 ast2 in let ast = Cpp_ast_c.cpp_ifdef_statementize ast in ast +> List.iter (fun e -> (try let flow = Ast_to_flow.ast_to_control_flow e in flow +> do_option (fun flow -> Ast_to_flow.deadcode_detection flow; let flow = Ast_to_flow.annotate_loop_nodes flow in Ograph_extended.print_ograph_mutable flow ("/tmp/output.dot") true ) with Ast_to_flow.Error (x) -> Ast_to_flow.report_error x ) ) (* ---------------------------------------------------------------------- *) let test_parse_unparse infile = if not (infile =~ ".*\\.c") then pr2 "warning: seems not a .c file"; (* test parsing of format strings *) let (program2, _stat) = Parse_c.parse_c_and_cpp true infile in let program2_with_ppmethod = program2 +> List.map (fun x -> x, Unparse_c.PPnormal) in Unparse_c.pp_program program2_with_ppmethod tmpfile; Common.command2 ("cat " ^ tmpfile); (* if want see diff of space => no -b -B *) Common.command2 (spf "diff -u -p %s %s" infile tmpfile); (* +> Transformation.test_simple_trans1;*) () (* let parse_and_print_sexp file = let (ast2,_stat) = Parse_c.parse_c_and_cpp file in let ast = Parse_c.program_of_program2 ast2 in let _ast = Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast in (* let sexp = Sexp_ast_c.sexp_of_program ast in let s = Sexp.to_string_hum sexp in *) Sexp_ast_c.show_info := false; let s = Sexp_ast_c.string_of_program ast in pr2 s; () *) let test_type_c infile = if not (infile =~ ".*\\.c") then pr2 "warning: seems not a .c file"; Flag_parsing_c.pretty_print_type_info := true; (* no point to parse format strings *) let (program2, _stat) = Parse_c.parse_c_and_cpp false infile in let _program2 = program2 +> Common.unzip +> (fun (program, infos) -> Type_annoter_c.annotate_program !Type_annoter_c.initial_env program +> List.map fst, infos ) +> Common.uncurry Common.zip in let program2_with_ppmethod = program2 +> List.map (fun x -> x, Unparse_c.PPnormal) in Unparse_c.pp_program program2_with_ppmethod tmpfile; Common.command2 ("cat " ^ tmpfile); ();; (* ---------------------------------------------------------------------- *) (* ex: demos/platform_ifdef.c *) let test_comment_annotater infile = (* no point to parse format strings *) let (program2, _stat) = Parse_c.parse_c_and_cpp false infile in let asts = program2 +> List.map (fun (ast,_) -> ast) in let toks = program2 +> List.map (fun (ast, (s, toks)) -> toks) +> List.flatten in Flag_parsing_c.pretty_print_comment_info := true; pr2 "pretty print, before comment annotation: --->"; Common.adjust_pp_with_indent (fun () -> asts +> List.iter (fun ast -> Pretty_print_c.pp_toplevel_simple ast; ); ); let _ = Comment_annotater_c.annotate_program toks asts in Common.adjust_pp_with_indent (fun () -> pr2 "pretty print, after comment annotation: --->"; asts +> List.iter (fun ast -> Pretty_print_c.pp_toplevel_simple ast; ); ); () (* ---------------------------------------------------------------------- *) (* used by generic_makefile now *) let test_compare_c file1 file2 = let (correct, diffxs) = Compare_c.compare_default file1 file2 in let res = Compare_c.compare_result_to_bool correct in if res then raise (Common.UnixExit 0) else raise (Common.UnixExit (-1)) let test_compare_c_hardcoded () = Compare_c.compare_default "tests/compare1.c" "tests/compare2.c" (* "tests/equal_modulo1.c" "tests/equal_modulo2.c" *) +> Compare_c.compare_result_to_string +> pr2 (* ---------------------------------------------------------------------- *) let test_attributes file = (* no point to parse format strings *) let (ast2, _stat) = Parse_c.parse_c_and_cpp false file in let ast = Parse_c.program_of_program2 ast2 in Visitor_c.vk_program { Visitor_c.default_visitor_c with Visitor_c.kdef = (fun (k, bigf) (defbis, ii) -> let sattr = Ast_c.s_of_attr defbis.f_attr in pr2 (spf "%-30s: %s" (Ast_c.str_of_name (defbis.f_name)) sattr); ); Visitor_c.kdecl = (fun (k, bigf) decl -> match decl with | DeclList (xs, ii) -> xs +> List.iter (fun (onedecl, iicomma) -> let sattr = Ast_c.s_of_attr onedecl.v_attr in let idname = match onedecl.v_namei with | Some (name, ini) -> Ast_c.str_of_name name | None -> "novar" in pr2 (spf "%-30s: %s" idname sattr); ); | _ -> () ); } ast; () let cpp_options () = [ Cpp_ast_c.I "/home/yyzhou/pad/linux/include"; ] ++ Cpp_ast_c.cpp_option_of_cmdline (!Flag_parsing_c.cpp_i_opts,!Flag_parsing_c.cpp_d_opts) let test_cpp file = (* no point to parse format strings *) let (ast2, _stat) = Parse_c.parse_c_and_cpp false file in let dirname = Filename.dirname file in let ast = Parse_c.program_of_program2 ast2 in let ast = Cpp_ast_c.cpp_expand_include (cpp_options()) dirname ast in let _ast = Cpp_ast_c.cpp_ifdef_statementize ast in () (* CONFIG [ch] ? also do for .c ? maybe less needed now that I * add local_macros. *) let extract_macros ~selection dir = let ext = "h" in let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in let macros_and_filename = fullxs +> List.map (fun file -> pr2 (spf "processing: %s" file); let xs = Parse_c.extract_macros file in file, xs ) in let macros = if selection then Cpp_analysis_c.extract_dangerous_macros macros_and_filename else macros_and_filename in macros +> List.iter (fun (file, defs) -> pr ("/* PARSING: " ^ file ^ " */"); defs +> List.iter (fun (s, def) -> let str = Cpp_token_c.string_of_define_def def in pr str; ) ); () let test_parse xs = Flag_parsing_c.filter_msg_define_error := true; Flag_parsing_c.filter_define_error := true; Flag_parsing_c.verbose_lexing := false; Flag_parsing_c.verbose_parsing := false; let dirname_opt = match xs with | [x] when is_directory x -> Some x | _ -> None in dirname_opt +> Common.do_option (fun dir -> let ext = "h" in let fullxs = Common.files_of_dir_or_files_no_vcs ext [dir] in let macros_and_filename = fullxs +> List.map (fun file -> pr2 (spf "processing: %s" file); let xs = Parse_c.extract_macros file in file, xs ) in let macros = Cpp_analysis_c.extract_dangerous_macros macros_and_filename in macros +> List.iter (fun (file, xs) -> xs +> List.iter (fun (x, def) -> let (s, params, body) = def in let str = Cpp_token_c.string_of_define_def def in pr str; (* builtins ? *) Hashtbl.replace !Parse_c._defs_builtins s (s, params, body); ); ); ); let ext = "[ch]" in let fullxs = Common.files_of_dir_or_files_no_vcs ext xs in let stat_list = ref [] in Common.check_stack_nbfiles (List.length fullxs); fullxs +> List.iter (fun file -> if not (file =~ (".*\\."^ext)) then pr2 ("warning: seems not a ."^ext^" file"); pr2 ""; pr2 ("PARSING: " ^ file); (* test parsing of format strings *) let (xs, stat) = Parse_c.parse_c_and_cpp true file in xs +> List.iter (fun (ast, (s, toks)) -> Parse_c.print_commentized toks ); Common.push2 stat stat_list; ); if not (null !stat_list) then begin Parsing_stat.print_recurring_problematic_tokens !stat_list; Parsing_stat.print_parsing_stat_list !stat_list; end; () (* ---------------------------------------------------------------------- *) let test_xxx a = () (* ignore(Parse_c.parse_cpp_define_file "standard.h") pr2 "pr2"; pr "pr" Format.print_newline(); Format.printf "@[--@,--@,@[--@,--@,@]--@,--@,@]"; Format.print_newline(); Format.printf "@[(---@[(---@[(---@,)@]@,)@]@,)@]" *) (*****************************************************************************) (* Main entry for Arg *) (*****************************************************************************) let actions () = [ "--tokens-c", " ", Common.mk_action_1_arg test_tokens_c; "--parse-c", " ", Common.mk_action_n_arg test_parse_c; "--parse-h", " ", Common.mk_action_n_arg test_parse_h; "--parse-ch", " ", Common.mk_action_n_arg test_parse_ch; "--parse-i", " ", Common.mk_action_n_arg test_parse_i; "--parse-c++", " ", Common.mk_action_n_arg new_test_parse_gen; "--parse", " ", Common.mk_action_n_arg test_parse; "--show-flow", " ", Common.mk_action_1_arg (local_test_cfg true); "--control-flow", " ", Common.mk_action_1_arg (local_test_cfg true); "--control-flow-to-file", " ", Common.mk_action_1_arg (local_test_cfg false); "--test-cfg-ifdef", " ", Common.mk_action_1_arg test_cfg_ifdef; "--parse-unparse", " ", Common.mk_action_1_arg test_parse_unparse; (* "--parse-and-print-sexp", " ", Common.mk_action_1_arg parse_and_print_sexp;*) "--type-c", " ", Common.mk_action_1_arg test_type_c; "--compare-c", " ", Common.mk_action_2_arg test_compare_c (* result is in unix code *); "--comment-annotater-c", " ", Common.mk_action_1_arg test_comment_annotater; "--compare-c-hardcoded", " ", Common.mk_action_0_arg test_compare_c_hardcoded; "--test-attributes", " ", Common.mk_action_1_arg test_attributes; "--test-cpp", " ", Common.mk_action_1_arg test_cpp; "--extract-macros", " ", Common.mk_action_1_arg (extract_macros ~selection:false) ; "--extract-macros-select", " ", Common.mk_action_1_arg (extract_macros ~selection:true); "--xxx", " <>", Common.mk_action_n_arg test_xxx; ] coccinelle-1.0.0-rc19/parsing_c/pretty_print_c.ml0000644000175000017500000013245612247437436020747 0ustar eugeneugen(* Yoann Padioleau, Julia Lawall * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c module F = Control_flow_c (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_unparsing (*****************************************************************************) (* Types *) (*****************************************************************************) type type_with_ident = (string * Ast_c.info) option -> (Ast_c.storage * Ast_c.il) option -> Ast_c.fullType -> Ast_c.attribute list -> unit type 'a printer = 'a -> unit type pretty_printers = { expression : Ast_c.expression printer; arg_list : (Ast_c.argument Ast_c.wrap2 list) printer; arg : Ast_c.argument printer; statement : Ast_c.statement printer; decl : Ast_c.declaration printer; field : Ast_c.field printer; field_list : Ast_c.field list printer; init : Ast_c.initialiser printer; init_list : (Ast_c.initialiser wrap2 list) printer; param : Ast_c.parameterType printer; paramlist : (Ast_c.parameterType Ast_c.wrap2 list) printer; ty : Ast_c.fullType printer; type_with_ident : type_with_ident; toplevel : Ast_c.toplevel printer; fragment : Ast_c.string_fragment printer; fragment_list : (Ast_c.string_fragment list) printer; format : Ast_c.string_format printer; flow : Control_flow_c.node printer } (*****************************************************************************) (* This module is used by unparse_c, but because unparse_c have also * the list of tokens, pretty_print_c could be useless in the future * (except that the ast_c have some fake tokens not present in the list * of tokens so it's still useful). But this module is also useful to * unparse C when you don't have the ordered list of tokens separately, * or tokens without position information, for instance when you want * to pretty print some piece of C that was generated, or some * abstract-lined piece of code, etc. *) let mk_pretty_printers ~pr_elem ~pr_space ~pr_nl ~pr_indent ~pr_outdent ~pr_unindent = let start_block () = pr_nl(); pr_indent() in let end_block () = pr_unindent(); pr_nl() in (* let pr_nl_slash _ = (* multiline macro *) let slash = (Ast_c.fakeInfo() +> Ast_c.rewrap_str " \\") in pr_elem slash; pr_nl() in *) let indent_if_needed st f = match Ast_c.unwrap_st st with Compound _ -> pr_space(); f() | _ -> (*no newline at the end - someone else will do that*) start_block(); f(); pr_unindent() in let pp_list printer l = l +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); (* opt must be a comma? *) opt +> List.iter (function x -> pr_elem x; pr_space()); printer e) in let pp_list2 printer l = (* no comma case *) l +> List.iter printer in let rec pp_expression = fun ((exp, typ), ii) -> (match exp, ii with | Ident (ident), [] -> pp_name ident (* only a MultiString can have multiple ii *) | Constant (MultiString _), is -> is +> List.iter pr_elem | Constant (c), [i] -> pr_elem i | StringConstant(s,os,w), [i1;i2] -> pr_elem i1; s +> (List.iter pp_string_fragment); pr_elem i2 | FunCall (e, es), [i1;i2] -> pp_expression e; pr_elem i1; pp_arg_list es; pr_elem i2; | CondExpr (e1, e2, e3), [i1;i2] -> pp_expression e1; pr_space(); pr_elem i1; pr_space(); do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2; pr_space(); pp_expression e3 | Sequence (e1, e2), [i] -> pp_expression e1; pr_elem i; pr_space(); pp_expression e2 | Assignment (e1, op, e2), [i] -> pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 | Postfix (e, op), [i] -> pp_expression e; pr_elem i; | Infix (e, op), [i] -> pr_elem i; pp_expression e; | Unary (e, op), [i] -> pr_elem i; pp_expression e | Binary (e1, op, e2), [i] -> pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 | ArrayAccess (e1, e2), [i1;i2] -> pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2 | RecordAccess (e, name), [i1] -> pp_expression e; pr_elem i1; pp_name name; | RecordPtAccess (e, name), [i1] -> pp_expression e; pr_elem i1; pp_name name; | SizeOfExpr (e), [i] -> pr_elem i; (match Ast_c.unwrap e with ParenExpr (e), _ -> () | _ -> pr_space()); pp_expression e | SizeOfType (t), [i1;i2;i3] -> pr_elem i1; pr_elem i2; pp_type t; pr_elem i3 | Cast (t, e), [i1;i2] -> pr_elem i1; pp_type t; pr_elem i2; pp_expression e | StatementExpr (statxs, [ii1;ii2]), [i1;i2] -> pr_elem i1; pr_elem ii1; statxs +> List.iter pp_statement_seq; pr_elem ii2; pr_elem i2; | Constructor (t, init), [lp;rp] -> pr_elem lp; pp_type t; pr_elem rp; pp_init init | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2; | New (None, t), [i1] -> pr_elem i1; pp_argument t | New (Some ts, t), [i1; i2; i3] -> pr_elem i1; pr_elem i2; pp_arg_list ts; pr_elem i3; pp_argument t | Delete(t), [i1] -> pr_elem i1; pp_expression t | (Ident (_) | Constant _ | StringConstant _ | FunCall (_,_) | CondExpr (_,_,_) | Sequence (_,_) | Assignment (_,_,_) | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_) | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | StatementExpr (_) | Constructor _ | ParenExpr (_) | New (_) | Delete (_)),_ -> raise (Impossible 95) ); if !Flag_parsing_c.pretty_print_type_info then begin pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*"); !typ +> (fun (ty,_test) -> ty +> Common.do_option (fun (x,l) -> pp_type x; let s = match l with Ast_c.LocalVar _ -> ", local" | _ -> "" in pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s))); pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/"); end and pp_arg_list es = pp_list pp_argument es and pp_argument argument = let rec pp_action (ActMisc ii) = ii +> List.iter pr_elem in match argument with | Left e -> pp_expression e | Right weird -> (match weird with | ArgType param -> pp_param param | ArgAction action -> pp_action action) (* ---------------------- *) and pp_name = function | RegularName (s, ii) -> let (i1) = Common.tuple_of_list1 ii in pr_elem i1 | CppConcatenatedName xs -> xs +> List.iter (fun ((x,ii1), ii2) -> ii2 +> List.iter pr_elem; ii1 +> List.iter pr_elem; ) | CppVariadicName (s, ii) -> ii +> List.iter pr_elem | CppIdentBuilder ((s,iis), xs) -> let (iis, iop, icp) = Common.tuple_of_list3 iis in pr_elem iis; pr_elem iop; xs +> List.iter (fun ((x,iix), iicomma) -> iicomma +> List.iter pr_elem; iix +> List.iter pr_elem; ); pr_elem icp and pp_string_fragment (e,ii) = match (e,ii) with ConstantFragment(str), ii -> let (i) = Common.tuple_of_list1 ii in pr_elem i | FormatFragment(fmt), ii -> let (i) = Common.tuple_of_list1 ii in pr_elem i; pp_string_format fmt and pp_string_fragment_list sfl = pp_list2 pp_string_fragment sfl and pp_string_format (e,ii) = match (e,ii) with ConstantFormat(str), ii -> let (i) = Common.tuple_of_list1 ii in pr_elem i (* ---------------------- *) and pp_statement = fun st -> match Ast_c.get_st_and_ii st with | Labeled (Label (name, st)), ii -> let (i2) = Common.tuple_of_list1 ii in pr_outdent(); pp_name name; pr_elem i2; pr_nl(); pp_statement st | Labeled (Case (e, st)), [i1;i2] -> pr_unindent(); pr_elem i1; pp_expression e; pr_elem i2; pr_nl(); pr_indent(); pp_statement st | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] -> pr_unindent(); pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3; pr_nl(); pr_indent(); pp_statement st | Labeled (Default st), [i1;i2] -> pr_unindent(); pr_elem i1; pr_elem i2; pr_nl(); pr_indent(); pp_statement st | Compound statxs, [i1;i2] -> pr_elem i1; start_block(); statxs +> Common.print_between pr_nl pp_statement_seq; end_block(); pr_elem i2; | ExprStatement (None), [i] -> pr_elem i; | ExprStatement (None), [] -> () | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i (* the last ExprStatement of a for does not have a trailing ';' hence the [] for ii *) | ExprStatement (Some e), [] -> pp_expression e; | Selection (If (e, st1, st2)), i1::i2::i3::is -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st1 (function _ -> pp_statement st1); (match (Ast_c.get_st_and_ii st2, is) with | ((ExprStatement None, []), []) -> () | ((ExprStatement None, []), [iifakend]) -> pr_elem iifakend | _st2, [i4;iifakend] -> pr_elem i4; indent_if_needed st2 (function _ -> pp_statement st2); pr_elem iifakend | x -> raise (Impossible 96) ) | Selection (Switch (e, st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st (function _-> pp_statement st); pr_elem iifakend | Iteration (While (e, st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st (function _-> pp_statement st); pr_elem iifakend | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] -> pr_elem i1; indent_if_needed st (function _ -> pp_statement st); pr_elem i2; pr_elem i3; pp_expression e; pr_elem i4; pr_elem i5; pr_elem iifakend | Iteration (For (first,(e2opt,il2),(e3opt, il3),st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; (match first with ForExp (e1opt,il1) -> pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1) | ForDecl decl -> pp_decl decl); pp_statement (Ast_c.mk_st (ExprStatement e2opt) il2); assert (null il3); pp_statement (Ast_c.mk_st (ExprStatement e3opt) il3); pr_elem i3; indent_if_needed st (function _ -> pp_statement st); pr_elem iifakend | Iteration (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem i3; indent_if_needed st (function _ -> pp_statement st); pr_elem iifakend | Jump (Goto name), ii -> let (i1, i3) = Common.tuple_of_list2 ii in pr_elem i1; pr_space(); pp_name name; pr_elem i3; | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2; | Jump (ReturnExpr e), [i1;i2] -> pr_elem i1; pr_space(); pp_expression e; pr_elem i2 | Jump (GotoComputed e), [i1;i2;i3] -> pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3 | Decl decl, [] -> pp_decl decl | Asm asmbody, ii -> (match ii with | [iasm;iopar;icpar;iptvirg] -> pr_elem iasm; pr_elem iopar; pp_asmbody asmbody; pr_elem icpar; pr_elem iptvirg | [iasm;ivolatile;iopar;icpar;iptvirg] -> pr_elem iasm; pr_elem ivolatile; pr_elem iopar; pp_asmbody asmbody; pr_elem icpar; pr_elem iptvirg | _ -> raise (Impossible 97) ) | NestedFunc def, ii -> assert (null ii); pp_def def | MacroStmt, ii -> ii +> List.iter pr_elem ; | (Labeled (Case (_,_)) | Labeled (CaseRange (_,_,_)) | Labeled (Default _) | Compound _ | ExprStatement _ | Selection (If (_, _, _)) | Selection (Switch (_, _)) | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) | Iteration (For (_, (_,_), (_, _), _)) | Iteration (MacroIteration (_,_,_)) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) | Jump (GotoComputed _) | Decl _ ), _ -> raise (Impossible 98) and pp_statement_seq = function | StmtElem st -> pp_statement st | IfdefStmt ifdef -> pp_ifdef ifdef | CppDirectiveStmt cpp -> pp_directive cpp | IfdefStmt2 (ifdef, xxs) -> pp_ifdef_tree_sequence ifdef xxs (* ifdef XXX elsif YYY elsif ZZZ endif *) and pp_ifdef_tree_sequence ifdef xxs = match ifdef with | if1::ifxs -> pp_ifdef if1; pp_ifdef_tree_sequence_aux ifxs xxs | _ -> raise (Impossible 99) (* XXX elsif YYY elsif ZZZ endif *) and pp_ifdef_tree_sequence_aux ifdefs xxs = Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) -> xs +> List.iter pp_statement_seq; pp_ifdef ifdef ) (* ---------------------- *) and pp_asmbody (string_list, colon_list) = string_list +> List.iter pr_elem ; colon_list +> List.iter (fun (Colon xs, ii) -> ii +> List.iter pr_elem; xs +> List.iter (fun (x,iicomma) -> assert ((List.length iicomma) <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); (match x with | ColonMisc, ii -> ii +> List.iter pr_elem; | ColonExpr e, [istring;iopar;icpar] -> pr_elem istring; pr_elem iopar; pp_expression e; pr_elem icpar (* the following case used to be just raise Impossible, but the code __asm__ __volatile__ ("dcbz 0, %[input]" ::[input]"r"(&coherence_data[i])); in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *) | (ColonExpr e), ii -> (match List.rev ii with icpar::iopar::istring::rest -> List.iter pr_elem (List.rev rest); pr_elem istring; pr_elem iopar; pp_expression e; pr_elem icpar | _ -> raise (Impossible 100))) )) (* ---------------------- *) (* pp_type_with_ident pp_base_type pp_type_with_ident_rest pp_type_left pp_type_right pp_type pp_decl *) and (pp_type_with_ident: (string * info) option -> (storage * il) option -> fullType -> attribute list -> unit) = fun ident sto ft attrs -> pp_base_type ft sto; (match (ident, Ast_c.unwrap_typeC ft) with (Some _,_) | (_,Pointer _) -> pr_space() | _ -> ()); pp_type_with_ident_rest ident ft attrs and (pp_base_type: fullType -> (storage * il) option -> unit) = fun (qu, (ty, iity)) sto -> let get_sto sto = match sto with | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis in let print_sto_qu (sto, (qu, iiqu)) = let all_ii = get_sto sto ++ iiqu in all_ii +> List.sort Ast_c.compare_pos +> Common.print_between pr_space pr_elem in let print_sto_qu_ty (sto, (qu, iiqu), iity) = let all_ii = get_sto sto ++ iiqu ++ iity in let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in if all_ii <> all_ii2 then begin (* TODO in fact for pointer, the qualifier is after the type * cf -test strangeorder *) pr2 "STRANGEORDER"; all_ii2 +> Common.print_between pr_space pr_elem end else all_ii2 +> Common.print_between pr_space pr_elem in match ty, iity with | (NoType,_) -> () | (Pointer t, [i]) -> pp_base_type t sto | (ParenType t, _) -> pp_base_type t sto | (Array (eopt, t), [i1;i2]) -> pp_base_type t sto | (FunctionType (returnt, paramst), [i1;i2]) -> pp_base_type returnt sto; | (StructUnion (su, sopt, fields),iis) -> print_sto_qu (sto, qu); (match sopt,iis with | Some s , [i1;i2;i3;i4] -> pr_elem i1; pr_elem i2; pr_elem i3; | None, [i1;i2;i3] -> pr_elem i1; pr_elem i2; | x -> raise (Impossible 101) ); fields +> List.iter pp_field; (match sopt,iis with | Some s , [i1;i2;i3;i4] -> pr_elem i4 | None, [i1;i2;i3] -> pr_elem i3; | x -> raise (Impossible 102) ); | (Enum (sopt, enumt), iis) -> print_sto_qu (sto, qu); (match sopt, iis with | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) -> pr_elem i1; pr_elem i2; pr_elem i3; | (None, ([i1;i2;i3]|[i1;i2;i3;_])) -> pr_elem i1; pr_elem i2 | x -> raise (Impossible 103) ); enumt +> List.iter (fun ((name, eopt), iicomma) -> assert (List.length iicomma <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); pp_name name; eopt +> Common.do_option (fun (ieq, e) -> pr_elem ieq; pp_expression e; )); (match sopt, iis with | (Some s, [i1;i2;i3;i4]) -> pr_elem i4 | (Some s, [i1;i2;i3;i4;i5]) -> pr_elem i5; pr_elem i4 (* trailing comma *) | (None, [i1;i2;i3]) -> pr_elem i3 | (None, [i1;i2;i3;i4]) -> pr_elem i4; pr_elem i3 (* trailing comma *) | x -> raise (Impossible 104) ); | (BaseType _, iis) -> print_sto_qu_ty (sto, qu, iis); | (StructUnionName (s, structunion), iis) -> assert (List.length iis =|= 2); print_sto_qu_ty (sto, qu, iis); | (EnumName s, iis) -> assert (List.length iis =|= 2); print_sto_qu_ty (sto, qu, iis); | (Decimal(l,p), [dec;lp;cm;rp]) -> (* hope that sto before qu is right... cf print_sto_qu_ty *) let stoqulp = get_sto sto ++ (snd qu) ++ [dec] in Common.print_between pr_space pr_elem stoqulp; pr_elem lp; pp_expression l; pr_elem cm; do_option pp_expression p; pr_elem rp | (TypeName (name,typ), noii) -> assert (null noii); let (_s, iis) = get_s_and_info_of_name name in print_sto_qu_ty (sto, qu, [iis]); if !Flag_parsing_c.pretty_print_typedef_value then begin pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "{*"); typ +> Common.do_option (fun typ -> pp_type typ; ); pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*}"); end; | (TypeOfExpr (e), iis) -> print_sto_qu (sto, qu); (match iis with | [itypeof;iopar;icpar] -> pr_elem itypeof; pr_elem iopar; pp_expression e; pr_elem icpar; | _ -> raise (Impossible 105) ) | (TypeOfType (t), iis) -> print_sto_qu (sto, qu); (match iis with | [itypeof;iopar;icpar] -> pr_elem itypeof; pr_elem iopar; pp_type t; pr_elem icpar; | _ -> raise (Impossible 106) ) | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _ | Decimal _ (* | StructUnion _ | Enum _ | BaseType _ *) (* | StructUnionName _ | EnumName _ | TypeName _ *) (* | TypeOfExpr _ | TypeOfType _ *) ), _ -> raise (Impossible 107) and pp_field_list fields = fields +> Common.print_between pr_nl pp_field and pp_field = function DeclarationField(FieldDeclList(onefield_multivars,iiptvirg))-> (match onefield_multivars with x::xs -> (* handling the first var. Special case, with the first var, we print the whole type *) (match x with (Simple (nameopt, typ)), iivirg -> (* first var cannot have a preceding ',' *) assert (List.length iivirg =|= 0); let identinfo = match nameopt with | None -> None | Some name -> Some (get_s_and_info_of_name name) in pp_type_with_ident identinfo None typ Ast_c.noattr; | (BitField (nameopt, typ, iidot, expr)), iivirg -> (* first var cannot have a preceding ',' *) assert (List.length iivirg =|= 0); (match nameopt with | None -> pp_type typ; | Some name -> let (s, is) = get_s_and_info_of_name name in pp_type_with_ident (Some (s, is)) None typ Ast_c.noattr; ); pr_elem iidot; pp_expression expr ); (* match x, first onefield_multivars *) (* for other vars *) xs +> List.iter (function | (Simple (nameopt, typ)), iivirg -> iivirg +> List.iter pr_elem; let identinfo = match nameopt with | None -> None | Some name -> Some (get_s_and_info_of_name name) in pp_type_with_ident_rest identinfo typ Ast_c.noattr | (BitField (nameopt, typ, iidot, expr)), iivirg -> iivirg +> List.iter pr_elem; (match nameopt with | Some name -> let (s,is) = get_s_and_info_of_name name in pp_type_with_ident_rest (Some (s, is)) typ Ast_c.noattr; pr_elem iidot; pp_expression expr | None -> (* was raise Impossible, but have no idea why because nameless bit fields are accepted by the parser and nothing seems to be done to give them names *) pr_elem iidot; pp_expression expr )); (* iter other vars *) | [] -> raise (Impossible 108) ); (* onefield_multivars *) assert (List.length iiptvirg =|= 1); iiptvirg +> List.iter pr_elem; | MacroDeclField ((s, es), ii) -> let (iis, lp, rp, iiend, ifakestart) = Common.tuple_of_list5 ii in (* iis::lp::rp::iiend::ifakestart::iisto iisto +> List.iter pr_elem; (* static and const *) *) pr_elem ifakestart; pr_elem iis; pr_elem lp; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem rp; pr_elem iiend; | EmptyField iipttvirg_when_emptyfield -> pr_elem iipttvirg_when_emptyfield | CppDirectiveStruct cpp -> pp_directive cpp | IfdefStruct ifdef -> pp_ifdef ifdef (* used because of DeclList, in int i,*j[23]; we don't print anymore the int before *j *) and (pp_type_with_ident_rest: (string * info) option -> fullType -> attribute list -> unit) = fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs -> let print_ident ident = Common.do_option (fun (s, iis) -> (* XXX attrs +> pp_attributes pr_elem pr_space; *) pr_elem iis ) ident in match ty, iity with (* the work is to do in base_type !! *) | (NoType, iis) -> () | (BaseType _, iis) -> print_ident ident | (Enum (sopt, enumt), iis) -> print_ident ident | (StructUnion (_, sopt, fields),iis) -> print_ident ident | (StructUnionName (s, structunion), iis) -> print_ident ident | (EnumName s, iis) -> print_ident ident | (Decimal _, iis) -> print_ident ident | (TypeName (_name,_typ), iis) -> print_ident ident | (TypeOfExpr (e), iis) -> print_ident ident | (TypeOfType (e), iis) -> print_ident ident | (Pointer t, [i]) -> (* subtil: void ( *done)(int i) is a Pointer (FunctionType (return=void, params=int i) *) (*WRONG I THINK, use left & right function *) (* bug: pp_type_with_ident_rest None t; print_ident ident *) pr_elem i; iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) pp_type_with_ident_rest ident t attrs; (* ugly special case ... todo? maybe sufficient in practice *) | (ParenType ttop, [i1;i2]) -> (match Ast_c.get_ty_and_ii ttop with | (_q1, (Pointer t2, [ipointer])) -> (match Ast_c.get_ty_and_ii t2 with | (q2, (FunctionType t, ii3)) -> pp_type_left (q2, mk_tybis (FunctionType t) ii3); pr_elem i1; pr_elem ipointer; print_ident ident; pr_elem i2; pp_type_right (q2, mk_tybis (FunctionType t) ii3); | _ -> pr2 "PB PARENTYPE ZARB, I forget about the ()"; pp_type_with_ident_rest ident ttop attrs; ) (* another ugly special case *) | _q1, (Array (eopt,t2 ), [iarray1;iarray2]) -> (match Ast_c.get_ty_and_ii t2 with | (_q2, (Pointer t3, [ipointer])) -> (match Ast_c.get_ty_and_ii t3 with | (q3, (FunctionType t, iifunc)) -> pp_type_left (q3, mk_tybis (FunctionType t) iifunc); pr_elem i1; pr_elem ipointer; print_ident ident; pr_elem iarray1; do_option pp_expression eopt; pr_elem iarray2; pr_elem i2; pp_type_right (q3, mk_tybis (FunctionType t) iifunc) | _ -> pr2 "PB PARENTYPE ZARB, I forget about the ()"; pp_type_with_ident_rest ident ttop attrs; ) | _ -> pr2 "PB PARENTYPE ZARB, I forget about the ()"; pp_type_with_ident_rest ident ttop attrs; ) | _t -> pr2 "PB PARENTYPE ZARB, I forget about the ()"; pp_type_with_ident_rest ident ttop attrs; ) | (Array (eopt, t), [i1;i2]) -> pp_type_left fullt; iiqu +> List.iter pr_elem; print_ident ident; pp_type_right fullt; | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left fullt; iiqu +> List.iter pr_elem; print_ident ident; pp_type_right fullt; | (FunctionType _ | Array _ | ParenType _ | Pointer _), _ -> raise (Impossible 109) and (pp_type_left: fullType -> unit) = fun ((qu, iiqu), (ty, iity)) -> match ty, iity with (NoType,_) -> failwith "pp_type_left: unexpected NoType" | (Pointer t, [i]) -> pr_elem i; iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) pp_type_left t | (Array (eopt, t), [i1;i2]) -> pp_type_left t | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt | (ParenType t, _) -> failwith "parenType" | (BaseType _, iis) -> () | (Enum (sopt, enumt), iis) -> () | (StructUnion (_, sopt, fields),iis) -> () | (StructUnionName (s, structunion), iis) -> () | (EnumName s, iis) -> () | (Decimal(l,p), iis) -> () | (TypeName (_name,_typ), iis) -> () | TypeOfType _, _ -> () | TypeOfExpr _, _ -> () | (FunctionType _ | Array _ | Pointer _), _ -> raise (Impossible 110) and pp_param param = let {p_namei = nameopt; p_register = (b,iib); p_type=t;} = param in iib +> List.iter pr_elem; match nameopt with | None -> pp_type t | Some name -> let (s,i1) = get_s_and_info_of_name name in pp_type_with_ident (Some (s, i1)) None t Ast_c.noattr and pp_type_right (((qu, iiqu), (ty, iity)) : fullType) = match ty, iity with (NoType,_) -> failwith "pp_type_right: unexpected NoType" | (Pointer t, [i]) -> pp_type_right t | (Array (eopt, t), [i1;i2]) -> pr_elem i1; eopt +> do_option pp_expression; pr_elem i2; pp_type_right t | (ParenType t, _) -> failwith "parenType" | (FunctionType (returnt, paramst), [i1;i2]) -> pr_elem i1; (match paramst with | (ts, (b, iib)) -> ts +> List.iter (fun (param,iicomma) -> assert ((List.length iicomma) <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); pp_param param; ); iib +> List.iter pr_elem; ); pr_elem i2 | (BaseType _, iis) -> () | (Enum (sopt, enumt), iis) -> () | (StructUnion (_, sopt, fields),iis)-> () | (StructUnionName (s, structunion), iis) -> () | (EnumName s, iis) -> () | (Decimal(l,p), iis) -> () | (TypeName (name,_typ), iis) -> () | TypeOfType _, _ -> () | TypeOfExpr _, _ -> () | (FunctionType _ | Array _ | Pointer _), _ -> raise (Impossible 111) and pp_type t = pp_type_with_ident None None t Ast_c.noattr (* ---------------------- *) and pp_decl = function | DeclList ((({v_namei = var; v_type = returnType; v_storage = storage; v_attr = attrs; },[])::xs), iivirg::ifakestart::iisto) -> pr_elem ifakestart; (* old: iisto +> List.iter pr_elem; *) (* handling the first var. Special case, we print the whole type *) (match var with | Some (name, iniopt) -> let (s,iis) = get_s_and_info_of_name name in pp_type_with_ident (Some (s, iis)) (Some (storage, iisto)) returnType attrs; (match iniopt with Ast_c.NoInit -> () | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init | Ast_c.ConstrInit((init,[lp;rp])) -> pr_elem lp; pp_arg_list init; pr_elem rp | Ast_c.ConstrInit _ -> raise (Impossible 112)) | None -> pp_type returnType ); (* for other vars, we just call pp_type_with_ident_rest. *) xs +> List.iter (function | ({v_namei = Some (name, iniopt); v_type = returnType; v_storage = storage2; v_attr = attrs; }, iivirg) -> let (s,iis) = get_s_and_info_of_name name in assert (storage2 =*= storage); iivirg +> List.iter pr_elem; pp_type_with_ident_rest (Some (s, iis)) returnType attrs; (match iniopt with Ast_c.NoInit -> () | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init | Ast_c.ConstrInit((init,[lp;rp])) -> pr_elem lp; pp_arg_list init; pr_elem rp | Ast_c.ConstrInit _ -> raise (Impossible 113)); | x -> raise (Impossible 114) ); pr_elem iivirg; | MacroDecl ((s, es, true), iis::lp::rp::iiend::ifakestart::iisto) -> pr_elem ifakestart; iisto +> List.iter pr_elem; (* static and const *) pr_elem iis; pr_elem lp; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem rp; pr_elem iiend; | MacroDecl ((s, es, false), iis::lp::rp::ifakestart::iisto) -> pr_elem ifakestart; iisto +> List.iter pr_elem; (* static and const *) pr_elem iis; pr_elem lp; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem rp; | MacroDeclInit ((s, es, ini), iis::lp::rp::eq::iiend::ifakestart::iisto) -> pr_elem ifakestart; iisto +> List.iter pr_elem; (* static and const *) pr_elem iis; pr_elem lp; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem rp; pr_elem eq; pp_init ini; pr_elem iiend; | (DeclList (_, _) | (MacroDecl _) | (MacroDeclInit _)) -> raise (Impossible 115) (* ---------------------- *) and pp_init (init, iinit) = match init, iinit with | InitExpr e, [] -> pp_expression e; | InitList xs, i1::i2::iicommaopt -> pr_elem i1; start_block(); xs +> List.iter (fun (x, ii) -> assert (List.length ii <= 1); ii +> List.iter (function e -> pr_elem e; pr_nl()); pp_init x ); iicommaopt +> List.iter pr_elem; end_block(); pr_elem i2; | InitDesignators (xs, initialiser), [i1] -> (* : *) xs +> List.iter pp_designator; pr_elem i1; pp_init initialiser (* no use of '=' in the "Old" style *) | InitFieldOld (string, initialiser), [i1;i2] -> (* label: in oldgcc *) pr_elem i1; pr_elem i2; pp_init initialiser | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *) pr_elem i1; pp_expression expression; pr_elem i2; pp_init initialiser | (InitIndexOld _ | InitFieldOld _ | InitDesignators _ | InitList _ | InitExpr _ ), _ -> raise (Impossible 116) and pp_init_list ini = pp_list pp_init ini and pp_designator = function | DesignatorField (s), [i1; i2] -> pr_elem i1; pr_elem i2; | DesignatorIndex (expression), [i1;i2] -> pr_elem i1; pp_expression expression; pr_elem i2; | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] -> pr_elem iocro; pp_expression e1; pr_elem iellipsis; pp_expression e2; pr_elem iccro; | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _ ), _ -> raise (Impossible 117) (* ---------------------- *) and pp_attributes pr_elem pr_space attrs = attrs +> List.iter (fun (attr, ii) -> ii +> List.iter pr_elem; ); (* ---------------------- *) and pp_def def = let defbis, ii = def in match ii with | iifunc1::iifunc2::i1::i2::ifakestart::isto -> let {f_name = name; f_type = (returnt, (paramst, (b, iib))); f_storage = sto; f_body = statxs; f_attr = attrs; } = defbis in pr_elem ifakestart; pp_type_with_ident None (Some (sto, isto)) returnt Ast_c.noattr; pp_attributes pr_elem pr_space attrs; pr_space(); pp_name name; pr_elem iifunc1; (* not anymore, cf tests/optional_name_parameter and macro_parameter_shortcut.c (match paramst with | [(((bool, None, t), ii_b_s), iicomma)] -> assert (match t with | qu, (BaseType Void, ii) -> true | _ -> true ); assert (null iicomma); assert (null ii_b_s); pp_type_with_ident None None t | paramst -> paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) -> iicomma +> List.iter pr_elem; (match b, s, ii_b_s with | false, Some s, [i1] -> pp_type_with_ident (Some (s, i1)) None t; | true, Some s, [i1;i2] -> pr_elem i1; pp_type_with_ident (Some (s, i2)) None t; (* in definition we have name for params, except when f(void) *) | _, None, _ -> raise Impossible | false, None, [] -> | _ -> raise Impossible ))); (* normally ii represent the ",..." but it is also abused with the f(void) case *) (* assert (List.length iib <= 2);*) iib +> List.iter pr_elem; *) pp_param_list paramst; iib +> List.iter pr_elem; pr_elem iifunc2; pr_space(); pr_elem i1; statxs +> List.iter pp_statement_seq; pr_elem i2; | _ -> raise (Impossible 118) and pp_param_list paramst = pp_list pp_param paramst (* ---------------------- *) and pp_ifdef ifdef = match ifdef with | IfdefDirective (ifdef, ii) -> List.iter pr_elem ii and pp_directive = function | Include {i_include = (s, ii);} -> let (i1,i2) = Common.tuple_of_list2 ii in pr_elem i1; pr_space(); pr_elem i2 | Define ((s,ii), (defkind, defval)) -> let (idefine,iident,ieol) = Common.tuple_of_list3 ii in pr_elem idefine; pr_elem iident; let define_val = function | DefineExpr e -> pp_expression e | DefineStmt st -> pp_statement st | DefineDoWhileZero ((st,e), ii) -> (match ii with | [ido;iwhile;iopar;icpar] -> pr_elem ido; pp_statement st; pr_elem iwhile; pr_elem iopar; pp_expression e; pr_elem icpar | _ -> raise (Impossible 119) ) | DefineFunction def -> pp_def def | DefineType ty -> pp_type ty | DefineText (s, ii) -> List.iter pr_elem ii | DefineEmpty -> () | DefineInit ini -> pp_init ini | DefineMulti ss -> ss +> List.iter pp_statement | DefineTodo -> pr2 "DefineTodo" in (match defkind with | DefineVar | Undef -> () | DefineFunc (params, ii) -> let (i1,i2) = tuple_of_list2 ii in pr_elem i1; params +> List.iter (fun ((s,iis), iicomma) -> assert (List.length iicomma <= 1); iicomma +> List.iter pr_elem; iis +> List.iter pr_elem; ); pr_elem i2; ); define_val defval; pr_elem ieol | Pragma ((s,ii), pragmainfo) -> let (ipragma,iident,ieol) = Common.tuple_of_list3 ii in pr_elem ipragma; pr_elem iident; pp_pragmainfo pragmainfo; pr_elem ieol | OtherDirective (ii) -> List.iter pr_elem ii and pp_pragmainfo = function PragmaTuple(args,ii) -> let (ilp,irp) = Common.tuple_of_list2 ii in pr_elem ilp; pp_arg_list args; pr_elem irp | PragmaIdList(ids) -> let rec loop = function [] -> () | [id,_] -> pp_name id | (id,_)::rest -> pp_name id; pr_space() in loop ids in let rec pp_toplevel = function | Declaration decl -> pp_decl decl | Definition def -> pp_def def | CppTop directive -> pp_directive directive | MacroTop (s, es, [i1;i2;i3;i4]) -> pr_elem i1; pr_elem i2; es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem i3; pr_elem i4; | EmptyDef ii -> ii +> List.iter pr_elem | NotParsedCorrectly ii -> assert (List.length ii >= 1); ii +> List.iter pr_elem | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info) | IfdefTop ifdefdir -> pp_ifdef ifdefdir | Namespace (tls, [i1; i2; i3; i4]) -> pr_elem i1; pr_elem i2; pr_elem i3; List.iter pp_toplevel tls; pr_elem i4; | (MacroTop _) | (Namespace _) -> raise (Impossible 120) in let pp_flow n = match F.unwrap n with | F.FunHeader ({f_name =idb; f_type = (rett, (paramst,(isvaargs,iidotsb))); f_storage = stob; f_body = body; f_attr = attrs},ii) -> assert(null body); (* iif ii; iif iidotsb; attrs +> List.iter (vk_attribute bigf); vk_type bigf rett; paramst +> List.iter (fun (param, iicomma) -> vk_param bigf param; iif iicomma; ); *) pr2 "Def"; | F.Decl decl -> (* vk_decl bigf decl *) pr2 "Decl" | F.ExprStatement (st, (eopt, ii)) -> pp_statement (Ast_c.mk_st (ExprStatement eopt) ii) | F.IfHeader (_, (e,ii)) | F.SwitchHeader (_, (e,ii)) | F.WhileHeader (_, (e,ii)) | F.DoWhileTail (e,ii) -> (* iif ii; vk_expr bigf e *) pr2 "XXX"; | F.ForHeader (_st, ((first, (e2opt,i2), (e3opt,i3)), ii)) -> (* iif i1; iif i2; iif i3; iif ii; e1opt +> do_option (vk_expr bigf); e2opt +> do_option (vk_expr bigf); e3opt +> do_option (vk_expr bigf); *) pr2 "XXX" | F.MacroIterHeader (_s, ((s,es), ii)) -> (* iif ii; vk_argument_list bigf es; *) pr2 "XXX" | F.ReturnExpr (_st, (e,ii)) -> (* iif ii; vk_expr bigf e*) pr2 "XXX" | F.Case (_st, (e,ii)) -> (* iif ii; vk_expr bigf e *) pr2 "XXX" | F.CaseRange (_st, ((e1, e2),ii)) -> (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *) pr2 "XXX" | F.CaseNode i -> () | F.DefineExpr e -> (* vk_expr bigf e *) pr2 "XXX" | F.DefineType ft -> (* vk_type bigf ft *) pr2 "XXX" | F.DefineHeader ((s,ii), (defkind)) -> (* iif ii; vk_define_kind bigf defkind; *) pr2 "XXX" | F.DefineDoWhileZeroHeader (((),ii)) -> (* iif ii *) pr2 "XXX" | F.PragmaHeader((s,ii), pragmainfo) -> let (ipragma,iident,ieol) = Common.tuple_of_list3 ii in pr_elem ipragma; pr_elem iident; pp_pragmainfo pragmainfo | F.Include {i_include = (s, ii);} -> (* iif ii; *) pr2 "XXX" | F.MacroTop (s, args, ii) -> (* iif ii; vk_argument_list bigf args *) pr2 "XXX" | F.Break (st,((),ii)) -> (* iif ii *) pr2 "XXX" | F.Continue (st,((),ii)) -> (* iif ii *) pr2 "XXX" | F.Default (st,((),ii)) -> (* iif ii *) pr2 "XXX" | F.Return (st,((),ii)) -> (* iif ii *) pr2 "XXX" | F.Goto (st, name, ((),ii)) -> (* iif ii *) pr2 "XXX" | F.Label (st, name, ((),ii)) -> (* iif ii *) pr2 "XXX" | F.EndStatement iopt -> (* do_option infof iopt *) pr2 "XXX" | F.DoHeader (st, info) -> (* infof info *) pr2 "XXX" | F.Else info -> (* infof info *) pr2 "XXX" | F.SeqEnd (i, info) -> (* infof info *) pr2 "XXX" | F.SeqStart (st, i, info) -> (* infof info *) pr2 "XXX" | F.MacroStmt (st, ((),ii)) -> (* iif ii *) pr2 "XXX" | F.Asm (st, (asmbody,ii)) -> (* iif ii; vk_asmbody bigf asmbody *) pr2 "XXX" | F.IfdefHeader (info) -> pp_ifdef info | F.IfdefElse (info) -> pp_ifdef info | F.IfdefEndif (info) -> pp_ifdef info | F.DefineTodo -> pr2 "XXX" | (F.TopNode|F.EndNode| F.ErrorExit|F.Exit|F.Enter|F.LoopFallThroughNode|F.FallThroughNode| F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| F.Fake) -> pr2 "YYY" in { expression = pp_expression; arg_list = pp_arg_list; arg = pp_argument; statement = pp_statement; decl = pp_decl; field = pp_field; field_list = pp_field_list; init = pp_init; init_list = pp_init_list; param = pp_param; paramlist = pp_param_list; ty = pp_type; type_with_ident = pp_type_with_ident; toplevel = pp_toplevel; fragment = pp_string_fragment; fragment_list = pp_string_fragment_list; format = pp_string_format; flow = pp_flow; } (*****************************************************************************) (* Here we do not use (mcode, env). It is a simple C pretty printer. *) let pr_elem info = let s = Ast_c.str_of_info info in if !Flag_parsing_c.pretty_print_comment_info then begin let before = !(info.comments_tag).mbefore in if not (null before) then begin pp "-->"; before +> List.iter (fun (comment_like, pinfo) -> let s = pinfo.Common.str in pp s ); pp "<--"; end; end; pp s let pr_space _ = Format.print_space() let pr_nl _ = () let pr_indent _ = () let pr_outdent _ = () let pr_unindent _ = () let ppc = mk_pretty_printers ~pr_elem ~pr_space ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent let pp_expression_simple = ppc.expression let pp_decl_simple = ppc.decl let pp_field_simple = ppc.field let pp_statement_simple = ppc.statement let pp_type_simple = ppc.ty let pp_init_simple = ppc.init let pp_toplevel_simple = ppc.toplevel let pp_string_fragment_simple = ppc.fragment let pp_string_format_simple = ppc.format let pp_flow_simple = ppc.flow let pp_elem_sp ~pr_elem ~pr_space = mk_pretty_printers ~pr_elem ~pr_space ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent let pp_expression_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).expression let pp_arg_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).arg_list let pp_arg_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).arg let pp_statement_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).statement let pp_decl_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).decl let pp_field_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).field let pp_field_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).field_list let pp_init_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).init let pp_init_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).init_list let pp_param_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).param let pp_param_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).paramlist let pp_type_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).ty let pp_type_with_ident_gen pr_elem pr_space = (pp_elem_sp pr_elem pr_space).type_with_ident let pp_string_fragment_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).fragment_list let pp_string_format_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).format let pp_program_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).toplevel let string_of_expression e = Common.format_to_string (fun () -> pp_expression_simple e ) let string_of_toplevel top = Common.format_to_string (fun () -> pp_toplevel_simple top ) let (debug_info_of_node: Ograph_extended.nodei -> Control_flow_c.cflow -> string) = fun nodei flow -> let node = flow#nodes#assoc nodei in let s = Common.format_to_string (fun () -> pp_flow_simple node ) in let pos = Lib_parsing_c.min_pinfo_of_node node in (spf "%s(n%d)--> %s" (Common.string_of_parse_info_bis pos) nodei s) coccinelle-1.0.0-rc19/parsing_c/cpp_token_c.mli0000644000175000017500000000311712247437436020326 0ustar eugeneugen(* Expanding or extracting macros, at the token level *) (* corresponds to what is in the yacfe configuration file (e.g. standard.h) *) type define_def = string * define_param * define_body and define_param = | NoParam | Params of define_arg list and define_arg = FixedArg of string | VariadicArg of string and define_body = | DefineBody of Parser_c.token list | DefineHint of parsinghack_hint (* strongly corresponds to the TMacroXxx in the grammar and lexer and the * MacroXxx in the ast. *) and parsinghack_hint = | HintIterator | HintDeclarator | HintMacroString | HintMacroStatement | HintAttribute | HintMacroIdentBuilder val string_of_define_def: define_def -> string (* This function work by side effect and may generate new tokens * in the new_tokens_before field of the token_extended in the * paren_grouped list. So don't forget to recall * Token_views_c.rebuild_tokens_extented after this call, as well * as probably insert_virtual_positions as new tokens * are generated. * * note: it does not do some fixpoint, so the generated code may also * contain some macros names. *) val apply_macro_defs: msg_apply_known_macro:(string -> unit) -> msg_apply_known_macro_hint:(string -> unit) -> ?evaluate_concatop:bool -> ?inplace_when_single:bool -> (string, define_def) Hashtbl.t -> Token_views_c.paren_grouped list -> unit (* extracting define_def, e.g. from a standard.h; assume have called * fix_tokens_define before to have the TDefEol *) val extract_macros : Parser_c.token list -> (string, define_def) Common.assoc coccinelle-1.0.0-rc19/parsing_c/parsing_recovery_c.mli0000644000175000017500000000021112247437436021715 0ustar eugeneugenval find_next_synchro: next:Parser_c.token list -> already_passed:Parser_c.token list -> Parser_c.token list * Parser_c.token list coccinelle-1.0.0-rc19/parsing_c/license.txt0000644000175000017500000004307512247437436017531 0ustar eugeneugenGPL GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. coccinelle-1.0.0-rc19/parsing_c/control_flow_c.ml0000644000175000017500000003163012247437436020703 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c (*****************************************************************************) (* * There is more information in the CFG we build that in the CFG usually built * in a compiler. This is because: * * - We need later to go back from flow to original ast, because we are * doing a refactoring tool, so different context. So we have to add * some nodes for '{' or '}' or goto that normally disapear in a CFG. * We must keep those entities, in the same way that we must keep the parens * (ParenExpr, ParenType) in the Ast_c during parsing. * * Moreover, the coccier can mention in his semantic patch those entities, * so we must keep those entities in the CFG. * * We also have to add some extra nodes to make the process that goes from * flow to ast deterministic with for instance the CaseNode, or easier * with for instance the Fake node. * * - The coccinelle engine later transforms some nodes, and we need to rebuild * the ast from a statement now defined and altered in different nodes. * So we can't just put all the parsing info (Ast_c.il) in the top node of * a statement. We have to split those Ast_c.il in different nodes, to * later reconstruct a full Ast_c.il from different nodes. This is why * we need the Else node, ... * * Note that at the same time, we also need to store the fullstatement * in the top node, because the CTL engine need to get that information * when dealing with MetaStatement (statement S; in a Semantic Patch). * * * - The CTL engine needs more information than just the CFG, and we use * tricks to encode those informations in the nodes: * * - We have some TrueNode, FalseNode to know in what branch we are. * Normally we could achieve this by putting this information in the * edges, but CTL engine know nothing about edges, it must do * everything with only nodes information. * * - We need to mark each braces with an identifier so that the CTL * can know if one specific '}' correspond to a specific '{'. * * - We add some labels to each node to handle the MetaRuleElem and * MetaStatement. It allows to groups nodes that belong to the same * statement. Normally CFG are there to abstract from this, but in * Coccinelle we need sometimes the CFG view, and sometimes the Ast * view and the labels allow that. * * - We even add nodes. We add '}', not only to be able to go back to AST * but also because of the CTL engine. So one '}' may in fact be * represented by multiple nodes, one in each CFG path. * * - need After, * - need FallThrough. * - Need know if ErrorExit, * * choice: Julia proposed that the flow is in fact just * a view through the Ast, which means just Ocaml ref, so that when we * modify some nodes, in fact it modifies the ast. But I prefer do it * the functional way. * * The node2 type should be as close as possible to Ast_cocci.rule_elem to * facilitate the job of cocci_vs_c. * *) (*****************************************************************************) type fullstatement = statement (* ---------------------------------------------------------------------- *) (* The string is for debugging. Used by Ograph_extended.print_graph. * The int list are Labels. Trick used for CTL engine. Must not * transform that in a triple or record because print_graph would * not work. *) type node = node1 * string and node1 = node2 * nodeinfo and nodeinfo = { labels: int list; bclabels: int list; (* parent of a break or continue node *) is_loop: bool; is_fake: bool; } and node2 = (* ------------------------ *) (* For CTL to work, we need that some nodes loop over itself. We * need that every nodes have a successor. Julia also want to go back * indefinitely. So must tag some nodes as the beginning and end of * the graph so that some fix_ctl function can easily find those * nodes. * * If have a function, then no need for EndNode; Exit and ErrorExit * will play that role. * * When everything we analyze was a function there was no pb. We used * FunHeader as a Topnode and Exit for EndNode but now that we also * analyse #define body, so we need those nodes. *) | TopNode | EndNode (* ------------------------ *) | FunHeader of definition (* but empty body *) | Decl of declaration (* ------------------------ *) (* flow_to_ast: cocci: Need the { and } in the control flow graph also * because the coccier can express patterns containing such { }. * * ctl: to make possible the forall (AX, A[...]), have to add more than * one node sometimes for the same '}' (one in each CFG path) in the graph. * * ctl: Morover, the int in the type is here to indicate to what { } * they correspond. Two pairwise { } share the same number. kind of * "brace_identifier". Used for debugging or for checks and more importantly, * needed by CTL engine. * * Because of those nodes, there is no equivalent for Compound. * * There was a problem with SeqEnd. Some info can be tagged on it * but there is multiple SeqEnd that correspond to the same '}' even * if they are in different nodes. Solved by using shared ref * and allow the "already-tagged" token. *) | SeqStart of fullstatement * int * info | SeqEnd of int * info | ExprStatement of fullstatement * (expression option) wrap | IfHeader of fullstatement * expression wrap | Else of info | WhileHeader of fullstatement * expression wrap | DoHeader of fullstatement * info | DoWhileTail of expression wrap | ForHeader of fullstatement * (declOrExpr * exprStatement wrap * exprStatement wrap) wrap | SwitchHeader of fullstatement * expression wrap | MacroIterHeader of fullstatement * (string * argument wrap2 list) wrap (* Used to mark the end of if, while, dowhile, for, switch. Later we * will be able to "tag" some cocci code on this node. * * This is because in * * - S + foo(); * * the S can be anything, including an if, and this is internally * translated in a series of MetaRuleElem, and the last element is a * EndStatement, and we must tag foo() to this EndStatement. * Otherwise, without this last common node, we would tag foo() to 2 * nodes :( So having a unique node makes it correct, and in * flow_to_ast we must propagate back this + foo() to the last token * of an if (maybe a '}', maybe a ';') * * The problem is that this stuff should be in transformation.ml, * but need information available in flow_to_ast, but we don't want * to polluate both files. * * So the choices are * * - soluce julia1, extend Ast_c by adding a fake token to the if * * - extend Ast with a Skip, and add this next to EndStatement node, * and do special case in flow_to_ast to start from this node * (not to get_next EndStatement, but from EndStatement directly) * and so add a case when have directly a EndStatement node an extract * the statement from it. * * - remonter dans le graphe pour accrocher le foo() non plus au * EndStatement (qui n'a pas d'equivalent niveau token dans l'ast_c), * mais au dernier token de la branche Else (ou Then si y'a pas de else). * * I first did solution 2 and then when we decided to use ref, * I use julia'as solution. Have virtual-placeholders, the fakeInfo * for the if, while, and put this shared ref in the EndStatement. *) | EndStatement of info option (* fake_info *) | Return of fullstatement * unit wrap | ReturnExpr of fullstatement * expression wrap (* ------------------------ *) | IfdefHeader of ifdef_directive | IfdefElse of ifdef_directive | IfdefEndif of ifdef_directive (* ------------------------ *) | DefineHeader of string wrap * define_kind | DefineExpr of expression | DefineType of fullType | DefineDoWhileZeroHeader of unit wrap | DefineTodo | Include of includ | PragmaHeader of string wrap * pragmainfo (* obsolete? *) | MacroTop of string * argument wrap2 list * il (* ------------------------ *) | Case of fullstatement * expression wrap | Default of fullstatement * unit wrap | Continue of fullstatement * unit wrap | Break of fullstatement * unit wrap (* no counter part in cocci *) | CaseRange of fullstatement * (expression * expression) wrap | Label of fullstatement * name * unit wrap (* : *) | Goto of fullstatement * name * unit wrap (* goto *) | Asm of fullstatement * asmbody wrap | MacroStmt of fullstatement * unit wrap (* ------------------------ *) (* some control nodes *) | Enter | Exit (* Redundant nodes, often to mark the end of an if/switch. * That makes it easier to do later the flow_to_ast. * update: no more used for the end. see Endstatement. Just used * to mark the start of the function, as required by julia. * Maybe would be better to use instead a Enter2. *) | Fake (* flow_to_ast: In this case, I need to know the order between the children * of the switch in the graph. *) | CaseNode of int (* ------------------------ *) (* for ctl: *) | TrueNode | FalseNode | InLoopNode (* almost equivalent to TrueNode but just for loops *) | AfterNode | FallThroughNode | LoopFallThroughNode | ErrorExit type edge = Direct (* Normal | Shadow *) type cflow = (node, edge) Ograph_extended.ograph_mutable (* ------------------------------------------------------------------------ *) let unwrap ((node, info), nodestr) = node let rewrap ((_node, info), nodestr) node = (node, info), nodestr let extract_labels ((node, info), nodestr) = info.labels let extract_bclabels ((node, info), nodestr) = info.bclabels let extract_is_loop ((node, info), nodestr) = info.is_loop let extract_is_fake ((node, info), nodestr) = info.is_fake let mk_any_node is_fake node labels bclabels nodestr = let nodestr = if !Flag_parsing_c.show_flow_labels then nodestr ^ ("[" ^ (labels +> List.map i_to_s +> join ",") ^ "]") else nodestr in ((node, {labels = labels;is_loop=false;bclabels=bclabels;is_fake=is_fake}), nodestr) let mk_node = mk_any_node false let mk_fake_node = mk_any_node true (* for duplicated braces *) (* ------------------------------------------------------------------------ *) let first_node g = g#nodes#tolist +> List.find (fun (i, node) -> match unwrap node with TopNode -> true | _ -> false ) +> fst let find_node f g = g#nodes#tolist +> List.find (fun (nodei, node) -> f (unwrap node)) +> fst (* remove an intermediate node and redirect the connexion *) let remove_one_node nodei g = let preds = (g#predecessors nodei)#tolist in let succs = (g#successors nodei)#tolist in assert (not (null preds)); preds +> List.iter (fun (predi, Direct) -> g#del_arc ((predi, nodei), Direct); ); succs +> List.iter (fun (succi, Direct) -> g#del_arc ((nodei, succi), Direct); ); g#del_node nodei; (* connect in-nodes to out-nodes *) preds +> List.iter (fun (pred, Direct) -> succs +> List.iter (fun (succ, Direct) -> g#add_arc ((pred, succ), Direct); ); ) (* ------------------------------------------------------------------------ *) let extract_fullstatement node = match unwrap node with | Decl decl -> (* new policy. no more considered as a statement *) (* old: Some (Ast_c.Decl decl, []) *) None | MacroStmt (st, _) -> Some st | MacroIterHeader (st, _) -> Some st | Include _ | DefineHeader _ | DefineType _ | DefineExpr _ | DefineDoWhileZeroHeader _ | DefineTodo | PragmaHeader _ | MacroTop _ -> None | IfdefHeader _ | IfdefElse _ | IfdefEndif _ -> None | SeqStart (st,_,_) | ExprStatement (st, _) | IfHeader (st, _) | WhileHeader (st, _) | DoHeader (st, _) | ForHeader (st, _) | SwitchHeader (st, _) | Return (st, _) | ReturnExpr (st, _) (* no counter part in cocci *) | Label (st, _, _) | Case (st,_) | CaseRange (st, _) | Default (st, _) | Goto (st, _, _) | Continue (st, _) | Break (st, _) | Asm (st,_) -> Some st | TopNode|EndNode | FunHeader _ | SeqEnd _ | Else _ | EndStatement _ | DoWhileTail _ | Enter | Exit | Fake | CaseNode _ | TrueNode | FalseNode | InLoopNode | AfterNode | FallThroughNode | LoopFallThroughNode | ErrorExit -> None coccinelle-1.0.0-rc19/parsing_c/unparse_cocci.ml0000644000175000017500000014113312247437436020507 0ustar eugeneugen(* * Copyright (C) 2012, INRIA. * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007 Julia Lawall * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. * * This file was part of Coccinelle. *) open Common (*****************************************************************************) (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml * todo?: try to factorize ? *) (*****************************************************************************) module Ast = Ast_cocci let term s = Ast.unwrap_mcode s (* or perhaps can have in plus, for instance a Disj, but those Disj must be * handled by interactive tool (by proposing alternatives) *) exception CantBeInPlus (*****************************************************************************) type pos = Before | After | InPlace type nlhint = StartBox | EndBox | SpaceOrNewline of string ref let get_string_info = function Ast.Noindent s | Ast.Indent s | Ast.Space s -> s let unknown = -1 let rec do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier, indent, unindent, eatspace) generating xxs before = (* Just to be able to copy paste the code from pretty_print_cocci.ml. *) let print_string s line lcol = let rcol = if lcol = unknown then unknown else lcol + (String.length s) in pr s line lcol rcol None in let print_string_with_hint hint s line lcol = let rcol = if lcol = unknown then unknown else lcol + (String.length s) in pr s line lcol rcol (Some hint) in let print_text s = pr s unknown unknown unknown None in let close_box _ = () in let force_newline _ = print_text "\n" in let start_block () = (*indent();*) force_newline() in let end_block () = (*unindent true;*) force_newline () in let print_string_box s = print_string s in let print_option = Common.do_option in let print_option_space fn = function None -> () | Some x -> fn x; pr_space() in let print_option_prespace fn = function None -> () | Some x -> pr_space(); fn x in let print_between = Common.print_between in let rec param_print_between between fn = function | [] -> () | [x] -> fn x | x::xs -> fn x; between x; param_print_between between fn xs in let rec param_print_before_and_after before fn = function | [] -> before () | x::xs -> before (); fn x; param_print_before_and_after before fn xs in let outdent _ = () (* should go to leftmost col, does nothing now *) in let pretty_print_c = Pretty_print_c.mk_pretty_printers pr_celem pr_cspace force_newline (fun _ -> ()) outdent (function _ -> ()) in (* --------------------------------------------------------------------- *) (* Only for make_hrule, print plus code, unbound metavariables *) (* avoid polyvariance problems *) let anything : (Ast.anything -> unit) ref = ref (function _ -> ()) in let rec print_anything = function [] -> () | stream -> start_block(); print_between force_newline print_anything_list stream; end_block() and print_anything_list = function [] -> () | [x] -> !anything x | bef::((aft::_) as rest) -> !anything bef; let space = (match bef with Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_) | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or (match aft with Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_) | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true | _ -> false) in if space then pr_space (); print_anything_list rest in let print_around printer term = function Ast.NOTHING -> printer term | Ast.BEFORE(bef,_) -> print_anything bef; printer term | Ast.AFTER(aft,_) -> printer term; print_anything aft | Ast.BEFOREAFTER(bef,aft,_) -> print_anything bef; printer term; print_anything aft in let print_string_befaft fn fn1 x info = let print ln col s = print_string (get_string_info s) ln col in List.iter (function (s,ln,col) -> fn1(); print ln col s; force_newline()) info.Ast.strbef; fn x; List.iter (function (s,ln,col) -> force_newline(); fn1(); print ln col s) info.Ast.straft in let print_meta (r,x) = print_text x in let print_pos l = List.iter (function Ast.MetaPos(name,_,_,_,_) -> let name = Ast.unwrap_mcode name in print_text "@"; print_meta name) l in (* --------------------------------------------------------------------- *) let mcode fn (s,info,mc,pos) = let line = info.Ast.line in let lcol = info.Ast.column in match (generating,mc) with (false,_) -> (* printing for transformation *) (* Here we don't care about the annotation on s. *) let print_comments lb comments = List.fold_left (function line_before -> function (str,line,col) -> match line_before with None -> let str = match str with Ast.Noindent s -> unindent false; s | Ast.Indent s -> s | Ast.Space s -> s in print_string str line col; Some line | Some lb when line =|= lb -> print_string (get_string_info str) line col; Some line | _ -> force_newline(); (* not super elegant to put side-effecting unindent in a let expression... *) let str = match str with Ast.Noindent s -> unindent false; s | Ast.Indent s -> s | Ast.Space s -> s in print_string str line col; Some line) lb comments in let line_before = print_comments None info.Ast.strbef in (match line_before with None -> () | Some lb when lb =|= info.Ast.line -> () | _ -> force_newline()); fn s line lcol; let _ = print_comments (Some info.Ast.line) info.Ast.straft in (* newline after a pragma should really store parsed versions of the strings, but make a cheap effort here print_comments takes care of interior newlines *) () (* printing for rule generation *) | (true, Ast.MINUS(_,_,_,plus_stream)) -> force_newline(); print_text "- "; fn s line lcol; print_pos pos; (match plus_stream with Ast.NOREPLACEMENT -> () | Ast.REPLACEMENT(plus_stream,ct) -> print_anything plus_stream) | (true, Ast.CONTEXT(_,plus_streams)) -> let fn s = force_newline(); fn s line lcol; print_pos pos in print_around fn s plus_streams | (true,Ast.PLUS Ast.ONE) -> let fn s = force_newline(); print_text "+ "; fn s line lcol; print_pos pos in print_string_befaft fn (function _ -> print_text "+ ") s info | (true,Ast.PLUS Ast.MANY) -> let fn s = force_newline(); print_text "++ "; fn s line lcol; print_pos pos in print_string_befaft fn (function _ -> print_text "++ ") s info in (* --------------------------------------------------------------------- *) let lookup_metavar name = let ((_,b) as s,info,mc,pos) = name in let line = info.Ast.line in let lcol = info.Ast.column in let rcol = if lcol = unknown then unknown else lcol + (String.length b) in let res = Common.optionise (fun () -> List.assoc s env) in (res,b,line,lcol,rcol) in let handle_metavar name fn = let (res,name_string,line,lcol,rcol) = lookup_metavar name in match res with None -> if generating then mcode (function _ -> print_string name_string) name else failwith (Printf.sprintf "SP line %d: Not found a value in env for: %s" line name_string) | Some e -> pr_barrier line lcol; (if generating then (* call mcode to preserve the -+ annotation *) mcode (fun _ _ _ -> fn e) name else fn e); pr_barrier line rcol in (* --------------------------------------------------------------------- *) let dots between fn d = match Ast.unwrap d with Ast.DOTS(l) -> param_print_between between fn l | Ast.CIRCLES(l) -> param_print_between between fn l | Ast.STARS(l) -> param_print_between between fn l in let dots_before_and_after before fn d = match Ast.unwrap d with Ast.DOTS(l) -> param_print_before_and_after before fn l | Ast.CIRCLES(l) -> param_print_before_and_after before fn l | Ast.STARS(l) -> param_print_before_and_after before fn l in let nest_dots starter ender fn f d = mcode print_string starter; f(); start_block(); (match Ast.unwrap d with Ast.DOTS(l) -> print_between force_newline fn l | Ast.CIRCLES(l) -> print_between force_newline fn l | Ast.STARS(l) -> print_between force_newline fn l); end_block(); mcode print_string ender in let print_disj_list fn l = print_text "\n(\n"; print_between (function _ -> print_text "\n|\n") fn l; print_text "\n)\n" in (* --------------------------------------------------------------------- *) (* Identifier *) let rec ident i = match Ast.unwrap i with Ast.Id(name) -> mcode print_string name | Ast.MetaId(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaIdVal (id,_)) -> print_text id | _ -> raise (Impossible 142) ) | Ast.MetaFunc(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaFuncVal id) -> print_text id | _ -> raise (Impossible 143) ) | Ast.MetaLocalFunc(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaLocalFuncVal id) -> print_text id | _ -> raise (Impossible 144) ) | Ast.AsIdent(id,asid) -> ident id | Ast.DisjId(id_list) -> if generating then print_disj_list ident id_list else raise CantBeInPlus | Ast.OptIdent(_) | Ast.UniqueIdent(_) -> raise CantBeInPlus in (* --------------------------------------------------------------------- *) (* Expression *) let rec expression e = let top = 0 in let assign = 1 in let cond = 2 in let log_or = 3 in let log_and = 4 in let bit_or = 5 in let bit_xor = 6 in let bit_and = 7 in let equal = 8 in let relat = 9 in let shift = 10 in let addit = 11 in let mulit = 12 in let cast = 13 in let unary = 14 in let postfix = 15 in let primary = 16 in let left_prec_of (op, _, _, _) = match op with | Ast.Arith Ast.Plus -> addit | Ast.Arith Ast.Minus -> addit | Ast.Arith Ast.Mul -> mulit | Ast.Arith Ast.Div -> mulit | Ast.Arith Ast.Min -> relat | Ast.Arith Ast.Max -> relat | Ast.Arith Ast.Mod -> mulit | Ast.Arith Ast.DecLeft -> shift | Ast.Arith Ast.DecRight -> shift | Ast.Arith Ast.And -> bit_and | Ast.Arith Ast.Or -> bit_or | Ast.Arith Ast.Xor -> bit_xor | Ast.Logical Ast.Inf -> relat | Ast.Logical Ast.Sup -> relat | Ast.Logical Ast.InfEq -> relat | Ast.Logical Ast.SupEq -> relat | Ast.Logical Ast.Eq -> equal | Ast.Logical Ast.NotEq -> equal | Ast.Logical Ast.AndLog -> log_and | Ast.Logical Ast.OrLog -> log_or in let right_prec_of (op, _, _, _) = match op with | Ast.Arith Ast.Plus -> mulit | Ast.Arith Ast.Minus -> mulit | Ast.Arith Ast.Mul -> cast | Ast.Arith Ast.Div -> cast | Ast.Arith Ast.Min -> shift | Ast.Arith Ast.Max -> shift | Ast.Arith Ast.Mod -> cast | Ast.Arith Ast.DecLeft -> addit | Ast.Arith Ast.DecRight -> addit | Ast.Arith Ast.And -> equal | Ast.Arith Ast.Or -> bit_xor | Ast.Arith Ast.Xor -> bit_and | Ast.Logical Ast.Inf -> shift | Ast.Logical Ast.Sup -> shift | Ast.Logical Ast.InfEq -> shift | Ast.Logical Ast.SupEq -> shift | Ast.Logical Ast.Eq -> relat | Ast.Logical Ast.NotEq -> relat | Ast.Logical Ast.AndLog -> bit_or | Ast.Logical Ast.OrLog -> log_and in let prec_of_c = function | Ast_c.Ident (ident) -> primary | Ast_c.Constant (c) -> primary | Ast_c.StringConstant (c,os,w) -> primary | Ast_c.FunCall (e, es) -> postfix | Ast_c.CondExpr (e1, e2, e3) -> cond | Ast_c.Sequence (e1, e2) -> top | Ast_c.Assignment (e1, op, e2) -> assign | Ast_c.Postfix(e, op) -> postfix | Ast_c.Infix (e, op) -> unary | Ast_c.Unary (e, op) -> unary | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Plus, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Minus, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mul, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Div, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Min, e2) -> relat | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Max, e2) -> relat | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mod, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecLeft, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecRight, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.And, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Or, e2) -> addit | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Xor, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.AndLog, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.OrLog, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Eq, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.NotEq, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Sup, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Inf, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.SupEq, e2) -> addit | Ast_c.Binary (e1, Ast_c.Logical Ast_c.InfEq, e2) -> addit | Ast_c.ArrayAccess (e1, e2) -> postfix | Ast_c.RecordAccess (e, name) -> postfix | Ast_c.RecordPtAccess (e, name) -> postfix | Ast_c.SizeOfExpr (e) -> unary | Ast_c.SizeOfType (t) -> unary | Ast_c.Cast (t, e) -> cast | Ast_c.StatementExpr (statxs, _) -> top | Ast_c.Constructor (t, init) -> unary | Ast_c.ParenExpr (e) -> primary | Ast_c.New (_, t) -> unary | Ast_c.Delete(t) -> unary in let rec loop e prec = match Ast.unwrap e with Ast.Ident(id) -> ident id | Ast.Constant(const) -> mcode constant const | Ast.StringConstant(lq,str,rq) -> mcode print_string lq; dots (function _ -> ()) string_fragment str; mcode print_string rq | Ast.FunCall(fn,lp,args,rp) -> loop fn postfix; mcode (print_string_with_hint StartBox) lp; dots (function _ -> ()) arg_expression args; mcode (print_string_with_hint EndBox) rp | Ast.Assignment(left,op,right,_) -> loop left unary; pr_space(); mcode assignOp op; pr_space(); loop right assign | Ast.Sequence(left,op,right) -> loop left top; mcode print_string op; pr_space(); loop right assign | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> loop exp1 log_or; pr_space(); mcode print_string why; print_option (function e -> pr_space(); loop e top) exp2; pr_space(); mcode print_string colon; pr_space(); loop exp3 cond | Ast.Postfix(exp,op) -> loop exp postfix; mcode fixOp op | Ast.Infix(exp,op) -> mcode fixOp op; loop exp unary | Ast.Unary(exp,op) -> mcode unaryOp op; loop exp unary | Ast.Binary(left,op,right) -> loop left (left_prec_of op); pr_space(); mcode binaryOp op; pr_space(); loop right (right_prec_of op) | Ast.Nested(left,op,right) -> failwith "nested only in minus code" | Ast.Paren(lp,exp,rp) -> mcode print_string_box lp; loop exp top; close_box(); mcode print_string rp | Ast.ArrayAccess(exp1,lb,exp2,rb) -> loop exp1 postfix; mcode print_string_box lb; loop exp2 top; close_box(); mcode print_string rb | Ast.RecordAccess(exp,pt,field) -> loop exp postfix; mcode print_string pt; ident field | Ast.RecordPtAccess(exp,ar,field) -> loop exp postfix; mcode print_string ar; ident field | Ast.Cast(lp,ty,rp,exp) -> mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp; loop exp cast | Ast.SizeOfExpr(sizeof,exp) -> mcode print_string sizeof; loop exp unary | Ast.SizeOfType(sizeof,lp,ty,rp) -> mcode print_string sizeof; mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp | Ast.TypeExp(ty) -> fullType ty | Ast.Constructor(lp,ty,rp,init) -> mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp; initialiser true init | Ast.MetaErr(name,_,_,_) -> failwith "metaErr not handled" | Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) -> handle_metavar name (function | Ast_c.MetaExprVal ((((e, _), _) as exp),_) -> if prec_of_c e < prec then begin print_text "("; pretty_print_c.Pretty_print_c.expression exp; print_text ")" end else pretty_print_c.Pretty_print_c.expression exp | _ -> raise (Impossible 145) ) | Ast.MetaExprList (name,_,_,_) -> handle_metavar name (function | Ast_c.MetaExprListVal args -> pretty_print_c.Pretty_print_c.arg_list args | Ast_c.MetaParamListVal _ -> failwith "have meta param list matching meta exp list\n"; | _ -> raise (Impossible 146) ) | Ast.AsExpr(expr,asexpr) -> loop expr prec | Ast.EComma(cm) -> mcode (print_string_with_hint (SpaceOrNewline (ref " "))) cm | Ast.DisjExpr(exp_list) -> if generating then print_disj_list expression exp_list else raise CantBeInPlus | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi) when generating -> nest_dots starter ender expression (function _ -> print_text " when != "; expression whencode) expr_dots | Ast.NestExpr(starter,expr_dots,ender,None,multi) when generating -> nest_dots starter ender expression (function _ -> ()) expr_dots | Ast.NestExpr _ -> raise CantBeInPlus | Ast.Edots(dots,Some whencode) | Ast.Ecircles(dots,Some whencode) | Ast.Estars(dots,Some whencode) -> if generating then (mcode print_string dots; print_text " when != "; expression whencode) else raise CantBeInPlus | Ast.Edots(dots,None) | Ast.Ecircles(dots,None) | Ast.Estars(dots,None) -> if generating then mcode print_string dots else raise CantBeInPlus | Ast.OptExp(exp) | Ast.UniqueExp(exp) -> raise CantBeInPlus in loop e top and arg_expression e = match Ast.unwrap e with Ast.EComma(cm) -> (* space is only used by add_newline, and only if not using SMPL spacing. pr_cspace uses a " " in unparse_c.ml. Not so nice... *) mcode (print_string_with_hint (SpaceOrNewline (ref " "))) cm | _ -> expression e and string_fragment e = match Ast.unwrap e with Ast.ConstantFragment(str) -> mcode print_string str | Ast.FormatFragment(pct,fmt) -> mcode print_string pct; string_format fmt | Ast.Strdots dots -> mcode print_string dots | Ast.MetaFormatList(pct,name,lenname,_,_) -> (*mcode print_string pct;*) handle_metavar name (function Ast_c.MetaFragListVal(frags) -> frags +> (List.iter pretty_print_c.Pretty_print_c.fragment) | _ -> raise (Impossible 158)) and string_format e = match Ast.unwrap e with Ast.ConstantFormat(str) -> mcode print_string str | Ast.MetaFormat(name,_,_,_) -> handle_metavar name (function Ast_c.MetaFmtVal fmt -> pretty_print_c.Pretty_print_c.format fmt | _ -> raise (Impossible 157)) and unaryOp = function Ast.GetRef -> print_string "&" | Ast.GetRefLabel -> print_string "&&" | Ast.DeRef -> print_string "*" | Ast.UnPlus -> print_string "+" | Ast.UnMinus -> print_string "-" | Ast.Tilde -> print_string "~" | Ast.Not -> print_string "!" and assignOp = function Ast.SimpleAssign -> print_string "=" | Ast.OpAssign(aop) -> (function line -> function lcol -> arithOp aop line lcol; print_string "=" line lcol) and fixOp = function Ast.Dec -> print_string "--" | Ast.Inc -> print_string "++" and binaryOp = function Ast.Arith(aop) -> arithOp aop | Ast.Logical(lop) -> logicalOp lop and arithOp = function Ast.Plus -> print_string "+" | Ast.Minus -> print_string "-" | Ast.Mul -> print_string "*" | Ast.Div -> print_string "/" | Ast.Min -> print_string " print_string ">?" | Ast.Mod -> print_string "%" | Ast.DecLeft -> print_string "<<" | Ast.DecRight -> print_string ">>" | Ast.And -> print_string "&" | Ast.Or -> print_string "|" | Ast.Xor -> print_string "^" and logicalOp = function Ast.Inf -> print_string "<" | Ast.Sup -> print_string ">" | Ast.InfEq -> print_string "<=" | Ast.SupEq -> print_string ">=" | Ast.Eq -> print_string "==" | Ast.NotEq -> print_string "!=" | Ast.AndLog -> print_string "&&" | Ast.OrLog -> print_string "||" and constant = function Ast.String(s) -> print_string ("\""^s^"\"") | Ast.Char(s) -> print_string ("\'"^s^"\'") | Ast.Int(s) -> print_string s | Ast.Float(s) -> print_string s | Ast.DecimalConst(s,_l,_p) -> print_string s (* --------------------------------------------------------------------- *) (* Types *) and fullType ft = match Ast.unwrap ft with Ast.Type(_,cv,ty) -> (match Ast.unwrap ty with Ast.Pointer(_,_) -> typeC ty; print_option_prespace (mcode const_vol) cv | _ -> print_option_space (mcode const_vol) cv; typeC ty) | Ast.AsType(ty, asty) -> fullType ty | Ast.DisjType _ -> failwith "can't be in plus" | Ast.OptType(_) | Ast.UniqueType(_) -> raise CantBeInPlus and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn = fullType ty; mcode print_string lp1; mcode print_string star; fn(); mcode print_string rp1; mcode print_string lp1; parameter_list params; mcode print_string rp2 and print_function_type (ty,lp1,params,rp1) fn = print_option fullType ty; fn(); mcode print_string lp1; parameter_list params; mcode print_string rp1 and typeC ty = match Ast.unwrap ty with Ast.BaseType(ty,strings) -> print_between pr_space (mcode print_string) strings | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star; eatspace() | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> ()) | Ast.FunctionType (am,ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> ()) | Ast.Array(ty,lb,size,rb) -> fullType ty; mcode print_string lb; print_option expression size; mcode print_string rb | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> mcode print_string dec; mcode print_string lp; expression length; print_option (mcode print_string) comma; print_option expression precision_opt; mcode print_string rp | Ast.EnumName(kind,name) -> mcode print_string kind; print_option_prespace ident name | Ast.EnumDef(ty,lb,ids,rb) -> fullType ty; ft_space ty; mcode print_string lb; dots force_newline expression ids; mcode print_string rb | Ast.StructUnionName(kind,name) -> mcode structUnion kind; print_option_prespace ident name | Ast.StructUnionDef(ty,lb,decls,rb) -> fullType ty; ft_space ty; mcode print_string lb; dots_before_and_after force_newline declaration decls; mcode print_string rb | Ast.TypeName(name)-> mcode print_string name | Ast.MetaType(name,_,_) -> handle_metavar name (function Ast_c.MetaTypeVal exp -> pretty_print_c.Pretty_print_c.ty exp | _ -> raise (Impossible 147)) and baseType = function Ast.VoidType -> print_string "void" | Ast.CharType -> print_string "char" | Ast.ShortType -> print_string "short" | Ast.ShortIntType -> print_string "short int" | Ast.IntType -> print_string "int" | Ast.DoubleType -> print_string "double" | Ast.LongDoubleType -> print_string "long double" | Ast.FloatType -> print_string "float" | Ast.LongType -> print_string "long" | Ast.LongIntType -> print_string "long int" | Ast.LongLongType -> print_string "long long" | Ast.LongLongIntType -> print_string "long long int" | Ast.SizeType -> print_string "size_t " | Ast.SSizeType -> print_string "ssize_t " | Ast.PtrDiffType -> print_string "ptrdiff_t " and structUnion = function Ast.Struct -> print_string "struct" | Ast.Union -> print_string "union" and sign = function Ast.Signed -> print_string "signed" | Ast.Unsigned -> print_string "unsigned" and const_vol = function Ast.Const -> print_string "const" | Ast.Volatile -> print_string "volatile" (* --------------------------------------------------------------------- *) (* Function declaration *) and storage = function Ast.Static -> print_string "static" | Ast.Auto -> print_string "auto" | Ast.Register -> print_string "register" | Ast.Extern -> print_string "extern" (* --------------------------------------------------------------------- *) (* Variable declaration *) and print_named_type ty id = match Ast.unwrap ty with Ast.Type(_,None,ty1) -> (match Ast.unwrap ty1 with Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> pr_space(); ident id) | Ast.FunctionType(am,ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> pr_space(); ident id) | Ast.Array(_,_,_,_) -> let rec loop ty k = match Ast.unwrap ty with Ast.Array(ty,lb,size,rb) -> (match Ast.unwrap ty with Ast.Type(_,cv,ty) -> print_option_space (mcode const_vol) cv; loop ty (function _ -> k (); mcode print_string lb; print_option expression size; mcode print_string rb) | _ -> failwith "complex array types not supported") | _ -> typeC ty; ty_space ty; ident id; k () in loop ty1 (function _ -> ()) (*| should have a case here for pointer to array or function type that would put ( * ) around the variable. This makes one wonder why we really need a special case for function pointer *) | _ -> fullType ty; ft_space ty; ident id) | _ -> fullType ty; ft_space ty; ident id and ty_space ty = match Ast.unwrap ty with Ast.Pointer(_,_) -> () | _ -> pr_space() and ft_space ty = match Ast.unwrap ty with Ast.Type(_,cv,ty) -> let isptr = match Ast.unwrap ty with Ast.Pointer(_,_) -> true | Ast.MetaType(name,_,_) -> let (res,name_string,line,lcol,rcol) = lookup_metavar name in (match res with None -> failwith (Printf.sprintf "variable %s not known on SP line %d\n" name_string line) | Some (Ast_c.MetaTypeVal (tq,ty)) -> (match Ast_c.unwrap ty with Ast_c.Pointer(_,_) -> true | _ -> false) | _ -> false) | _ -> false in if isptr then () else pr_space() | _ -> pr_space() and declaration d = match Ast.unwrap d with Ast.MetaDecl(name,_,_) -> handle_metavar name (function Ast_c.MetaDeclVal d -> pretty_print_c.Pretty_print_c.decl d | _ -> raise (Impossible 148)) | Ast.MetaField(name,_,_) -> handle_metavar name (function Ast_c.MetaFieldVal f -> pretty_print_c.Pretty_print_c.field f | _ -> raise (Impossible 149)) | Ast.MetaFieldList(name,_,_,_) -> handle_metavar name (function Ast_c.MetaFieldListVal f -> print_between force_newline pretty_print_c.Pretty_print_c.field f | _ -> raise (Impossible 150)) | Ast.AsDecl(decl,asdecl) -> declaration decl | Ast.Init(stg,ty,id,eq,ini,sem) -> print_option (mcode storage) stg; print_option (function _ -> pr_space()) stg; print_named_type ty id; pr_space(); mcode print_string eq; pr_space(); initialiser true ini; mcode print_string sem | Ast.UnInit(stg,ty,id,sem) -> print_option (mcode storage) stg; print_option (function _ -> pr_space()) stg; print_named_type ty id; mcode print_string sem | Ast.MacroDecl(name,lp,args,rp,sem) -> ident name; mcode print_string_box lp; dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp; mcode print_string sem | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> ident name; mcode print_string_box lp; dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp; pr_space(); mcode print_string eq; pr_space(); initialiser true ini; mcode print_string sem | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem | Ast.Typedef(stg,ty,id,sem) -> mcode print_string stg; fullType ty; pr_space(); typeC id; mcode print_string sem | Ast.DisjDecl(_) -> raise CantBeInPlus | Ast.Ddots(_,_) -> raise CantBeInPlus | Ast.OptDecl(decl) | Ast.UniqueDecl(decl) -> raise CantBeInPlus (* --------------------------------------------------------------------- *) (* Initialiser *) and initialiser nlcomma i = match Ast.unwrap i with Ast.MetaInit(name,_,_) -> handle_metavar name (function Ast_c.MetaInitVal ini -> pretty_print_c.Pretty_print_c.init ini | _ -> raise (Impossible 151)) | Ast.MetaInitList(name,_,_,_) -> handle_metavar name (function Ast_c.MetaInitListVal ini -> pretty_print_c.Pretty_print_c.init_list ini | _ -> raise (Impossible 152)) | Ast.AsInit(init,asinit) -> initialiser nlcomma init | Ast.InitExpr(exp) -> expression exp | Ast.ArInitList(lb,initlist,rb) -> (match Ast.undots initlist with [] -> mcode print_string lb; mcode print_string rb | lst -> mcode print_string lb; start_block(); initialiser_list nlcomma lst; end_block(); mcode print_string rb) | Ast.StrInitList(_,lb,[],rb,[]) -> mcode print_string lb; mcode print_string rb | Ast.StrInitList(_,lb,initlist,rb,[]) -> mcode print_string lb; start_block(); initialiser_list nlcomma initlist; end_block(); mcode print_string rb | Ast.StrInitList(_,lb,initlist,rb,_) -> failwith "unexpected whencode in plus" | Ast.InitGccExt(designators,eq,ini) -> List.iter designator designators; pr_space(); mcode print_string eq; pr_space(); initialiser nlcomma ini | Ast.InitGccName(name,eq,ini) -> ident name; mcode print_string eq; initialiser nlcomma ini | Ast.IComma(comma) -> mcode print_string comma; if nlcomma then force_newline() else pr_space() | Ast.Idots(dots,Some whencode) -> if generating then (mcode print_string dots; print_text " when != "; initialiser nlcomma whencode) else raise CantBeInPlus | Ast.Idots(dots,None) -> if generating then mcode print_string dots else raise CantBeInPlus | Ast.OptIni(ini) | Ast.UniqueIni(ini) -> raise CantBeInPlus and initialiser_list nlcomma = function (* awkward, because the comma is separate from the initialiser *) [] -> () | [x] -> initialiser false x | x::xs -> initialiser nlcomma x; initialiser_list nlcomma xs and designator = function Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id | Ast.DesignatorIndex(lb,exp,rb) -> mcode print_string lb; expression exp; mcode print_string rb | Ast.DesignatorRange(lb,min,dots,max,rb) -> mcode print_string lb; expression min; mcode print_string dots; expression max; mcode print_string rb (* --------------------------------------------------------------------- *) (* Parameter *) and parameterTypeDef p = match Ast.unwrap p with Ast.VoidParam(ty) -> fullType ty | Ast.Param(ty,Some id) -> print_named_type ty id | Ast.Param(ty,None) -> fullType ty | Ast.MetaParam(name,_,_) -> handle_metavar name (function Ast_c.MetaParamVal p -> pretty_print_c.Pretty_print_c.param p | _ -> raise (Impossible 153)) | Ast.MetaParamList(name,_,_,_) -> handle_metavar name (function Ast_c.MetaParamListVal p -> pretty_print_c.Pretty_print_c.paramlist p | _ -> raise (Impossible 154)) | Ast.AsParam(p,e) -> raise CantBeInPlus | Ast.PComma(cm) -> mcode print_string cm | Ast.Pdots(dots) | Ast.Pcircles(dots) when generating -> mcode print_string dots | Ast.Pdots(dots) | Ast.Pcircles(dots) -> raise CantBeInPlus | Ast.OptParam(param) | Ast.UniqueParam(param) -> raise CantBeInPlus and parameter_list l = let comma p = parameterTypeDef p; match Ast.unwrap p with Ast.PComma(cm) -> pr_space() | _ -> () in dots (function _ -> ()) comma l in (* --------------------------------------------------------------------- *) (* CPP code *) let rec inc_file = function Ast.Local(elems) -> print_string ("\""^(String.concat "/" (List.map inc_elem elems))^"\"") | Ast.NonLocal(elems) -> print_string ("<"^(String.concat "/" (List.map inc_elem elems))^">") and inc_elem = function Ast.IncPath s -> s | Ast.IncDots -> "..." (* --------------------------------------------------------------------- *) (* Top-level code *) and rule_elem arity re = match Ast.unwrap re with Ast.FunHeader(_,_,fninfo,name,lp,params,rp) -> pr_arity arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; close_box(); mcode print_string rp; pr_space() | Ast.Decl(_,_,decl) -> pr_arity arity; declaration decl | Ast.SeqStart(brace) -> pr_arity arity; mcode print_string brace; start_block() | Ast.SeqEnd(brace) -> end_block(); pr_arity arity; mcode print_string brace | Ast.ExprStatement(exp,sem) -> pr_arity arity; print_option expression exp; mcode print_string sem | Ast.IfHeader(iff,lp,exp,rp) -> pr_arity arity; mcode print_string iff; pr_space(); mcode print_string_box lp; expression exp; close_box(); mcode print_string rp | Ast.Else(els) -> pr_arity arity; mcode print_string els | Ast.WhileHeader(whl,lp,exp,rp) -> pr_arity arity; mcode print_string whl; pr_space(); mcode print_string_box lp; expression exp; close_box(); mcode print_string rp | Ast.DoHeader(d) -> pr_arity arity; mcode print_string d | Ast.WhileTail(whl,lp,exp,rp,sem) -> pr_arity arity; mcode print_string whl; pr_space(); mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; mcode print_string sem | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> pr_arity arity; mcode print_string fr; mcode print_string_box lp; forinfo first; print_option expression e2; mcode print_string sem2; print_option expression e3; close_box(); mcode print_string rp | Ast.IteratorHeader(nm,lp,args,rp) -> pr_arity arity; ident nm; pr_space(); mcode print_string_box lp; dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp | Ast.SwitchHeader(switch,lp,exp,rp) -> pr_arity arity; mcode print_string switch; pr_space(); mcode print_string_box lp; expression exp; close_box(); mcode print_string rp | Ast.Break(br,sem) -> pr_arity arity; mcode print_string br; mcode print_string sem | Ast.Continue(cont,sem) -> pr_arity arity; mcode print_string cont; mcode print_string sem | Ast.Label(l,dd) -> ident l; mcode print_string dd | Ast.Goto(goto,l,sem) -> mcode print_string goto; ident l; mcode print_string sem | Ast.Return(ret,sem) -> pr_arity arity; mcode print_string ret; mcode print_string sem | Ast.ReturnExpr(ret,exp,sem) -> pr_arity arity; mcode print_string ret; pr_space(); expression exp; mcode print_string sem | Ast.Exp(exp) -> pr_arity arity; expression exp | Ast.TopExp(exp) -> pr_arity arity; expression exp | Ast.Ty(ty) -> pr_arity arity; fullType ty | Ast.TopInit(init) -> initialiser false init | Ast.Include(inc,s) -> mcode print_string inc; print_text " "; mcode inc_file s | Ast.Undef(def,id) -> mcode print_string def; pr_space(); ident id | Ast.DefineHeader(def,id,params) -> mcode print_string def; pr_space(); ident id; print_define_parameters params | Ast.Pragma(prg,id,body) -> mcode print_string prg; pr_space(); ident id; pr_space(); pragmainfo body | Ast.Default(def,colon) -> mcode print_string def; mcode print_string colon; pr_space() | Ast.Case(case,exp,colon) -> mcode print_string case; pr_space(); expression exp; mcode print_string colon; pr_space() | Ast.DisjRuleElem(res) -> if generating then (pr_arity arity; print_text "\n(\n"; print_between (function _ -> print_text "\n|\n") (rule_elem arity) res; print_text "\n)") else raise CantBeInPlus | Ast.MetaRuleElem(name,_,_) -> raise (Impossible 155) | Ast.MetaStmt(name,_,_,_) -> handle_metavar name (function | Ast_c.MetaStmtVal stm -> pretty_print_c.Pretty_print_c.statement stm | _ -> raise (Impossible 156) ) | Ast.MetaStmtList(name,_,_) -> failwith "MetaStmtList not supported (not even in ast_c metavars binding)" and pragmainfo pi = match Ast.unwrap pi with Ast.PragmaTuple(lp,args,rp) -> mcode print_string lp; dots (function _ -> ()) arg_expression args; mcode print_string rp | Ast.PragmaIdList(ids) -> dots (function _ -> ()) ident ids | Ast.PragmaDots (dots) -> mcode print_string dots and forinfo = function Ast.ForExp(e1,sem1) -> print_option expression e1; mcode print_string sem1 | Ast.ForDecl (_,_,decl) -> declaration decl and print_define_parameters params = match Ast.unwrap params with Ast.NoParams -> () | Ast.DParams(lp,params,rp) -> mcode print_string lp; dots (function _ -> ()) print_define_param params; mcode print_string rp and print_define_param param = match Ast.unwrap param with Ast.DParam(id) -> ident id | Ast.DPComma(comma) -> mcode print_string comma | Ast.DPdots(dots) -> mcode print_string dots | Ast.DPcircles(circles) -> mcode print_string circles | Ast.OptDParam(dp) -> print_text "?"; print_define_param dp | Ast.UniqueDParam(dp) -> print_text "!"; print_define_param dp and print_fninfo = function Ast.FStorage(stg) -> mcode storage stg | Ast.FType(ty) -> fullType ty | Ast.FInline(inline) -> mcode print_string inline; pr_space() | Ast.FAttr(attr) -> mcode print_string attr; pr_space() in let indent_if_needed s f = let isseq = match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> true | Ast.Atomic s -> (match Ast.unwrap s with | Ast.MetaStmt(name,_,_,_) -> let (res,name_string,line,lcol,rcol) = lookup_metavar name in (match res with None -> failwith (Printf.sprintf "variable %s not known on SP line %d\n" name_string line) | Some (Ast_c.MetaStmtVal stm) -> (match Ast_c.unwrap stm with Ast_c.Compound _ -> true | _ -> false) | _ -> failwith "bad metavariable value") | _ -> false) | _ -> false in if isseq then begin pr_space(); f() end else begin (*no newline at the end - someone else will do that*) indent(); start_block(); f(); unindent true end in let rec statement arity s = match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> rule_elem arity lbrace; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.IfThen(header,branch,_) -> rule_elem arity header; indent_if_needed branch (function _ -> statement arity branch) | Ast.IfThenElse(header,branch1,els,branch2,_) -> rule_elem arity header; indent_if_needed branch1 (function _ -> statement arity branch1); force_newline(); rule_elem arity els; indent_if_needed branch2 (function _ -> statement arity branch2) | Ast.While(header,body,_) -> rule_elem arity header; indent_if_needed body (function _ -> statement arity body) | Ast.Do(header,body,tail) -> rule_elem arity header; indent_if_needed body (function _ -> statement arity body); rule_elem arity tail | Ast.For(header,body,_) -> rule_elem arity header; indent_if_needed body (function _ -> statement arity body) | Ast.Iterator(header,body,(_,_,_,aft)) -> rule_elem arity header; indent_if_needed body (function _ -> statement arity body); mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Switch(header,lb,decls,cases,rb) -> rule_elem arity header; pr_space(); rule_elem arity lb; dots force_newline (statement arity) decls; List.iter (function x -> case_line arity x; force_newline()) cases; rule_elem arity rb | Ast.Atomic(re) -> rule_elem arity re | Ast.FunDecl(header,lbrace,body,rbrace) -> rule_elem arity header; rule_elem arity lbrace; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.Define(header,body) -> rule_elem arity header; pr_space(); dots force_newline (statement arity) body | Ast.AsStmt(stmt,asstmt) -> statement arity stmt | Ast.Disj([stmt_dots]) -> if generating then (pr_arity arity; dots force_newline (statement arity) stmt_dots) else raise CantBeInPlus | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *) if generating then (pr_arity arity; print_text "\n(\n"; print_between (function _ -> print_text "\n|\n") (dots force_newline (statement arity)) stmt_dots_list; print_text "\n)") else raise CantBeInPlus | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) when generating -> pr_arity arity; nest_dots starter ender (statement arity) (function _ -> print_between force_newline (whencode (dots force_newline (statement "")) (statement "")) whn; force_newline()) stmt_dots | Ast.Nest(_) -> raise CantBeInPlus | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> if generating then (pr_arity arity; mcode print_string d; print_between force_newline (whencode (dots force_newline (statement "")) (statement "")) whn; force_newline()) else raise CantBeInPlus | Ast.OptStm(s) | Ast.UniqueStm(s) -> raise CantBeInPlus and whencode notfn alwaysfn = function Ast.WhenNot a -> print_text " WHEN != "; notfn a | Ast.WhenAlways a -> print_text " WHEN = "; alwaysfn a | Ast.WhenModifier x -> print_text " WHEN "; print_when_modif x | Ast.WhenNotTrue a -> print_text " WHEN != TRUE "; rule_elem "" a | Ast.WhenNotFalse a -> print_text " WHEN != FALSE "; rule_elem "" a and print_when_modif = function | Ast.WhenAny -> print_text "ANY" | Ast.WhenStrict -> print_text "STRICT" | Ast.WhenForall -> print_text "FORALL" | Ast.WhenExists -> print_text "EXISTS" and case_line arity c = match Ast.unwrap c with Ast.CaseLine(header,code) -> rule_elem arity header; pr_space(); dots force_newline (statement arity) code | Ast.OptCase(case) -> raise CantBeInPlus in let top_level t = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus | Ast.NONDECL(stmt) -> statement "" stmt | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots | Ast.ERRORWORDS(exps) -> raise CantBeInPlus in (* let rule = print_between (function _ -> force_newline(); force_newline()) top_level in *) let if_open_brace = function "{" -> true | _ -> false in (* boolean result indicates whether an indent is needed *) let rec pp_any = function (* assert: normally there is only CONTEXT NOTHING tokens in any *) Ast.FullTypeTag(x) -> fullType x; false | Ast.BaseTypeTag(x) -> baseType x unknown unknown; false | Ast.StructUnionTag(x) -> structUnion x unknown unknown; false | Ast.SignTag(x) -> sign x unknown unknown; false | Ast.IdentTag(x) -> ident x; false | Ast.ExpressionTag(x) -> expression x; false | Ast.ConstantTag(x) -> constant x unknown unknown; false | Ast.UnaryOpTag(x) -> unaryOp x unknown unknown; false | Ast.AssignOpTag(x) -> assignOp x unknown unknown; false | Ast.FixOpTag(x) -> fixOp x unknown unknown; false | Ast.BinaryOpTag(x) -> binaryOp x unknown unknown; false | Ast.ArithOpTag(x) -> arithOp x unknown unknown; false | Ast.LogicalOpTag(x) -> logicalOp x unknown unknown; false | Ast.InitTag(x) -> initialiser false x; false | Ast.DeclarationTag(x) -> declaration x; false | Ast.StorageTag(x) -> storage x unknown unknown; false | Ast.IncFileTag(x) -> inc_file x unknown unknown; false | Ast.Rule_elemTag(x) -> rule_elem "" x; false | Ast.StatementTag(x) -> statement "" x; false | Ast.ForInfoTag(x) -> forinfo x; false | Ast.CaseLineTag(x) -> case_line "" x; false | Ast.ConstVolTag(x) -> const_vol x unknown unknown; false | Ast.Directive(xs) -> (match xs with (Ast.Space s)::_ -> pr_space() | _ -> ()); let rec loop = function [] -> () | [Ast.Noindent s] -> unindent false; print_text s | [Ast.Indent s] -> print_text s | (Ast.Space s) :: (((Ast.Indent _ | Ast.Noindent _) :: _) as rest) -> print_text s; force_newline(); loop rest | (Ast.Space s) :: rest -> print_text s; pr_space(); loop rest | Ast.Noindent s :: rest -> unindent false; print_text s; force_newline(); loop rest | Ast.Indent s :: rest -> print_text s; force_newline(); loop rest in loop xs; false | Ast.Token(x,None) -> print_text x; if_open_brace x | Ast.Token(x,Some info) -> mcode (fun x line lcol -> (match x with "else" -> force_newline() | _ -> ()); (match x with (* not sure if special case for comma is useful *) "," -> print_string_with_hint (SpaceOrNewline(ref " ")) x line lcol | _ -> print_string x line lcol)) (let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in (x,info,nomcodekind,[])); if_open_brace x | Ast.Code(x) -> let _ = top_level x in false (* this is not '...', but a list of expr/statement/params, and normally there should be no '...' inside them *) | Ast.ExprDotsTag(x) -> dots (fun _ -> ()) expression x; false | Ast.ParamDotsTag(x) -> parameter_list x; false | Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false | Ast.DeclDotsTag(x) -> dots force_newline declaration x; false | Ast.TypeCTag(x) -> typeC x; false | Ast.ParamTag(x) -> parameterTypeDef x; false | Ast.SgrepStartTag(x) -> failwith "unexpected start tag" | Ast.SgrepEndTag(x) -> failwith "unexpected end tag" in (*Printf.printf "start of the function\n";*) anything := (function x -> let _ = pp_any x in ()); (* todo? imitate what is in pretty_print_cocci ? *) match xxs with [] -> () | x::xs -> (* for many tags, we must not do a newline before the first '+' *) let isfn s = match Ast.unwrap s with Ast.FunDecl _ -> true | _ -> false in let prnl x = force_newline() in let newline_before _ = if before =*= After then let hd = List.hd xxs in match hd with (Ast.Directive l::_) when List.for_all (function Ast.Space x -> true | _ -> false) l -> () | (Ast.StatementTag s::_) when isfn s -> force_newline(); force_newline() | (Ast.Directive _::_) | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_) | (Ast.InitTag _::_) | (Ast.DeclarationTag _::_) | (Ast.Token ("}",_)::_) -> prnl hd | _ -> () in let newline_after _ = if before =*= Before then match List.rev(List.hd(List.rev xxs)) with (Ast.StatementTag s::_) -> (if isfn s then force_newline()); force_newline() | (Ast.Directive _::_) | (Ast.Rule_elemTag _::_) | (Ast.InitTag _::_) | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) -> force_newline() | _ -> () in (* print a newline at the beginning, if needed *) newline_before(); (* print a newline before each of the rest *) let rec loop leading_newline indent_needed = function [] -> () | x::xs -> (if leading_newline then force_newline()); let space_needed_before = function Ast.ParamTag(x) -> (match Ast.unwrap x with Ast.PComma _ -> false | _ -> true) | Ast.ExpressionTag(x) -> (match Ast.unwrap x with Ast.EComma _ -> false | _ -> true) | Ast.InitTag(x) -> (match Ast.unwrap x with Ast.IComma _ -> false | _ -> true) | Ast.Token(t,_) when List.mem t [",";";";"(";")";".";"->"] -> false | _ -> true in let space_needed_after = function Ast.Token(t,_) when List.mem t ["(";".";"->"] -> (*never needed*) false | Ast.Token(t,_) when List.mem t ["if";"for";"while";"do"] -> (* space always needed *) pr_space(); false | Ast.ExpressionTag(x) -> (match Ast.unwrap x with Ast.EComma _ -> false | _ -> true) | t -> true in let indent_needed = let rec loop space_after indent_needed = function [] -> indent_needed | x::xs -> (if indent_needed (* for open brace *) then force_newline() else if space_after && space_needed_before x then pr_space()); let indent_needed = pp_any x in let space_after = space_needed_after x in loop space_after indent_needed xs in loop false false x in loop true indent_needed xs in loop false false (x::xs); (* print a newline at the end, if needed *) newline_after() let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier, indent, unindent, eatspace) generating xxs before = List.iter (function env -> do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier, indent, unindent, eatspace) generating xxs before) envs coccinelle-1.0.0-rc19/parsing_c/token_helpers.ml0000644000175000017500000004702512247437436020541 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Parser_c (*****************************************************************************) (* Is_xxx, categories *) (*****************************************************************************) (* could define a type token_class = Comment | Ident | Operator | ... * update: now token_c can maybe do that. * but still, sometimes tokens belon to multiple classes. Could maybe * return then a set of classes. *) let is_space = function | TCommentSpace _ -> true | TCommentNewline _ -> true | _ -> false let is_whitespace = is_space let is_just_comment_or_space = function | TComment _ -> true | TCommentSpace _ -> true | TCommentNewline _ -> true | _ -> false let is_real_comment = is_just_comment_or_space let is_just_comment = function | TComment _ -> true | _ -> false let is_comment = function | TComment _ | TCommentSpace _ | TCommentNewline _ | TCommentCpp _ | TCommentMisc _ -> true | _ -> false (* coupling with comment_annotater_c.ml. * In fact more tokens than comments are not in the ast, but * they were usually temporally created by ocamllex and removed * in parsing_hacks. *) let is_not_in_ast = is_comment let is_fake_comment = function | TCommentCpp _ | TCommentMisc _ -> true | _ -> false let is_not_comment x = not (is_comment x) (* ---------------------------------------------------------------------- *) let is_cpp_instruction = function | TInclude _ | TDefine _ | TPragma _ | TIfdef _ | TIfdefelse _ | TIfdefelif _ | TEndif _ | TIfdefBool _ | TIfdefMisc _ | TIfdefVersion _ | TUndef _ | TCppDirectiveOther _ -> true | _ -> false let is_gcc_token = function | Tasm _ | Tinline _ | Tattribute _ | Ttypeof _ -> true | _ -> false (* ---------------------------------------------------------------------- *) let is_opar = function | TOPar _ | TOParDefine _ -> true | _ -> false let is_cpar = function | TCPar _ | TCParEOL _ -> true | _ -> false let is_obrace = function | TOBrace _ | TOBraceDefineInit _ -> true | _ -> false let is_cbrace = function | TCBrace _ -> true | _ -> false (* ---------------------------------------------------------------------- *) (* end of file *) let is_eof = function | EOF x -> true | _ -> false (* end of macro *) let is_eom = function | TDefEOL _ -> true | _ -> false let is_statement = function | Tfor _ | Tdo _ | Tif _ | Twhile _ | Treturn _ | Tbreak _ | Telse _ | Tswitch _ | Tcase _ | Tcontinue _ | Tgoto _ | TPtVirg _ | TMacroIterator _ -> true | _ -> false (* is_start_of_something is used in parse_c for error recovery, to find * a synchronisation token. * * Would like to put TIdent or TDefine, TIfdef but they can be in the * middle of a function, for instance with label:. * * Could put Typedefident but fired ? it would work in error recovery * on the already_passed tokens, which has been already gone in the * Parsing_hacks.lookahead machinery, but it will not work on the * "next" tokens. But because the namespace for labels is different * from namespace for ident/typedef, we can use the name for a typedef * for a label and so dangerous to put Typedefident at true here. * * Can look in parser_c.output to know what can be at toplevel * at the very beginning. *) let is_start_of_something = function | Tchar _ | Tshort _ | Tint _ | Tdouble _ | Tfloat _ | Tlong _ | Tunsigned _ | Tsigned _ | Tvoid _ | Tsize_t _ | Tssize_t _ | Tptrdiff_t _ | Tauto _ | Tregister _ | Textern _ | Tstatic _ | Tconst _ | Tvolatile _ | Ttypedef _ | Tstruct _ | Tunion _ | Tenum _ | Tdecimal _ -> true | _ -> false let is_binary_operator = function | TOrLog _ | TAndLog _ | TOr _ | TXor _ | TAnd _ | TEqEq _ | TNotEq _ | TInf _ | TSup _ | TInfEq _ | TSupEq _ | TShl _ | TShr _ | TPlus _ | TMinus _ | TMul _ | TDiv _ | TMod _ | TMax _ | TMin _ -> true | _ -> false let is_stuff_taking_parenthized = function | Tif _ | Twhile _ | Tswitch _ | Ttypeof _ | TMacroIterator _ -> true | _ -> false (* used in the algorithms for "10 most problematic errors" *) let is_ident_like = function | TIdent _ | TKRParam _ | TypedefIdent _ | TIdentDefine _ | TDefParamVariadic _ | TUnknown _ | TMacroAttr _ | TMacroAttrStorage _ | TMacroStmt _ | TMacroString _ | TMacroDecl _ | TMacroDeclConst _ | TMacroIterator _ -> true | _ -> false (*****************************************************************************) (* Visitors *) (*****************************************************************************) (* Because ocamlyacc force us to do it that way. The ocamlyacc token * cannot be a pair of a sum type, it must be directly a sum type. *) let info_of_tok = function | TString ((string, isWchar), i) -> i | TChar ((string, isWchar), i) -> i | TFloat ((string, floatType), i) -> i | TDecimal ((string, n, p), i) -> i | TQuote (_,i) -> i | TPct i -> i | TFormat(str,i) -> i | TSubString(str,i) -> i | TAssign (assignOp, i) -> i | TIdent (s, i) -> i | TKRParam (s, i) -> i | Tconstructorname (s, i) -> i | TypedefIdent (s, i) -> i | TInt (s, i) -> i | TDefine (ii) -> ii | TInclude (includes, filename, inifdef, i1) -> i1 | TUndef (ii) -> ii | TPragma (ii) -> ii | TCppDirectiveOther (ii) -> ii | TIncludeStart (i1, inifdef) -> i1 | TIncludeFilename (s, i1) -> i1 | TDefEOL (i1) -> i1 | TOParDefine (i1) -> i1 | TIdentDefine (s, i) -> i | TCppEscapedNewline (ii) -> ii | TDefParamVariadic (s, i1) -> i1 | TCppConcatOp (ii) -> ii | TOBraceDefineInit (i1) -> i1 | TUnknown (i) -> i | TMacroIdentBuilder (s, i) -> i | TMacroAttr (s, i) -> i | TMacroAttrStorage (s, i) -> i | TMacroStmt (s, i) -> i | TMacroString (s, i) -> i | TMacroDecl (s, i) -> i | TMacroDeclConst (i) -> i | TMacroIterator (s,i) -> i (* | TMacroTop (s,i) -> i *) | TCParEOL (i1) -> i1 | TAction (i) -> i | TComment (i) -> i | TCommentSpace (i) -> i | TCommentNewline (i) -> i | TCommentCpp (cppkind, i) -> i | TCommentMisc (i) -> i | TCommentSkipTagStart (i) -> i | TCommentSkipTagEnd (i) -> i | TIfdef (_, i) -> i | TIfdefelse (_, i) -> i | TIfdefelif (_, i) -> i | TEndif (_, i) -> i | TIfdefBool (b, _, i) -> i | TIfdefMisc (b, _, i) -> i | TIfdefVersion (b, _, i) -> i | TOPar (i) -> i | TCPar (i) -> i | TOBrace (i) -> i | TCBrace (i) -> i | TOCro (i) -> i | TCCro (i) -> i | TDot (i) -> i | TComma (i) -> i | TPtrOp (i) -> i | TInc (i) -> i | TDec (i) -> i | TEq (i) -> i | TWhy (i) -> i | TTilde (i) -> i | TBang (i) -> i | TEllipsis (i) -> i | TDotDot (i) -> i | TPtVirg (i) -> i | TOrLog (i) -> i | TAndLog (i) -> i | TOr (i) -> i | TXor (i) -> i | TAnd (i) -> i | TEqEq (i) -> i | TNotEq (i) -> i | TInf (i) -> i | TSup (i) -> i | TInfEq (i) -> i | TSupEq (i) -> i | TShl (i) -> i | TShr (i) -> i | TPlus (i) -> i | TMinus (i) -> i | TMul (i) -> i | TDiv (i) -> i | TMin (i) -> i | TMax (i) -> i | TMod (i) -> i | Tchar (i) -> i | Tshort (i) -> i | Tint (i) -> i | Tdouble (i) -> i | Tfloat (i) -> i | Tlong (i) -> i | Tunsigned (i) -> i | Tsigned (i) -> i | Tvoid (i) -> i | Tsize_t (i) -> i | Tssize_t (i) -> i | Tptrdiff_t (i) -> i | Tauto (i) -> i | Tregister (i) -> i | Textern (i) -> i | Tstatic (i) -> i | Tconst (i) -> i | Tvolatile (i) -> i | Trestrict (i) -> i | Tstruct (i) -> i | Tenum (i) -> i | Tdecimal (i) -> i | Ttypedef (i) -> i | Tunion (i) -> i | Tbreak (i) -> i | Telse (i) -> i | Tswitch (i) -> i | Tcase (i) -> i | Tcontinue (i) -> i | Tfor (i) -> i | Tdo (i) -> i | Tif (i) -> i | Twhile (i) -> i | Treturn (i) -> i | Tgoto (i) -> i | Tdefault (i) -> i | Tsizeof (i) -> i | Tasm (i) -> i | Tattribute (i) -> i | TattributeNoarg (i) -> i | Tinline (i) -> i | Ttypeof (i) -> i | Tnew (i) -> i | Tdelete (i) -> i | TOParCplusplusInit (i) -> i | EOF (i) -> i | Tnamespace (i) -> i (* used by tokens to complete the parse_info with filename, line, col infos *) let visitor_info_of_tok f = function | TString ((s, isWchar), i) -> TString ((s, isWchar), f i) | TChar ((s, isWchar), i) -> TChar ((s, isWchar), f i) | TFloat ((s, floatType), i) -> TFloat ((s, floatType), f i) | TDecimal ((s, n, p), i) -> TDecimal ((s, n, p), f i) | TAssign (assignOp, i) -> TAssign (assignOp, f i) | TQuote ((str,isW),i) -> TQuote ((str,isW),f i) | TPct i -> TPct (f i) | TFormat(str,i) -> TFormat(str,f i) | TSubString(str,i) -> TSubString(str,f i) | TIdent (s, i) -> TIdent (s, f i) | TKRParam(s, i) -> TKRParam(s, f i) | Tconstructorname(s, i) -> Tconstructorname (s, f i) | TypedefIdent (s, i) -> TypedefIdent (s, f i) | TInt (s, i) -> TInt (s, f i) | TDefine (i1) -> TDefine(f i1) | TUndef (i1) -> TUndef(f i1) | TPragma (i1) -> TPragma(f i1) | TCppDirectiveOther (i1) -> TCppDirectiveOther(f i1) | TInclude (includes, filename, inifdef, i1) -> TInclude (includes, filename, inifdef, f i1) | TIncludeStart (i1, inifdef) -> TIncludeStart (f i1, inifdef) | TIncludeFilename (s, i1) -> TIncludeFilename (s, f i1) | TCppEscapedNewline (i1) -> TCppEscapedNewline (f i1) | TDefEOL (i1) -> TDefEOL (f i1) | TCppConcatOp (ii) -> TCppConcatOp (f ii) | TOParDefine (i1) -> TOParDefine (f i1) | TIdentDefine (s, i) -> TIdentDefine (s, f i) | TDefParamVariadic (s, i1) -> TDefParamVariadic (s, f i1) | TOBraceDefineInit (i1) -> TOBraceDefineInit (f i1) | TUnknown (i) -> TUnknown (f i) | TMacroIdentBuilder (s, i) -> TMacroIdentBuilder (s, f i) | TMacroAttr (s, i) -> TMacroAttr (s, f i) | TMacroAttrStorage (s, i) -> TMacroAttrStorage (s, f i) | TMacroStmt (s, i) -> TMacroStmt (s, f i) | TMacroString (s, i) -> TMacroString (s, f i) | TMacroDecl (s, i) -> TMacroDecl (s, f i) | TMacroDeclConst (i) -> TMacroDeclConst (f i) | TMacroIterator (s, i) -> TMacroIterator (s, f i) (* | TMacroTop (s,i) -> TMacroTop (s,f i) *) | TCParEOL (i) -> TCParEOL (f i) | TAction (i) -> TAction (f i) | TComment (i) -> TComment (f i) | TCommentSpace (i) -> TCommentSpace (f i) | TCommentNewline (i) -> TCommentNewline (f i) | TCommentCpp (cppkind, i) -> TCommentCpp (cppkind, f i) | TCommentMisc (i) -> TCommentMisc (f i) | TCommentSkipTagStart (i) -> TCommentSkipTagStart (f i) | TCommentSkipTagEnd (i) -> TCommentSkipTagEnd (f i) | TIfdef (t, i) -> TIfdef (t, f i) | TIfdefelse (t, i) -> TIfdefelse (t, f i) | TIfdefelif (t, i) -> TIfdefelif (t, f i) | TEndif (t, i) -> TEndif (t, f i) | TIfdefBool (b, t, i) -> TIfdefBool (b, t, f i) | TIfdefMisc (b, t, i) -> TIfdefMisc (b, t, f i) | TIfdefVersion (b, t, i) -> TIfdefVersion (b, t, f i) | TOPar (i) -> TOPar (f i) | TCPar (i) -> TCPar (f i) | TOBrace (i) -> TOBrace (f i) | TCBrace (i) -> TCBrace (f i) | TOCro (i) -> TOCro (f i) | TCCro (i) -> TCCro (f i) | TDot (i) -> TDot (f i) | TComma (i) -> TComma (f i) | TPtrOp (i) -> TPtrOp (f i) | TInc (i) -> TInc (f i) | TDec (i) -> TDec (f i) | TEq (i) -> TEq (f i) | TWhy (i) -> TWhy (f i) | TTilde (i) -> TTilde (f i) | TBang (i) -> TBang (f i) | TEllipsis (i) -> TEllipsis (f i) | TDotDot (i) -> TDotDot (f i) | TPtVirg (i) -> TPtVirg (f i) | TOrLog (i) -> TOrLog (f i) | TAndLog (i) -> TAndLog (f i) | TOr (i) -> TOr (f i) | TXor (i) -> TXor (f i) | TAnd (i) -> TAnd (f i) | TEqEq (i) -> TEqEq (f i) | TNotEq (i) -> TNotEq (f i) | TInf (i) -> TInf (f i) | TSup (i) -> TSup (f i) | TInfEq (i) -> TInfEq (f i) | TSupEq (i) -> TSupEq (f i) | TShl (i) -> TShl (f i) | TShr (i) -> TShr (f i) | TPlus (i) -> TPlus (f i) | TMinus (i) -> TMinus (f i) | TMul (i) -> TMul (f i) | TDiv (i) -> TDiv (f i) | TMin (i) -> TMin (f i) | TMax (i) -> TMax (f i) | TMod (i) -> TMod (f i) | Tchar (i) -> Tchar (f i) | Tshort (i) -> Tshort (f i) | Tint (i) -> Tint (f i) | Tdouble (i) -> Tdouble (f i) | Tfloat (i) -> Tfloat (f i) | Tlong (i) -> Tlong (f i) | Tunsigned (i) -> Tunsigned (f i) | Tsigned (i) -> Tsigned (f i) | Tvoid (i) -> Tvoid (f i) | Tsize_t (i) -> Tsize_t (f i) | Tssize_t (i) -> Tssize_t (f i) | Tptrdiff_t (i) -> Tptrdiff_t (f i) | Tauto (i) -> Tauto (f i) | Tregister (i) -> Tregister (f i) | Textern (i) -> Textern (f i) | Tstatic (i) -> Tstatic (f i) | Tconst (i) -> Tconst (f i) | Tvolatile (i) -> Tvolatile (f i) | Trestrict (i) -> Trestrict (f i) | Tstruct (i) -> Tstruct (f i) | Tenum (i) -> Tenum (f i) | Tdecimal (i) -> Tdecimal (f i) | Ttypedef (i) -> Ttypedef (f i) | Tunion (i) -> Tunion (f i) | Tbreak (i) -> Tbreak (f i) | Telse (i) -> Telse (f i) | Tswitch (i) -> Tswitch (f i) | Tcase (i) -> Tcase (f i) | Tcontinue (i) -> Tcontinue (f i) | Tfor (i) -> Tfor (f i) | Tdo (i) -> Tdo (f i) | Tif (i) -> Tif (f i) | Twhile (i) -> Twhile (f i) | Treturn (i) -> Treturn (f i) | Tgoto (i) -> Tgoto (f i) | Tdefault (i) -> Tdefault (f i) | Tsizeof (i) -> Tsizeof (f i) | Tasm (i) -> Tasm (f i) | Tattribute (i) -> Tattribute (f i) | TattributeNoarg (i) -> TattributeNoarg (f i) | Tinline (i) -> Tinline (f i) | Ttypeof (i) -> Ttypeof (f i) | Tnew (i) -> Tnew (f i) | Tdelete (i) -> Tdelete (f i) | TOParCplusplusInit (i) -> TOParCplusplusInit (f i) | EOF (i) -> EOF (f i) | Tnamespace (i) -> Tnamespace (f i) (*****************************************************************************) (* Accessors *) (*****************************************************************************) let linecol_of_tok tok = let info = info_of_tok tok in Ast_c.line_of_info info, Ast_c.col_of_info info let col_of_tok x = snd (linecol_of_tok x) let line_of_tok x = fst (linecol_of_tok x) let pos_of_tok x = Ast_c.opos_of_info (info_of_tok x) let str_of_tok x = Ast_c.str_of_info (info_of_tok x) let file_of_tok x = Ast_c.file_of_info (info_of_tok x) let pinfo_of_tok x = Ast_c.pinfo_of_info (info_of_tok x) (* for a comment, the end line is not the same as line_of_tok *) let end_line_of_tok = function (TComment _) as t -> let newlines = List.length (Str.split_delim (Str.regexp "\n") (str_of_tok t)) - 1 in line_of_tok t + newlines | t -> line_of_tok t let is_origin x = match pinfo_of_tok x with Ast_c.OriginTok _ -> true | _ -> false let is_expanded x = match pinfo_of_tok x with Ast_c.ExpandedTok _ -> true | _ -> false let is_fake x = match pinfo_of_tok x with Ast_c.FakeTok _ -> true | _ -> false let is_abstract x = match pinfo_of_tok x with Ast_c.AbstractLineTok _ -> true | _ -> false (*****************************************************************************) (* Helpers *) (*****************************************************************************) let is_same_line_or_close line tok = line_of_tok tok =|= line || line_of_tok tok =|= line - 1 || line_of_tok tok =|= line - 2 coccinelle-1.0.0-rc19/parsing_c/control_flow_c_build.mli0000644000175000017500000000133012247437436022225 0ustar eugeneugen val ast_to_control_flow : Ast_c.toplevel -> Control_flow_c.cflow option val deadcode_detection : Control_flow_c.cflow -> unit val check_control_flow : Control_flow_c.cflow -> unit val annotate_loop_nodes : Control_flow_c.cflow -> Control_flow_c.cflow type error = | DeadCode of Common.parse_info option | CaseNoSwitch of Common.parse_info | OnlyBreakInSwitch of Common.parse_info | WeirdSwitch of Common.parse_info | NoEnclosingLoop of Common.parse_info | GotoCantFindLabel of string * Common.parse_info | NoExit of Common.parse_info | DuplicatedLabel of string | NestedFunc | ComputedGoto | Define of Common.parse_info exception Error of error val report_error : error -> unit coccinelle-1.0.0-rc19/parsing_c/copyright.txt0000644000175000017500000000114412247437436020106 0ustar eugeneugenparsing_c library - Yoann Padioleau Copyright (C) 2002, 2005, 2006, 2007, 2008, 2009 Yoann Padioleau, Ecole des Mines de Nantes, University of Urbana Champaign, Université de Rennes. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License (GPL) version 2 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file license.txt for more details. coccinelle-1.0.0-rc19/parsing_c/cpp_analysis_c.mli0000644000175000017500000000024612247437436021031 0ustar eugeneugen val extract_dangerous_macros: (Common.filename * (string * Cpp_token_c.define_def) list) list -> (Common.filename * (string * Cpp_token_c.define_def) list) list coccinelle-1.0.0-rc19/parsing_c/pretty_print_c.mli0000644000175000017500000000716512247437436021116 0ustar eugeneugentype type_with_ident = (string * Ast_c.info) option -> (Ast_c.storage * Ast_c.il) option -> Ast_c.fullType -> Ast_c.attribute list -> unit type 'a printer = 'a -> unit type pretty_printers = { expression : Ast_c.expression printer; arg_list : (Ast_c.argument Ast_c.wrap2 list) printer; arg : Ast_c.argument printer; statement : Ast_c.statement printer; decl : Ast_c.declaration printer; field : Ast_c.field printer; field_list : Ast_c.field list printer; init : Ast_c.initialiser printer; init_list : (Ast_c.initialiser Ast_c.wrap2 list) printer; param : Ast_c.parameterType printer; paramlist : (Ast_c.parameterType Ast_c.wrap2 list) printer; ty : Ast_c.fullType printer; type_with_ident : type_with_ident; toplevel : Ast_c.toplevel printer; fragment : Ast_c.string_fragment printer; fragment_list : (Ast_c.string_fragment list) printer; format : Ast_c.string_format printer; flow : Control_flow_c.node printer } val mk_pretty_printers : pr_elem:Ast_c.info printer -> pr_space:unit printer -> pr_nl: unit printer -> pr_indent: unit printer -> pr_outdent: unit printer -> pr_unindent: unit printer -> pretty_printers (* used in pycocci mostly *) val pp_expression_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.expression printer val pp_arg_list_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> (Ast_c.argument Ast_c.wrap2 list) printer val pp_arg_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.argument printer val pp_decl_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.declaration printer val pp_field_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.field printer val pp_field_list_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.field list printer val pp_statement_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.statement printer val pp_param_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.parameterType printer val pp_param_list_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> (Ast_c.parameterType Ast_c.wrap2 list) printer val pp_type_gen: pr_elem:Ast_c.info printer -> pr_space:unit printer -> Ast_c.fullType printer val pp_init_gen: pr_elem:Ast_c.info printer -> pr_space:unit printer -> Ast_c.initialiser printer val pp_init_list_gen: pr_elem:Ast_c.info printer -> pr_space:unit printer -> (Ast_c.initialiser Ast_c.wrap2 list) printer val pp_string_fragment_list_gen: pr_elem:Ast_c.info printer -> pr_space:unit printer -> Ast_c.string_fragment list printer val pp_string_format_gen: pr_elem:Ast_c.info printer -> pr_space:unit printer -> Ast_c.string_format printer val pp_program_gen : pr_elem:Ast_c.info printer -> pr_space:unit printer -> Ast_c.toplevel printer (* used in pretty_print_engine.ml mostly *) val pp_expression_simple: Ast_c.expression printer val pp_init_simple: Ast_c.initialiser printer val pp_type_simple: Ast_c.fullType printer val pp_decl_simple: Ast_c.declaration printer val pp_field_simple: Ast_c.field printer val pp_statement_simple: Ast_c.statement printer val pp_toplevel_simple: Ast_c.toplevel printer val pp_string_fragment_simple: Ast_c.string_fragment printer val pp_string_format_simple: Ast_c.string_format printer val debug_info_of_node: Ograph_extended.nodei -> Control_flow_c.cflow -> string val string_of_expression: Ast_c.expression -> string val string_of_toplevel: Ast_c.toplevel -> string coccinelle-1.0.0-rc19/parsing_c/parse_string_c.ml0000644000175000017500000000741212247437436020675 0ustar eugeneugenmodule PC = Parser_c type position = Before | After | Middle let make_int str info = PC.TInt((str,(Ast_c.Signed,Ast_c.CInt)),info) let make_float str info = PC.TFloat((str,(Ast_c.CFloat)),info) let make_quote str isW _ info = PC.TQuote ((str,isW),info) let make_pct str info = PC.TPct info let make_format str info = PC.TFormat (str,info) let make_sub_string str info = PC.TSubString (str,info) let update_info str offset oldinfo pos maker = let pinfo = match oldinfo.Ast_c.pinfo with Ast_c.OriginTok oldpinfo -> Ast_c.OriginTok {oldpinfo with Common.str = str; Common.charpos = oldpinfo.Common.charpos + offset; Common.column = oldpinfo.Common.column + offset} | Ast_c.FakeTok(str,vp) -> failwith "fake" | Ast_c.ExpandedTok(pi,vp) -> failwith (Printf.sprintf "expanded: %s" (Dumper.dump oldinfo.Ast_c.pinfo)) | Ast_c.AbstractLineTok(pi) -> failwith "abstract" (*| _ -> failwith "bad parse info token"*) in let newinfo = match pos with Middle -> {Ast_c.pinfo = pinfo; Ast_c.cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref Ast_c.emptyComments; } | Before -> let ct = !(oldinfo.Ast_c.comments_tag) in let ct = {ct with Ast_c.mafter = []; Ast_c.mafter2 = []; } in {Ast_c.pinfo = pinfo; Ast_c.cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref ct; } | After -> let ct = !(oldinfo.Ast_c.comments_tag) in let ct = {ct with Ast_c.mbefore = []; Ast_c.mbefore2 = []; } in {Ast_c.pinfo = pinfo; Ast_c.cocci_tag = ref Ast_c.emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref ct; } in maker str newinfo let pct_split str = let lst = Common.list_of_string str in let complete l = let l = List.rev l in String.concat "" (List.map (function c -> Printf.sprintf "%c" c) l) in let rec loop acc cur = function [] -> List.rev ((complete cur)::acc) | '%'::'%'::rest -> loop acc ('%'::'%'::cur) rest | ['%'] -> raise Parse_printf.Not_format_string | '%'::rest -> loop ((complete cur)::acc) [] rest | x :: rest -> loop acc (x :: cur) rest in loop [] [] lst let parse_middle middle info offset = let pieces = pct_split middle in let string_to_frag str info offset = update_info str offset info Middle make_sub_string in match pieces with [] | [_] -> raise Parse_printf.Not_format_string | fst::rest -> let (first,offset) = if fst = "" then ([],offset) else ([(string_to_frag fst info 0)],offset + String.length fst) in let (rest,_) = List.fold_left (function (prev,offset) -> function r -> let pct = update_info "%" offset info Middle make_pct in let offset = offset + 1 in let after_offset = offset + String.length r in let mkfmt d offset = update_info d offset info Middle make_format in let (c1,rest) = Parse_printf.get_format_string r in let first = [mkfmt c1 offset;pct] in if rest = "" then (first@prev,after_offset) else ((string_to_frag rest info offset)::first@prev, after_offset)) (first,offset) rest in rest let not_format_string (str,isW) info = [PC.TString((str,isW),info)] let parse_string (str,isW) info = if List.length(Str.split_delim (Str.regexp "%") str) > 1 then try begin let first = update_info "\"" 0 info Before (make_quote str isW) in let last = update_info "\"" (String.length str - 1) info After (make_quote str isW) in let middle = parse_middle str info 1 in List.rev (last :: middle @ [first]) end with Parse_printf.Not_format_string -> not_format_string (str,isW) info else not_format_string (str,isW) info coccinelle-1.0.0-rc19/parsing_c/ast_c.ml0000644000175000017500000012561412247437436016771 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2002, 2006, 2007, 2008, 2009 Yoann Padioleau * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (*****************************************************************************) (* The AST C related types *) (*****************************************************************************) (* * Some stuff are tagged semantic: which means that they are computed * after parsing. * * This means that some elements in this AST are present only if * some annotation/transformation has been done on the original AST returned * by the parser. Cf type_annotater, comment_annotater, cpp_ast_c, etc. *) (* ------------------------------------------------------------------------- *) (* Token/info *) (* ------------------------------------------------------------------------- *) (* To allow some transformations over the AST, we keep as much information * as possible in the AST such as the tokens content and their locations. * Those info are called 'info' (how original) and can be tagged. * For instance one tag may say that the unparser should remove this token. * * Update: Now I use a ref! in those 'info' so take care. * That means that modifications of the info of tokens can have * an effect on the info stored in the ast (which is sometimes * convenient, cf unparse_c.ml or comment_annotater_c.ml) * * convention: I often use 'ii' for the name of a list of info. * * Sometimes we want to add something at the beginning or at the end * of a construct. For 'function' and 'decl' we want to add something * to their left and for 'if' 'while' et 'for' and so on at their right. * We want some kinds of "virtual placeholders" that represent the start or * end of a construct. We use fakeInfo for that purpose. * To identify those cases I have added a fakestart/fakeend comment. * * cocci: Each token will be decorated in the future by the mcodekind * of cocci. It is the job of the pretty printer to look at this * information and decide to print or not the token (and also the * pending '+' associated sometimes with the token). * * The first time that we parse the original C file, the mcodekind is * empty, or more precisely all is tagged as a CONTEXT with NOTHING * associated. This is what I call a "clean" expr/statement/.... * * Each token will also be decorated in the future with an environment, * because the pending '+' may contain metavariables that refer to some * C code. * *) (* for unparser: *) type posl = int * int (* line-col, for MetaPosValList, for position variables *) (* with sexp *) (* the virtual position is set in Parsing_hacks.insert_virtual_positions *) type virtual_position = Common.parse_info * int (* character offset *) (* with sexp *) type parse_info = (* Present both in ast and list of tokens *) | OriginTok of Common.parse_info (* Present only in ast and generated after parsing. Used mainly * by Julia, to add stuff at virtual places, beginning of func or decl *) | FakeTok of string * virtual_position (* Present both in ast and list of tokens. *) | ExpandedTok of Common.parse_info * virtual_position (* Present neither in ast nor in list of tokens * but only in the '+' of the mcode of some tokens. Those kind of tokens * are used to be able to use '=' to compare big ast portions. *) | AbstractLineTok of Common.parse_info (* local to the abstracted thing *) (* with sexp *) type info = { pinfo : parse_info; (* this cocci_tag can be changed, which is how we can express some program * transformations by tagging the tokens involved in this transformation. *) cocci_tag: (Ast_cocci.mcodekind * metavars_binding list) option ref; (* set in comment_annotater_c.ml *) comments_tag: comments_around ref; (* annotations on the token (mutable) *) mutable annots_tag: Token_annot.annots (* todo? token_info : sometimes useful to know what token it was *) } and il = info list (* wrap2 is like wrap, except that I use it often for separator such * as ','. In that case the info is associated to the argument that * follows, so in 'a,b' I will have in the list [(a,[]); (b,[','])]. * * wrap3 is like wrap, except that I use it in case sometimes it * will be empty because the info will be included in a nested * entity (e.g. for Ident in expr because it's inlined in the name) * so user should never assume List.length wrap3 > 0. *) and 'a wrap = 'a * il and 'a wrap2 = 'a * il and 'a wrap3 = 'a * il (* * evotype*) (* ------------------------------------------------------------------------- *) (* Name *) (* ------------------------------------------------------------------------- *) (* was called 'ident' before, but 'name' is I think better * as concatenated strings can be used not only for identifiers and for * declarators, but also for fields, for labels, etc. * * Note: because now the info is embedded in the name, the info for * expression like Ident, or types like Typename, are not anymore * stored in the expression or type. Hence if you assume this, * which was true before, you are now wrong. So never write code like * let (unwrape,_), ii = e and use 'ii' believing it contains * the local ii to e. If you want to do that, use the appropriate * wrapper get_local_ii_of_expr_inlining_ii_of_name. *) and name = | RegularName of string wrap | CppConcatenatedName of (string wrap) wrap2 (* the ## separators *) list (* normally only used inside list of things, as in parameters or arguments * in which case, cf cpp-manual, it has a special meaning *) | CppVariadicName of string wrap (* ## s *) | CppIdentBuilder of string wrap (* s ( ) *) * ((string wrap) wrap2 list) (* arguments *) (* ------------------------------------------------------------------------- *) (* C Type *) (* ------------------------------------------------------------------------- *) (* Could have more precise type in fullType, in expression, etc, but * it requires to do too much things in parsing such as checking no * conflicting structname, computing value, etc. Better to separate * concern. So I put '=>' to mean what we would really like. In fact * what we really like is defining another fullType, expression, etc * from scratch, because many stuff are just sugar. * * invariant: Array and FunctionType have also typeQualifier but they * don't have sense. I put this to factorise some code. If you look in * the grammar, you see that we can never specify const for the array * himself (but we can do it for pointer) or function, we always * have in the action rule of the grammar a { (nQ, FunctionType ...) }. * * * Because of ExprStatement, we can have more 'new scope' events, but * rare I think. For instance with 'array of constExpression' there can * have an exprStatement and a new (local) struct defined. Same for * Constructor. * *) and fullType = typeQualifier * typeC and typeC = typeCbis wrap (* todo reput wrap3 *) and typeCbis = NoType (* for c++ only, and for K&R C *) | BaseType of baseType | Pointer of fullType | Array of constExpression option * fullType | Decimal of constExpression * constExpression option | FunctionType of functionType | Enum of string option * enumType | StructUnion of structUnion * string option * structType (* new scope *) | EnumName of string | StructUnionName of structUnion * string | TypeName of name * fullType option (* semantic: filled later *) | ParenType of fullType (* for unparser: *) (* gccext: TypeOfType below may seems useless; Why declare a * __typeof__(int) x; ? * When used with macros, it allows to fix a problem of C which * is that type declaration can be spread around the ident. Indeed it * may be difficult to have a macro such as * '#define macro(type, ident) type ident;' * because when you want to do a * macro(char[256], x), * then it will generate invalid code, but with a * '#define macro(type, ident) __typeof(type) ident;' * it will work. *) | TypeOfExpr of expression | TypeOfType of fullType (* cppext: IfdefType TODO *) (* -------------------------------------- *) and baseType = Void | IntType of intType | FloatType of floatType | SizeType | SSizeType | PtrDiffType (* stdC: type section * add a | SizeT ? * note: char and signed char are semantically different!! *) and intType = CChar (* obsolete? | CWchar *) | Si of signed and signed = sign * base and base = CChar2 | CShort | CInt | CLong | CLongLong (* gccext: *) and sign = Signed | UnSigned and floatType = CFloat | CDouble | CLongDouble (* -------------------------------------- *) and structUnion = Struct | Union and structType = field list and field = | DeclarationField of field_declaration (* gccext: *) | EmptyField of info (* cppext: *) | MacroDeclField of (string * argument wrap2 list) wrap (* optional ';'*) (* cppext: *) | CppDirectiveStruct of cpp_directive | IfdefStruct of ifdef_directive (* * field list list *) (* before unparser, I didn't have a FieldDeclList but just a Field. *) and field_declaration = | FieldDeclList of fieldkind wrap2 list (* , *) wrap (* ; *) (* At first I thought that a bitfield could be only Signed/Unsigned. * But it seems that gcc allow char i:4. C rule must say that you * can cast into int so enum too, ... *) and fieldkind = | Simple of name option * fullType | BitField of name option * fullType * info (* : *) * constExpression (* fullType => BitFieldInt | BitFieldUnsigned *) (* -------------------------------------- *) and enumType = oneEnumType wrap2 (* , *) list (* => string * int list *) and oneEnumType = name * (info (* = *) * constExpression) option (* -------------------------------------- *) (* return * (params * has "...") *) and functionType = fullType * (parameterType wrap2 list * bool wrap) and parameterType = { p_namei: name option; p_register: bool wrap; p_type: fullType; } (* => (bool (register) * fullType) list * bool *) and typeQualifier = typeQualifierbis wrap and typeQualifierbis = {const: bool; volatile: bool} (* gccext: cppext: *) and attribute = attributebis wrap and attributebis = | Attribute of string (* ------------------------------------------------------------------------- *) (* C expression *) (* ------------------------------------------------------------------------- *) and expression = (expressionbis * exp_info ref (* semantic: *)) wrap3 and exp_info = exp_type option * test and exp_type = fullType (* Type_c.completed_and_simplified *) * local and local = LocalVar of parse_info | StaticLocalVar of parse_info | NotLocalVar (* cocci: *) and test = Test | NotTest (* cocci: *) and expressionbis = (* Ident can be a enumeration constant, a simple variable, a name of a func. * With cppext, Ident can also be the name of a macro. Sparse says * "an identifier with a meaning is a symbol" *) | Ident of name (* todo? more semantic info such as LocalFunc *) | Constant of constant | StringConstant of string_fragment list * string (*src string*) * isWchar | FunCall of expression * argument wrap2 (* , *) list (* gccext: x ? /* empty */ : y <=> x ? x : y; hence the 'option' below *) | CondExpr of expression * expression option * expression (* should be considered as statements, bad C langage *) | Sequence of expression * expression | Assignment of expression * assignOp * expression | Postfix of expression * fixOp | Infix of expression * fixOp | Unary of expression * unaryOp | Binary of expression * binaryOp * expression | ArrayAccess of expression * expression (* field ident access *) | RecordAccess of expression * name | RecordPtAccess of expression * name (* redundant normally, could replace it by DeRef RecordAcces *) | SizeOfExpr of expression | SizeOfType of fullType | Cast of fullType * expression (* gccext: *) | StatementExpr of compound wrap (* ( ) new scope *) | Constructor of fullType * initialiser (* for unparser: *) | ParenExpr of expression (* for C++: *) | New of (argument wrap2 (* , *) list) option * argument | Delete of expression (* cppext: IfdefExpr TODO *) (* cppext: normally just expression *) and argument = (expression, weird_argument) Common.either and weird_argument = | ArgType of parameterType | ArgAction of action_macro and action_macro = (* todo: ArgStatement of statement, possibly have ghost token *) | ActMisc of il (* I put string for Int and Float because int would not be enough because * OCaml int are 31 bits. So simpler to do string. Same reason to have * string instead of int list for the String case. * * note: -2 is not a constant, it is the unary operator '-' * applied to constant 2. So the string must represent a positive * integer only. *) and constant = | String of (string * isWchar) | MultiString of string list (* can contain MacroString, todo: more info *) | Char of (string * isWchar) (* normally it is equivalent to Int *) | Int of (string * intType) | Float of (string * floatType) | DecimalConst of (string * string * string) and isWchar = IsWchar | IsChar and unaryOp = GetRef | DeRef | UnPlus | UnMinus | Tilde | Not | GetRefLabel (* gccext: GetRefLabel, via &&label notation *) and assignOp = SimpleAssign | OpAssign of arithOp and fixOp = Dec | Inc and binaryOp = Arith of arithOp | Logical of logicalOp and arithOp = | Plus | Minus | Mul | Div | Mod | DecLeft | DecRight | And | Or | Xor | Max | Min and logicalOp = | Inf | Sup | InfEq | SupEq | Eq | NotEq | AndLog | OrLog and constExpression = expression (* => int *) and string_fragment = string_fragment_bis wrap and string_fragment_bis = ConstantFragment of string | FormatFragment of string_format (* format *) and string_format = string_format_bis wrap and string_format_bis = ConstantFormat of string (* ------------------------------------------------------------------------- *) (* C statement *) (* ------------------------------------------------------------------------- *) (* note: that assignment is not a statement but an expression; * wonderful C langage. * * note: I use 'and' for type definition cos gccext allow statement as * expression, so need mutual recursive type definition. * *) and statement = statementbis wrap3 and statementbis = | Labeled of labeled | Compound of compound (* new scope *) | ExprStatement of exprStatement | Selection of selection (* have fakeend *) | Iteration of iteration (* have fakeend *) | Jump of jump (* simplify cocci: only at the beginning of a compound normally *) | Decl of declaration (* gccext: *) | Asm of asmbody | NestedFunc of definition (* cppext: *) | MacroStmt and labeled = Label of name * statement | Case of expression * statement | CaseRange of expression * expression * statement (* gccext: *) | Default of statement (* cppext: * old: compound = (declaration list * statement list) * old: (declaration, statement) either list * Simplify cocci to just have statement list, by integrating Decl in stmt. * * update: now introduce also the _sequencable to allow ifdef in the middle. * Indeed, I now allow ifdefs in the ast but they must be only between * "sequencable" elements. They can be put in a type only if this type * is used in a list, like at the toplevel, used in a 'toplevel list', * or inside a compound, used in a 'statement list'. I must not allow * ifdef anywhere. For instance I can not make ifdef a statement * cos some instruction like If accept only one statement and the * ifdef directive must not take the place of a legitimate instruction. * We had a similar phenomena in SmPL where we have the notion * of statement and sequencable statement too. Once you have * such a type of sequencable thing, then s/xx list/xx_sequencable list/ * and introduce the ifdef. * * update: those ifdefs are either passed, or present in the AST but in * a flat form. To structure those flat ifdefs you have to run * a transformation that will put in a tree the statements inside * ifdefs branches. Cf cpp_ast_c.ml. This is for instance the difference * between a IfdefStmt (flat) and IfdefStmt2 (tree structured). * *) and compound = statement_sequencable list (* cppext: easier to put at statement_list level than statement level *) and statement_sequencable = | StmtElem of statement (* cppext: *) | CppDirectiveStmt of cpp_directive | IfdefStmt of ifdef_directive (* this will be build in cpp_ast_c from the previous flat IfdefStmt *) | IfdefStmt2 of ifdef_directive list * (statement_sequencable list) list and exprStatement = expression option and declOrExpr = ForDecl of declaration | ForExp of expression option wrap (* for Switch, need check that all elements in the compound start * with a case:, otherwise unreachable code. *) and selection = | If of expression * statement * statement | Switch of expression * statement and iteration = | While of expression * statement | DoWhile of statement * expression | For of declOrExpr * exprStatement wrap * exprStatement wrap * statement (* cppext: *) | MacroIteration of string * argument wrap2 list * statement and jump = Goto of name | Continue | Break | Return | ReturnExpr of expression | GotoComputed of expression (* gccext: goto *exp ';' *) (* gccext: *) and asmbody = il (* string list *) * colon wrap (* : *) list and colon = Colon of colon_option wrap2 list and colon_option = colon_option_bis wrap and colon_option_bis = ColonMisc | ColonExpr of expression (* ------------------------------------------------------------------------- *) (* Declaration *) (* ------------------------------------------------------------------------- *) (* (string * ...) option cos can have empty declaration or struct tag * declaration. * * Before I had a Typedef constructor, but why make this special case and not * have StructDef, EnumDef, ... so that 'struct t {...} v' will generate 2 * declarations ? So I try to generalise and not have Typedef either. This * requires more work in parsing. Better to separate concern. * * Before the need for unparser, I didn't have a DeclList but just a Decl. * * I am not sure what it means to declare a prototype inline, but gcc * accepts it. *) and declaration = | DeclList of onedecl wrap2 (* , *) list wrap (* ; fakestart sto *) (* cppext: *) (* bool is true if there is a ; at the end *) | MacroDecl of (string * argument wrap2 list * bool) wrap (* fakestart *) | MacroDeclInit of (string * argument wrap2 list * initialiser) wrap (* fakestart *) and onedecl = { v_namei: (name * v_init) option; v_type: fullType; (* semantic: set in type annotated and used in cocci_vs_c * when we transform some initialisation into affectation *) v_type_bis: fullType (* Type_c.completed_and_simplified *) option ref; v_storage: storage; v_local: local_decl; (* cocci: *) v_attr: attribute list; (* gccext: *) } and v_init = NoInit | ValInit of info * initialiser | ConstrInit of argument wrap2 (* , *) list wrap and storage = storagebis * bool (* gccext: inline or not *) and storagebis = NoSto | StoTypedef | Sto of storageClass and storageClass = Auto | Static | Register | Extern and local_decl = LocalDecl | NotLocalDecl (* fullType is the type used if the type should be converted to an assignment. It can be adjusted in the type annotation phase when typedef information is available *) and initialiser = initialiserbis wrap and initialiserbis = | InitExpr of expression | InitList of initialiser wrap2 (* , *) list (* gccext: *) | InitDesignators of designator list * initialiser | InitFieldOld of string * initialiser | InitIndexOld of expression * initialiser (* ex: [2].y = x, or .y[2] or .y.x. They can be nested *) and designator = designatorbis wrap and designatorbis = | DesignatorField of string | DesignatorIndex of expression | DesignatorRange of expression * expression (* ------------------------------------------------------------------------- *) (* Function definition *) (* ------------------------------------------------------------------------- *) (* Normally we should define another type functionType2 because there * are more restrictions on what can define a function than a pointer * function. For instance a function declaration can omit the name of the * parameter whereas a function definition can not. But, in some cases such * as 'f(void) {', there is no name too, so I simplified and reused the * same functionType type for both declaration and function definition. * * Also old style C does not have type in the parameter, so again simpler * to abuse the functionType and allow missing type. *) and definition = definitionbis wrap (* ( ) { } fakestart sto *) and definitionbis = { f_name: name; f_type: functionType; (* less? a functionType2 ? *) f_storage: storage; f_body: compound; f_attr: attribute list; (* gccext: *) f_old_c_style: declaration list option; } (* cppext: IfdefFunHeader TODO *) (* ------------------------------------------------------------------------- *) (* cppext: cpp directives, #ifdef, #define and #include body *) (* ------------------------------------------------------------------------- *) and cpp_directive = | Define of define | Include of includ | Pragma of string wrap * pragmainfo | OtherDirective of il (*| Ifdef ? no, ifdefs are handled differently, cf ifdef_directive below *) and define = string wrap (* #define s eol *) * (define_kind * define_val) and define_kind = | DefineVar | DefineFunc of ((string wrap) wrap2 list) wrap (* () *) | Undef and define_val = (* most common case; e.g. to define int constant *) | DefineExpr of expression | DefineStmt of statement | DefineType of fullType | DefineDoWhileZero of (statement * expression) wrap (* do { } while(0) *) | DefineFunction of definition | DefineInit of initialiser (* in practice only { } with possible ',' *) | DefineMulti of statement list | DefineText of string wrap | DefineEmpty | DefineTodo and includ = { i_include: inc_file wrap; (* #include s *) (* cocci: computed in ? *) i_rel_pos: include_rel_pos option ref; (* cocci: cf -test incl *) i_is_in_ifdef: bool; (* cf cpp_ast_c.ml. set to None at parsing time. *) i_content: (Common.filename (* full path *) * program) option; } and inc_file = | Local of inc_elem list | NonLocal of inc_elem list | Weird of string (* ex: #include SYSTEM_H *) and inc_elem = string (* cocci: to tag the first of #include and last of #include * * The first_of and last_of store the list of prefixes that was * introduced by the include. On #include , if the include was * the first in the file, it would give in first_of the following * prefixes a/b/c; a/b/; a/ ; * * This is set after parsing, in cocci.ml, in update_rel_pos. *) and include_rel_pos = { first_of : string list list; last_of : string list list; } and pragmainfo = PragmaTuple of argument wrap2 (* , *) list wrap | PragmaIdList of name wrap2 list (* no commas, wrap2 is always empty *) (* todo? to specialize if someone need more info *) and ifdef_directive = (* or and 'a ifdefed = 'a list wrap *) | IfdefDirective of (ifdefkind * matching_tag) wrap and ifdefkind = | Ifdef (* todo? of string ? of formula_cpp ? *) | IfdefElseif (* same *) | IfdefElse (* same *) | IfdefEndif (* set in Parsing_hacks.set_ifdef_parenthize_info. It internally use * a global so it means if you parse the same file twice you may get * different id. I try now to avoid this pb by resetting it each * time I parse a file. *) and matching_tag = IfdefTag of (int (* tag *) * int (* total with this tag *)) (* ------------------------------------------------------------------------- *) (* The toplevels elements *) (* ------------------------------------------------------------------------- *) and toplevel = | Declaration of declaration | Definition of definition (* cppext: *) | CppTop of cpp_directive | IfdefTop of ifdef_directive (* * toplevel list *) (* cppext: *) | MacroTop of string * argument wrap2 list * il | EmptyDef of il (* gccext: allow redundant ';' *) | NotParsedCorrectly of il | FinalDef of info (* EOF *) (* c++ *) | Namespace of toplevel list * il (* ------------------------------------------------------------------------- *) and program = toplevel list (*****************************************************************************) (* Cocci Bindings *) (*****************************************************************************) (* Was previously in pattern.ml, but because of the transformer, * we need to decorate each token with some cocci code AND the environment * for this cocci code. *) and metavars_binding = (Ast_cocci.meta_name, metavar_binding_kind) assoc and metavar_binding_kind = | MetaIdVal of string * Ast_cocci.meta_name list (* negative constraints *) | MetaFuncVal of string | MetaLocalFuncVal of string | MetaExprVal of expression (* a "clean expr" *) * (*subterm constraints, currently exprs*) Ast_cocci.meta_name list | MetaExprListVal of argument wrap2 list | MetaParamVal of parameterType | MetaParamListVal of parameterType wrap2 list | MetaTypeVal of fullType | MetaInitVal of initialiser | MetaInitListVal of initialiser wrap2 list | MetaDeclVal of declaration | MetaFieldVal of field | MetaFieldListVal of field list | MetaStmtVal of statement | MetaFmtVal of string_format | MetaFragListVal of string_fragment list (* Could also be in Lib_engine.metavars_binding2 with the ParenVal, * because don't need to have the value for a position in the env of * a '+'. But ParenVal or LabelVal are used only by CTL, they are not * variables accessible via SmPL whereas the position can be one day * so I think it's better to put MetaPosVal here *) | MetaPosVal of (Ast_cocci.fixpos * Ast_cocci.fixpos) (* max, min *) | MetaPosValList of (Common.filename * string (*element*) * posl * posl) list (* min, max *) | MetaListlenVal of int (*****************************************************************************) (* C comments *) (*****************************************************************************) (* convention: I often use "m" for comments as I can not use "c" * (already use for c stuff) and "com" is too long. *) (* this type will be associated to each token. *) and comments_around = { mbefore: Token_c.comment_like_token list; mafter: Token_c.comment_like_token list; (* less: could remove ? do something simpler than CComment for * coccinelle, cf above. *) mbefore2: comment_and_relative_pos list; mafter2: comment_and_relative_pos list; } and comment_and_relative_pos = { minfo: Common.parse_info; (* the int represent the number of lines of difference between the * current token and the comment. When on same line, this number is 0. * When previous line, -1. In some way the after/before in previous * record is useless because the sign of the integer can helps * do the difference too, but I keep it that way. *) mpos: int; (* todo? * cppbetween: bool; touse? if false positive * is_alone_in_line: bool; (*for labels, to avoid false positive*) *) } and comment = Common.parse_info and com = comment list ref (* with sexp *) (*****************************************************************************) (* Some constructors *) (*****************************************************************************) let nullQualif = ({const=false; volatile= false}, []) let nQ = nullQualif let defaultInt = (BaseType (IntType (Si (Signed, CInt)))) let noType () = ref (None,NotTest) let noInstr = (ExprStatement (None), []) let noTypedefDef () = None let emptyMetavarsBinding = ([]: metavars_binding) let emptyAnnotCocci = (Ast_cocci.CONTEXT (Ast_cocci.NoPos,Ast_cocci.NOTHING), ([] : metavars_binding list)) let emptyAnnot = (None: (Ast_cocci.mcodekind * metavars_binding list) option) (* compatibility mode *) let mcode_and_env_of_cocciref aref = match !aref with | Some x -> x | None -> emptyAnnotCocci let emptyComments= { mbefore = []; mafter = []; mbefore2 = []; mafter2 = []; } (* for include, some meta information needed by cocci *) let noRelPos () = ref (None: include_rel_pos option) let noInIfdef () = ref false (* When want add some info in ast that does not correspond to * an existing C element. * old: or when don't want 'synchronize' on it in unparse_c.ml * (now have other mark for the matter). *) let no_virt_pos = ({str="";charpos=0;line=0;column=0;file=""},-1) let fakeInfo pi = { pinfo = FakeTok ("",no_virt_pos); cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref emptyComments; } let noii = [] let noattr = [] let noi_content = (None: ((Common.filename * program) option)) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let unwrap = fst let unwrap2 = fst let unwrap_expr ((unwrap_e, typ), iie) = unwrap_e let rewrap_expr ((_old_unwrap_e, typ), iie) newe = ((newe, typ), iie) let unwrap_typeC (qu, (typeC, ii)) = typeC let rewrap_typeC (qu, (typeC, ii)) newtypeC = (qu, (newtypeC, ii)) let unwrap_typeCbis (typeC, ii) = typeC let unwrap_st (unwrap_st, ii) = unwrap_st (* ------------------------------------------------------------------------- *) let mk_e unwrap_e ii = (unwrap_e, noType()), ii let mk_e_bis unwrap_e ty ii = (unwrap_e, ty), ii let mk_ty typeC ii = nQ, (typeC, ii) let mk_tybis typeC ii = (typeC, ii) let mk_st unwrap_st ii = (unwrap_st, ii) (* ------------------------------------------------------------------------- *) let get_ii_typeC_take_care (typeC, ii) = ii let get_ii_st_take_care (st, ii) = ii let get_ii_expr_take_care (e, ii) = ii let get_st_and_ii (st, ii) = st, ii let get_ty_and_ii (qu, (typeC, ii)) = qu, (typeC, ii) let get_e_and_ii (e, ii) = e, ii (* ------------------------------------------------------------------------- *) let get_type_expr ((unwrap_e, typ), iie) = !typ let set_type_expr ((unwrap_e, oldtyp), iie) newtyp = oldtyp := newtyp (* old: (unwrap_e, newtyp), iie *) let get_onlytype_expr ((unwrap_e, typ), iie) = match !typ with | Some (ft,_local), _test -> Some ft | None, _ -> None let get_onlylocal_expr ((unwrap_e, typ), iie) = match !typ with | Some (ft,local), _test -> Some local | None, _ -> None (* ------------------------------------------------------------------------- *) let rewrap_str s ii = {ii with pinfo = (match ii.pinfo with OriginTok pi -> OriginTok { pi with Common.str = s;} | ExpandedTok (pi,vpi) -> ExpandedTok ({ pi with Common.str = s;},vpi) | FakeTok (_,vpi) -> FakeTok (s,vpi) | AbstractLineTok pi -> OriginTok { pi with Common.str = s;})} let rewrap_pinfo pi ii = {ii with pinfo = pi} (* info about the current location *) let get_pi = function OriginTok pi -> pi | ExpandedTok (_,(pi,_)) -> pi | FakeTok (_,(pi,_)) -> pi | AbstractLineTok pi -> pi (* original info *) let get_opi = function OriginTok pi -> pi | ExpandedTok (pi,_) -> pi (* diff with get_pi *) | FakeTok (_,_) -> failwith "no position information" | AbstractLineTok pi -> pi let str_of_info ii = match ii.pinfo with OriginTok pi -> pi.Common.str | ExpandedTok (pi,_) -> pi.Common.str | FakeTok (s,_) -> s | AbstractLineTok pi -> pi.Common.str let get_info f ii = match ii.pinfo with OriginTok pi -> f pi | ExpandedTok (_,(pi,_)) -> f pi | FakeTok (_,(pi,_)) -> f pi | AbstractLineTok pi -> f pi let get_orig_info f ii = match ii.pinfo with OriginTok pi -> f pi | ExpandedTok (pi,_) -> f pi (* diff with get_info *) | FakeTok (_,(pi,_)) -> f pi | AbstractLineTok pi -> f pi let make_expanded ii = {ii with pinfo = ExpandedTok (get_opi ii.pinfo,no_virt_pos)} let pos_of_info ii = get_info (function x -> x.Common.charpos) ii let opos_of_info ii = get_orig_info (function x -> x.Common.charpos) ii let line_of_info ii = get_orig_info (function x -> x.Common.line) ii let col_of_info ii = get_orig_info (function x -> x.Common.column) ii let file_of_info ii = get_orig_info (function x -> x.Common.file) ii let mcode_of_info ii = fst (mcode_and_env_of_cocciref ii.cocci_tag) let pinfo_of_info ii = ii.pinfo let parse_info_of_info ii = get_pi ii.pinfo let strloc_of_info ii = spf "%s:%d" (file_of_info ii) (line_of_info ii) let is_fake ii = match ii.pinfo with FakeTok (_,_) -> true | _ -> false let is_origintok ii = match ii.pinfo with | OriginTok pi -> true | _ -> false (* ------------------------------------------------------------------------- *) type posrv = Real of Common.parse_info | Virt of virtual_position let compare_pos ii1 ii2 = let get_pos = function OriginTok pi -> Real pi | FakeTok (s,vpi) -> Virt vpi | ExpandedTok (pi,vpi) -> Virt vpi | AbstractLineTok pi -> Real pi in (* used for printing *) let pos1 = get_pos (pinfo_of_info ii1) in let pos2 = get_pos (pinfo_of_info ii2) in match (pos1,pos2) with (Real p1, Real p2) -> compare p1.Common.charpos p2.Common.charpos | (Virt (p1,_), Real p2) -> if (compare p1.Common.charpos p2.Common.charpos) =|= (-1) then (-1) else 1 | (Real p1, Virt (p2,_)) -> if (compare p1.Common.charpos p2.Common.charpos) =|= 1 then 1 else (-1) | (Virt (p1,o1), Virt (p2,o2)) -> let poi1 = p1.Common.charpos in let poi2 = p2.Common.charpos in match compare poi1 poi2 with -1 -> -1 | 0 -> compare o1 o2 | x -> x let equal_posl (l1,c1) (l2,c2) = (l1 =|= l2) && (c1 =|= c2) let compare_posl (l1,c1) (l2,c2) = match l2 - l1 with 0 -> c2 - c1 | r -> r let info_to_fixpos ii = match pinfo_of_info ii with OriginTok pi -> Ast_cocci.Real pi.Common.charpos | ExpandedTok (_,(pi,offset)) -> Ast_cocci.Virt (pi.Common.charpos,offset) | FakeTok (_,(pi,offset)) -> Ast_cocci.Virt (pi.Common.charpos,offset) | AbstractLineTok pi -> failwith "unexpected abstract" (* cocci: *) let is_test (e : expression) = let (_,info), _ = e in let (_,test) = !info in test =*= Test (*****************************************************************************) (* Abstract line *) (*****************************************************************************) (* When we have extended the C Ast to add some info to the tokens, * such as its line number in the file, we can not use anymore the * ocaml '=' to compare Ast elements. To overcome this problem, to be * able to use again '=', we just have to get rid of all those extra * information, to "abstract those line" (al) information. * * Julia then modifies it a little to have a tokenindex, so the original * true al_info is in fact real_al_info. *) let al_info tokenindex x = { pinfo = (AbstractLineTok {charpos = tokenindex; line = tokenindex; column = tokenindex; file = ""; str = str_of_info x}); cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref emptyComments; } let semi_al_info x = { x with cocci_tag = ref emptyAnnot; comments_tag = ref emptyComments; } let magic_real_number = -10 let real_al_info x = { pinfo = (AbstractLineTok {charpos = magic_real_number; line = magic_real_number; column = magic_real_number; file = ""; str = str_of_info x}); cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref emptyComments; } let al_comments x = let keep_cpp l = List.filter (function (Token_c.TCommentCpp _,_) -> true | _ -> false) l in let al_com (x,i) = (x,{i with Common.charpos = magic_real_number; Common.line = magic_real_number; Common.file = ""; Common.column = magic_real_number}) in {mbefore = []; (* duplicates mafter of the previous token *) mafter = List.map al_com (keep_cpp x.mafter); mbefore2=[]; mafter2=[]; } let al_info_cpp tokenindex x = { pinfo = (AbstractLineTok {charpos = tokenindex; line = tokenindex; column = tokenindex; file = ""; str = str_of_info x}); cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref (al_comments !(x.comments_tag)); } let semi_al_info_cpp x = { x with cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref (al_comments !(x.comments_tag)); } let real_al_info_cpp x = { pinfo = (AbstractLineTok {charpos = magic_real_number; line = magic_real_number; column = magic_real_number; file = ""; str = str_of_info x}); cocci_tag = ref emptyAnnot; annots_tag = Token_annot.empty; comments_tag = ref (al_comments !(x.comments_tag)); } (*****************************************************************************) (* Views *) (*****************************************************************************) (* Transform a list of arguments (or parameters) where the commas are * represented via the wrap2 and associated with an element, with * a list where the comma are on their own. f(1,2,2) was * [(1,[]); (2,[,]); (2,[,])] and become [1;',';2;',';2]. * * Used in cocci_vs_c.ml, to have a more direct correspondence between * the ast_cocci of julia and ast_c. *) let rec (split_comma: 'a wrap2 list -> ('a, il) either list) = function | [] -> [] | (e, ii)::xs -> if null ii then (Left e)::split_comma xs else Right ii::Left e::split_comma xs let rec (unsplit_comma: ('a, il) either list -> 'a wrap2 list) = function | [] -> [] | Right ii::Left e::xs -> (e, ii)::unsplit_comma xs | Left e::xs -> let empty_ii = [] in (e, empty_ii)::unsplit_comma xs | Right ii::_ -> raise (Impossible 59) let (split_nocomma: 'a list -> ('a, il) either list) = function l -> List.map (function x -> Left x) l let (unsplit_nocomma: ('a, il) either list -> 'a list) = function l -> l +> List.map (function Left x -> x | Right x -> failwith "not possible") (*****************************************************************************) (* Helpers, could also be put in lib_parsing_c.ml instead *) (*****************************************************************************) (* should maybe be in pretty_print_c ? *) let s_of_inc_file inc_file = match inc_file with | Local xs -> xs +> Common.join "/" | NonLocal xs -> xs +> Common.join "/" | Weird s -> s let s_of_inc_file_bis inc_file = match inc_file with | Local xs -> "\"" ^ xs +> Common.join "/" ^ "\"" | NonLocal xs -> "<" ^ xs +> Common.join "/" ^ ">" | Weird s -> s let fieldname_of_fieldkind fieldkind = match fieldkind with | Simple (sopt, ft) -> sopt | BitField (sopt, ft, info, expr) -> sopt let s_of_attr attr = attr +> List.map (fun (Attribute s, ii) -> s) +> Common.join "," (* ------------------------------------------------------------------------- *) let str_of_name ident = match ident with | RegularName (s,ii) -> s | CppConcatenatedName xs -> xs +> List.map (fun (x,iiop) -> unwrap x) +> Common.join "##" | CppVariadicName (s, ii) -> "##" ^ s | CppIdentBuilder ((s,iis), xs) -> s ^ "(" ^ (xs +> List.map (fun ((x,iix), iicomma) -> x) +> Common.join ",") ^ ")" let get_s_and_ii_of_name name = match name with | RegularName (s, iis) -> s, iis | CppIdentBuilder ((s, iis), xs) -> s, iis | CppVariadicName (s,iis) -> let (iop, iis) = Common.tuple_of_list2 iis in s, [iis] | CppConcatenatedName xs -> (match xs with | [] -> raise (Impossible 60) | ((s,iis),noiiop)::xs -> s, iis ) let get_s_and_info_of_name name = let (s,ii) = get_s_and_ii_of_name name in s, List.hd ii let info_of_name name = let (s,ii) = get_s_and_ii_of_name name in List.hd ii let ii_of_name name = let (s,ii) = get_s_and_ii_of_name name in ii let get_local_ii_of_expr_inlining_ii_of_name e = let (ebis,_),ii = e in match ebis, ii with | Ident name, noii -> assert(null noii); ii_of_name name | RecordAccess (e, name), ii -> ii @ ii_of_name name | RecordPtAccess (e, name), ii -> ii @ ii_of_name name | _, ii -> ii let get_local_ii_of_tybis_inlining_ii_of_name ty = match ty with | TypeName (name, _typ), [] -> ii_of_name name | _, ii -> ii (* the following is used to obtain the argument to LocalVar *) let info_of_type ft = let (qu, ty) = ft in (* bugfix: because of string->name, the ii can be deeper *) let ii = get_local_ii_of_tybis_inlining_ii_of_name ty in match ii with | ii::_ -> Some ii.pinfo | [] -> None (* only Label and Goto have name *) let get_local_ii_of_st_inlining_ii_of_name st = match st with | Labeled (Label (name, st)), ii -> ii_of_name name @ ii | Jump (Goto name), ii -> let (i1, i3) = Common.tuple_of_list2 ii in [i1] @ ii_of_name name @ [i3] | _, ii -> ii (* ------------------------------------------------------------------------- *) let name_of_parameter param = param.p_namei +> Common.map_option (str_of_name) (* ------------------------------------------------------------------------- *) (* Annotations on tokens *) (* ------------------------------------------------------------------------- *) (* to put a given annotation on a token *) let put_annot_info info key value = info.annots_tag <- Token_annot.put_annot key value info.annots_tag (* to check if an annotation has such a token *) let get_annot_info info key = Token_annot.get_annot info.annots_tag key coccinelle-1.0.0-rc19/parsing_c/lib_parsing_c.ml0000644000175000017500000003207512247437436020471 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008, 2009 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Abstract line *) (*****************************************************************************) (* todo?: al_expr doit enlever les infos de type ? et doit remettre en * emptyAnnot ? No! Keeping the type information is important to ensuring that variables of different type and declared in different places do not seem to match each other. On the other hand, we don't want to keep around the information about whether the expression is a test expression, because a term that is a test expression should match one that is not. The test information is only useful for matching to the CTL. *) (* drop all info information *) let strip_info_visitor _ = let drop_test ty = let (ty,_) = !ty in ref (ty,Ast_c.NotTest) in { Visitor_c.default_visitor_c_s with Visitor_c.kinfo_s = (* traversal should be deterministic... *) (let ctr = ref 0 in (function (k,_) -> function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i)); Visitor_c.kexpr_s = (fun (k,_) e -> let (e', ty), ii' = k e in (e', drop_test ty), ii' (* keep type - jll *) ); (* Visitor_c.ktype_s = (fun (k,_) ft -> let ft' = k ft in match Ast_c.unwrap_typeC ft' with | Ast_c.TypeName (s,_typ) -> Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft' | _ -> ft' ); *) } let al_expr x = Visitor_c.vk_expr_s (strip_info_visitor()) x let al_declaration x = Visitor_c.vk_decl_s (strip_info_visitor()) x let al_field x = Visitor_c.vk_struct_field_s (strip_info_visitor()) x let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x let al_type x = Visitor_c.vk_type_s (strip_info_visitor()) x let al_init x = Visitor_c.vk_ini_s (strip_info_visitor()) x let al_inits x = Visitor_c.vk_inis_s (strip_info_visitor()) x let al_param x = Visitor_c.vk_param_s (strip_info_visitor()) x let al_params x = Visitor_c.vk_params_s (strip_info_visitor()) x let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x let al_fields x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x let al_name x = Visitor_c.vk_name_s (strip_info_visitor()) x let al_string_format x = Visitor_c.vk_string_format_s (strip_info_visitor()) x let al_string_fragments x = Visitor_c.vk_string_fragments_s (strip_info_visitor()) x let al_node x = Visitor_c.vk_node_s (strip_info_visitor()) x let al_program x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x let al_ii x = Visitor_c.vk_ii_s (strip_info_visitor()) x let strip_inh_info_visitor _ = (* for inherited metavariables *) let drop_test_lv ty bigf = let (ty,_) = !ty in let ty = match ty with None -> None | Some (ty,_) -> let ty = Visitor_c.vk_type_s bigf ty in Some (ty,Ast_c.NotLocalVar) in ref ((ty,Ast_c.NotTest) : Ast_c.exp_info) in { Visitor_c.default_visitor_c_s with Visitor_c.kinfo_s = (* traversal should be deterministic... *) (let ctr = ref 0 in (function (k,_) -> function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i)); Visitor_c.kexpr_s = (fun (k,bigf) e -> let (e', ty), ii' = k e in (e', drop_test_lv ty bigf), ii' (* keep type, but process it - jll *) ); (* Visitor_c.ktype_s = (fun (k,_) ft -> let ft' = k ft in match Ast_c.unwrap_typeC ft' with | Ast_c.TypeName (s,_typ) -> Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft' | _ -> ft' ); *) } let al_inh_expr x = Visitor_c.vk_expr_s (strip_inh_info_visitor()) x let al_inh_declaration x = Visitor_c.vk_decl_s (strip_inh_info_visitor()) x let al_inh_field x = Visitor_c.vk_struct_field_s (strip_inh_info_visitor()) x let al_inh_field_list x = Visitor_c.vk_struct_fields_s (strip_inh_info_visitor()) x let al_inh_statement x = Visitor_c.vk_statement_s (strip_inh_info_visitor()) x let al_inh_type x = Visitor_c.vk_type_s (strip_inh_info_visitor()) x let al_inh_init x = Visitor_c.vk_ini_s (strip_inh_info_visitor()) x let al_inh_inits x = Visitor_c.vk_inis_s (strip_inh_info_visitor()) x let al_inh_arguments x = Visitor_c.vk_arguments_s (strip_inh_info_visitor()) x let al_inh_string_format x = Visitor_c.vk_string_format_s (strip_inh_info_visitor()) x let al_inh_string_fragments x = Visitor_c.vk_string_fragments_s (strip_inh_info_visitor()) x let semi_strip_info_visitor = (* keep position information *) let drop_test ty = let (ty,_) = !ty in ref (ty,Ast_c.NotTest) in { Visitor_c.default_visitor_c_s with Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info_cpp i); Visitor_c.kexpr_s = (fun (k,_) e -> let (e', ty),ii' = k e in (e', drop_test ty), ii' (* keep type - jll *) ); } let semi_al_expr = Visitor_c.vk_expr_s semi_strip_info_visitor let semi_al_declaration = Visitor_c.vk_decl_s semi_strip_info_visitor let semi_al_field = Visitor_c.vk_struct_field_s semi_strip_info_visitor let semi_al_fields = Visitor_c.vk_struct_fields_s semi_strip_info_visitor let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor let semi_al_type = Visitor_c.vk_type_s semi_strip_info_visitor let semi_al_init = Visitor_c.vk_ini_s semi_strip_info_visitor let semi_al_inits = Visitor_c.vk_inis_s semi_strip_info_visitor let semi_al_param = Visitor_c.vk_param_s semi_strip_info_visitor let semi_al_params = Visitor_c.vk_params_s semi_strip_info_visitor let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor let semi_al_string_format = Visitor_c.vk_string_format_s semi_strip_info_visitor let semi_al_string_fragments = Visitor_c.vk_string_fragments_s semi_strip_info_visitor let semi_al_program = List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor) (* really strip, do not keep position nor anything specificities, true * abstracted form. This is used outside coccinelle in Yacfe and aComment *) let real_strip_info_visitor _ = { Visitor_c.default_visitor_c_s with Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.real_al_info_cpp i ); Visitor_c.kexpr_s = (fun (k,_) e -> let (e', ty),ii' = k e in (e', Ast_c.noType()), ii' ); (* Visitor_c.ktype_s = (fun (k,_) ft -> let ft' = k ft in match Ast_c.unwrap_typeC ft' with | Ast_c.TypeName (s,_typ) -> Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft' | _ -> ft' ); *) } let real_al_expr x = Visitor_c.vk_expr_s (real_strip_info_visitor()) x let real_al_arguments x = Visitor_c.vk_arguments_s (real_strip_info_visitor()) x let real_al_node x = Visitor_c.vk_node_s (real_strip_info_visitor()) x let real_al_type x = Visitor_c.vk_type_s (real_strip_info_visitor()) x let real_al_decl x = Visitor_c.vk_decl_s (real_strip_info_visitor()) x let real_al_init x = Visitor_c.vk_ini_s (real_strip_info_visitor()) x let real_al_inits x = Visitor_c.vk_inis_s (real_strip_info_visitor()) x let real_al_statement x = Visitor_c.vk_statement_s (real_strip_info_visitor()) x let real_al_def x = Visitor_c.vk_toplevel_s (real_strip_info_visitor()) x (*****************************************************************************) (* Extract infos *) (*****************************************************************************) let extract_info_visitor recursor x = let globals = ref [] in let visitor = { Visitor_c.default_visitor_c with Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals) } in begin recursor visitor x; !globals end let ii_of_decl = extract_info_visitor Visitor_c.vk_decl let ii_of_field = extract_info_visitor Visitor_c.vk_struct_field let ii_of_node = extract_info_visitor Visitor_c.vk_node let ii_of_expr = extract_info_visitor Visitor_c.vk_expr let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted let ii_of_type = extract_info_visitor Visitor_c.vk_type let ii_of_ini = extract_info_visitor Visitor_c.vk_ini let ii_of_inis = extract_info_visitor Visitor_c.vk_inis_splitted let ii_of_param = extract_info_visitor Visitor_c.vk_param let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted let ii_of_enum_fields = extract_info_visitor Visitor_c.vk_enum_fields_splitted let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*) let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds let ii_of_cst = extract_info_visitor Visitor_c.vk_cst let ii_of_fragments = extract_info_visitor Visitor_c.vk_string_fragments_splitted let ii_of_format = extract_info_visitor Visitor_c.vk_string_format let ii_of_define_params = extract_info_visitor Visitor_c.vk_define_params_splitted let ii_of_pragmainfo = extract_info_visitor Visitor_c.vk_pragmainfo let ii_of_ident_list = extract_info_visitor Visitor_c.vk_ident_list_splitted let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel (*****************************************************************************) (* Max min, range *) (*****************************************************************************) let max_min_ii_by_pos xs = match xs with | [] -> failwith "empty list, max_min_ii_by_pos" | [x] -> (x, x) | x::xs -> let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) =|= (-1) in xs +> List.fold_left (fun (maxii,minii) e -> let maxii' = if pos_leq maxii e then e else maxii in let minii' = if pos_leq e minii then e else minii in maxii', minii' ) (x,x) let info_to_fixpos ii = match Ast_c.pinfo_of_info ii with Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos | Ast_c.ExpandedTok (_,(pi,offset)) -> Ast_cocci.Virt (pi.Common.charpos,offset) | Ast_c.FakeTok (_,(pi,offset)) -> Ast_cocci.Virt (pi.Common.charpos,offset) | Ast_c.AbstractLineTok pi -> failwith ("unexpected abstract: "^(Dumper.dump pi)) let max_min_by_pos xs = let (i1, i2) = max_min_ii_by_pos xs in (info_to_fixpos i1, info_to_fixpos i2) let lin_col_by_pos xs = (* put min before max; no idea why they are backwards above *) let non_fake = List.filter (function ii -> not (Ast_c.is_fake ii)) xs in let (i2, i1) = max_min_ii_by_pos non_fake in let posf x = Ast_c.col_of_info x in let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in (Ast_c.file_of_info i1,!Flag.current_element, (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2)) let min_pinfo_of_node node = let ii = ii_of_node node in let (maxii, minii) = max_min_ii_by_pos ii in Ast_c.parse_info_of_info minii let (range_of_origin_ii: Ast_c.info list -> (int * int) option) = fun ii -> let ii = List.filter Ast_c.is_origintok ii in try let (max, min) = max_min_ii_by_pos ii in assert(Ast_c.is_origintok max); assert(Ast_c.is_origintok min); let strmax = Ast_c.str_of_info max in Some (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax) with _ -> None (*****************************************************************************) (* Ast getters *) (*****************************************************************************) let names_of_parameters_in_def def = match def.Ast_c.f_old_c_style with | Some _ -> pr2_once "names_of_parameters_in_def: f_old_c_style not handled"; [] | None -> let ftyp = def.Ast_c.f_type in let (ret, (params, bwrap)) = ftyp in params +> Common.map_filter (fun (param,ii) -> Ast_c.name_of_parameter param ) let names_of_parameters_in_macro xs = xs +> List.map (fun (xx, ii) -> let (s, ii2) = xx in s ) (* only used in ast_to_flow, so move it ? *) let rec stmt_elems_of_sequencable xs = xs +> Common.map (fun x -> match x with | Ast_c.StmtElem e -> [e] | Ast_c.CppDirectiveStmt _ | Ast_c.IfdefStmt _ -> pr2_once ("stmt_elems_of_sequencable: filter a directive"); [] | Ast_c.IfdefStmt2 (_ifdef, xxs) -> pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?"); xxs +> List.map (fun xs -> let xs' = stmt_elems_of_sequencable xs in xs' ) +> List.flatten ) +> List.flatten coccinelle-1.0.0-rc19/parsing_c/unparse_c.mli0000644000175000017500000000037712247437436020026 0ustar eugeneugentype ppmethod = PPnormal | PPviastr (* program -> output filename (often "/tmp/output.c") -> unit *) val pp_program : (Parse_c.toplevel2 * ppmethod) list -> Common.filename -> unit val pp_program_default: Parse_c.program2 -> Common.filename -> unit coccinelle-1.0.0-rc19/parsing_c/visitor_c.ml0000644000175000017500000015654212247437436017705 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c module F = Control_flow_c (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* todo? don't go in Include. Have a visitor flag ? disable_go_include ? * disable_go_type_annotation ? *) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_visit (*****************************************************************************) (* Functions to visit the Ast, and now also the CFG nodes *) (*****************************************************************************) (* Why this module ? * * The problem is that we manipulate the AST of C programs * and some of our analysis need only to specify an action for * specific cases, such as the function call case, and recurse * for the other cases. * Here is a simplification of our AST: * * type ctype = * | Basetype of ... * | Pointer of ctype * | Array of expression option * ctype * | ... * and expression = * | Ident of string * | FunCall of expression * expression list * | Postfix of ... * | RecordAccess of .. * | ... * and statement = * ... * and declaration = * ... * and program = * ... * * What we want is really write code like * * let my_analysis program = * analyze_all_expressions program (fun expr -> * match expr with * | FunCall (e, es) -> do_something() * | _ -> * ) * * The problem is how to write analyze_all_expressions * and find_a_way_to_recurse_for_all_the_other_cases. * * Our solution is to mix the ideas of visitor, pattern matching, * and continuation. Here is how it looks like * using our hybrid-visitor API: * * let my_analysis program = * Visitor.visit_iter program { * Visitor.kexpr = (fun k e -> * match e with * | FunCall (e, es) -> do_something() * | _ -> k e * ); * } * * You can of course also give action "hooks" for * kstatement, ktype, or kdeclaration. But we don't overuse * visitors and so it would be stupid to provide * kfunction_call, kident, kpostfix hooks as one can just * use pattern matching with kexpr to achieve the same effect. * * Note: when want to apply recursively, always apply the continuator * on the toplevel expression, otherwise may miss some intermediate steps. * Do * match expr with * | FunCall (e, es) -> ... * k expr * Or * match expr with * | FunCall (e, es) -> ... * Visitor_c.vk_expr bigf e * Not * match expr with * | FunCall (e, es) -> ... * k e * * * * * * Alternatives: from the caml mailing list: * "You should have a look at the Camlp4 metaprogramming facilities : * http://brion.inria.fr/gallium/index.php/Camlp4MapGenerator * You would write something like" : * let my_analysis program = * let analysis = object (self) * inherit fold as super * method expr = function * | FunCall (e, es) -> do_something (); self * | other -> super#expr other * end in analysis#expr * * The problem is that you don't have control about what is generated * and in our case we sometimes don't want to visit too much. For instance * our visitor don't recurse on the type annotation of expressions * Ok, this could be worked around, but the pb remains, you * don't have control and at some point you may want. In the same * way we want to enforce a certain order in the visit (ok this is not good, * but it's convenient) of ast elements. For instance first * processing the left part 'e' of a Funcall(e,es), then the arguments 'es'. * *) (* Visitor based on continuation. Cleaner than the one based on mutable * pointer functions that I had before. * src: based on a (vague) idea from Remy Douence. * * * * Diff with Julia's visitor ? She does: * * let ident r k i = * ... * let expression r k e = * ... * ... (List.map r.V0.combiner_expression expr_list) ... * ... * let res = V0.combiner bind option_default * mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode * donothing donothing donothing donothing * ident expression typeC donothing parameter declaration statement * donothing in * ... * collect_unitary_nonunitary * (List.concat (List.map res.V0.combiner_top_level t)) * * * * So she has to remember at which position you must put the 'expression' * function. I use record which is easier. * * When she calls recursively, her res.V0.combiner_xxx does not take bigf * in param whereas I do * | F.Decl decl -> Visitor_c.vk_decl bigf decl * And with the record she gets, she does not have to do my * multiple defs of function such as 'let al_type = V0.vk_type_s bigf' * * The code of visitor.ml is cleaner with julia because mutual recursive calls * are clean such as ... 'expression e' ... and not 'f (k, bigf) e' * or 'vk_expr bigf e'. * * So it is very dual: * - I give a record but then I must handle bigf. * - She gets a record, and gives a list of function * *) (* old: first version (only visiting expr) let (iter_expr:((expression -> unit) -> expression -> unit) -> expression -> unit) = fun f expr -> let rec k e = match e with | Constant c -> () | FunCall (e, es) -> f k e; List.iter (f k) es | CondExpr (e1, e2, e3) -> f k e1; f k e2; f k e3 | Sequence (e1, e2) -> f k e1; f k e2; | Assignment (e1, op, e2) -> f k e1; f k e2; | Postfix (e, op) -> f k e | Infix (e, op) -> f k e | Unary (e, op) -> f k e | Binary (e1, op, e2) -> f k e1; f k e2; | ArrayAccess (e1, e2) -> f k e1; f k e2; | RecordAccess (e, s) -> f k e | RecordPtAccess (e, s) -> f k e | SizeOfExpr e -> f k e | SizeOfType t -> () | _ -> failwith "to complete" in f k expr let ex1 = Sequence (Sequence (Constant (Ident "1"), Constant (Ident "2")), Constant (Ident "4")) let test = iter_expr (fun k e -> match e with | Constant (Ident x) -> Common.pr2 x | rest -> k rest ) ex1 ==> 1 2 4 *) (*****************************************************************************) (* Side effect style visitor *) (*****************************************************************************) (* Visitors for all langage concept, not just for expression. * * Note that I don't visit necesserally in the order of the token * found in the original file. So don't assume such hypothesis! * * todo? parameter ? *) type visitor_c = { kexpr: (expression -> unit) * visitor_c -> expression -> unit; kstatement: (statement -> unit) * visitor_c -> statement -> unit; ktype: (fullType -> unit) * visitor_c -> fullType -> unit; kdecl: (declaration -> unit) * visitor_c -> declaration -> unit; konedecl: (onedecl -> unit) * visitor_c -> onedecl -> unit; kparam: (parameterType -> unit) * visitor_c -> parameterType -> unit; kdef: (definition -> unit) * visitor_c -> definition -> unit; kname : (name -> unit) * visitor_c -> name -> unit; kini: (initialiser -> unit) * visitor_c -> initialiser -> unit; kfield: (field -> unit) * visitor_c -> field -> unit; kcppdirective: (cpp_directive -> unit) * visitor_c -> cpp_directive -> unit; kdefineval : (define_val -> unit) * visitor_c -> define_val -> unit; kstatementseq: (statement_sequencable -> unit) * visitor_c -> statement_sequencable -> unit; (* CFG *) knode: (F.node -> unit) * visitor_c -> F.node -> unit; (* AST *) ktoplevel: (toplevel -> unit) * visitor_c -> toplevel -> unit; kfragment: (string_fragment -> unit) * visitor_c -> string_fragment -> unit; kformat: (string_format -> unit) * visitor_c -> string_format -> unit; kinfo: (info -> unit) * visitor_c -> info -> unit; } let default_visitor_c = { kexpr = (fun (k,_) e -> k e); kstatement = (fun (k,_) st -> k st); ktype = (fun (k,_) t -> k t); kdecl = (fun (k,_) d -> k d); konedecl = (fun (k,_) d -> k d); kparam = (fun (k,_) d -> k d); kdef = (fun (k,_) d -> k d); kini = (fun (k,_) ie -> k ie); kname = (fun (k,_) x -> k x); kfragment = (fun (k,_) f -> k f); kformat = (fun (k,_) f -> k f); kinfo = (fun (k,_) ii -> k ii); knode = (fun (k,_) n -> k n); ktoplevel = (fun (k,_) p -> k p); kcppdirective = (fun (k,_) p -> k p); kdefineval = (fun (k,_) p -> k p); kstatementseq = (fun (k,_) p -> k p); kfield = (fun (k,_) p -> k p); } (* ------------------------------------------------------------------------ *) let rec vk_expr = fun bigf expr -> let iif ii = vk_ii bigf ii in let rec exprf e = bigf.kexpr (k,bigf) e (* !!! don't go in _typ !!! *) and k ((e,_typ), ii) = iif ii; match e with | Ident (name) -> vk_name bigf name | Constant (c) -> () | StringConstant(s,os,w) -> vk_string_fragments bigf s | FunCall (e, es) -> exprf e; vk_argument_list bigf es; | CondExpr (e1, e2, e3) -> exprf e1; do_option (exprf) e2; exprf e3 | Sequence (e1, e2) -> exprf e1; exprf e2; | Assignment (e1, op, e2) -> exprf e1; exprf e2; | Postfix (e, op) -> exprf e | Infix (e, op) -> exprf e | Unary (e, op) -> exprf e | Binary (e1, op, e2) -> exprf e1; exprf e2; | ArrayAccess (e1, e2) -> exprf e1; exprf e2; | RecordAccess (e, name) -> exprf e; vk_name bigf name | RecordPtAccess (e, name) -> exprf e; vk_name bigf name | SizeOfExpr (e) -> exprf e | SizeOfType (t) -> vk_type bigf t | Cast (t, e) -> vk_type bigf t; exprf e (* old: | StatementExpr (((declxs, statxs), is)), is2 -> * List.iter (vk_decl bigf) declxs; * List.iter (vk_statement bigf) statxs *) | StatementExpr ((statxs, is)) -> iif is; statxs +> List.iter (vk_statement_sequencable bigf); | Constructor (t, init) -> vk_type bigf t; vk_ini bigf init | ParenExpr (e) -> exprf e | New (None, t) -> vk_argument bigf t | New (Some ts, t) -> vk_argument_list bigf ts; vk_argument bigf t | Delete e -> vk_expr bigf e in exprf expr (* ------------------------------------------------------------------------ *) and vk_name = fun bigf ident -> let iif ii = vk_ii bigf ii in let rec namef x = bigf.kname (k,bigf) x and k id = match id with | RegularName (s, ii) -> iif ii | CppConcatenatedName xs -> xs +> List.iter (fun ((x,ii1), ii2) -> iif ii2; iif ii1; ); | CppVariadicName (s, ii) -> iif ii | CppIdentBuilder ((s,iis), xs) -> iif iis; xs +> List.iter (fun ((x,iix), iicomma) -> iif iicomma; iif iix; ) in namef ident (* ------------------------------------------------------------------------ *) and vk_statement = fun bigf (st: Ast_c.statement) -> let iif ii = vk_ii bigf ii in let rec statf x = bigf.kstatement (k,bigf) x and k st = let (unwrap_st, ii) = st in iif ii; match unwrap_st with | Labeled (Label (name, st)) -> vk_name bigf name; statf st; | Labeled (Case (e, st)) -> vk_expr bigf e; statf st; | Labeled (CaseRange (e, e2, st)) -> vk_expr bigf e; vk_expr bigf e2; statf st; | Labeled (Default st) -> statf st; | Compound statxs -> statxs +> List.iter (vk_statement_sequencable bigf) | ExprStatement (eopt) -> do_option (vk_expr bigf) eopt; | Selection (If (e, st1, st2)) -> vk_expr bigf e; statf st1; statf st2; | Selection (Switch (e, st)) -> vk_expr bigf e; statf st; | Iteration (While (e, st)) -> vk_expr bigf e; statf st; | Iteration (DoWhile (st, e)) -> statf st; vk_expr bigf e; | Iteration (For (first, (e2opt,i2), (e3opt,i3), st)) -> (match first with ForExp (e1opt,i1) -> statf (mk_st (ExprStatement (e1opt)) i1) | ForDecl decl -> vk_decl bigf decl); statf (mk_st (ExprStatement (e2opt)) i2); statf (mk_st (ExprStatement (e3opt)) i3); statf st; | Iteration (MacroIteration (s, es, st)) -> vk_argument_list bigf es; statf st; | Jump (Goto name) -> vk_name bigf name | Jump ((Continue|Break|Return)) -> () | Jump (ReturnExpr e) -> vk_expr bigf e; | Jump (GotoComputed e) -> vk_expr bigf e; | Decl decl -> vk_decl bigf decl | Asm asmbody -> vk_asmbody bigf asmbody | NestedFunc def -> vk_def bigf def | MacroStmt -> () in statf st and vk_statement_sequencable = fun bigf stseq -> let f = bigf.kstatementseq in let rec k stseq = match stseq with | StmtElem st -> vk_statement bigf st | CppDirectiveStmt directive -> vk_cpp_directive bigf directive | IfdefStmt ifdef -> vk_ifdef_directive bigf ifdef | IfdefStmt2 (ifdef, xxs) -> ifdef +> List.iter (vk_ifdef_directive bigf); xxs +> List.iter (fun xs -> xs +> List.iter (vk_statement_sequencable bigf) ) in f (k, bigf) stseq and vk_type = fun bigf t -> let iif ii = vk_ii bigf ii in let rec typef x = bigf.ktype (k, bigf) x and k t = let (q, t) = t in let (unwrap_q, iiq) = q in let (unwrap_t, iit) = t in iif iiq; iif iit; match unwrap_t with | NoType -> () | BaseType _ -> () | Pointer t -> typef t | Array (eopt, t) -> do_option (vk_expr bigf) eopt; typef t | Decimal(length,precision_opt) -> vk_expr bigf length; do_option (vk_expr bigf) precision_opt | FunctionType (returnt, paramst) -> typef returnt; (match paramst with | (ts, (b,iihas3dots)) -> iif iihas3dots; vk_param_list bigf ts ) | Enum (sopt, enumt) -> vk_enum_fields bigf enumt | StructUnion (sopt, _su, fields) -> vk_struct_fields bigf fields | StructUnionName (s, structunion) -> () | EnumName s -> () (* don't go in _typ *) | TypeName (name,_typ) -> vk_name bigf name | ParenType t -> typef t | TypeOfExpr e -> vk_expr bigf e | TypeOfType t -> typef t in typef t and vk_attribute = fun bigf attr -> let iif ii = vk_ii bigf ii in match attr with | Attribute s, ii -> iif ii (* ------------------------------------------------------------------------ *) and vk_decl = fun bigf d -> let iif ii = vk_ii bigf ii in let f = bigf.kdecl in let rec k decl = match decl with | DeclList (xs,ii) -> iif ii; xs +> List.iter (fun (x,ii) -> iif ii; vk_onedecl bigf x ); | MacroDecl ((s, args, ptvg),ii) -> iif ii; vk_argument_list bigf args | MacroDeclInit ((s, args, ini),ii) -> iif ii; vk_argument_list bigf args; vk_ini bigf ini in f (k, bigf) d and vk_decl_list = fun bigf ts -> ts +> List.iter (vk_decl bigf) and vk_onedecl = fun bigf onedecl -> let iif ii = vk_ii bigf ii in let f = bigf.konedecl in let rec k onedecl = match onedecl with | ({v_namei = var; v_type = t; v_type_bis = tbis; v_storage = _sto; v_attr = attrs}) -> vk_type bigf t; (* don't go in tbis *) attrs +> List.iter (vk_attribute bigf); var +> Common.do_option (fun (name, iniopt) -> vk_name bigf name; (match iniopt with Ast_c.NoInit -> () | Ast_c.ValInit(iini,init) -> iif [iini]; vk_ini bigf init | Ast_c.ConstrInit((init,ii)) -> iif ii; vk_argument_list bigf init) ) in f (k, bigf) onedecl and vk_ini = fun bigf ini -> let iif ii = vk_ii bigf ii in let rec inif x = bigf.kini (k, bigf) x and k (ini, iini) = iif iini; match ini with | InitExpr e -> vk_expr bigf e | InitList initxs -> initxs +> List.iter (fun (ini, ii) -> inif ini; iif ii; ) | InitDesignators (xs, e) -> xs +> List.iter (vk_designator bigf); inif e | InitFieldOld (s, e) -> inif e | InitIndexOld (e1, e) -> vk_expr bigf e1; inif e in inif ini and vk_ini_list = fun bigf ts -> let iif ii = vk_ii bigf ii in ts +> List.iter (fun (ini,iicomma) -> vk_ini bigf ini; iif iicomma; ) and vk_designator = fun bigf design -> let iif ii = vk_ii bigf ii in let (designator, ii) = design in iif ii; match designator with | DesignatorField s -> () | DesignatorIndex e -> vk_expr bigf e | DesignatorRange (e1, e2) -> vk_expr bigf e1; vk_expr bigf e2 (* ------------------------------------------------------------------------ *) and vk_struct_fields = fun bigf fields -> fields +> List.iter (vk_struct_field bigf); and vk_struct_field = fun bigf field -> let iif ii = vk_ii bigf ii in let f = bigf.kfield in let rec k field = match field with | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) -> vk_struct_fieldkinds bigf onefield_multivars; iif iiptvirg; | EmptyField info -> iif [info] | MacroDeclField ((s, args),ii) -> iif ii; vk_argument_list bigf args; | CppDirectiveStruct directive -> vk_cpp_directive bigf directive | IfdefStruct ifdef -> vk_ifdef_directive bigf ifdef in f (k, bigf) field and vk_struct_fieldkinds = fun bigf onefield_multivars -> let iif ii = vk_ii bigf ii in onefield_multivars +> List.iter (fun (field, iicomma) -> iif iicomma; match field with | Simple (nameopt, t) -> Common.do_option (vk_name bigf) nameopt; vk_type bigf t; | BitField (nameopt, t, info, expr) -> Common.do_option (vk_name bigf) nameopt; vk_info bigf info; vk_expr bigf expr; vk_type bigf t ) and vk_enum_fields = fun bigf enumt -> let iif ii = vk_ii bigf ii in enumt +> List.iter (fun ((name, eopt), iicomma) -> vk_oneEnum bigf (name, eopt); iif iicomma) and vk_oneEnum = fun bigf (name, eopt) -> let iif ii = vk_ii bigf ii in vk_name bigf name; eopt +> Common.do_option (fun (info, e) -> iif [info]; vk_expr bigf e ) (* ------------------------------------------------------------------------ *) and vk_def = fun bigf d -> let iif ii = vk_ii bigf ii in let f = bigf.kdef in let rec k d = match d with | {f_name = name; f_type = (returnt, (paramst, (b, iib))); f_storage = sto; f_body = statxs; f_attr = attrs; f_old_c_style = oldstyle; }, ii -> iif ii; iif iib; attrs +> List.iter (vk_attribute bigf); vk_type bigf returnt; vk_name bigf name; paramst +> List.iter (fun (param,iicomma) -> vk_param bigf param; iif iicomma; ); oldstyle +> Common.do_option (fun decls -> decls +> List.iter (vk_decl bigf); ); statxs +> List.iter (vk_statement_sequencable bigf) in f (k, bigf) d and vk_toplevel = fun bigf p -> let f = bigf.ktoplevel in let iif ii = vk_ii bigf ii in let rec k p = match p with | Declaration decl -> (vk_decl bigf decl) | Definition def -> (vk_def bigf def) | EmptyDef ii -> iif ii | MacroTop (s, xs, ii) -> vk_argument_list bigf xs; iif ii | CppTop top -> vk_cpp_directive bigf top | IfdefTop ifdefdir -> vk_ifdef_directive bigf ifdefdir | NotParsedCorrectly ii -> iif ii | FinalDef info -> vk_info bigf info | Namespace (tls, ii) -> List.iter (vk_toplevel bigf) tls in f (k, bigf) p and vk_program = fun bigf xs -> xs +> List.iter (vk_toplevel bigf) and vk_ifdef_directive bigf directive = let iif ii = vk_ii bigf ii in match directive with | IfdefDirective (ifkind, ii) -> iif ii and vk_cpp_directive bigf directive = let iif ii = vk_ii bigf ii in let f = bigf.kcppdirective in let rec k directive = match directive with | Include {i_include = (s, ii); i_content = copt; } -> (* go inside ? yes, can be useful, for instance for type_annotater. * The only pb may be that when we want to unparse the code we * don't want to unparse the included file but the unparser * and pretty_print do not use visitor_c so no problem. *) iif ii; copt +> Common.do_option (fun (file, asts) -> vk_program bigf asts ); | Define ((s,ii), (defkind, defval)) -> iif ii; vk_define_kind bigf defkind; vk_define_val bigf defval | Pragma ((s,ii), pragmainfo) -> iif ii; vk_pragmainfo bigf pragmainfo | OtherDirective (ii) -> iif ii in f (k, bigf) directive and vk_define_kind bigf defkind = match defkind with | DefineVar -> () | DefineFunc (params, ii) -> vk_ii bigf ii; params +> List.iter (fun ((s,iis), iicomma) -> vk_ii bigf iis; vk_ii bigf iicomma; ) | Undef -> () and vk_define_val bigf defval = let f = bigf.kdefineval in let rec k defval = match defval with | DefineExpr e -> vk_expr bigf e | DefineStmt stmt -> vk_statement bigf stmt | DefineDoWhileZero ((stmt, e), ii) -> vk_statement bigf stmt; vk_expr bigf e; vk_ii bigf ii | DefineFunction def -> vk_def bigf def | DefineType ty -> vk_type bigf ty | DefineText (s, ii) -> vk_ii bigf ii | DefineEmpty -> () | DefineInit ini -> vk_ini bigf ini (* christia: added multi *) | DefineMulti stmts -> List.fold_left (fun () d -> vk_statement bigf d) () stmts | DefineTodo -> pr2_once "DefineTodo"; () in f (k, bigf) defval and vk_pragmainfo bigf pragmainfo = match pragmainfo with PragmaTuple(args,ii) -> vk_ii bigf ii; vk_argument_list bigf args | PragmaIdList ids -> ids +> List.iter (function (id, _) -> vk_name bigf id) and vk_string_fragment = fun bigf x -> let rec fragf x = bigf.kfragment (k, bigf) x and k st = let (unwrap_x, ii) = x in vk_ii bigf ii; match unwrap_x with ConstantFragment s -> () | FormatFragment(fmt) -> vk_string_format bigf fmt in fragf x and vk_string_fragments = fun bigf ts -> ts +> List.iter (vk_string_fragment bigf) and vk_string_format = fun bigf x -> let rec fmtf x = bigf.kformat (k, bigf) x and k st = let (unwrap_x, ii) = x in vk_ii bigf ii; match unwrap_x with (* probably not very useful... *) ConstantFormat s -> () in fmtf x (* ------------------------------------------------------------------------ *) (* Now keep fullstatement inside the control flow node, * so that can then get in a MetaStmtVar the fullstatement to later * pp back when the S is in a +. But that means that * Exp will match an Ifnode even if there is no such exp * inside the condition of the Ifnode (because the exp may * be deeper, in the then branch). So have to not visit * all inside a node anymore. * * update: j'ai choisi d'accrocher au noeud du CFG a la * fois le fullstatement et le partialstatement et appeler le * visiteur que sur le partialstatement. *) and vk_node = fun bigf node -> let iif ii = vk_ii bigf ii in let infof info = vk_info bigf info in let f = bigf.knode in let rec k n = match F.unwrap n with | F.FunHeader (def) -> assert(null (fst def).f_body); vk_def bigf def; | F.Decl decl -> vk_decl bigf decl | F.ExprStatement (st, (eopt, ii)) -> iif ii; eopt +> do_option (vk_expr bigf) | F.IfHeader (_, (e,ii)) | F.SwitchHeader (_, (e,ii)) | F.WhileHeader (_, (e,ii)) | F.DoWhileTail (e,ii) -> iif ii; vk_expr bigf e | F.ForHeader (_st, ((ForExp (e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) -> iif i1; iif i2; iif i3; iif ii; e1opt +> do_option (vk_expr bigf); e2opt +> do_option (vk_expr bigf); e3opt +> do_option (vk_expr bigf); | F.ForHeader (_st, ((ForDecl decl, (e2opt,i2), (e3opt,i3)), ii)) -> iif i2; iif i3; iif ii; decl +> (vk_decl bigf); e2opt +> do_option (vk_expr bigf); e3opt +> do_option (vk_expr bigf); | F.MacroIterHeader (_s, ((s,es), ii)) -> iif ii; vk_argument_list bigf es; | F.ReturnExpr (_st, (e,ii)) -> iif ii; vk_expr bigf e | F.Case (_st, (e,ii)) -> iif ii; vk_expr bigf e | F.CaseRange (_st, ((e1, e2),ii)) -> iif ii; vk_expr bigf e1; vk_expr bigf e2 | F.CaseNode i -> () | F.DefineExpr e -> vk_expr bigf e | F.DefineType ft -> vk_type bigf ft | F.DefineHeader ((s,ii), (defkind)) -> iif ii; vk_define_kind bigf defkind; | F.DefineDoWhileZeroHeader (((),ii)) -> iif ii | F.DefineTodo -> pr2_once "DefineTodo"; () | F.PragmaHeader((s,ii), pragmainfo) -> iif ii; vk_pragmainfo bigf pragmainfo | F.Include {i_include = (s, ii);} -> iif ii; | F.MacroTop (s, args, ii) -> iif ii; vk_argument_list bigf args | F.IfdefHeader (info) -> vk_ifdef_directive bigf info | F.IfdefElse (info) -> vk_ifdef_directive bigf info | F.IfdefEndif (info) -> vk_ifdef_directive bigf info | F.Break (st,((),ii)) -> iif ii | F.Continue (st,((),ii)) -> iif ii | F.Default (st,((),ii)) -> iif ii | F.Return (st,((),ii)) -> iif ii | F.Goto (st, name, ((),ii)) -> vk_name bigf name; iif ii | F.Label (st, name, ((),ii)) -> vk_name bigf name; iif ii | F.DoHeader (st, info) -> infof info | F.Else info -> infof info | F.EndStatement iopt -> do_option infof iopt | F.SeqEnd (i, info) -> infof info | F.SeqStart (st, i, info) -> infof info | F.MacroStmt (st, ((),ii)) -> iif ii | F.Asm (st, (asmbody,ii)) -> iif ii; vk_asmbody bigf asmbody | ( F.TopNode|F.EndNode| F.ErrorExit|F.Exit|F.Enter|F.LoopFallThroughNode|F.FallThroughNode| F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| F.Fake ) -> () in f (k, bigf) node (* ------------------------------------------------------------------------ *) and vk_info = fun bigf info -> let rec infof ii = bigf.kinfo (k, bigf) ii and k i = () in infof info and vk_ii = fun bigf ii -> List.iter (vk_info bigf) ii (* ------------------------------------------------------------------------ *) and vk_argument = fun bigf arg -> let rec do_action = function | (ActMisc ii) -> vk_ii bigf ii in match arg with | Left e -> (vk_expr bigf) e | Right (ArgType param) -> vk_param bigf param | Right (ArgAction action) -> do_action action and vk_argument_list = fun bigf es -> let iif ii = vk_ii bigf ii in es +> List.iter (fun (e, ii) -> iif ii; vk_argument bigf e ) and vk_param = fun bigf param -> let iif ii = vk_ii bigf ii in let f = bigf.kparam in let rec k param = let {p_namei = swrapopt; p_register = (b, iib); p_type=ft} = param in swrapopt +> Common.do_option (vk_name bigf); iif iib; vk_type bigf ft in f (k, bigf) param and vk_param_list = fun bigf ts -> let iif ii = vk_ii bigf ii in ts +> List.iter (fun (param,iicomma) -> vk_param bigf param; iif iicomma; ) (* ------------------------------------------------------------------------ *) and vk_asmbody = fun bigf (string_list, colon_list) -> let iif ii = vk_ii bigf ii in iif string_list; colon_list +> List.iter (fun (Colon xs, ii) -> iif ii; xs +> List.iter (fun (x,iicomma) -> iif iicomma; (match x with | ColonMisc, ii -> iif ii | ColonExpr e, ii -> vk_expr bigf e; iif ii ) )) (* ------------------------------------------------------------------------ *) let vk_splitted element = fun bigf args_splitted -> let iif ii = vk_ii bigf ii in args_splitted +> List.iter (function | Left arg -> element bigf arg | Right ii -> iif ii ) let vk_args_splitted = vk_splitted vk_argument let vk_define_params_splitted = vk_splitted (fun bigf (_,ii) -> vk_ii bigf ii) let vk_params_splitted = vk_splitted vk_param let vk_enum_fields_splitted = vk_splitted vk_oneEnum let vk_inis_splitted = vk_splitted vk_ini let vk_ident_list_splitted = vk_splitted vk_name let vk_string_fragments_splitted = vk_splitted vk_string_fragment (* ------------------------------------------------------------------------ *) let vk_cst = fun bigf (cst, ii) -> let iif ii = vk_ii bigf ii in iif ii; (match cst with | Left cst -> () | Right s -> () ) (*****************************************************************************) (* "syntetisized attributes" style *) (*****************************************************************************) (* TODO port the xxs_s to new cpp construct too *) type 'a inout = 'a -> 'a (* _s for synthetizized attributes * * Note that I don't visit necesserally in the order of the token * found in the original file. So don't assume such hypothesis! *) type visitor_c_s = { kexpr_s: (expression inout * visitor_c_s) -> expression inout; kstatement_s: (statement inout * visitor_c_s) -> statement inout; ktype_s: (fullType inout * visitor_c_s) -> fullType inout; kdecl_s: (declaration inout * visitor_c_s) -> declaration inout; kdef_s: (definition inout * visitor_c_s) -> definition inout; kname_s: (name inout * visitor_c_s) -> name inout; kini_s: (initialiser inout * visitor_c_s) -> initialiser inout; kcppdirective_s: (cpp_directive inout * visitor_c_s) -> cpp_directive inout; kdefineval_s: (define_val inout * visitor_c_s) -> define_val inout; kstatementseq_s: (statement_sequencable inout * visitor_c_s) -> statement_sequencable inout; kstatementseq_list_s: (statement_sequencable list inout * visitor_c_s) -> statement_sequencable list inout; knode_s: (F.node inout * visitor_c_s) -> F.node inout; ktoplevel_s: (toplevel inout * visitor_c_s) -> toplevel inout; kfragment_s: (string_fragment inout * visitor_c_s) -> string_fragment inout; kformat_s: (string_format inout * visitor_c_s) -> string_format inout; kinfo_s: (info inout * visitor_c_s) -> info inout; } let default_visitor_c_s = { kexpr_s = (fun (k,_) e -> k e); kstatement_s = (fun (k,_) st -> k st); ktype_s = (fun (k,_) t -> k t); kdecl_s = (fun (k,_) d -> k d); kdef_s = (fun (k,_) d -> k d); kname_s = (fun (k,_) x -> k x); kini_s = (fun (k,_) d -> k d); ktoplevel_s = (fun (k,_) p -> k p); knode_s = (fun (k,_) n -> k n); kfragment_s = (fun (k,_) f -> k f); kformat_s = (fun (k,_) f -> k f); kinfo_s = (fun (k,_) i -> k i); kdefineval_s = (fun (k,_) x -> k x); kstatementseq_s = (fun (k,_) x -> k x); kstatementseq_list_s = (fun (k,_) x -> k x); kcppdirective_s = (fun (k,_) x -> k x); } let rec vk_expr_s = fun bigf expr -> let iif ii = vk_ii_s bigf ii in let rec exprf e = bigf.kexpr_s (k, bigf) e and k e = let ((unwrap_e, typ), ii) = e in (* !!! don't analyse optional type !!! * old: typ +> map_option (vk_type_s bigf) in *) let typ' = typ in let e' = match unwrap_e with | Ident (name) -> Ident (vk_name_s bigf name) | Constant (c) -> Constant (c) | StringConstant(s,os,w) -> StringConstant(s +> (List.map (vk_string_fragment_s bigf)),os,w) | FunCall (e, es) -> FunCall (exprf e, es +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii )) | CondExpr (e1, e2, e3) -> CondExpr (exprf e1, fmap exprf e2, exprf e3) | Sequence (e1, e2) -> Sequence (exprf e1, exprf e2) | Assignment (e1, op, e2) -> Assignment (exprf e1, op, exprf e2) | Postfix (e, op) -> Postfix (exprf e, op) | Infix (e, op) -> Infix (exprf e, op) | Unary (e, op) -> Unary (exprf e, op) | Binary (e1, op, e2) -> Binary (exprf e1, op, exprf e2) | ArrayAccess (e1, e2) -> ArrayAccess (exprf e1, exprf e2) | RecordAccess (e, name) -> RecordAccess (exprf e, vk_name_s bigf name) | RecordPtAccess (e, name) -> RecordPtAccess (exprf e, vk_name_s bigf name) | SizeOfExpr (e) -> SizeOfExpr (exprf e) | SizeOfType (t) -> SizeOfType (vk_type_s bigf t) | Cast (t, e) -> Cast (vk_type_s bigf t, exprf e) | StatementExpr (statxs, is) -> StatementExpr ( vk_statement_sequencable_list_s bigf statxs, iif is) | Constructor (t, init) -> Constructor (vk_type_s bigf t, vk_ini_s bigf init) | ParenExpr (e) -> ParenExpr (exprf e) | New (None, t) -> New (None, vk_argument_s bigf t) | New (Some ts, t) -> New (Some (ts +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii)), vk_argument_s bigf t) | Delete e -> Delete (vk_expr_s bigf e) in (e', typ'), (iif ii) in exprf expr and vk_argument_s bigf argument = let iif ii = vk_ii_s bigf ii in let rec do_action = function | (ActMisc ii) -> ActMisc (iif ii) in (match argument with | Left e -> Left (vk_expr_s bigf e) | Right (ArgType param) -> Right (ArgType (vk_param_s bigf param)) | Right (ArgAction action) -> Right (ArgAction (do_action action)) ) (* ------------------------------------------------------------------------ *) and vk_name_s = fun bigf ident -> let iif ii = vk_ii_s bigf ii in let rec namef x = bigf.kname_s (k,bigf) x and k id = (match id with | RegularName (s,ii) -> RegularName (s, iif ii) | CppConcatenatedName xs -> CppConcatenatedName (xs +> List.map (fun ((x,ii1), ii2) -> (x, iif ii1), iif ii2 )) | CppVariadicName (s, ii) -> CppVariadicName (s, iif ii) | CppIdentBuilder ((s,iis), xs) -> CppIdentBuilder ((s, iif iis), xs +> List.map (fun ((x,iix), iicomma) -> ((x, iif iix), iif iicomma))) ) in namef ident (* ------------------------------------------------------------------------ *) and vk_statement_s = fun bigf st -> let rec statf st = bigf.kstatement_s (k, bigf) st and k st = let (unwrap_st, ii) = st in let st' = match unwrap_st with | Labeled (Label (name, st)) -> Labeled (Label (vk_name_s bigf name, statf st)) | Labeled (Case (e, st)) -> Labeled (Case ((vk_expr_s bigf) e , statf st)) | Labeled (CaseRange (e, e2, st)) -> Labeled (CaseRange ((vk_expr_s bigf) e, (vk_expr_s bigf) e2, statf st)) | Labeled (Default st) -> Labeled (Default (statf st)) | Compound statxs -> Compound (vk_statement_sequencable_list_s bigf statxs) | ExprStatement (None) -> ExprStatement (None) | ExprStatement (Some e) -> ExprStatement (Some ((vk_expr_s bigf) e)) | Selection (If (e, st1, st2)) -> Selection (If ((vk_expr_s bigf) e, statf st1, statf st2)) | Selection (Switch (e, st)) -> Selection (Switch ((vk_expr_s bigf) e, statf st)) | Iteration (While (e, st)) -> Iteration (While ((vk_expr_s bigf) e, statf st)) | Iteration (DoWhile (st, e)) -> Iteration (DoWhile (statf st, (vk_expr_s bigf) e)) | Iteration (For (first, (e2opt,i2), (e3opt,i3), st)) -> let first = match first with ForExp (e1opt,i1) -> let e1opt' = statf (mk_st (ExprStatement (e1opt)) i1) in let e1' = Ast_c.unwrap_st e1opt' in let i1' = Ast_c.get_ii_st_take_care e1opt' in (match e1' with ExprStatement x1 -> ForExp (x1,i1') | _ -> failwith "cant be here if iterator keep ExprStatement as is") | ForDecl decl -> ForDecl (vk_decl_s bigf decl) in let e2opt' = statf (mk_st (ExprStatement (e2opt)) i2) in let e3opt' = statf (mk_st (ExprStatement (e3opt)) i3) in let e2' = Ast_c.unwrap_st e2opt' in let e3' = Ast_c.unwrap_st e3opt' in let i2' = Ast_c.get_ii_st_take_care e2opt' in let i3' = Ast_c.get_ii_st_take_care e3opt' in (match (e2', e3') with | ((ExprStatement x2), ((ExprStatement x3))) -> Iteration (For (first, (x2,i2'), (x3,i3'), statf st)) | x -> failwith "cant be here if iterator keep ExprStatement as is" ) | Iteration (MacroIteration (s, es, st)) -> Iteration (MacroIteration (s, es +> List.map (fun (e, ii) -> vk_argument_s bigf e, vk_ii_s bigf ii ), statf st )) | Jump (Goto name) -> Jump (Goto (vk_name_s bigf name)) | Jump (((Continue|Break|Return) as x)) -> Jump (x) | Jump (ReturnExpr e) -> Jump (ReturnExpr ((vk_expr_s bigf) e)) | Jump (GotoComputed e) -> Jump (GotoComputed (vk_expr_s bigf e)); | Decl decl -> Decl (vk_decl_s bigf decl) | Asm asmbody -> Asm (vk_asmbody_s bigf asmbody) | NestedFunc def -> NestedFunc (vk_def_s bigf def) | MacroStmt -> MacroStmt in st', vk_ii_s bigf ii in statf st and vk_statement_sequencable_s = fun bigf stseq -> let f = bigf.kstatementseq_s in let k stseq = match stseq with | StmtElem st -> StmtElem (vk_statement_s bigf st) | CppDirectiveStmt directive -> CppDirectiveStmt (vk_cpp_directive_s bigf directive) | IfdefStmt ifdef -> IfdefStmt (vk_ifdef_directive_s bigf ifdef) | IfdefStmt2 (ifdef, xxs) -> let ifdef' = List.map (vk_ifdef_directive_s bigf) ifdef in let xxs' = xxs +> List.map (fun xs -> xs +> vk_statement_sequencable_list_s bigf ) in IfdefStmt2(ifdef', xxs') in f (k, bigf) stseq and vk_statement_sequencable_list_s = fun bigf statxs -> let f = bigf.kstatementseq_list_s in let k xs = xs +> List.map (vk_statement_sequencable_s bigf) in f (k, bigf) statxs and vk_asmbody_s = fun bigf (string_list, colon_list) -> let iif ii = vk_ii_s bigf ii in iif string_list, colon_list +> List.map (fun (Colon xs, ii) -> Colon (xs +> List.map (fun (x, iicomma) -> (match x with | ColonMisc, ii -> ColonMisc, iif ii | ColonExpr e, ii -> ColonExpr (vk_expr_s bigf e), iif ii ), iif iicomma )), iif ii ) (* todo? a visitor for qualifier *) and vk_type_s = fun bigf t -> let rec typef t = bigf.ktype_s (k,bigf) t and iif ii = vk_ii_s bigf ii and k t = let (q, t) = t in let (unwrap_q, iiq) = q in (* strip_info_visitor needs iiq to be processed before iit *) let iif_iiq = iif iiq in let q' = unwrap_q in let (unwrap_t, iit) = t in let t' = match unwrap_t with | NoType -> NoType | BaseType x -> BaseType x | Pointer t -> Pointer (typef t) | Array (eopt, t) -> Array (fmap (vk_expr_s bigf) eopt, typef t) | Decimal (len,prec_opt) -> Decimal (vk_expr_s bigf len, fmap (vk_expr_s bigf) prec_opt) | FunctionType (returnt, paramst) -> FunctionType (typef returnt, (match paramst with | (ts, (b, iihas3dots)) -> (ts +> List.map (fun (param,iicomma) -> (vk_param_s bigf param, iif iicomma)), (b, iif iihas3dots)) )) | Enum (sopt, enumt) -> Enum (sopt, vk_enum_fields_s bigf enumt) | StructUnion (sopt, su, fields) -> StructUnion (sopt, su, vk_struct_fields_s bigf fields) | StructUnionName (s, structunion) -> StructUnionName (s, structunion) | EnumName s -> EnumName s | TypeName (name, typ) -> TypeName (vk_name_s bigf name, typ) | ParenType t -> ParenType (typef t) | TypeOfExpr e -> TypeOfExpr (vk_expr_s bigf e) | TypeOfType t -> TypeOfType (typef t) in (q', iif_iiq), (t', iif iit) in typef t and vk_attribute_s = fun bigf attr -> let iif ii = vk_ii_s bigf ii in match attr with | Attribute s, ii -> Attribute s, iif ii and vk_decl_s = fun bigf d -> let f = bigf.kdecl_s in let iif ii = vk_ii_s bigf ii in let rec k decl = match decl with | DeclList (xs, ii) -> DeclList (List.map aux xs, iif ii) | MacroDecl ((s, args, ptvg),ii) -> MacroDecl ((s, args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii), ptvg), iif ii) | MacroDeclInit ((s, args, ini),ii) -> MacroDeclInit ((s, args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii), vk_ini_s bigf ini), iif ii) and aux ({v_namei = var; v_type = t; v_type_bis = tbis; v_storage = sto; v_local= local; v_attr = attrs}, iicomma) = {v_namei = (var +> map_option (fun (name, iniopt) -> vk_name_s bigf name, (match iniopt with Ast_c.NoInit -> iniopt | Ast_c.ValInit(iini,init) -> Ast_c.ValInit(vk_info_s bigf iini,vk_ini_s bigf init) | Ast_c.ConstrInit((init,ii)) -> let init = init +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii) in Ast_c.ConstrInit((init, List.map (vk_info_s bigf) ii))) )); v_type = vk_type_s bigf t; (* !!! dont go in semantic related stuff !!! *) v_type_bis = tbis; v_storage = sto; v_local = local; v_attr = attrs +> List.map (vk_attribute_s bigf); }, iif iicomma in f (k, bigf) d and vk_decl_list_s = fun bigf decls -> decls +> List.map (vk_decl_s bigf) and vk_ini_s = fun bigf ini -> let rec inif ini = bigf.kini_s (k,bigf) ini and k ini = let (unwrap_ini, ii) = ini in let ini' = match unwrap_ini with | InitExpr e -> InitExpr (vk_expr_s bigf e) | InitList initxs -> InitList (initxs +> List.map (fun (ini, ii) -> inif ini, vk_ii_s bigf ii) ) | InitDesignators (xs, e) -> InitDesignators (xs +> List.map (vk_designator_s bigf), inif e ) | InitFieldOld (s, e) -> InitFieldOld (s, inif e) | InitIndexOld (e1, e) -> InitIndexOld (vk_expr_s bigf e1, inif e) in ini', vk_ii_s bigf ii in inif ini and vk_designator_s = fun bigf design -> let iif ii = vk_ii_s bigf ii in let (designator, ii) = design in (match designator with | DesignatorField s -> DesignatorField s | DesignatorIndex e -> DesignatorIndex (vk_expr_s bigf e) | DesignatorRange (e1, e2) -> DesignatorRange (vk_expr_s bigf e1, vk_expr_s bigf e2) ), iif ii and vk_struct_fieldkinds_s = fun bigf onefield_multivars -> let iif ii = vk_ii_s bigf ii in onefield_multivars +> List.map (fun (field, iicomma) -> (match field with | Simple (nameopt, t) -> Simple (Common.map_option (vk_name_s bigf) nameopt, vk_type_s bigf t) | BitField (nameopt, t, info, expr) -> BitField (Common.map_option (vk_name_s bigf) nameopt, vk_type_s bigf t, vk_info_s bigf info, vk_expr_s bigf expr) ), iif iicomma ) and vk_struct_field_s = fun bigf field -> let iif ii = vk_ii_s bigf ii in match field with (DeclarationField (FieldDeclList (onefield_multivars, iiptvirg))) -> DeclarationField (FieldDeclList (vk_struct_fieldkinds_s bigf onefield_multivars, iif iiptvirg)) | EmptyField info -> EmptyField (vk_info_s bigf info) | MacroDeclField ((s, args),ii) -> MacroDeclField ((s, args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii) ), iif ii) | CppDirectiveStruct directive -> CppDirectiveStruct (vk_cpp_directive_s bigf directive) | IfdefStruct ifdef -> IfdefStruct (vk_ifdef_directive_s bigf ifdef) and vk_struct_fields_s = fun bigf fields -> fields +> List.map (vk_struct_field_s bigf) and vk_enum_fields_s = fun bigf enumt -> let iif ii = vk_ii_s bigf ii in enumt +> List.map (fun ((name, eopt), iicomma) -> vk_oneEnum_s bigf (name, eopt), iif iicomma) and vk_oneEnum_s = fun bigf oneEnum -> let (name,eopt) = oneEnum in (vk_name_s bigf name, eopt +> Common.fmap (fun (info, e) -> vk_info_s bigf info, vk_expr_s bigf e )) and vk_def_s = fun bigf d -> let f = bigf.kdef_s in let iif ii = vk_ii_s bigf ii in let rec k d = match d with | {f_name = name; f_type = (returnt, (paramst, (b, iib))); f_storage = sto; f_body = statxs; f_attr = attrs; f_old_c_style = oldstyle; }, ii -> {f_name = vk_name_s bigf name; f_type = (vk_type_s bigf returnt, (paramst +> List.map (fun (param, iicomma) -> (vk_param_s bigf param, iif iicomma) ), (b, iif iib))); f_storage = sto; f_body = vk_statement_sequencable_list_s bigf statxs; f_attr = attrs +> List.map (vk_attribute_s bigf); f_old_c_style = oldstyle +> Common.map_option (fun decls -> decls +> List.map (vk_decl_s bigf) ); }, iif ii in f (k, bigf) d and vk_toplevel_s = fun bigf p -> let f = bigf.ktoplevel_s in let iif ii = vk_ii_s bigf ii in let rec k p = match p with | Declaration decl -> Declaration (vk_decl_s bigf decl) | Definition def -> Definition (vk_def_s bigf def) | EmptyDef ii -> EmptyDef (iif ii) | MacroTop (s, xs, ii) -> MacroTop (s, xs +> List.map (fun (elem, iicomma) -> vk_argument_s bigf elem, iif iicomma ), iif ii ) | CppTop top -> CppTop (vk_cpp_directive_s bigf top) | IfdefTop ifdefdir -> IfdefTop (vk_ifdef_directive_s bigf ifdefdir) | NotParsedCorrectly ii -> NotParsedCorrectly (iif ii) | FinalDef info -> FinalDef (vk_info_s bigf info) | Namespace (tls, ii) -> Namespace (List.map (vk_toplevel_s bigf) tls, ii) in f (k, bigf) p and vk_program_s = fun bigf xs -> xs +> List.map (vk_toplevel_s bigf) and vk_cpp_directive_s = fun bigf top -> let iif ii = vk_ii_s bigf ii in let f = bigf.kcppdirective_s in let rec k top = match top with (* go inside ? *) | Include {i_include = (s, ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = copt; } -> Include {i_include = (s, iif ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = copt +> Common.map_option (fun (file, asts) -> file, vk_program_s bigf asts ); } | Define ((s,ii), (defkind, defval)) -> Define ((s, iif ii), (vk_define_kind_s bigf defkind, vk_define_val_s bigf defval)) | Pragma((s,ii), pragmainfo) -> Pragma((s,iif ii), vk_pragmainfo_s bigf pragmainfo) | OtherDirective (ii) -> OtherDirective (iif ii) in f (k, bigf) top and vk_ifdef_directive_s = fun bigf ifdef -> let iif ii = vk_ii_s bigf ii in match ifdef with | IfdefDirective (ifkind, ii) -> IfdefDirective (ifkind, iif ii) and vk_define_kind_s = fun bigf defkind -> match defkind with | DefineVar -> DefineVar | DefineFunc (params, ii) -> DefineFunc (params +> List.map (fun ((s,iis),iicomma) -> ((s, vk_ii_s bigf iis), vk_ii_s bigf iicomma) ), vk_ii_s bigf ii ) | Undef -> Undef and vk_define_val_s = fun bigf x -> let f = bigf.kdefineval_s in let iif ii = vk_ii_s bigf ii in let rec k x = match x with | DefineExpr e -> DefineExpr (vk_expr_s bigf e) | DefineStmt st -> DefineStmt (vk_statement_s bigf st) | DefineDoWhileZero ((st,e),ii) -> let st' = vk_statement_s bigf st in let e' = vk_expr_s bigf e in DefineDoWhileZero ((st',e'), iif ii) | DefineFunction def -> DefineFunction (vk_def_s bigf def) | DefineType ty -> DefineType (vk_type_s bigf ty) | DefineText (s, ii) -> DefineText (s, iif ii) | DefineEmpty -> DefineEmpty | DefineInit ini -> DefineInit (vk_ini_s bigf ini) (* christia: added multi *) | DefineMulti ds -> DefineMulti (List.map (vk_statement_s bigf) ds) | DefineTodo -> pr2_once "DefineTodo"; DefineTodo in f (k, bigf) x and vk_pragmainfo_s bigf pragmainfo = match pragmainfo with PragmaTuple(args,ii) -> PragmaTuple( args +> List.map (fun (e,ii) -> vk_argument_s bigf e, vk_ii_s bigf ii), vk_ii_s bigf ii) | PragmaIdList ids -> PragmaIdList (ids +> List.map (function id, [] -> vk_name_s bigf id, [] | _ -> failwith "bad ident_list")) and vk_string_fragment_s = fun bigf x -> let rec fragf x = bigf.kfragment_s (k, bigf) x and k st = let (unwrap_x, ii) = x in let x' = match unwrap_x with ConstantFragment s -> ConstantFragment s | FormatFragment(fmt) -> FormatFragment(vk_string_format_s bigf fmt) in x', vk_ii_s bigf ii in fragf x and vk_string_fragments_s = fun bigf frags -> frags +> List.map (vk_string_fragment_s bigf) and vk_string_format_s = fun bigf x -> let rec fmtf x = bigf.kformat_s (k, bigf) x and k st = let (unwrap_x, ii) = x in let x' = match unwrap_x with ConstantFormat s -> ConstantFormat s in x', vk_ii_s bigf ii in fmtf x and vk_info_s = fun bigf info -> let rec infof ii = bigf.kinfo_s (k, bigf) ii and k i = i in infof info and vk_ii_s = fun bigf ii -> List.map (vk_info_s bigf) ii (* ------------------------------------------------------------------------ *) and vk_node_s = fun bigf node -> let iif ii = vk_ii_s bigf ii in let infof info = vk_info_s bigf info in let rec nodef n = bigf.knode_s (k, bigf) n and k node = F.rewrap node ( match F.unwrap node with | F.FunHeader (def) -> assert (null (fst def).f_body); F.FunHeader (vk_def_s bigf def) | F.Decl declb -> F.Decl (vk_decl_s bigf declb) | F.ExprStatement (st, (eopt, ii)) -> F.ExprStatement (st, (eopt +> map_option (vk_expr_s bigf), iif ii)) | F.IfHeader (st, (e,ii)) -> F.IfHeader (st, (vk_expr_s bigf e, iif ii)) | F.SwitchHeader (st, (e,ii)) -> F.SwitchHeader(st, (vk_expr_s bigf e, iif ii)) | F.WhileHeader (st, (e,ii)) -> F.WhileHeader (st, (vk_expr_s bigf e, iif ii)) | F.DoWhileTail (e,ii) -> F.DoWhileTail (vk_expr_s bigf e, iif ii) | F.ForHeader (st, ((first, (e2opt,i2), (e3opt,i3)), ii)) -> let first = match first with ForExp (e1opt,i1) -> ForExp (e1opt +> Common.map_option (vk_expr_s bigf), iif i1) | ForDecl decl -> ForDecl (vk_decl_s bigf decl) in F.ForHeader (st, ((first, (e2opt +> Common.map_option (vk_expr_s bigf), iif i2), (e3opt +> Common.map_option (vk_expr_s bigf), iif i3)), iif ii)) | F.MacroIterHeader (st, ((s,es), ii)) -> F.MacroIterHeader (st, ((s, es +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii)), iif ii)) | F.ReturnExpr (st, (e,ii)) -> F.ReturnExpr (st, (vk_expr_s bigf e, iif ii)) | F.Case (st, (e,ii)) -> F.Case (st, (vk_expr_s bigf e, iif ii)) | F.CaseRange (st, ((e1, e2),ii)) -> F.CaseRange (st, ((vk_expr_s bigf e1, vk_expr_s bigf e2), iif ii)) | F.CaseNode i -> F.CaseNode i | F.DefineHeader((s,ii), (defkind)) -> F.DefineHeader ((s, iif ii), (vk_define_kind_s bigf defkind)) | F.DefineExpr e -> F.DefineExpr (vk_expr_s bigf e) | F.DefineType ft -> F.DefineType (vk_type_s bigf ft) | F.DefineDoWhileZeroHeader ((),ii) -> F.DefineDoWhileZeroHeader ((),iif ii) | F.DefineTodo -> F.DefineTodo | F.PragmaHeader ((s,ii),pragmainfo) -> F.PragmaHeader((s,iif ii), vk_pragmainfo_s bigf pragmainfo) | F.Include {i_include = (s, ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = copt; } -> assert (copt =*= None); F.Include {i_include = (s, iif ii); i_rel_pos = h_rel_pos; i_is_in_ifdef = b; i_content = copt; } | F.MacroTop (s, args, ii) -> F.MacroTop (s, args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii), iif ii) | F.MacroStmt (st, ((),ii)) -> F.MacroStmt (st, ((),iif ii)) | F.Asm (st, (body,ii)) -> F.Asm (st, (vk_asmbody_s bigf body,iif ii)) | F.Break (st,((),ii)) -> F.Break (st,((),iif ii)) | F.Continue (st,((),ii)) -> F.Continue (st,((),iif ii)) | F.Default (st,((),ii)) -> F.Default (st,((),iif ii)) | F.Return (st,((),ii)) -> F.Return (st,((),iif ii)) | F.Goto (st, name, ((),ii)) -> F.Goto (st, vk_name_s bigf name, ((),iif ii)) | F.Label (st, name, ((),ii)) -> F.Label (st, vk_name_s bigf name, ((),iif ii)) | F.EndStatement iopt -> F.EndStatement (map_option infof iopt) | F.DoHeader (st, info) -> F.DoHeader (st, infof info) | F.Else info -> F.Else (infof info) | F.SeqEnd (i, info) -> F.SeqEnd (i, infof info) | F.SeqStart (st, i, info) -> F.SeqStart (st, i, infof info) | F.IfdefHeader (info) -> F.IfdefHeader (vk_ifdef_directive_s bigf info) | F.IfdefElse (info) -> F.IfdefElse (vk_ifdef_directive_s bigf info) | F.IfdefEndif (info) -> F.IfdefEndif (vk_ifdef_directive_s bigf info) | ( ( F.TopNode|F.EndNode| F.ErrorExit|F.Exit|F.Enter|F.LoopFallThroughNode|F.FallThroughNode| F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| F.Fake ) as x) -> x ) in nodef node (* ------------------------------------------------------------------------ *) and vk_param_s = fun bigf param -> let iif ii = vk_ii_s bigf ii in let {p_namei = swrapopt; p_register = (b, iib); p_type=ft} = param in { p_namei = swrapopt +> Common.map_option (vk_name_s bigf); p_register = (b, iif iib); p_type = vk_type_s bigf ft; } let vk_arguments_s = fun bigf args -> let iif ii = vk_ii_s bigf ii in args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii) let vk_inis_s = fun bigf inis -> let iif ii = vk_ii_s bigf ii in inis +> List.map (fun (e, ii) -> vk_ini_s bigf e, iif ii) let vk_params_s = fun bigf args -> let iif ii = vk_ii_s bigf ii in args +> List.map (fun (p,ii) -> vk_param_s bigf p, iif ii) let vk_cst_s = fun bigf (cst, ii) -> let iif ii = vk_ii_s bigf ii in (match cst with | Left cst -> Left cst | Right s -> Right s ), iif ii (* ------------------------------------------------------------------------ *) let vk_splitted_s element = fun bigf args_splitted -> let iif ii = vk_ii_s bigf ii in args_splitted +> List.map (function | Left arg -> Left (element bigf arg) | Right ii -> Right (iif ii) ) let vk_args_splitted_s = vk_splitted_s vk_argument_s let vk_params_splitted_s = vk_splitted_s vk_param_s let vk_define_params_splitted_s = vk_splitted_s (fun bigf (s,ii) -> (s,vk_ii_s bigf ii)) let vk_enum_fields_splitted_s = vk_splitted_s vk_oneEnum_s let vk_inis_splitted_s = vk_splitted_s vk_ini_s let vk_ident_list_splitted_s = vk_splitted_s vk_name_s let vk_string_fragments_splitted_s = vk_splitted_s vk_string_fragment_s coccinelle-1.0.0-rc19/parsing_c/token_helpers.mli0000644000175000017500000000364212247437436020707 0ustar eugeneugen val is_space : Parser_c.token -> bool val is_just_comment : Parser_c.token -> bool val is_just_comment_or_space : Parser_c.token -> bool val is_comment : Parser_c.token -> bool val is_not_comment : Parser_c.token -> bool val is_real_comment : Parser_c.token -> bool val is_fake_comment : Parser_c.token -> bool val is_not_in_ast : Parser_c.token -> bool val is_cpp_instruction : Parser_c.token -> bool val is_gcc_token : Parser_c.token -> bool val is_eof : Parser_c.token -> bool val is_eom : Parser_c.token -> bool val is_statement : Parser_c.token -> bool val is_start_of_something : Parser_c.token -> bool val is_binary_operator : Parser_c.token -> bool val is_stuff_taking_parenthized : Parser_c.token -> bool val is_opar : Parser_c.token -> bool val is_cpar : Parser_c.token -> bool val is_obrace : Parser_c.token -> bool val is_cbrace : Parser_c.token -> bool val is_ident_like: Parser_c.token -> bool (* ---------------------------------------------------------------------- *) val info_of_tok : Parser_c.token -> Ast_c.info val visitor_info_of_tok : (Ast_c.info -> Ast_c.info) -> Parser_c.token -> Parser_c.token (* ---------------------------------------------------------------------- *) val linecol_of_tok : Parser_c.token -> int * int val col_of_tok : Parser_c.token -> int val line_of_tok : Parser_c.token -> int val pos_of_tok : Parser_c.token -> int val str_of_tok : Parser_c.token -> string val file_of_tok : Parser_c.token -> Common.filename val pinfo_of_tok : Parser_c.token -> Ast_c.parse_info (* val mark_of_tok : Parser_c.token -> Ast_c.mark_token *) val is_origin : Parser_c.token -> bool val is_expanded : Parser_c.token -> bool val is_fake : Parser_c.token -> bool val is_abstract : Parser_c.token -> bool val is_same_line_or_close: int -> Parser_c.token -> bool coccinelle-1.0.0-rc19/parsing_c/lexer_parser.mli0000644000175000017500000000210112247437436020525 0ustar eugeneugen val _handle_typedef : bool ref val enable_typedef : unit -> unit val disable_typedef : unit -> unit val is_enabled_typedef : unit -> bool (* private *) type identkind = TypeDefI | IdentI val _typedef : (string, identkind) Common.scoped_h_env ref val add_ident : string -> unit val add_typedef : string -> unit val add_typedef_root : string -> unit val new_scope : unit -> unit val del_scope : unit -> unit val is_typedef : string -> bool val lexer_reset_typedef : (string, identkind) Common.scoped_h_env option (* known typedefs *) -> unit val _old_state : (string, identkind) Common.scoped_h_env ref val save_typedef_state : unit -> unit val restore_typedef_state : unit -> unit type context = | InTopLevel | InFunction | InStruct | InParameter | InInitializer | InEnum type lexer_hint = { mutable context_stack: context Common.stack; } val _lexer_hint : lexer_hint ref val current_context: unit -> context val push_context: context -> unit val pop_context: unit -> unit val default_hint : unit -> lexer_hint val is_top_or_struct : context -> bool coccinelle-1.0.0-rc19/parsing_c/token_annot.mli0000644000175000017500000000034012247437436020354 0ustar eugeneugentype annot_key = Exclude_start | Exclude_end type annot_val = Unit type annots val empty : annots val get_annot : annots -> annot_key -> annot_val option val put_annot : annot_key -> annot_val -> annots -> annots coccinelle-1.0.0-rc19/parsing_c/unparse_hrule.mli0000644000175000017500000000032212247437436020711 0ustar eugeneugen(* program -> output filename (often "/tmp/output.c") -> unit *) val pp_rule : Ast_cocci.metavar list (* local metavars only *) -> Ast_cocci.rule -> Ast_c.metavars_binding -> Common.filename -> unit coccinelle-1.0.0-rc19/parsing_c/parser_c.mly0000644000175000017500000021104112247437436017655 0ustar eugeneugen%{ (* Yoann Padioleau * * Copyright (C) 2002, 2006, 2007, 2008, 2009 Yoann Padioleau * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c module LP = Lexer_parser open Lexer_parser (* for the fields *) open Semantic_c (* Semantic exn *) module T = Token_c (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let warning s v = if !Flag_parsing_c.verbose_parsing then Common.warning ("PARSING: " ^ s) v else v let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Parse helpers functions *) (*****************************************************************************) (*-------------------------------------------------------------------------- *) (* Type related *) (*-------------------------------------------------------------------------- *) type shortLong = Short | Long | LongLong type decl = { storageD: storagebis wrap; typeD: ((sign option) * (shortLong option) * (typeCbis option)) wrap; qualifD: typeQualifierbis wrap; inlineD: bool wrap; (* note: have a full_info: parse_info list; to remember ordering * between storage, qualifier, type ? well this info is already in * the Ast_c.info, just have to sort them to get good order *) } let nullDecl = { storageD = NoSto, []; typeD = (None, None, None), []; qualifD = nullQualif; inlineD = false, []; } let fake_pi = Common.fake_parse_info let addStorageD = function | ((x,ii), ({storageD = (NoSto,[])} as v)) -> { v with storageD = (x, [ii]) } | ((x,ii), ({storageD = (y, ii2)} as v)) -> if x =*= y then warning "duplicate storage classes" v else raise (Semantic ("multiple storage classes", fake_pi)) let addInlineD = function | ((true,ii), ({inlineD = (false,[])} as v)) -> { v with inlineD=(true,[ii])} | ((true,ii), ({inlineD = (true, ii2)} as v)) -> warning "duplicate inline" v | _ -> raise (Impossible 86) let addTypeD = function | ((Left3 Signed,ii) ,({typeD = ((Some Signed, b,c),ii2)} as v)) -> warning "duplicate 'signed'" v | ((Left3 UnSigned,ii) ,({typeD = ((Some UnSigned,b,c),ii2)} as v)) -> warning "duplicate 'unsigned'" v | ((Left3 _,ii), ({typeD = ((Some _,b,c),ii2)} as _v)) -> raise (Semantic ("both signed and unsigned specified", fake_pi)) | ((Left3 x,ii), ({typeD = ((None,b,c),ii2)} as v)) -> {v with typeD = (Some x,b,c),ii ++ ii2} | ((Middle3 Short,ii), ({typeD = ((a,Some Short,c),ii2)} as v)) -> warning "duplicate 'short'" v (* gccext: long long allowed *) | ((Middle3 Long,ii), ({typeD = ((a,Some Long ,c),ii2)} as v)) -> { v with typeD = (a, Some LongLong, c),ii++ii2 } | ((Middle3 Long,ii), ({typeD = ((a,Some LongLong ,c),ii2)} as v)) -> warning "triplicate 'long'" v | ((Middle3 _,ii), ({typeD = ((a,Some _,c),ii2)} as _v)) -> raise (Semantic ("both long and short specified", fake_pi)) | ((Middle3 x,ii), ({typeD = ((a,None,c),ii2)} as v)) -> {v with typeD = (a, Some x,c),ii++ii2} | ((Right3 t,ii), ({typeD = ((a,b,Some x),ii2)} as _v)) -> raise (Semantic ((Printf.sprintf "two or more data types: t %s ii %s\ntypeD %s ii2 %s\n" (Dumper.dump t) (Dumper.dump ii) (Dumper.dump x) (Dumper.dump ii2)), fake_pi)) | ((Right3 t,ii), ({typeD = ((a,b,None),ii2)} as v)) -> {v with typeD = (a,b, Some t),ii++ii2} let addQualif = function | ({const=true}, ({const=true} as x)) -> warning "duplicate 'const'" x | ({volatile=true},({volatile=true} as x))-> warning "duplicate 'volatile'" x | ({const=true}, v) -> {v with const=true} | ({volatile=true}, v) -> {v with volatile=true} | _ -> internal_error "there is no noconst or novolatile keyword" let addQualifD ((qu,ii), ({qualifD = (v,ii2)} as x)) = { x with qualifD = (addQualif (qu, v),ii::ii2) } (*-------------------------------------------------------------------------- *) (* Declaration/Function related *) (*-------------------------------------------------------------------------- *) (* stdC: type section, basic integer types (and ritchie) * To understand the code, just look at the result (right part of the PM) * and go back. *) let (fixDeclSpecForDecl: decl -> (fullType * (storage wrap))) = function {storageD = (st,iist); qualifD = (qu,iiq); typeD = (ty,iit); inlineD = (inline,iinl); } -> let ty',iit' = (match ty with | (None,None,None) -> (* generate fake_info, otherwise type_annotater can crash in * offset. *) warning "type defaults to 'int'" (defaultInt, [fakeInfo fake_pi]) | (None, None, Some t) -> (t, iit) | (Some sign, None, (None| Some (BaseType (IntType (Si (_,CInt)))))) -> BaseType(IntType (Si (sign, CInt))), iit | ((None|Some Signed),Some x,(None|Some(BaseType(IntType (Si (_,CInt)))))) -> BaseType(IntType (Si (Signed, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit | (Some UnSigned, Some x, (None| Some (BaseType (IntType (Si (_,CInt))))))-> BaseType(IntType (Si (UnSigned, [Short,CShort; Long, CLong; LongLong, CLongLong] +> List.assoc x))), iit | (Some sign, None, (Some (BaseType (IntType CChar)))) -> BaseType(IntType (Si (sign, CChar2))), iit | (None, Some Long,(Some(BaseType(FloatType CDouble)))) -> BaseType (FloatType (CLongDouble)), iit | (Some _,_, Some _) -> (*mine*) raise (Semantic ("signed, unsigned valid only for char and int", fake_pi)) | (_,Some _,(Some(BaseType(FloatType (CFloat|CLongDouble))))) -> raise (Semantic ("long or short specified with floating type", fake_pi)) | (_,Some Short,(Some(BaseType(FloatType CDouble)))) -> raise (Semantic ("the only valid combination is long double", fake_pi)) | (_, Some _, Some _) -> (* mine *) raise (Semantic ("long, short valid only for int or float", fake_pi)) (* if do short uint i, then gcc say parse error, strange ? it is * not a parse error, it is just that we dont allow with typedef * either short/long or signed/unsigned. In fact, with * parse_typedef_fix2 (with et() and dt()) now I say too parse * error so this code is executed only when do short struct * {....} and never with a typedef cos now we parse short uint i * as short ident ident => parse error (cos after first short i * pass in dt() mode) *) ) in ((qu, iiq), (ty', iit')) ,((st, inline),iist++iinl) let fixDeclSpecForParam = function ({storageD = (st,iist)} as r) -> let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in match st with | (Sto Register) -> (v, true), iist | NoSto -> (v, false), iist | _ -> raise (Semantic ("storage class specified for parameter of function", fake_pi)) let fixDeclSpecForMacro = function ({storageD = (st,iist)} as r) -> let ((qu,ty) as v,_st) = fixDeclSpecForDecl r in match st with | NoSto -> v | _ -> raise (Semantic ("storage class specified for macro type decl", fake_pi)) let fixDeclSpecForFuncDef x = let (returnType,storage) = fixDeclSpecForDecl x in (match fst (unwrap storage) with | StoTypedef -> raise (Semantic ("function definition declared 'typedef'", fake_pi)) | _ -> (returnType, storage) ) (* parameter: (this is the context where we give parameter only when * in func DEFINITION not in funct DECLARATION) We must have a name. * This function ensure that we give only parameterTypeDecl with well * formed Classic constructor todo?: do we accept other declaration * in ? so I must add them to the compound of the deffunc. I dont * have to handle typedef pb here cos C forbid to do VF f { ... } * with VF a typedef of func cos here we dont see the name of the * argument (in the typedef) *) let (fixOldCDecl: fullType -> fullType) = fun ty -> match Ast_c.unwrap_typeC ty with | FunctionType (fullt, (params, (b, iib))) -> (* stdC: If the prototype declaration declares a parameter for a * function that you are defining (it is part of a function * definition), then you must write a name within the declarator. * Otherwise, you can omit the name. *) (match params with | [{p_namei = None; p_type = ty2},_] -> (match Ast_c.unwrap_typeC ty2 with | BaseType Void -> ty | _ -> pr2_once ("SEMANTIC:parameter name omitted, but I continue"); ty ) | params -> (params +> List.iter (fun (param,_) -> match param with | {p_namei = None} -> (* if majuscule, then certainly macro-parameter *) pr2_once ("SEMANTIC:parameter name omitted, but I continue"); | _ -> () )); ty ) (* todo? can we declare prototype in the decl or structdef, ... => length <> but good kan meme *) | _ -> (* gcc say parse error but dont see why *) raise (Semantic ("seems this is not a function", fake_pi)) let fixFunc (typ, compound, old_style_opt) = let (cp,iicp) = compound in let (name, ty, (st,iist), attrs) = typ in let (qu, tybis) = ty in match Ast_c.unwrap_typeC ty with | FunctionType (fullt, (params,abool)) -> let iifunc = Ast_c.get_ii_typeC_take_care tybis in let iistart = Ast_c.fakeInfo () in assert (qu =*= nullQualif); (match params with | [{p_namei= None; p_type = ty2}, _] -> (match Ast_c.unwrap_typeC ty2 with | BaseType Void -> () | _ -> (* failwith "internal errror: fixOldCDecl not good" *) () ) | params -> params +> List.iter (function | ({p_namei = Some s}, _) -> () | _ -> () (* failwith "internal errror: fixOldCDecl not good" *) ) ); (* bugfix: cf tests_c/function_pointer4.c. * Apparemment en C on peut syntaxiquement ecrire ca: * * void a(int)(int x); * mais apres gcc gueule au niveau semantique avec: * xxx.c:1: error: 'a' declared as function returning a function * Je ne faisais pas cette verif. Sur du code comme * void METH(foo)(int x) { ...} , le parser croit (a tort) que foo * est un typedef, et donc c'est parsé comme l'exemple precedent, * ce qui ensuite confuse l'unparser qui n'est pas habitué * a avoir dans le returnType un FunctionType et qui donc * pr_elem les ii dans le mauvais sens ce qui genere au final * une exception. Hence this fix to at least detect the error * at parsing time (not unparsing time). *) (match Ast_c.unwrap_typeC fullt with | FunctionType _ -> let s = Ast_c.str_of_name name in let iis = Ast_c.info_of_name name in pr2 (spf "WEIRD: %s declared as function returning a function." s); pr2 (spf "This is probably because of a macro. Extend standard.h"); raise (Semantic (spf "error: %s " s, Ast_c.parse_info_of_info iis)) | _ -> () ); (* it must be nullQualif,cos parser construct only this*) {f_name = name; f_type = (fullt, (params, abool)); f_storage = st; f_body = cp; f_attr = attrs; f_old_c_style = old_style_opt; }, (iifunc++iicp++[iistart]++iist) | _ -> raise (Semantic ("you are trying to do a function definition but you dont give " ^ "any parameter", fake_pi)) (*-------------------------------------------------------------------------- *) (* parse_typedef_fix2 *) (*-------------------------------------------------------------------------- *) let dt s () = if !Flag_parsing_c.debug_etdt then pr2 ("<" ^ s); LP.disable_typedef () let et s () = if !Flag_parsing_c.debug_etdt then pr2 (">" ^ s); LP.enable_typedef () let fix_add_params_ident x = let (s, ty, st, _attrs) = x in match Ast_c.unwrap_typeC ty with | FunctionType (fullt, (params, bool)) -> (match params with | [{p_namei=None; p_type=ty2}, _] -> (match Ast_c.unwrap_typeC ty2 with | BaseType Void -> () | _ -> (* failwith "internal errror: fixOldCDecl not good" *) () ) | params -> params +> List.iter (function | ({p_namei= Some name}, _) -> LP.add_ident (Ast_c.str_of_name s) | _ -> () (* failwith "internal errror: fixOldCDecl not good" *) ) ) | _ -> () (*-------------------------------------------------------------------------- *) (* shortcuts *) (*-------------------------------------------------------------------------- *) let mk_e e ii = Ast_c.mk_e e ii let mk_string_wrap (s,info) = (s, [info]) %} /*(*****************************************************************************)*/ /*(* Tokens *)*/ /*(*************************************************************************)*/ /* (* * Some tokens are not even used in this file because they are filtered * in some intermediate phase. But they still must be declared because * ocamllex may generate them, or some intermediate phase may also * generate them (like some functions in parsing_hacks.ml) *) */ %token TUnknown /*(* unrecognized token *)*/ /*(* coupling: Token_helpers.is_real_comment *)*/ %token TCommentSpace TCommentNewline TComment /*(*-----------------------------------------*)*/ /*(* the normal tokens *)*/ /*(*-----------------------------------------*)*/ %token <(string * (Ast_c.sign * Ast_c.base)) * Ast_c.info> TInt %token <(string * Ast_c.floatType) * Ast_c.info> TFloat %token <(string * Ast_c.isWchar) * Ast_c.info> TChar %token <(string * Ast_c.isWchar) * Ast_c.info> TString %token <(string * Ast_c.isWchar) * Ast_c.info> TQuote %token TPct %token TFormat TSubString %token <(string * string (*n*) * string (*p*)) * Ast_c.info> TDecimal %token TIdent %token TKRParam %token Tconstructorname /* parsing_hack for c++ */ /*(* appears mostly after some fix_xxx in parsing_hack *)*/ %token TypedefIdent /* (* Some tokens like TOPar and TCPar are used as synchronisation stuff, * in parsing_hack.ml. So if define special tokens like TOParDefine and * TCParEOL, then take care to also modify in Token_helpers. *) */ %token TOPar TCPar TOBrace TCBrace TOCro TCCro %token TDot TComma TPtrOp %token TInc TDec %token TAssign %token TEq %token TWhy TTilde TBang %token TEllipsis %token TDotDot %token TPtVirg %token TOrLog TAndLog TOr TXor TAnd TEqEq TNotEq TInf TSup TInfEq TSupEq TShl TShr TPlus TMinus TMul TDiv TMod TMax TMin %token Tchar Tshort Tint Tdouble Tfloat Tlong Tunsigned Tsigned Tvoid Tsize_t Tssize_t Tptrdiff_t Tauto Tregister Textern Tstatic Ttypedef Tconst Tvolatile Tstruct Tunion Tenum Tdecimal Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif Twhile Treturn Tgoto Tdefault Tsizeof Tnew Tdelete TOParCplusplusInit Tnamespace /*(* C99 *)*/ %token Trestrict /*(*-----------------------------------------*)*/ /*(* gccext: extra tokens *)*/ /*(*-----------------------------------------*)*/ %token Tasm %token Tattribute %token TattributeNoarg %token Tinline %token Ttypeof /*(*-----------------------------------------*)*/ /*(* cppext: extra tokens *)*/ /*(*-----------------------------------------*)*/ /*(* coupling with Token_helpers.is_cpp_token *)*/ /*(*---------------*)*/ /*(* define *)*/ /*(*---------------*)*/ %token TDefine %token <(string * Ast_c.info)> TDefParamVariadic /*(* disappear after fix_tokens_define *)*/ %token TCppEscapedNewline %token TCppConcatOp /*(* appear after fix_tokens_define *)*/ %token TOParDefine %token TOBraceDefineInit %token <(string * Ast_c.info)> TIdentDefine /*(* same *)*/ %token TDefEOL /*(* same *)*/ /*(*---------------*)*/ /*(* include *)*/ /*(*---------------*)*/ /*(* used only in lexer_c, then transformed in comment or splitted in tokens *)*/ %token <(string * string * bool ref * Ast_c.info)> TInclude /*(* tokens coming from above, generated in parse_c from TInclude, etc *)*/ %token <(Ast_c.info * bool ref)> TIncludeStart %token <(string * Ast_c.info)> TIncludeFilename /*(*---------------*)*/ /*(* ifdef *)*/ /*(*---------------*)*/ /*(* coupling: Token_helpers.is_cpp_instruction *)*/ %token <((int * int) option ref * Ast_c.info)> TIfdef TIfdefelse TIfdefelif TEndif %token <(bool * (int * int) option ref * Ast_c.info)> TIfdefBool TIfdefMisc TIfdefVersion /*(*---------------*)*/ /*(* other *)*/ /*(*---------------*)*/ %token TUndef %token TPragma %token TCppDirectiveOther /*(*---------------*)*/ /*(* macro use *)*/ /*(*---------------*)*/ /*(* appear after fix_tokens_cpp, cf also parsing_hacks#hint *)*/ %token <(string * Ast_c.info)> TMacroAttr %token <(string * Ast_c.info)> TMacroStmt %token <(string * Ast_c.info)> TMacroIdentBuilder /*(* no need value for the moment *)*/ %token <(string * Ast_c.info)> TMacroString %token <(string * Ast_c.info)> TMacroDecl %token TMacroDeclConst %token <(string * Ast_c.info)> TMacroIterator /*(* %token <(string * Ast_c.info)> TMacroTop %token <(string * Ast_c.info)> TMacroStructDecl *)*/ %token <(string * Ast_c.info)> TMacroAttrStorage /*(*---------------*)*/ /*(* other *)*/ /*(*---------------*)*/ /*(* should disappear after parsing_hack *)*/ %token TCommentSkipTagStart TCommentSkipTagEnd /*(* appear after parsing_hack *)*/ %token TCParEOL %token TAction /*(* TCommentMisc still useful ? obsolete ? *)*/ %token TCommentMisc %token <(Token_c.cppcommentkind * Ast_c.info)> TCommentCpp /*(*-----------------------------------------*)*/ %token EOF /*(*-----------------------------------------*)*/ /*(* must be at the top so that it has the lowest priority *)*/ %nonassoc SHIFTHERE %nonassoc Telse %left TOrLog %left TAndLog %left TOr %left TXor %left TAnd %left TEqEq TNotEq %left TInf TSup TInfEq TSupEq %left TShl TShr %left TPlus TMinus %left TMul TDiv TMod TMin TMax /*(*************************************************************************)*/ /*(* Rules type declaration *)*/ /*(*************************************************************************)*/ %start main celem statement expr type_name %type main %type celem %type statement %type expr %type type_name %% /*(*************************************************************************)*/ /* (* TOC: * toplevel (obsolete) * * ident * expression * statement * types with * - left part (type_spec, qualif), * - right part (declarator, abstract declarator) * - aux part (parameters) * declaration, storage, initializers * struct * enum * cpp directives * celem (=~ main) * * generic workarounds (obrace, cbrace for context setting) * xxx_list, xxx_opt *) */ /*(*************************************************************************)*/ /*(*************************************************************************)*/ /*(* toplevel *)*/ /*(*************************************************************************)*/ /*(* no more used; now that use error recovery *)*/ main: translation_unit EOF { $1 } translation_unit: | { [] } | translation_unit external_declaration { !LP._lexer_hint.context_stack <- [LP.InTopLevel]; $1 ++ [$2] } | translation_unit Tnamespace TIdent TOBrace translation_unit TCBrace { !LP._lexer_hint.context_stack <- [LP.InTopLevel]; $1 ++ [Namespace ($5, [$2; snd $3; $4; $6])] } /*(*************************************************************************)*/ /*(* ident *)*/ /*(*************************************************************************)*/ /*(* Why this ? Why not s/ident/TIdent ? cos there is multiple namespaces in C, * so a label can have the same name that a typedef, same for field and tags * hence sometimes the use of ident instead of TIdent. *)*/ ident: | TIdent { $1 } | TypedefIdent { $1 } identifier: | TIdent { $1 } /* (* cppext: string concatenation of idents * also cppext: gccext: ##args for variadic macro *) */ identifier_cpp: | TIdent { RegularName (mk_string_wrap $1) } | ident_extra_cpp { $1 } ident_cpp: | TIdent { RegularName (mk_string_wrap $1) } | TypedefIdent { RegularName (mk_string_wrap $1) } | ident_extra_cpp { $1 } ident_extra_cpp: | TIdent TCppConcatOp identifier_cpp_list { CppConcatenatedName ( match $3 with | [] -> raise (Impossible 87) | (x,concatnull)::xs -> assert(null concatnull); (mk_string_wrap $1, [])::(x,[$2])::xs ) } | TCppConcatOp TIdent { CppVariadicName (fst $2, [$1; snd $2]) } | TMacroIdentBuilder TOPar param_define_list TCPar { CppIdentBuilder ((fst $1, [snd $1;$2;$4]), $3) } identifier_cpp_list: | TIdent { [mk_string_wrap $1, []] } | identifier_cpp_list TCppConcatOp TIdent { $1 ++ [mk_string_wrap $3, [$2]] } /*(*************************************************************************)*/ /*(* expr *)*/ /*(*************************************************************************)*/ expr: | assign_expr { $1 } | expr TComma assign_expr { mk_e (Sequence ($1,$3)) [$2] } /*(* bugfix: in C grammar they put unary_expr, but in fact it must be * cast_expr, otherwise (int * ) xxx = &yy; is not allowed *)*/ assign_expr: | cond_expr { $1 } | cast_expr TAssign assign_expr { mk_e(Assignment ($1,fst $2,$3)) [snd $2]} | cast_expr TEq assign_expr { mk_e(Assignment ($1,SimpleAssign,$3)) [$2]} /*(* gccext: allow optional then part hence gcc_opt_expr * bugfix: in C grammar they put TDotDot cond_expr, but in fact it must be * assign_expr, otherwise pnp ? x : x = 0x388 is not allowed *)*/ cond_expr: | arith_expr { $1 } | arith_expr TWhy gcc_opt_expr TDotDot assign_expr { mk_e (CondExpr ($1,$3,$5)) [$2;$4] } arith_expr: | cast_expr { $1 } | arith_expr TMul arith_expr { mk_e(Binary ($1, Arith Mul, $3)) [$2] } | arith_expr TDiv arith_expr { mk_e(Binary ($1, Arith Div, $3)) [$2] } | arith_expr TMin arith_expr { mk_e(Binary ($1, Arith Min, $3)) [$2] } | arith_expr TMax arith_expr { mk_e(Binary ($1, Arith Max, $3)) [$2] } | arith_expr TMod arith_expr { mk_e(Binary ($1, Arith Mod, $3)) [$2] } | arith_expr TPlus arith_expr { mk_e(Binary ($1, Arith Plus, $3)) [$2] } | arith_expr TMinus arith_expr { mk_e(Binary ($1, Arith Minus, $3)) [$2] } | arith_expr TShl arith_expr { mk_e(Binary ($1, Arith DecLeft, $3)) [$2] } | arith_expr TShr arith_expr { mk_e(Binary ($1, Arith DecRight, $3)) [$2] } | arith_expr TInf arith_expr { mk_e(Binary ($1, Logical Inf, $3)) [$2] } | arith_expr TSup arith_expr { mk_e(Binary ($1, Logical Sup, $3)) [$2] } | arith_expr TInfEq arith_expr { mk_e(Binary ($1, Logical InfEq, $3)) [$2] } | arith_expr TSupEq arith_expr { mk_e(Binary ($1, Logical SupEq, $3)) [$2] } | arith_expr TEqEq arith_expr { mk_e(Binary ($1, Logical Eq, $3)) [$2] } | arith_expr TNotEq arith_expr { mk_e(Binary ($1, Logical NotEq, $3)) [$2] } | arith_expr TAnd arith_expr { mk_e(Binary ($1, Arith And, $3)) [$2] } | arith_expr TOr arith_expr { mk_e(Binary ($1, Arith Or, $3)) [$2] } | arith_expr TXor arith_expr { mk_e(Binary ($1, Arith Xor, $3)) [$2] } | arith_expr TAndLog arith_expr { mk_e(Binary ($1, Logical AndLog, $3)) [$2] } | arith_expr TOrLog arith_expr { mk_e(Binary ($1, Logical OrLog, $3)) [$2] } cast_expr: | unary_expr { $1 } | topar2 type_name tcpar2 cast_expr { mk_e(Cast ($2, $4)) [$1;$3] } unary_expr: | postfix_expr { $1 } | TInc unary_expr { mk_e(Infix ($2, Inc)) [$1] } | TDec unary_expr { mk_e(Infix ($2, Dec)) [$1] } | unary_op cast_expr { mk_e(Unary ($2, fst $1)) [snd $1] } | Tsizeof unary_expr { mk_e(SizeOfExpr ($2)) [$1] } | Tsizeof topar2 type_name tcpar2 { mk_e(SizeOfType ($3)) [$1;$2;$4] } | Tnew new_argument { mk_e(New (None, $2)) [$1] } | Tnew TOPar argument_list_ne TCPar new_argument { mk_e(New (Some $3, $5)) [$1; $2; $4] } | Tdelete cast_expr { mk_e(Delete $2) [$1] } new_argument: | TIdent TOPar argument_list_ne TCPar { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in Left (mk_e(FunCall (fn, $3)) [$2;$4]) } | TIdent TOPar TCPar { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in Left(mk_e(FunCall (fn, [])) [$2;$3]) } | TypedefIdent TOPar argument_list_ne TCPar { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in Left (mk_e(FunCall (fn, $3)) [$2;$4]) } | TypedefIdent TOPar TCPar { let fn = mk_e(Ident (RegularName (mk_string_wrap $1))) [] in Left (mk_e(FunCall (fn, [])) [$2;$3]) } | type_spec { let ty = addTypeD ($1,nullDecl) in let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam ty in Right (ArgType { p_namei = None; p_type = returnType; p_register = hasreg, iihasreg; } ) } | new_argument TOCro expr TCCro { match $1 with Left(e) -> Left(mk_e(ArrayAccess (e, $3)) [$2;$4]) | Right(ArgType(ty)) -> (* lots of hacks to make the right type *) let fty = mk_ty (Array (Some $3, ty.Ast_c.p_type)) [$2;$4] in let pty = { ty with p_type = fty } in Right(ArgType pty) | _ -> raise (Impossible 88) } unary_op: | TAnd { GetRef, $1 } | TMul { DeRef, $1 } | TPlus { UnPlus, $1 } | TMinus { UnMinus, $1 } | TTilde { Tilde, $1 } | TBang { Not, $1 } /*(* gccext: have that a lot in old kernel to get address of local label. * cf gcc manual "local labels as values". *)*/ | TAndLog { GetRefLabel, $1 } postfix_expr: | primary_expr { $1 } | postfix_expr TOCro expr TCCro { mk_e(ArrayAccess ($1, $3)) [$2;$4] } | postfix_expr TOPar argument_list_ne TCPar { mk_e(FunCall ($1, $3)) [$2;$4] } | postfix_expr TOPar TCPar { mk_e(FunCall ($1, [])) [$2;$3] } | postfix_expr TDot ident_cpp { mk_e(RecordAccess ($1,$3)) [$2] } | postfix_expr TPtrOp ident_cpp { mk_e(RecordPtAccess ($1,$3)) [$2] } | postfix_expr TInc { mk_e(Postfix ($1, Inc)) [$2] } | postfix_expr TDec { mk_e(Postfix ($1, Dec)) [$2] } /*(* gccext: also called compound literals *)*/ | topar2 type_name tcpar2 TOBrace TCBrace { mk_e(Constructor ($2, (InitList [], [$4;$5]))) [$1;$3] } | topar2 type_name tcpar2 TOBrace initialize_list gcc_comma_opt TCBrace { mk_e(Constructor ($2, (InitList (List.rev $5),[$4;$7]++$6))) [$1;$3] } primary_expr: | identifier_cpp { mk_e(Ident ($1)) [] } | TInt { let (str,(sign,base)) = fst $1 in mk_e(Constant (Int (str,Si(sign,base)))) [snd $1] } | TFloat { mk_e(Constant (Float (fst $1))) [snd $1] } | TString { mk_e(Constant (String (fst $1))) [snd $1] } | TQuote string_fragments TQuote { let ((fullstring,isW),lqinfo) = $1 in let (_,rqinfo) = $3 in mk_e (Ast_c.StringConstant($2, fullstring, isW)) [lqinfo;rqinfo] } | TChar { mk_e(Constant (Char (fst $1))) [snd $1] } | TDecimal { let (a,b,c) = fst $1 in mk_e(Constant (DecimalConst (a,b,c))) [snd $1] } | TOPar expr TCPar { mk_e(ParenExpr ($2)) [$1;$3] } /*(* forunparser: *)*/ /*(* gccext: cppext: TODO better ast ? *)*/ | TMacroString { mk_e(Constant (MultiString [fst $1])) [snd $1] } | string_elem string_list { mk_e(Constant (MultiString ["TODO: MultiString"])) ($1 ++ $2) } /*(* gccext: allow statement as expressions via ({ statement }) *)*/ | TOPar compound TCPar { mk_e(StatementExpr ($2)) [$1;$3] } string_fragments: | /* empty */ { [] } | string_fragment string_fragments { $1 :: $2 } string_fragment: | TPct string_format { Ast_c.FormatFragment($2), [$1] } | TSubString { Ast_c.ConstantFragment(fst $1), [snd $1] } string_format: | TFormat { Ast_c.ConstantFormat(fst $1), [snd $1] } /*(*----------------------------*)*/ /*(* cppext: *)*/ /*(*----------------------------*)*/ /*(* cppext: *)*/ /*(* to avoid conflicts have to introduce a _not_empty (ne) version *)*/ argument_ne: | assign_expr { Left $1 } | parameter_decl { Right (ArgType $1) } | action_higherordermacro_ne { Right (ArgAction $1) } argument: | assign_expr { Left $1 } | parameter_decl { Right (ArgType $1) } /*(* had conflicts before, but julia fixed them *)*/ | action_higherordermacro { Right (ArgAction $1) } action_higherordermacro_ne: | taction_list_ne { if null $1 then ActMisc [Ast_c.fakeInfo()] else ActMisc $1 } action_higherordermacro: | taction_list { if null $1 then ActMisc [Ast_c.fakeInfo()] else ActMisc $1 } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ /*(* would like evalInt $1 but require too much info *)*/ const_expr: cond_expr { $1 } topar2: TOPar { et "topar2" (); $1 } tcpar2: TCPar { et "tcpar2" (); $1 (*TODO? et ? sure ? c pas dt plutot ? *) } /*(*************************************************************************)*/ /*(* statement *)*/ /*(*************************************************************************)*/ statement: statement2 { mk_st (fst $1) (snd $1) } statement2: | labeled { Labeled (fst $1), snd $1 } | compound { Compound (fst $1), snd $1 } | expr_statement { ExprStatement(fst $1), snd $1 } | selection { Selection (fst $1), snd $1 ++ [fakeInfo()] } | iteration { Iteration (fst $1), snd $1 ++ [fakeInfo()] } | jump TPtVirg { Jump (fst $1), snd $1 ++ [$2] } /*(* gccext: *)*/ | Tasm TOPar asmbody TCPar TPtVirg { Asm $3, [$1;$2;$4;$5] } | Tasm Tvolatile TOPar asmbody TCPar TPtVirg { Asm $4, [$1;$2;$3;$5;$6] } /*(* cppext: *)*/ | TMacroStmt { MacroStmt, [snd $1] } /*(* note that case 1: case 2: i++; would be correctly parsed, but with * a Case (1, (Case (2, i++))) :( *)*/ labeled: | ident_cpp TDotDot sw_stat_or_decl { Label ($1, $3), [$2] } | Tcase const_expr TDotDot sw_stat_or_decl { Case ($2, $4), [$1; $3] } | Tcase const_expr TEllipsis const_expr TDotDot sw_stat_or_decl { CaseRange ($2, $4, $6), [$1;$3;$5] } /*(* gccext: allow range *)*/ | Tdefault TDotDot sw_stat_or_decl { Default $3, [$1; $2] } sw_stat_or_decl: | decl { mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii } | statement { $1 } end_labeled: /*(* gccext: allow toto: } * was generating each 30 shift/Reduce conflicts, * mais ca va, ca fait ce qu'il faut. * update: julia fixed the problem by introducing end_labeled * and modifying below stat_or_decl_list *)*/ | ident_cpp TDotDot { Label ($1, (mk_st (ExprStatement None) Ast_c.noii)), [$2] } | Tcase const_expr TDotDot { Case ($2, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$3] } | Tdefault TDotDot { Default (mk_st (ExprStatement None) Ast_c.noii), [$1; $2] } compound: tobrace compound2 tcbrace { $2, [$1; $3] } /* (* cppext: because of cpp, some stuff looks like declaration but are in * fact statement but too hard to figure out, and if parse them as * expression, then we force to have first decls and then exprs, then * will have a parse error. So easier to let mix decl/statement. * Moreover it helps to not make such a difference between decl and * statement for further coccinelle phases to factorize code. *)*/ compound2: | { ([]) } | stat_or_decl_list { $1 } stat_or_decl_list: | stat_or_decl { [$1] } /*(* gccext: to avoid conflicts, cf end_labeled above *)*/ | end_labeled { [StmtElem (mk_st (Labeled (fst $1)) (snd $1))] } /*(* old: conflicts | stat_or_decl_list stat_or_decl { $1 ++ [$2] } *)*/ | stat_or_decl stat_or_decl_list { $1 :: $2 } stat_or_decl: | decl { StmtElem (mk_st (Decl ($1 Ast_c.LocalDecl)) Ast_c.noii) } | statement { StmtElem $1 } /*(* gccext: *)*/ | function_definition { StmtElem (mk_st (NestedFunc $1) Ast_c.noii) } /* (* cppext: *)*/ | cpp_directive { CppDirectiveStmt $1 } | cpp_ifdef_directive/*(* stat_or_decl_list ...*)*/ { IfdefStmt $1 } expr_statement: | TPtVirg { None, [$1] } | expr TPtVirg { Some $1, [$2] } selection: | Tif TOPar expr TCPar statement %prec SHIFTHERE { If ($3, $5, (mk_st (ExprStatement None) Ast_c.noii)), [$1;$2;$4] } | Tif TOPar expr TCPar statement Telse statement { If ($3, $5, $7), [$1;$2;$4;$6] } | Tswitch TOPar expr TCPar statement { Switch ($3,$5), [$1;$2;$4] } iteration: | Twhile TOPar expr TCPar statement { While ($3,$5), [$1;$2;$4] } | Tdo statement Twhile TOPar expr TCPar TPtVirg { DoWhile ($2,$5), [$1;$3;$4;$6;$7] } | Tfor TOPar expr_statement expr_statement TCPar statement { For (ForExp $3,$4,(None, []),$6), [$1;$2;$5]} | Tfor TOPar expr_statement expr_statement expr TCPar statement { For (ForExp $3,$4,(Some $5, []),$7), [$1;$2;$6] } /*(* c++ext: for(int i = 0; i < n; i++)*)*/ | Tfor TOPar decl expr_statement TCPar statement { For (ForDecl ($3 Ast_c.LocalDecl),$4,(None, []),$6), [$1;$2;$5]} | Tfor TOPar decl expr_statement expr TCPar statement { For (ForDecl ($3 Ast_c.LocalDecl),$4,(Some $5, []),$7), [$1;$2;$6] } /*(* cppext: *)*/ | TMacroIterator TOPar argument_list_ne TCPar statement { MacroIteration (fst $1, $3, $5), [snd $1;$2;$4] } | TMacroIterator TOPar TCPar statement { MacroIteration (fst $1, [], $4), [snd $1;$2;$3] } /*(* the ';' in the caller grammar rule will be appended to the infos *)*/ jump: | Tgoto ident_cpp { Goto ($2), [$1] } | Tcontinue { Continue, [$1] } | Tbreak { Break, [$1] } | Treturn { Return, [$1] } | Treturn expr { ReturnExpr $2, [$1] } | Tgoto TMul expr { GotoComputed $3, [$1;$2] } /*(*----------------------------*)*/ /*(* gccext: *)*/ /*(*----------------------------*)*/ string_elem: | TString { [snd $1] } /*(* cppext: ex= printk (KERN_INFO "xxx" UTS_RELEASE) *)*/ | TMacroString { [snd $1] } asmbody: | string_list colon_asm_list { $1, $2 } | string_list { $1, [] } /*(* in old kernel *)*/ colon_asm: TDotDot colon_option_list { Colon $2, [$1] } colon_option: | TString { ColonMisc, [snd $1] } | TString TOPar asm_expr TCPar { ColonExpr $3, [snd $1; $2;$4] } /*(* cppext: certainly a macro *)*/ | TOCro identifier TCCro TString TOPar asm_expr TCPar { ColonExpr $6, [$1;snd $2;$3;snd $4; $5; $7 ] } | identifier { ColonMisc, [snd $1] } | /*(* empty *)*/ { ColonMisc, [] } asm_expr: assign_expr { $1 } /*(*************************************************************************)*/ /*(* types *)*/ /*(*************************************************************************)*/ /*(*-----------------------------------------------------------------------*)*/ /*(* Type spec, left part of a type *)*/ /*(*-----------------------------------------------------------------------*)*/ type_spec2: | Tvoid { Right3 (BaseType Void), [$1] } | Tchar { Right3 (BaseType (IntType CChar)), [$1]} | Tint { Right3 (BaseType (IntType (Si (Signed,CInt)))), [$1]} | Tfloat { Right3 (BaseType (FloatType CFloat)), [$1]} | Tdouble { Right3 (BaseType (FloatType CDouble)), [$1] } | Tsize_t { Right3 (BaseType SizeType), [$1] } | Tssize_t { Right3 (BaseType SSizeType), [$1] } | Tptrdiff_t { Right3 (BaseType PtrDiffType), [$1] } | Tshort { Middle3 Short, [$1]} | Tlong { Middle3 Long, [$1]} | Tsigned { Left3 Signed, [$1]} | Tunsigned { Left3 UnSigned, [$1]} | struct_or_union_spec { Right3 (fst $1), snd $1 } | enum_spec { Right3 (fst $1), snd $1 } | Tdecimal TOPar const_expr TComma const_expr TCPar { Right3 (Decimal($3,Some $5)), [$1;$2;$4;$6] } | Tdecimal TOPar const_expr TCPar { Right3 (Decimal($3,None)), [$1;$2;$4] } /* (* parse_typedef_fix1: cant put: TIdent {} cos it make the grammar * ambiguous, generates lots of conflicts => we must * use some tricks: we make the lexer and parser cooperate, cf lexerParser.ml. * * parse_typedef_fix2: this is not enough, and you must use * parse_typedef_fix2 to fully manage typedef problems in grammar. * * parse_typedef_fix3: * * parse_typedef_fix4: try also to do now some consistency checking in * Parse_c *)*/ | TypedefIdent { let name = RegularName (mk_string_wrap $1) in Right3 (TypeName (name, Ast_c.noTypedefDef())),[] } | Ttypeof TOPar assign_expr TCPar { Right3 (TypeOfExpr ($3)), [$1;$2;$4] } | Ttypeof TOPar type_name TCPar { Right3 (TypeOfType ($3)), [$1;$2;$4] } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ type_spec: type_spec2 { dt "type" (); $1 } /*(*-----------------------------------------------------------------------*)*/ /*(* Qualifiers *)*/ /*(*-----------------------------------------------------------------------*)*/ type_qualif: | Tconst { {const=true ; volatile=false}, $1 } | Tvolatile { {const=false ; volatile=true}, $1 } /*(* C99 *)*/ | Trestrict { (* TODO *) {const=false ; volatile=false}, $1 } /*(*-----------------------------------------------------------------------*)*/ /*(* gccext: attributes *)*/ /*(*-----------------------------------------------------------------------*)*/ attribute: | Tattribute TOPar /*stuff*/ TCPar { raise Todo } /*(* cppext: *)*/ | TMacroAttr { Attribute (fst $1), [snd $1] } attribute_storage: | TMacroAttrStorage { $1 } type_qualif_attr: | type_qualif { $1 } /*(*TODO !!!!! *)*/ | TMacroAttr { {const=true ; volatile=false}, snd $1 } /*(*-----------------------------------------------------------------------*)*/ /*(* Declarator, right part of a type + second part of decl (the ident) *)*/ /*(*-----------------------------------------------------------------------*)*/ /* (* declarator return a couple: * (name, partial type (a function to be applied to return type)) * * when int* f(int) we must return Func(Pointer int,int) and not * Pointer (Func(int,int) *)*/ declarator: | pointer direct_d { (fst $2, fun x -> x +> $1 +> (snd $2) ) } | direct_d { $1 } /*(* so must do int * const p; if the pointer is constant, not the pointee *)*/ pointer: | tmul { fun x -> mk_ty (Pointer x) [$1] } | tmul pointer { fun x -> mk_ty (Pointer ($2 x)) [$1] } | tmul type_qualif_list { fun x -> ($2.qualifD, mk_tybis (Pointer x) [$1])} | tmul type_qualif_list pointer { fun x -> ($2.qualifD, mk_tybis (Pointer ($3 x)) [$1]) } tmul: TMul { $1 } | TAnd { if !Flag.c_plus_plus then $1 else let i = Ast_c.parse_info_of_info $1 in raise (Semantic("& not allowed in C types, try -c++ option", i)) } direct_d: | identifier_cpp { ($1, fun x -> x) } | TOPar declarator TCPar /*(* forunparser: old: $2 *)*/ { (fst $2, fun x -> mk_ty (ParenType ((snd $2) x)) [$1;$3]) } | direct_d tocro tccro { (fst $1,fun x->(snd $1) (mk_ty (Array (None,x)) [$2;$3])) } | direct_d tocro const_expr tccro { (fst $1,fun x->(snd $1) (mk_ty (Array (Some $3,x)) [$2;$4])) } | direct_d topar tcpar { (fst $1, fun x->(snd $1) (mk_ty (FunctionType (x,(([],(false, []))))) [$2;$3])) } | direct_d topar parameter_type_list tcpar { (fst $1,fun x->(snd $1) (mk_ty (FunctionType (x, $3)) [$2;$4])) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ tocro: TOCro { et "tocro" ();$1 } tccro: TCCro { dt "tccro" ();$1 } /*(*-----------------------------------------------------------------------*)*/ abstract_declarator: | pointer { $1 } | direct_abstract_declarator { $1 } | pointer direct_abstract_declarator { fun x -> x +> $2 +> $1 } direct_abstract_declarator: | TOPar abstract_declarator TCPar /*(* forunparser: old: $2 *)*/ { fun x -> mk_ty (ParenType ($2 x)) [$1;$3] } | TOCro TCCro { fun x -> mk_ty (Array (None, x)) [$1;$2] } | TOCro const_expr TCCro { fun x -> mk_ty (Array (Some $2, x)) [$1;$3] } | direct_abstract_declarator TOCro TCCro { fun x -> $1 (mk_ty (Array (None, x)) [$2;$3]) } | direct_abstract_declarator TOCro const_expr TCCro { fun x -> $1 (mk_ty (Array (Some $3,x)) [$2;$4]) } | TOPar TCPar { fun x -> mk_ty (FunctionType (x, ([], (false, [])))) [$1;$2] } | topar parameter_type_list tcpar { fun x -> mk_ty (FunctionType (x, $2)) [$1;$3] } /*(* subtle: here must also use topar, not TOPar, otherwise if have for * instance (xxx ( * )(xxx)) cast, then the second xxx may still be a Tident * but we want to reduce topar, to set the InParameter so that * parsing_hack can get a chance to change the type of xxx into a typedef. * That's an example where parsing_hack and the lookahead of ocamlyacc does * not go very well together ... we got the info too late. We got * a similar pb with xxx xxx; declaration, cf parsing_hack.ml and the * "disable typedef cos special case ..." message. *)*/ | direct_abstract_declarator topar tcpar { fun x -> $1 (mk_ty (FunctionType (x, (([], (false, []))))) [$2;$3]) } | direct_abstract_declarator topar parameter_type_list tcpar { fun x -> $1 (mk_ty (FunctionType (x, $3)) [$2;$4]) } /*(*-----------------------------------------------------------------------*)*/ /*(* Parameters (use decl_spec not type_spec just for 'register') *)*/ /*(*-----------------------------------------------------------------------*)*/ parameter_type_list: | parameter_list { ($1, (false, []))} | parameter_list TComma TEllipsis { ($1, (true, [$2;$3])) } parameter_decl2: TKRParam { let name = RegularName (mk_string_wrap $1) in LP.add_ident (str_of_name name); { p_namei = Some name; p_type = mk_ty NoType []; p_register = (false, []); } } | decl_spec declaratorp { let ((returnType,hasreg),iihasreg) = fixDeclSpecForParam $1 in let (name, ftyp) = $2 in { p_namei = Some (name); p_type = ftyp returnType; p_register = (hasreg, iihasreg); } } | decl_spec abstract_declaratorp { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in { p_namei = None; p_type = $2 returnType; p_register = hasreg, iihasreg; } } | decl_spec { let ((returnType,hasreg), iihasreg) = fixDeclSpecForParam $1 in { p_namei = None; p_type = returnType; p_register = hasreg, iihasreg; } } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ parameter_decl: parameter_decl2 { et "param" (); $1 } | attributes parameter_decl2 { et "param" (); $2 } declaratorp: | declarator { LP.add_ident (str_of_name (fst $1)); $1 } /*(* gccext: *)*/ | attributes declarator { LP.add_ident (str_of_name (fst $2)); $2 } | declarator attributes { LP.add_ident (str_of_name (fst $1)); $1 } abstract_declaratorp: | abstract_declarator { $1 } /*(* gccext: *)*/ | attributes abstract_declarator { $2 } /*(*-----------------------------------------------------------------------*)*/ /*(* helper type rules *)*/ /*(*-----------------------------------------------------------------------*)*/ /*(* for struct and also typename *)*/ /*(* cant put decl_spec cos no storage is allowed for field struct *)*/ spec_qualif_list2: | type_spec { addTypeD ($1, nullDecl) } | type_qualif { {nullDecl with qualifD = (fst $1,[snd $1])}} | type_spec spec_qualif_list { addTypeD ($1,$2) } | type_qualif spec_qualif_list { addQualifD ($1,$2) } spec_qualif_list: spec_qualif_list2 { dt "spec_qualif" (); $1 } /*(* for pointers in direct_declarator and abstract_declarator *)*/ type_qualif_list: | type_qualif_attr { {nullDecl with qualifD = (fst $1,[snd $1])} } | type_qualif_list type_qualif_attr { addQualifD ($2,$1) } /*(*-----------------------------------------------------------------------*)*/ /*(* xxx_type_id *)*/ /*(*-----------------------------------------------------------------------*)*/ type_name: | spec_qualif_list { let (returnType, _) = fixDeclSpecForDecl $1 in returnType } | spec_qualif_list abstract_declaratort { let (returnType, _) = fixDeclSpecForDecl $1 in $2 returnType } abstract_declaratort: | abstract_declarator { $1 } /*(* gccext: *)*/ | attributes abstract_declarator { $2 } /*(*************************************************************************)*/ /*(* declaration and initializers *)*/ /*(*************************************************************************)*/ decl2: | decl_spec TPtVirg { function local -> let (returnType,storage) = fixDeclSpecForDecl $1 in let iistart = Ast_c.fakeInfo () in DeclList ([{v_namei = None; v_type = returnType; v_storage = unwrap storage; v_local = local; v_attr = Ast_c.noattr; v_type_bis = ref None; },[]], ($2::iistart::snd storage)) } | decl_spec init_declarator_list TPtVirg { function local -> let (returnType,storage) = fixDeclSpecForDecl $1 in let iistart = Ast_c.fakeInfo () in DeclList ( ($2 +> List.map (fun ((((name,f),attrs), ini), iivirg) -> let s = str_of_name name in if fst (unwrap storage) =*= StoTypedef then LP.add_typedef s; {v_namei = Some (name, ini); v_type = f returnType; v_storage = unwrap storage; v_local = local; v_attr = attrs; v_type_bis = ref None; }, iivirg ) ), ($3::iistart::snd storage)) } /*(* cppext: *)*/ | TMacroDecl TOPar argument_list TCPar TPtVirg { function _ -> MacroDecl ((fst $1, $3, true), [snd $1;$2;$4;$5;fakeInfo()]) } | Tstatic TMacroDecl TOPar argument_list TCPar TPtVirg { function _ -> MacroDecl ((fst $2, $4, true), [snd $2;$3;$5;$6;fakeInfo();$1]) } | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar TPtVirg { function _ -> MacroDecl ((fst $3, $5, true), [snd $3;$4;$6;$7;fakeInfo();$1;$2])} | TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg { function _ -> MacroDeclInit ((fst $1, $3, $6), [snd $1;$2;$4;$5;$7;fakeInfo()]) } | Tstatic TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg { function _ -> MacroDeclInit ((fst $2, $4, $7),[snd $2;$3;$5;$6;$8;fakeInfo();$1]) } | Tstatic TMacroDeclConst TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg { function _ -> MacroDeclInit ((fst $3, $5, $8), [snd $3;$4;$6;$7;$9;fakeInfo();$1;$2])} /*(*-----------------------------------------------------------------------*)*/ decl_spec2: | storage_class_spec { {nullDecl with storageD = (fst $1, [snd $1]) } } | type_spec { addTypeD ($1,nullDecl) } | type_qualif { {nullDecl with qualifD = (fst $1, [snd $1]) } } | Tinline { {nullDecl with inlineD = (true, [$1]) } } | storage_class_spec decl_spec2 { addStorageD ($1, $2) } | type_spec decl_spec2 { addTypeD ($1, $2) } | type_qualif decl_spec2 { addQualifD ($1, $2) } | Tinline decl_spec2 { addInlineD ((true, $1), $2) } /*(* can simplify by putting all in _opt ? must have at least one otherwise * decl_list is ambiguous ? (no cos have ';' between decl) *)*/ storage_class_spec2: | Tstatic { Sto Static, $1 } | Textern { Sto Extern, $1 } | Tauto { Sto Auto, $1 } | Tregister { Sto Register,$1 } | Ttypedef { StoTypedef, $1 } storage_class_spec: /*(* gccext: *)*/ | storage_class_spec2 { $1 } | storage_class_spec2 attribute_storage_list { $1 (* TODO *) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ decl: decl2 { et "decl" (); $1 } decl_spec: decl_spec2 { dt "declspec" (); $1 } /*(*-----------------------------------------------------------------------*)*/ /*(* declarators (right part of type and variable) *)*/ /*(*-----------------------------------------------------------------------*)*/ init_declarator2: | declaratori { ($1, NoInit) } | declaratori teq initialize { ($1, ValInit($2, $3)) } /* C++ only */ | declaratori TOParCplusplusInit argument_list TCPar { ($1, ConstrInit($3,[$2;$4])) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ teq: TEq { et "teq" (); $1 } init_declarator: init_declarator2 { dt "init" (); $1 } /*(*----------------------------*)*/ /*(* gccext: *)*/ /*(*----------------------------*)*/ declaratori: | declarator { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr } /*(* gccext: *)*/ | declarator gcc_asm_decl { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr } /*(* gccext: *)*/ | attributes declarator { LP.add_ident (str_of_name (fst $2)); $2, $1 } | declarator attributes { LP.add_ident (str_of_name (fst $1)); $1, Ast_c.noattr (* TODO *) } gcc_asm_decl: | Tasm TOPar asmbody TCPar { } | Tasm Tvolatile TOPar asmbody TCPar { } /*(*-----------------------------------------------------------------------*)*/ initialize: | assign_expr { InitExpr $1, [] } | tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini { InitList (List.rev $2), [$1;$4]++$3 } | tobrace_ini tcbrace_ini { InitList [], [$1;$2] } /*(* gccext: *)*/ /* (* opti: This time we use the weird order of non-terminal which requires in * the "caller" to do a List.rev cos quite critical. With this weird order it * allows yacc to use a constant stack space instead of exploding if we would * do a 'initialize2 Tcomma initialize_list'. *) */ initialize_list: | initialize2 { [$1, []] } | initialize_list TComma initialize2 { ($3, [$2])::$1 } /*(* gccext: condexpr and no assign_expr cos can have ambiguity with comma *)*/ initialize2: | cond_expr { InitExpr $1, [] } | tobrace_ini initialize_list gcc_comma_opt_struct tcbrace_ini { InitList (List.rev $2), [$1;$4]++$3 } | tobrace_ini tcbrace_ini { InitList [], [$1;$2] } /*(* gccext: labeled elements, a.k.a designators *)*/ | designator_list TEq initialize2 { InitDesignators ($1, $3), [$2] } /*(* gccext: old format *)*/ | ident TDotDot initialize2 { InitFieldOld (fst $1, $3), [snd $1; $2] } /*(* in old kernel *)*/ /* conflict | TOCro const_expr TCCro initialize2 { InitIndexOld ($2, $4), [$1;$3] } */ /*(* they can be nested, can have a .x[3].y *)*/ designator: | TDot ident { DesignatorField (fst $2), [$1;snd $2] } | TOCro const_expr TCCro { DesignatorIndex ($2), [$1;$3] } | TOCro const_expr TEllipsis const_expr TCCro { DesignatorRange ($2, $4), [$1;$3;$5] } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ gcc_comma_opt_struct: | TComma { [$1] } | /*(* empty *)*/ { [Ast_c.fakeInfo() +> Ast_c.rewrap_str ","] } /*(*************************************************************************)*/ /*(* struct *)*/ /*(*************************************************************************)*/ s_or_u_spec2: | struct_or_union ident tobrace_struct struct_decl_list_gcc tcbrace_struct { StructUnion (fst $1, Some (fst $2), $4), [snd $1;snd $2;$3;$5] } | struct_or_union tobrace_struct struct_decl_list_gcc tcbrace_struct { StructUnion (fst $1, None, $3), [snd $1;$2;$4] } | struct_or_union ident { StructUnionName (fst $1, fst $2), [snd $1;snd $2] } struct_or_union2: | Tstruct { Struct, $1 } | Tunion { Union, $1 } /*(* gccext: *)*/ | Tstruct attributes { Struct, $1 (* TODO *) } | Tunion attributes { Union, $1 (* TODO *) } struct_decl2: | field_declaration { DeclarationField $1 } | TPtVirg { EmptyField $1 } /*(* no conflict ? no need for a TMacroStruct ? apparently not as at struct * the rule are slightly different. *)*/ | identifier TOPar argument_list TCPar TPtVirg { MacroDeclField ((fst $1, $3), [snd $1;$2;$4;$5;fakeInfo()]) } /*(* cppext: *)*/ | cpp_directive { CppDirectiveStruct $1 } | cpp_ifdef_directive/*(* struct_decl_list ... *)*/ { IfdefStruct $1 } field_declaration: | spec_qualif_list struct_declarator_list TPtVirg { let (returnType,storage) = fixDeclSpecForDecl $1 in if fst (unwrap storage) <> NoSto then internal_error "parsing dont allow this"; FieldDeclList ($2 +> (List.map (fun (f, iivirg) -> f returnType, iivirg)) ,[$3]) (* dont need to check if typedef or func initialised cos * grammar dont allow typedef nor initialiser in struct *) } | spec_qualif_list TPtVirg { (* gccext: allow empty elements if it is a structdef or enumdef *) let (returnType,storage) = fixDeclSpecForDecl $1 in if fst (unwrap storage) <> NoSto then internal_error "parsing dont allow this"; FieldDeclList ([(Simple (None, returnType)) , []], [$2]) } struct_declarator: | declaratorsd { (fun x -> Simple (Some (fst $1), (snd $1) x)) } | dotdot const_expr2 { (fun x -> BitField (None, x, $1, $2)) } | declaratorsd dotdot const_expr2 { (fun x -> BitField (Some (fst $1), ((snd $1) x), $2, $3)) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ declaratorsd: | declarator { (*also ? LP.add_ident (fst (fst $1)); *) $1 } /*(* gccext: *)*/ | attributes declarator { $2 } | declarator attributes { $1 } struct_or_union_spec: s_or_u_spec2 { dt "su" (); $1 } struct_or_union: struct_or_union2 { et "su" (); $1 } struct_decl: struct_decl2 { et "struct" (); $1 } dotdot: TDotDot { et "dotdot" (); $1 } const_expr2: const_expr { dt "const_expr2" (); $1 } struct_decl_list_gcc: | struct_decl_list { $1 } | /*(* empty *)*/ { [] } /*(* gccext: allow empty struct *)*/ /*(*************************************************************************)*/ /*(* enum *)*/ /*(*************************************************************************)*/ enum_spec: | Tenum tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum { Enum (None, $3), [$1;$2;$5] ++ $4 } | Tenum ident tobrace_enum enumerator_list gcc_comma_opt_struct tcbrace_enum { Enum (Some (fst $2), $4), [$1; snd $2; $3;$6] ++ $5 } | Tenum ident { EnumName (fst $2), [$1; snd $2] } enumerator: | idente { $1, None } | idente TEq const_expr { $1, Some ($2, $3) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ idente: ident_cpp { LP.add_ident (str_of_name $1); $1 } /*(*************************************************************************)*/ /*(* function *)*/ /*(*************************************************************************)*/ function_definition: function_def { fixFunc $1 } decl_list: | decl { [$1 Ast_c.LocalDecl] } | decl_list decl { $1 ++ [$2 Ast_c.LocalDecl] } /* hack : to drop when a better solution is found */ cpp_directive_list: | cpp_directive { } | cpp_directive_list cpp_directive { } function_def: | start_fun compound { LP.del_scope(); ($1, $2, None) } | start_fun cpp_directive_list compound { LP.del_scope(); ($1, $3, None) } | start_fun decl_list compound { (* TODO: undo the typedef added ? *) LP.del_scope(); ($1, $3, Some $2) } start_fun: start_fun2 { LP.new_scope(); fix_add_params_ident $1; (* toreput? !LP._lexer_hint.toplevel <- false; *) $1 } start_fun2: decl_spec declaratorfd { let (returnType,storage) = fixDeclSpecForFuncDef $1 in let (id, attrs) = $2 in (fst id, fixOldCDecl ((snd id) returnType) , storage, attrs) } | ctor_dtor { $1 } ctor_dtor: | Tconstructorname topar tcpar { let id = RegularName (mk_string_wrap $1) in let ret = mk_ty NoType [] in let ty = mk_ty (FunctionType (ret, (([], (false, []))))) [$2;$3] in let storage = ((NoSto,false),[]) in let attrs = [] in (id, ty, storage, attrs) } | Tconstructorname topar parameter_type_list tcpar { let id = RegularName (mk_string_wrap $1) in let ret = mk_ty NoType [] in let ty = mk_ty (FunctionType (ret, $3)) [$2;$4] in let storage = ((NoSto,false),[]) in let attrs = [] in (id, ty, storage, attrs) } /*(*----------------------------*)*/ /*(* workarounds *)*/ /*(*----------------------------*)*/ /* It would be very nice if we could make declarator aware that this is coming from a function definition. Then on the ( and ) cases, it could set the state to something other than InParameter. Then the case (TIdent (s, i1)::(TComma _|TCPar _)::_ , (TComma _ |TOPar _)::_ ) in parsing_hacks.ml would not have to consider K&R variable declarations as typedefs. Unfortunately, doing something about this problem seems to introduce conflicts in the parser. */ declaratorfd: | declarator { et "declaratorfd" (); $1, Ast_c.noattr } /*(* gccext: *)*/ | attributes declarator { et "declaratorfd" (); $2, $1 } | declarator attributes { et "declaratorfd" (); $1, Ast_c.noattr } /*(*************************************************************************)*/ /*(* cpp directives *)*/ /*(*************************************************************************)*/ cpp_directive: | TIncludeStart TIncludeFilename { let (i1, in_ifdef) = $1 in let (s, i2) = $2 in (* redo some lexing work :( *) let inc_file = match () with | _ when s =~ "^\"\\(.*\\)\"$" -> Local (Common.split "/" (matched1 s)) | _ when s =~ "^\\<\\(.*\\)\\>$" -> NonLocal (Common.split "/" (matched1 s)) | _ -> Weird s in Include { i_include = (inc_file, [i1;i2]); i_rel_pos = Ast_c.noRelPos(); i_is_in_ifdef = !in_ifdef; i_content = Ast_c.noi_content; } } | TDefine TIdentDefine define_val TDefEOL { Define ((fst $2, [$1; snd $2;$4]), (DefineVar, $3)) } /* (* The TOParDefine is introduced to avoid ambiguity with previous rules. * A TOParDefine is a TOPar that was just next to the ident. *)*/ | TDefine TIdentDefine TOParDefine param_define_list TCPar define_val TDefEOL { Define ((fst $2, [$1; snd $2; $7]), (DefineFunc ($4, [$3;$5]), $6)) } | TUndef TIdentDefine TDefEOL { Define((fst $2, [$1; snd $2; $3]), (Undef,DefineEmpty)) } | TPragma TIdentDefine pragmainfo TDefEOL { Pragma((fst $2, [$1; snd $2; $4]), $3) } | TCppDirectiveOther { OtherDirective ([$1]) } pragmainfo: TOPar argument_list_ne TCPar { (PragmaTuple ($2, [$1;$3])) } | TOPar TCPar { PragmaTuple ([], [$1;$2]) } | ident_define_list_ne { PragmaIdList $1 } /*(* perhaps better to use assign_expr ? but in that case need * do a assign_expr_of_string in parse_c *)*/ define_val: | expr { DefineExpr $1 } | statement { DefineStmt $1 } | decl { DefineStmt (mk_st (Decl ($1 Ast_c.NotLocalDecl)) Ast_c.noii) } /*(*old: * | TypedefIdent { DefineType (nQ,(TypeName(fst $1,noTypedefDef()),[snd $1]))} * get conflicts: * | spec_qualif_list TMul * { let (returnType, _) = fixDeclSpecForDecl $1 in DefineType returnType } *) */ | decl_spec { let returnType = fixDeclSpecForMacro $1 in DefineType returnType } | decl_spec abstract_declarator { let returnType = fixDeclSpecForMacro $1 in let typ = $2 returnType in DefineType typ } /*(* can be in conflict with decl_spec, maybe change fixDeclSpecForMacro * to also allow storage ? | storage_class_spec { DefineTodo } | Tinline { DefineTodo } *)*/ | stat_or_decl stat_or_decl_list { DefineMulti (List.map (function StmtElem e -> e | _ -> failwith "unexpected statement for DefineMulti") ($1 :: $2)) } /*(* | statement statement { DefineTodo } | decl function_definition { DefineTodo } *)*/ | function_definition { DefineFunction $1 } | TOBraceDefineInit initialize_list gcc_comma_opt_struct TCBrace comma_opt { DefineInit (InitList (List.rev $2), [$1;$4]++$3++$5) } /*(* note: had a conflict before when were putting TInt instead of expr *)*/ | Tdo statement Twhile TOPar expr TCPar { (* TOREPUT if fst $5 <> "0" then pr2 "WEIRD: in macro and have not a while(0)"; *) DefineDoWhileZero (($2,$5), [$1;$3;$4;$6]) } | Tasm TOPar asmbody TCPar { DefineTodo } | Tasm Tvolatile TOPar asmbody TCPar { DefineTodo } /*(* aliases macro *)*/ | TMacroAttr { DefineTodo } | /*(* empty *)*/ { DefineEmpty } param_define: | TIdent { mk_string_wrap $1 } | TypedefIdent { mk_string_wrap $1 } | TDefParamVariadic { mk_string_wrap $1 } | TEllipsis { "...", [$1] } /*(* they reuse keywords :( *)*/ | Tregister { "register", [$1] } cpp_ifdef_directive: | TIfdef { let (tag,ii) = $1 in IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) } | TIfdefelse { let (tag,ii) = $1 in IfdefDirective ((IfdefElse, IfdefTag (Common.some !tag)), [ii]) } | TIfdefelif { let (tag,ii) = $1 in IfdefDirective ((IfdefElseif, IfdefTag (Common.some !tag)), [ii]) } | TEndif { let (tag,ii) = $1 in IfdefDirective ((IfdefEndif, IfdefTag (Common.some !tag)), [ii]) } | TIfdefBool { let (_b, tag,ii) = $1 in IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) } | TIfdefMisc { let (_b, tag,ii) = $1 in IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) } | TIfdefVersion { let (_b, tag,ii) = $1 in IfdefDirective ((Ifdef, IfdefTag (Common.some !tag)), [ii]) } /*(* cppext: *)*/ cpp_other: /*(* no conflict ? no need for a TMacroTop ? apparently not as at toplevel * the rule are slightly different, they cant be statement and so expr * at the top, only decl or function definition. *)*/ | identifier TOPar argument_list TCPar TPtVirg { Declaration(MacroDecl((fst $1, $3, true), [snd $1;$2;$4;$5;fakeInfo()])) (* old: MacroTop (fst $1, $3, [snd $1;$2;$4;$5]) *) } /*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/ | identifier TOPar argument_list TCParEOL { Declaration (MacroDecl ((fst $1, $3, false), [snd $1;$2;$4;fakeInfo()])) } /*(* ex: EXPORT_NO_SYMBOLS; *)*/ | identifier TPtVirg { EmptyDef [snd $1;$2] } /*(*************************************************************************)*/ /*(* celem *)*/ /*(*************************************************************************)*/ external_declaration: | function_definition { Definition $1 } | decl { Declaration ($1 Ast_c.NotLocalDecl) } celem: | Tnamespace TIdent TOBrace translation_unit TCBrace { !LP._lexer_hint.context_stack <- [LP.InTopLevel]; Namespace ($4, [$1; snd $2; $3; $5]) } | external_declaration { $1 } /*(* cppext: *)*/ | cpp_directive { CppTop $1 } | cpp_other { $1 } | cpp_ifdef_directive /* (*external_declaration_list ...*)*/ { IfdefTop $1 } /*(* can have asm declaration at toplevel *)*/ | Tasm TOPar asmbody TCPar TPtVirg { EmptyDef [$1;$2;$4;$5] } /* (* in ~/kernels/src/linux-2.5.2/drivers/isdn/hisax/isdnl3.c sometimes * the function ends with }; instead of just } * can also remove this rule and report "parse error" pb to morton *)*/ | TPtVirg { EmptyDef [$1] } | EOF { FinalDef $1 } /*(*************************************************************************)*/ /*(* some generic workarounds *)*/ /*(*************************************************************************)*/ tobrace: TOBrace { LP.push_context LP.InFunction; LP.new_scope (); $1 } tcbrace: TCBrace { LP.pop_context(); LP.del_scope (); $1 } tobrace_enum: TOBrace { LP.push_context LP.InEnum; $1 } tcbrace_enum: TCBrace { LP.pop_context (); $1 } tobrace_ini: TOBrace { LP.push_context LP.InInitializer; $1 } tcbrace_ini: TCBrace { LP.pop_context (); $1 } tobrace_struct: TOBrace { LP.push_context LP.InStruct; $1} tcbrace_struct: TCBrace { LP.pop_context (); $1 } topar: TOPar { LP.new_scope ();et "topar" (); LP.push_context LP.InParameter; $1 } tcpar: TCPar { LP.del_scope ();dt "tcpar" (); LP.pop_context (); $1 } /*(*************************************************************************)*/ /*(* xxx_list, xxx_opt *)*/ /*(*************************************************************************)*/ /*(* old: compound2: | { ([],[]) } | statement_list { ([], $1) } | decl_list { ($1, []) } | decl_list statement_list { ($1,$2) } statement_list: stat_or_decl_list { $1 } *)*/ /*(* decl_list: | decl { [$1] } | decl_list decl { $1 ++ [$2] } statement_list: | statement { [$1] } | statement_list statement { $1 ++ [$2] } *)*/ string_list: | string_elem { $1 } | string_list string_elem { $1 ++ $2 } colon_asm_list: | colon_asm { [$1] } | colon_asm_list colon_asm { $1 ++ [$2] } colon_option_list: | colon_option { [$1, []] } | colon_option_list TComma colon_option { $1 ++ [$3, [$2]] } argument_list_ne: | argument_ne { [$1, []] } | argument_list_ne TComma argument { $1 ++ [$3, [$2]] } argument_list: | argument { [$1, []] } | argument_list TComma argument { $1 ++ [$3, [$2]] } /*(* expression_list: | assign_expr { [$1, []] } | expression_list TComma assign_expr { $1 ++ [$3, [$2]] } *)*/ ident_define_list_ne: | TIdentDefine { [RegularName (mk_string_wrap $1), []] } | ident_define_list_ne TIdentDefine { $1 ++ [RegularName (mk_string_wrap $2), []] } struct_decl_list: | struct_decl { [$1] } | struct_decl_list struct_decl { $1 ++ [$2] } struct_declarator_list: | struct_declarator { [$1, []] } | struct_declarator_list TComma struct_declarator { $1 ++ [$3, [$2]] } enumerator_list: | enumerator { [$1, []] } | enumerator_list TComma enumerator { $1 ++ [$3, [$2]] } init_declarator_list: | init_declarator { [$1, []] } | init_declarator_list TComma init_declarator { $1 ++ [$3, [$2]] } parameter_list: | parameter_decl { [$1, []] } | parameter_list TComma parameter_decl { $1 ++ [$3, [$2]] } taction_list_ne: | TAction { [$1] } | TAction taction_list_ne { $1 :: $2 } taction_list: /*old: was generating conflict, hence now taction_list_ne | (* empty *) { [] } | TAction { [$1] } | taction_list TAction { $1 ++ [$2] } */ | { [] } | TAction taction_list { $1 :: $2 } param_define_list: | /*(* empty *)*/ { [] } | param_define { [$1, []] } | param_define_list TComma param_define { $1 ++ [$3, [$2]] } designator_list: | designator { [$1] } | designator_list designator { $1 ++ [$2] } attribute_list: | attribute { [$1] } | attribute_list attribute { $1 ++ [$2] } attribute_storage_list: | attribute_storage { [$1] } | attribute_storage_list attribute_storage { $1 ++ [$2] } attributes: attribute_list { $1 } /*(* gccext: which allow a trailing ',' in enum, as in perl *)*/ gcc_comma_opt: | TComma { [$1] } | /*(* empty *)*/ { [] } comma_opt: | TComma { [$1] } | /*(* empty *)*/ { [] } /*(* gcc_opt_virg: | TPtVirg { } | { } *)*/ gcc_opt_expr: | expr { Some $1 } | /*(* empty *)*/ { None } /*(* opt_ptvirg: | TPtVirg { [$1] } | { [] } *)*/ coccinelle-1.0.0-rc19/parsing_c/compare_c.ml0000644000175000017500000003117312247437436017624 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c type compare_result = | Correct | Pb of string | PbOnlyInNotParsedCorrectly of string (*****************************************************************************) (* Normalise before comparing *) (*****************************************************************************) (* List taken from CVS manual, 'Keyword substitution' chapter. Note * that I do not put "Log" because it is used only in comment, and it * is not enough to substituate until the end of the line. *) let cvs_keyword_list = [ "Id";"Date"; "Revision"; (* the common one *) "FreeBSD";"Heimdal";"KAME";"NetBSD";"OpenBSD";"OpenLDAP";"RuOBSD"; "SourceForge"; "Name";"Author";"CVSHeader";"Header";"Locker";"RCSfile";"Source";"State"; "Rev"; ] (* Can also have just dollarIDdollar but it is only when you have not * yet committed the file. After the commit it would be a dollarIddollar:. * If reput Id:, do not join the regexp!! otherwise CVS will modify it :) *) let cvs_keyword_regexp = Str.regexp ("\\$\\([A-Za-z_]+\\):[^\\$]*\\$") let cvs_compute_newstr s = Str.global_substitute cvs_keyword_regexp (fun _s -> let substr = Str.matched_string s in assert (substr ==~ cvs_keyword_regexp); (* use its side-effect *) let tag = matched1 substr in if not (List.mem tag cvs_keyword_list) then pr2_once ("unknown CVS keyword: " ^ tag); "CVS_MAGIC_STRING" ) s (* todo: get rid of the type for expressions ? *) let normal_form_program xs = let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kini_s = (fun (k,bigf) ini -> match ini with | InitList xs, [i1;i2;iicommaopt] -> k (InitList xs, [i1;i2]) | _ -> k ini ); Visitor_c.kexpr_s = (fun (k,bigf) e -> match e with (* todo: should also do something for multistrings *) | (Constant (String (s,kind)), typ), [ii] when Common.string_match_substring cvs_keyword_regexp s -> let newstr = cvs_compute_newstr s in (Constant (String (newstr,kind)), typ), [rewrap_str newstr ii] | _ -> k e ); Visitor_c.kfragment_s = (fun (k,bigf) e -> match e with (* todo: should also do something for multistrings *) | (ConstantFragment s), [ii] when Common.string_match_substring cvs_keyword_regexp s -> let newstr = cvs_compute_newstr s in (ConstantFragment newstr), [rewrap_str newstr ii] | _ -> k e ); Visitor_c.ktoplevel_s = (fun (k,bigf) p -> match p with | CppTop (Define _) -> raise Todo (* let (i1, i2, i3) = Common.tuple_of_list3 ii in if Common.string_match_substring cvs_keyword_regexp body then let newstr = cvs_compute_newstr body in Define ((s, newstr), [i1;i2;rewrap_str newstr i3]) else p *) | _ -> k p ); (* Visitor_c.kinfo_s = (fun (k,bigf) i -> let s = Ast_c.get_str_of_info i in if Common.string_match_substring cvs_keyword_regexp s then let newstr = cvs_compute_newstr s in rewrap_str newstr i else i ); *) } in xs +> List.map (fun p -> Visitor_c.vk_toplevel_s bigf p) let normal_form_token adjust_cvs x = let x' = match x with | Parser_c.TString ((s, kind),i1) -> Parser_c.TString (("",kind), i1) | x -> x in x' +> Token_helpers.visitor_info_of_tok (fun info -> let info = Ast_c.al_info 0 info in let str = Ast_c.str_of_info info in if adjust_cvs && Common.string_match_substring cvs_keyword_regexp str then let newstr = cvs_compute_newstr str in rewrap_str newstr info else info ) (*****************************************************************************) (* Compare at Ast level *) (*****************************************************************************) (* Note that I do a (simple) astdiff to know if there is a difference, but * then I use diff to print the differences. So sometimes you have to dig * a little to find really where the real difference (one not involving * just spacing difference) was. * Note also that the astdiff is not very accurate. As I skip comments, * macro definitions, those are not in the Ast and if there is a diff * between 2 files regarding macro def, then I will not be able to report it :( * update: I now put the toplevel #define at least in the Ast. * update: You can use token_compare for more precise diff. * * todo?: finer grain astdiff, better report, more precise. * * todo: do iso between if() S and if() { S } *) let compare_ast filename1 filename2 = let xs = match !Flag_parsing_c.diff_lines with None -> Common.cmd_to_list ("diff -u -b -B "^filename1^ " " ^ filename2) | Some n -> Common.cmd_to_list ("diff -U "^n^" -b -B "^filename1^" "^filename2) in (* get rid of the --- and +++ lines *) let xs = if null xs then xs else Common.drop 2 xs in let process_filename filename = (* no need for parsing of format strings *) let (c, _stat) = Parse_c.parse_c_and_cpp false filename in let c = List.map fst c in c +> Lib_parsing_c.al_program +> normal_form_program in let c1 = process_filename filename1 in let c2 = process_filename filename2 in let error = ref 0 in let pb_notparsed = ref 0 in let res = if List.length c1 <> List.length c2 then Pb "not same number of entities (func, decl, ...)" else begin let rec check = function | Declaration a, Declaration b -> if not (a =*= b) then incr error | Definition a, Definition b -> if not (a =*= b) then incr error | EmptyDef a, EmptyDef b -> if not (a =*= b) then incr error | MacroTop (a1,b1,c1), MacroTop (a2,b2,c2) -> if not ((a1,b1,c1) =*= (a2,b2,c2)) then incr error | CppTop (Include {i_include = a}), CppTop (Include {i_include = b}) -> if not (a =*= b) then incr error | CppTop Define _, CppTop Define _ -> raise Todo (* if not (a =*= b) then incr error *) | NotParsedCorrectly a, NotParsedCorrectly b -> if not (a =*= b) then incr pb_notparsed | NotParsedCorrectly a, _ -> (* Pb only in generated file *) incr error; | _, NotParsedCorrectly b -> incr pb_notparsed | FinalDef a, FinalDef b -> if not (a =*= b) then incr error | IfdefTop a, IfdefTop b -> if not (a =*= b) then incr error | Namespace (tlsa, iia), Namespace (tlsb, iib) -> if not (iia =*= iib) then incr error; zip tlsa tlsb +> List.iter check | (FinalDef _|EmptyDef _| MacroTop (_, _, _)|IfdefTop _| CppTop _|Definition _|Declaration _|Namespace _), _ -> incr error in zip c1 c2 +> List.iter check; (match () with | _ when !pb_notparsed > 0 && !error =|= 0 -> PbOnlyInNotParsedCorrectly "" | _ when !error > 0 -> Pb "" | _ -> Correct ) end in res, xs (*****************************************************************************) (* Compare at token level *) (*****************************************************************************) (* Because I now commentize more in parsing, with parsing_hacks, * compare_ast may say that 2 programs are equal whereas they are not. * Here I compare token, and so have still the TCommentCpp and TCommentMisc * so at least detect such differences. * * Morover compare_ast is not very precise in his report when it * detects a difference. So token_diff is better. * * I do token_diff but I use programCelement2, so that * I know if I am in a "notparsable" zone. The tokens are * in (snd programCelement2). * * Faire aussi un compare_token qui se moque des TCommentMisc, * TCommentCPP et TIfdef ? Normalement si fait ca retrouvera * les meme resultats que compare_ast. * *) (* Pass only "true" comments, don't pass TCommentMisc and TCommentCpp *) let is_normal_space_or_comment to_expected = function | Parser_c.TCommentSpace _ | Parser_c.TCommentNewline _ (* | Parser_c.TComma _ *) (* UGLY, because of gcc_opt_comma isomorphism *) -> true | Parser_c.TComment _ -> to_expected (* only ignore in compare to expected *) | _ -> false (* convetion: compare_token generated_file expected_res * because when there is a notparsablezone in generated_file, I * don't issue a PbOnlyInNotParsedCorrectly *) let do_compare_token adjust_cvs to_expected filename1 filename2 = let rec loop xs ys = match xs, ys with | [], [] -> None (* UGLY, because of gcc_opt_comma isomorphism *) | (Parser_c.TComma _::Parser_c.TCBrace _::xs), (Parser_c.TCBrace _::ys) -> loop xs ys | (Parser_c.TCBrace _::xs), (Parser_c.TComma _::Parser_c.TCBrace _::ys) -> loop xs ys | [], x::xs -> Some "not same number of tokens inside C elements" | x::xs, [] -> Some "not same number of tokens inside C elements" | x::xs, y::ys -> let x' = normal_form_token adjust_cvs x in let y' = normal_form_token adjust_cvs y in if x' =*= y' then loop xs ys else let str1, pos1 = Token_helpers.str_of_tok x, Token_helpers.pos_of_tok x in let str2, pos2 = Token_helpers.str_of_tok y, Token_helpers.pos_of_tok y in Some ("diff token: " ^ str1 ^" VS " ^ str2 ^ "\n" ^ Common.error_message filename1 (str1, pos1) ^ "\n" ^ Common.error_message filename2 (str2, pos2) ^ "\n" ) in let final_loop xs ys = loop (xs +> List.filter (fun x -> not (is_normal_space_or_comment to_expected x))) (ys +> List.filter (fun x -> not (is_normal_space_or_comment to_expected x))) in (* let toks1 = Parse_c.tokens filename1 in let toks2 = Parse_c.tokens filename2 in loop toks1 toks2 in *) let (c1, _stat) = Parse_c.parse_c_and_cpp false filename1 in let (c2, _stat) = Parse_c.parse_c_and_cpp false filename2 in let res = if List.length c1 <> List.length c2 then Pb "not same number of entities (func, decl, ...)" else zip c1 c2 +> Common.fold_k (fun acc ((a,infoa),(b,infob)) k -> match a, b with | NotParsedCorrectly a, NotParsedCorrectly b -> (match final_loop (snd infoa) (snd infob) with | None -> k acc | Some s -> PbOnlyInNotParsedCorrectly s ) | NotParsedCorrectly a, _ -> Pb "PB parsing only in generated-file" | _, NotParsedCorrectly b -> PbOnlyInNotParsedCorrectly "PB parsing only in expected-file" | _, _ -> (match final_loop (snd infoa) (snd infob) with | None -> k acc | Some s -> Pb s ) ) (fun acc -> acc) (Correct) in let xs = match !Flag_parsing_c.diff_lines with None -> Common.cmd_to_list ("diff -u -b -B "^filename1^ " " ^ filename2) | Some n -> Common.cmd_to_list ("diff -U "^n^" -b -B "^filename1^" "^filename2) in (* get rid of the --- and +++ lines *) let xs = if null xs then xs else Common.drop 2 xs in if null xs && (res <> Correct) then failwith "Impossible: How can diff be null and have not Correct in compare_c?"; res, xs let compare_token = do_compare_token true true (*****************************************************************************) (* compare to a res file *) let compare_default = do_compare_token true true (* compare to the source of the transformation *) let compare_to_original = do_compare_token false false let compare_result_to_string (correct, diffxs) = match correct with | Correct -> "seems correct" ^ "\n" | Pb s -> ("seems incorrect: " ^ s) ^ "\n" ^ "diff (result(-) vs expected_result(+)) = " ^ "\n" ^ (diffxs +> Common.join "\n") ^ "\n" | PbOnlyInNotParsedCorrectly s -> "seems incorrect, but only because of code that was not parsable" ^ "\n"^ ("explanation:" ^ s) ^ "\n" ^ "diff (result(-) vs expected_result(+)) = " ^ "\n" ^ (diffxs +> Common.join "\n") ^ "\n" let compare_result_to_bool correct = correct =*= Correct coccinelle-1.0.0-rc19/parsing_c/unparse_cocci.mli0000644000175000017500000000125012247437436020653 0ustar eugeneugenexception CantBeInPlus type pos = Before | After | InPlace type nlhint = StartBox | EndBox | SpaceOrNewline of string ref val pp_list_list_any : Ast_c.metavars_binding list * (* pr cocci *) (string -> int (*line*) -> int (*lcol*) -> int (*rcol*) -> nlhint option -> unit) * (Ast_c.info -> unit) (* pr c *) * (unit -> unit) (* pr C space *) * (unit -> unit) (* pr space *) * (string -> unit) (* pr arity *) * (int (*line*) -> int (*lcol*) -> unit) (* pr barrier *) * (unit -> unit) (* indent *) * (bool -> unit) (* unindent *) * (unit -> unit) (* eat_space *)-> bool (*true if generating*) -> Ast_cocci.anything list list -> pos -> unit coccinelle-1.0.0-rc19/parsing_c/parsing_c.mllib0000644000175000017500000000062312247437436020324 0ustar eugeneugenToken_annot Flag_parsing_c Parsing_stat Token_c Ast_c Control_flow_c Visitor_c Lib_parsing_c Control_flow_c_build Pretty_print_c Semantic_c Lexer_parser Parser_c Lexer_c Token_helpers Token_views_c Cpp_token_c Parsing_hacks Cpp_analysis_c Unparse_cocci Unparse_c Unparse_hrule Parsing_recovery_c Parsing_consistency_c Parse_c Type_c Cpp_ast_c Type_annoter_c Comment_annotater_c Compare_c Test_parsing_c coccinelle-1.0.0-rc19/parsing_c/parsing_hacks.mli0000644000175000017500000000576712247437436020673 0ustar eugeneugen(* This module tries to detect some cpp idioms so that we can parse as-is * files by adjusting or commenting some tokens. Parsing hack style. * Sometime we use some indentation information, * sometimes we do some kind of lalr(k) by finding patterns. Often try to * work on better token representation, like ifdef-paren-ized, brace-ized, * paren-ized, so can do easier pattern matching to more easily match * complex cpp idiom pattern (cf token_views_c.ml). * We also try to get more contextual information such as whether the * token is in a initializer as some common patterns have different * use depending on context. * * * Example of cpp idioms: * - if 0 for commenting stuff (not always code, sometimes just real comments) * - ifdef old version * - ifdef funheader * - ifdef statements, ifdef expression, ifdef-mid * - macro toplevel (with or without ptvirg) * - macro foreach * - macro higher order * - macro declare * - macro debug * - macro no ptvirg * - macro string, and macro function string taking param and ## * - macro attribute * * Cf the TMacroXxx in parser_c.mly and MacroXxx in ast_c.ml * * Also try to infer typedef. * * Also do other stuff involving cpp like expanding some macros, * or try parse well define body by finding the end of define virtual * end-of-line token. But now most of the code is actually in cpp_token_c.ml * It is related to what is in the yacfe configuration file (e.g. standard.h) *) val regexp_macro: Str.regexp val regexp_annot: Str.regexp val regexp_declare: Str.regexp val regexp_foreach: Str.regexp val regexp_typedef: Str.regexp (* can reset this global *) val ifdef_paren_cnt: int ref val filter_cpp_stuff : Token_views_c.token_extended list -> Token_views_c.token_extended list val insert_virtual_positions: Parser_c.token list -> Parser_c.token list (* expand format strings *) val fix_tokens_strings : Parser_c.token list -> Parser_c.token list (* will among other things interally call cpp_token_c to macro * expand some macros *) val fix_tokens_cpp : macro_defs:(string, Cpp_token_c.define_def) Hashtbl.t -> Parser_c.token list -> Parser_c.token list (* next stream tokens -> passed stream tokens -> final next token *) val lookahead : pass:int -> Parser_c.token list -> Parser_c.token list -> Parser_c.token (* ------------------------------------------------------------------------ *) (* Parsing hack helpers related to #define or #include *) (* ------------------------------------------------------------------------ *) (* generate virtual end-of-line token, TDefEol, pass the antislash, etc *) val fix_tokens_define : Parser_c.token list -> Parser_c.token list (* called when need to pass some tokens during some error recovery *) val drop_until_defeol: Parser_c.token list -> Parser_c.token list val comment_until_defeol: Parser_c.token list -> Parser_c.token list (* generates TIncludeStart and TIncludeFilename tokens *) val tokens_include: Ast_c.info * string * string * bool ref -> Parser_c.token * Parser_c.token list coccinelle-1.0.0-rc19/parsing_c/parse_c.mli0000644000175000017500000000626712247437436017467 0ustar eugeneugen(* The main function is parse_c_and_cpp. It uses globals in Lexer_Parser and * and also _defs below which often comes from a standard.h macro file. * cf also init_defs_xxx below. *) type program2 = toplevel2 list and extended_program2 = toplevel2 list * (string, Lexer_parser.identkind) Common.scoped_h_env (* type defs *) * (string, Cpp_token_c.define_def) Hashtbl.t (* macro defs *) and toplevel2 = Ast_c.toplevel * info_item (* the token list contains now also the comment-tokens *) and info_item = (string * Parser_c.token list) (* usually correspond to what is inside your macros.h *) val _defs : (string, Cpp_token_c.define_def) Hashtbl.t ref (* usually correspond to what is inside your standard.h *) val _defs_builtins : (string, Cpp_token_c.define_def) Hashtbl.t ref val init_defs_macros : Common.filename -> unit val init_defs_builtins : Common.filename -> unit (* This is the main function *) val parse_c_and_cpp : bool (* true if format characters need to be parsed *) -> Common.filename (*cfile*) -> (program2 * Parsing_stat.parsing_stat) val parse_c_and_cpp_keep_typedefs : (string, Lexer_parser.identkind) Common.scoped_h_env option (*typedefs*) -> (string, Cpp_token_c.define_def) Hashtbl.t option (* macro defs *) -> bool (* true if format characters need to be parsed *) -> Common.filename (*cfile*) -> (extended_program2 * Parsing_stat.parsing_stat) (* use some .ast_raw memoized version, and take care if obsolete *) val parse_cache: bool (* true if format characters need to be parsed *) -> Common.filename (*cfile*) -> (extended_program2 * Parsing_stat.parsing_stat) (* ---------------------------------------------------------------------- *) (* used to extract macros from standard.h, but also now from regular C files * in -extract_macros to later feed an automatically build standard.h *) val extract_macros : Common.filename -> (string, Cpp_token_c.define_def) Common.assoc (* ---------------------------------------------------------------------- *) (* used also for the standard.h file *) val tokens: ?profile:bool -> Common.filename -> Parser_c.token list val tokens_of_string: string -> Parser_c.token list val parse: Common.filename -> Ast_c.program val parse_print_error: Common.filename -> Ast_c.program val parse_gen: ((Lexing.lexbuf -> Parser_c.token) -> Lexing.lexbuf -> 'a) -> string -> 'a (* ---------------------------------------------------------------------- *) (* Easy way to build complex Ast elements from simple strings. * Can also be useful when called from the ocaml toplevel to test. *) val type_of_string : string -> Ast_c.fullType val statement_of_string : string -> Ast_c.statement (* similar but use parse_c_and_cpp and a /tmp/__cocci.c and extract the part *) val cstatement_of_string : string -> Ast_c.statement val cexpression_of_string : string -> Ast_c.expression (* ---------------------------------------------------------------------- *) (* a few helpers *) val print_commentized : Parser_c.token list -> unit val program_of_program2 : program2 -> Ast_c.program val with_program2: (Ast_c.program -> Ast_c.program) -> program2 -> program2 coccinelle-1.0.0-rc19/parsing_c/token_c.ml0000644000175000017500000002160212247437436017312 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2009 University of Urbana Champaign * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* This file may seems redundant with the tokens generated by Yacc * from parser.mly in parser_c.mli. The problem is that we need for * many reasons to remember in the ast_c the tokens invoved in this * ast, not just the string, especially for the comment and cpp_passed * tokens which pour le coup were not in the ast at all. So, * to avoid recursive mutual dependencies, we provide this file * so that ast_c does not need to depend on yacc which depends on * ast_c, etc. * * Also, ocamlyacc imposes some stupid constraints on the way we can define * the token type. ocamlyacc forces us to do a token type that * cannot be a pair of a sum type, it must be directly a sum type. * We don't have this constraint here. * * Also, some yacc tokens are not used in the grammar because they are filtered * in some intermediate phases. But they still must be declared because * ocamllex may generate them, or some intermediate phase may also * generate them (like some functions in parsing_hacks.ml). * Here we don't have this problem again so we can have a clearer token type. * * *) (*****************************************************************************) (* Cpp constructs put in comments in lexer or parsing_hack *) (*****************************************************************************) (* history: was in ast_c.ml before: * This type is not in the Ast but is associated with the TCommentCpp * token. I put this enum here because parser_c.mly need it. I could have put * it also in lexer_parser. * * update: now in token_c.ml, and actually right now we want those tokens * to be in the ast so that in the matching/transforming of C code, we * can detect if some metavariables match code which have some * cpp_passed tokens next to them (and so where we should issue a warning). *) type cppcommentkind = | CppDirective | CppIfDirective of ifdef (* ifdef - multipart directive *) | CppAttr | CppMacro | CppPassingNormal (* ifdef 0, cplusplus, etc *) | CppPassingCosWouldGetError (* expr passsing *) | CppPassingExplicit (* skip_start/end tag *) (* avoid circularity with Parser_c *) and ifdef = IfDef | IfDef0 | Else | Endif | Other (*****************************************************************************) (* Types *) (*****************************************************************************) (* * TODO? Do we want to handle also non OriginTok-like tokens here ? * Right now we use this file to be able to later store in the * ast some information about comments and passed cpp tokens, to * improve our matching/transforming and unparsing in coccinelle. * So we should be concerned really only with origin tok, so right * now I use a simple Common.parse_info, not the more complex * Ast_c.parse_info, or even more complex Ast_c.info. * Also right now I defined only the token_tags of comment-like * tokens. *) type info = Common.parse_info (* I try to be consistent with the names in parser_c.mli *) type token = token_tag * info and token_tag = | TCommentSpace | TCommentNewline | TComment (* the passed tokens because of our limited handling of cpp *) | TCommentCpp of cppcommentkind (*| TUnknown ? *) (* Later if decide to include more kinds of tokens, then may * have to move the current token_tag like TCommentXxx in their * own type and have a generic TCommentLike of comment_like_token * in token_tag. Could also do like in token_helpers have some * is_xxx predicate, but it's not very pretty (but required when * some tokens can belong to multiple categories). * * It's supposed to be all the tokens that are not otherwise represented * in the ast via regular constructors and info. *) type comment_like_token = token (*****************************************************************************) (* Getters *) (*****************************************************************************) (* simpler than in token_helpers :) because we don't have the ocamlyacc * constraints on how to define the token type. *) let info_of_token = snd (*****************************************************************************) (*****************************************************************************) (* remaining tokens could define a type token_class = Comment | Ident | Operator | ... | TInt of (string * Ast_c.info) | TFloat of ((string * Ast_c.floatType) * Ast_c.info) | TChar of ((string * Ast_c.isWchar) * Ast_c.info) | TString of ((string * Ast_c.isWchar) * Ast_c.info) | TIdent of (string * Ast_c.info) | TypedefIdent of (string * Ast_c.info) | TOPar of (Ast_c.info) | TCPar of (Ast_c.info) | TOBrace of (Ast_c.info) | TCBrace of (Ast_c.info) | TOCro of (Ast_c.info) | TCCro of (Ast_c.info) | TDot of (Ast_c.info) | TComma of (Ast_c.info) | TPtrOp of (Ast_c.info) | TInc of (Ast_c.info) | TDec of (Ast_c.info) | TAssign of (Ast_c.assignOp * Ast_c.info) | TEq of (Ast_c.info) | TWhy of (Ast_c.info) | TTilde of (Ast_c.info) | TBang of (Ast_c.info) | TEllipsis of (Ast_c.info) | TDotDot of (Ast_c.info) | TPtVirg of (Ast_c.info) | TOrLog of (Ast_c.info) | TAndLog of (Ast_c.info) | TOr of (Ast_c.info) | TXor of (Ast_c.info) | TAnd of (Ast_c.info) | TEqEq of (Ast_c.info) | TNotEq of (Ast_c.info) | TInf of (Ast_c.info) | TSup of (Ast_c.info) | TInfEq of (Ast_c.info) | TSupEq of (Ast_c.info) | TShl of (Ast_c.info) | TShr of (Ast_c.info) | TPlus of (Ast_c.info) | TMinus of (Ast_c.info) | TMul of (Ast_c.info) | TDiv of (Ast_c.info) | TMin of (Ast_c.info) | TMax of (Ast_c.info) | TMod of (Ast_c.info) | TMin of (Ast_c.info) | TMax of (Ast_c.info) | Tchar of (Ast_c.info) | Tshort of (Ast_c.info) | Tint of (Ast_c.info) | Tdouble of (Ast_c.info) | Tfloat of (Ast_c.info) | Tlong of (Ast_c.info) | Tunsigned of (Ast_c.info) | Tsigned of (Ast_c.info) | Tvoid of (Ast_c.info) | Tauto of (Ast_c.info) | Tregister of (Ast_c.info) | Textern of (Ast_c.info) | Tstatic of (Ast_c.info) | Ttypedef of (Ast_c.info) | Tconst of (Ast_c.info) | Tvolatile of (Ast_c.info) | Tstruct of (Ast_c.info) | Tunion of (Ast_c.info) | Tenum of (Ast_c.info) | Tbreak of (Ast_c.info) | Telse of (Ast_c.info) | Tswitch of (Ast_c.info) | Tcase of (Ast_c.info) | Tcontinue of (Ast_c.info) | Tfor of (Ast_c.info) | Tdo of (Ast_c.info) | Tif of (Ast_c.info) | Twhile of (Ast_c.info) | Treturn of (Ast_c.info) | Tgoto of (Ast_c.info) | Tdefault of (Ast_c.info) | Tsizeof of (Ast_c.info) | Trestrict of (Ast_c.info) | Tasm of (Ast_c.info) | Tattribute of (Ast_c.info) | Tinline of (Ast_c.info) | Ttypeof of (Ast_c.info) | TDefine of (Ast_c.info) | TDefParamVariadic of ((string * Ast_c.info)) | TCppEscapedNewline of (Ast_c.info) | TOParDefine of (Ast_c.info) | TOBraceDefineInit of (Ast_c.info) | TIdentDefine of ((string * Ast_c.info)) | TDefEOL of (Ast_c.info) | TInclude of ((string * string * bool ref * Ast_c.info)) | TIncludeStart of ((Ast_c.info * bool ref)) | TIncludeFilename of ((string * Ast_c.info)) | TIfdef of (((int * int) option ref * Ast_c.info)) | TIfdefelse of (((int * int) option ref * Ast_c.info)) | TIfdefelif of (((int * int) option ref * Ast_c.info)) | TEndif of (((int * int) option ref * Ast_c.info)) | TIfdefBool of ((bool * (int * int) option ref * Ast_c.info)) | TIfdefMisc of ((bool * (int * int) option ref * Ast_c.info)) | TIfdefVersion of ((bool * (int * int) option ref * Ast_c.info)) | TUndef of (string * Ast_c.info) | TCppDirectiveOther of (Ast_c.info) | TMacroAttr of ((string * Ast_c.info)) | TMacroStmt of ((string * Ast_c.info)) | TMacroString of ((string * Ast_c.info)) | TMacroDecl of ((string * Ast_c.info)) | TMacroDeclConst of (Ast_c.info) | TMacroStructDecl of ((string * Ast_c.info)) | TMacroIterator of ((string * Ast_c.info)) | TMacroAttrStorage of ((string * Ast_c.info)) | TCommentSkipTagStart of (Ast_c.info) | TCommentSkipTagEnd of (Ast_c.info) | TCParEOL of (Ast_c.info) | TAction of (Ast_c.info) | TCommentMisc xxx | EOF of (Ast_c.info) *) (*****************************************************************************) (* Helpers *) (*****************************************************************************) coccinelle-1.0.0-rc19/parsing_c/credits.txt0000644000175000017500000000064212247437436017535 0ustar eugeneugenThanks to Julia Lawall for the idea to better parse C+CPP by using indentation information for heuristic-based parsing. Thanks to Julia again for many other things too long to enumerate. Inspiration: - C yacc grammar published in 1985 by Jeff Lee: lex: http://www.lysator.liu.se/c/ANSI-C-grammar-l.html yacc: http://www.lysator.liu.se/c/ANSI-C-grammar-y.html - FrontC of hughes casse ? - CIL ? - EDG ? coccinelle-1.0.0-rc19/parsing_c/token_annot.ml0000644000175000017500000000132012247437436020202 0ustar eugeneugen(* Provides a dictionary of possible annotations on tokens, indexed by keys. * * The purpose of these annotations is to direct the pretty printing of * tokens. The annotations can be set by AST transformations. * * Assumptions: only a few tokens have annotations, and those have only * a few of them. *) type annot_key = Exclude_start | Exclude_end type annot_val = Unit (* A linked list should offer a good tradeoff between space usage * and lookup overhead given our assumptions. *) type annots = (annot_key * annot_val) list let empty = [] let get_annot anns key = if List.mem_assoc key anns then Some (List.assoc key anns) else None let put_annot key value anns = (key, value) :: anns coccinelle-1.0.0-rc19/parsing_c/cpp_ast_c.mli0000644000175000017500000000260512247437436017776 0ustar eugeneugentype cpp_option = | I of Common.dirname | D of string * string option val cpp_option_of_cmdline: Common.dirname list (* -I *) * string list (* -D *) -> cpp_option list val show_cpp_i_opts: string list -> unit val show_cpp_d_opts: string list -> unit (* ---------------------------------------------------------------------- *) (* cpp_expand_include below must internally use a cache of header files to * speedup as programs very often reinclude the same basic set of * header files. * * note: that also means that the asts of those headers are then shared * so take care!! *) val _headers_hash: (Common.filename, Parse_c.program2 * Parsing_stat.parsing_stat) Hashtbl.t (* It can also try to find header files in nested directories if the * caller use the function below first. *) val _hcandidates: (string, Common.filename) Hashtbl.t val init_adjust_candidate_header_files: Common.dirname -> unit (* ---------------------------------------------------------------------- *) (* #include *) val cpp_expand_include: ?depth_limit:int option -> ?threshold_cache_nb_files:int -> cpp_option list -> Common.dirname (* start point for relative paths *) -> Ast_c.program -> Ast_c.program (* #ifdef *) val cpp_ifdef_statementize: Ast_c.program -> Ast_c.program (* #define *) val cpp_expand_macro_expr: Ast_c.define_kind -> Ast_c.argument Ast_c.wrap2 list -> Ast_c.expression option coccinelle-1.0.0-rc19/parsing_c/token_views_c.ml0000644000175000017500000003706312247437436020537 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common module TH = Token_helpers open Parser_c (*****************************************************************************) (* Some debugging functions *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (* ------------------------------------------------------------------------- *) (* fuzzy parsing, different "views" over the same program *) (* ------------------------------------------------------------------------- *) (* Normally I should not use ref/mutable in the token_extended type * and I should have a set of functions taking a list of tokens and * returning a list of tokens. The problem is that to make easier some * functions, it is better to work on better representation, on "views" * over this list of tokens. But then modifying those views and get * back from those views to the original simple list of tokens is * tedious. One way is to maintain next to the view a list of "actions" * (I was using a hash storing the charpos of the token and associating * the action) but it is tedious too. Simpler to use mutable/ref. We * use the same idea that we use when working on the Ast_c. *) (* old: when I was using the list of "actions" next to the views, the hash * indexed by the charpos, there could have been some problems: * how my fake_pos interact with the way I tag and adjust token ? * because I base my tagging on the position of the token ! so sometimes * could tag another fakeInfo that should not be tagged ? * fortunately I don't use anymore this technique. *) (* update: quite close to the Place_c.Inxxx *) type context = InFunction | InEnum | InStruct | InInitializer | NoContext type token_extended = { mutable tok: Parser_c.token; mutable where: context; (* less: need also a after ? *) mutable new_tokens_before : Parser_c.token list; (* line x col cache, more easily accessible, of the info in the token *) line: int; col : int; } (* todo? is it ok to reset as a comment a TDefEOL ? if do that, then * can confuse the parser. *) let set_as_comment cppkind x = if TH.is_eof x.tok then () (* otherwise parse_c will be lost if don't find a EOF token *) else x.tok <- TCommentCpp (cppkind, TH.info_of_tok x.tok) let save_as_comment cppkind x = if TH.is_eof x.tok then () (* otherwise parse_c will be lost if don't find a EOF token *) else let t = match x.tok with TIfdef _ | TIfdefMisc _ | TIfdefVersion _ -> Token_c.IfDef | TIfdefBool _ -> Token_c.IfDef0 | TIfdefelse _ | TIfdefelif _ -> Token_c.Else | TEndif _ -> Token_c.Endif | _ -> Token_c.Other in x.tok <- TCommentCpp (cppkind t, TH.info_of_tok x.tok) let mk_token_extended x = let (line, col) = TH.linecol_of_tok x in { tok = x; line = line; col = col; where = NoContext; new_tokens_before = []; } let rebuild_tokens_extented toks_ext = let _tokens = ref [] in toks_ext +> List.iter (fun tok -> tok.new_tokens_before +> List.iter (fun x -> push2 x _tokens); push2 tok.tok _tokens ); let tokens = List.rev !_tokens in (tokens +> acc_map mk_token_extended) (* x list list, because x list separated by ',' *) type paren_grouped = | Parenthised of paren_grouped list list * token_extended list | PToken of token_extended type brace_grouped = | Braceised of brace_grouped list list * token_extended * token_extended option | BToken of token_extended (* Far better data structure than doing hacks in the lexer or parser * because in lexer we don't know to which ifdef a endif is related * and so when we want to comment a ifdef, we don't know which endif * we must also comment. Especially true for the #if 0 which sometimes * have a #else part. * * x list list, because x list separated by #else or #elif *) type ifdef_grouped = | Ifdef of ifdef_grouped list list * token_extended list | Ifdefbool of bool * ifdef_grouped list list * token_extended list | NotIfdefLine of token_extended list type 'a line_grouped = Line of 'a list type body_function_grouped = | BodyFunction of token_extended list | NotBodyLine of token_extended list (* ------------------------------------------------------------------------- *) (* view builders *) (* ------------------------------------------------------------------------- *) (* todo: synchro ! use more indentation * if paren not closed and same indentation level, certainly because * part of a mid-ifdef-expression. *) let rec mk_parenthised xs = let rec loop acc = function | [] -> acc | x::xs -> (match x.tok with | TOPar _ | TOParDefine _ -> let body, extras, xs = mk_parameters [x] [] xs in loop (Parenthised (body,extras)::acc) xs | _ -> loop (PToken x::acc) xs ) in List.rev(loop [] xs) (* return the body of the parenthised expression and the rest of the tokens *) and mk_parameters extras acc_before_sep xs = match xs with | [] -> (* maybe because of #ifdef which "opens" '(' in 2 branches *) pr2 "PB: not found closing paren in fuzzy parsing"; [List.rev acc_before_sep], List.rev extras, [] | x::xs -> (match x.tok with (* synchro *) | TOBrace _ when x.col =|= 0 -> pr2 "PB: found synchro point } in paren"; [List.rev acc_before_sep], List.rev (extras), (x::xs) | TCPar _ | TCParEOL _ -> [List.rev acc_before_sep], List.rev (x::extras), xs | TOPar _ | TOParDefine _ -> let body, extrasnest, xs = mk_parameters [x] [] xs in mk_parameters extras (Parenthised (body,extrasnest)::acc_before_sep) xs | TComma _ -> let body, extras, xs = mk_parameters (x::extras) [] xs in (List.rev acc_before_sep)::body, extras, xs | _ -> mk_parameters extras (PToken x::acc_before_sep) xs ) let rec mk_braceised xs = let rec loop acc = function | [] -> acc | x::xs -> (match x.tok with | TOBrace _ -> let body, endbrace, xs = mk_braceised_aux [] xs in loop (Braceised (body, x, endbrace)::acc) xs | TCBrace _ -> pr2 "PB: found closing brace alone in fuzzy parsing"; loop (BToken x::acc) xs | _ -> loop (BToken x::acc) xs) in List.rev(loop [] xs) (* return the body of the parenthised expression and the rest of the tokens *) and mk_braceised_aux acc xs = match xs with | [] -> (* maybe because of #ifdef which "opens" '(' in 2 branches *) pr2 "PB: not found closing brace in fuzzy parsing"; [List.rev acc], None, [] | x::xs -> (match x.tok with | TCBrace _ -> [List.rev acc], Some x, xs | TOBrace _ -> let body, endbrace, xs = mk_braceised_aux [] xs in mk_braceised_aux (Braceised (body,x, endbrace)::acc) xs | _ -> mk_braceised_aux (BToken x::acc) xs ) let rec mk_ifdef xs = match xs with | [] -> [] | x::xs -> (match x.tok with | TIfdef _ -> let body, extra, xs = mk_ifdef_parameters [x] [] xs in Ifdef (body, extra)::mk_ifdef xs | TIfdefBool (b,_, _) -> let body, extra, xs = mk_ifdef_parameters [x] [] xs in (* if not passing, then consider a #if 0 as an ordinary #ifdef *) if !Flag_parsing_c.if0_passing then Ifdefbool (b, body, extra)::mk_ifdef xs else Ifdef(body, extra)::mk_ifdef xs | TIfdefMisc (b,_,_) | TIfdefVersion (b,_,_) -> let body, extra, xs = mk_ifdef_parameters [x] [] xs in Ifdefbool (b, body, extra)::mk_ifdef xs | _ -> (* todo? can have some Ifdef in the line ? *) let line, xs = Common.span (fun y -> y.line =|= x.line) (x::xs) in NotIfdefLine line::mk_ifdef xs ) and mk_ifdef_parameters extras acc_before_sep xs = match xs with | [] -> (* Note that mk_ifdef is assuming that CPP instruction are alone * on their line. Because I do a span (fun x -> is_same_line ...) * I might take with me a #endif if this one is mixed on a line * with some "normal" tokens. *) pr2 "PB: not found closing ifdef in fuzzy parsing"; [List.rev acc_before_sep], List.rev extras, [] | x::xs -> (match x.tok with | TEndif _ -> [List.rev acc_before_sep], List.rev (x::extras), xs | TIfdef _ -> let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in mk_ifdef_parameters extras (Ifdef (body, extrasnest)::acc_before_sep) xs | TIfdefBool (b,_,_) -> let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in if !Flag_parsing_c.if0_passing then mk_ifdef_parameters extras (Ifdefbool (b, body, extrasnest)::acc_before_sep) xs else mk_ifdef_parameters extras (Ifdef (body, extrasnest)::acc_before_sep) xs | TIfdefMisc (b,_,_) | TIfdefVersion (b,_,_) -> let body, extrasnest, xs = mk_ifdef_parameters [x] [] xs in mk_ifdef_parameters extras (Ifdefbool (b, body, extrasnest)::acc_before_sep) xs | TIfdefelse _ | TIfdefelif _ -> let body, extras, xs = mk_ifdef_parameters (x::extras) [] xs in (List.rev acc_before_sep)::body, extras, xs | _ -> let line, xs = Common.span (fun y -> y.line =|= x.line) (x::xs) in mk_ifdef_parameters extras (NotIfdefLine line::acc_before_sep) xs ) (* --------------------------------------- *) let line_of_paren = function | PToken x -> x.line | Parenthised (xxs, info_parens) -> (match info_parens with | [] -> raise (Impossible 121) | x::xs -> x.line ) let rec span_line_paren line = function | [] -> [],[] | x::xs -> (match x with | PToken tok when TH.is_eof tok.tok -> [], x::xs | _ -> if line_of_paren x =|= line then let (l1, l2) = span_line_paren line xs in (x::l1, l2) else ([], x::xs) ) let rec mk_line_parenthised xs = match xs with | [] -> [] | x::xs -> let line_no = line_of_paren x in let line, xs = span_line_paren line_no xs in Line (x::line)::mk_line_parenthised xs (* --------------------------------------- *) let rec mk_body_function_grouped xs = match xs with | [] -> [] | x::xs -> (match x with | {tok = TOBrace _; col = 0} -> let is_closing_brace = function | {tok = TCBrace _; col = 0 } -> true | _ -> false in let body, xs = Common.span (fun x -> not (is_closing_brace x)) xs in (match xs with | ({tok = TCBrace _; col = 0 })::xs -> BodyFunction body::mk_body_function_grouped xs | [] -> pr2 "PB:not found closing brace in fuzzy parsing"; [NotBodyLine body] | _ -> raise (Impossible 122) ) | _ -> let line, xs = Common.span (fun y -> y.line =|= x.line) (x::xs) in NotBodyLine line::mk_body_function_grouped xs ) (* ------------------------------------------------------------------------- *) (* view iterators *) (* ------------------------------------------------------------------------- *) let rec iter_token_paren f xs = xs +> List.iter (function | PToken tok -> f tok; | Parenthised (xxs, info_parens) -> info_parens +> List.iter f; xxs +> List.iter (fun xs -> iter_token_paren f xs) ) let rec iter_token_brace f xs = xs +> List.iter (function | BToken tok -> f tok; | Braceised (xxs, tok1, tok2opt) -> f tok1; do_option f tok2opt; xxs +> List.iter (fun xs -> iter_token_brace f xs) ) let rec iter_token_ifdef f xs = xs +> List.iter (function | NotIfdefLine xs -> xs +> List.iter f; | Ifdefbool (_, xxs, info_ifdef) | Ifdef (xxs, info_ifdef) -> info_ifdef +> List.iter f; xxs +> List.iter (iter_token_ifdef f) ) let tokens_of_paren xs = let g = ref [] in xs +> iter_token_paren (fun tok -> push2 tok g); List.rev !g let tokens_of_paren_ordered xs = let g = ref [] in let rec aux_tokens_ordered = function | PToken tok -> push2 tok g; | Parenthised (xxs, info_parens) -> let (opar, cpar, commas) = match info_parens with | opar::xs -> (match List.rev xs with | cpar::xs -> opar, cpar, List.rev xs | _ -> raise (Impossible 123) ) | _ -> raise (Impossible 124) in push2 opar g; aux_args (xxs,commas); push2 cpar g; and aux_args (xxs, commas) = match xxs, commas with | [], [] -> () | [xs], [] -> xs +> List.iter aux_tokens_ordered | xs::ys::xxs, comma::commas -> xs +> List.iter aux_tokens_ordered; push2 comma g; aux_args (ys::xxs, commas) | _ -> raise (Impossible 125) in xs +> List.iter aux_tokens_ordered; List.rev !g (* ------------------------------------------------------------------------- *) (* set the context info in token *) (* ------------------------------------------------------------------------- *) let rec set_in_function_tag xs = (* could try: ) { } but it can be the ) of a if or while, so * better to base the heuristic on the position in column zero. * Note that some struct or enum or init put also their { in first column * but set_in_other will overwrite the previous InFunction tag. *) match xs with | [] -> () (* ) { and the closing } is in column zero, then certainly a function *) | BToken ({tok = TCPar _ })::(Braceised (body, tok1, Some tok2))::xs when tok1.col <> 0 && tok2.col =|= 0 -> body +> List.iter (iter_token_brace (fun tok -> tok.where <- InFunction )); set_in_function_tag xs | (BToken x)::xs -> set_in_function_tag xs | (Braceised (body, tok1, Some tok2))::xs when tok1.col =|= 0 && tok2.col =|= 0 -> body +> List.iter (iter_token_brace (fun tok -> tok.where <- InFunction )); set_in_function_tag xs | Braceised (body, tok1, tok2)::xs -> set_in_function_tag xs let rec set_in_other xs = match xs with | [] -> () (* enum x { } *) | BToken ({tok = Tenum _})::BToken ({tok = TIdent _}) ::Braceised(body, tok1, tok2)::xs | BToken ({tok = Tenum _}) ::Braceised(body, tok1, tok2)::xs -> body +> List.iter (iter_token_brace (fun tok -> tok.where <- InEnum; )); set_in_other xs (* struct x { } *) | BToken ({tok = Tstruct _})::BToken ({tok = TIdent _}) ::Braceised(body, tok1, tok2)::xs -> body +> List.iter (iter_token_brace (fun tok -> tok.where <- InStruct; )); set_in_other xs (* = { } *) | BToken ({tok = TEq _}) ::Braceised(body, tok1, tok2)::xs -> body +> List.iter (iter_token_brace (fun tok -> tok.where <- InInitializer; )); set_in_other xs | BToken _::xs -> set_in_other xs | Braceised(body, tok1, tok2)::xs -> body +> List.iter set_in_other; set_in_other xs let set_context_tag xs = begin set_in_function_tag xs; set_in_other xs; end coccinelle-1.0.0-rc19/parsing_c/authors.txt0000644000175000017500000000002012247437436017553 0ustar eugeneugenYoann Padioleau coccinelle-1.0.0-rc19/parsing_c/parsing_c.mldylib0000644000175000017500000000062312247437436020661 0ustar eugeneugenToken_annot Flag_parsing_c Parsing_stat Token_c Ast_c Control_flow_c Visitor_c Lib_parsing_c Control_flow_c_build Pretty_print_c Semantic_c Lexer_parser Parser_c Lexer_c Token_helpers Token_views_c Cpp_token_c Parsing_hacks Cpp_analysis_c Unparse_cocci Unparse_c Unparse_hrule Parsing_recovery_c Parsing_consistency_c Parse_c Type_c Cpp_ast_c Type_annoter_c Comment_annotater_c Compare_c Test_parsing_c coccinelle-1.0.0-rc19/parsing_c/parsing_recovery_c.ml0000644000175000017500000001207212247437436021554 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common module TH = Token_helpers (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2_err, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Helpers *) (*****************************************************************************) let is_defined_passed_bis last_round = let xs = last_round +> List.filter TH.is_not_comment in match xs with | Parser_c.TDefine _::_ -> true | _ -> false (*****************************************************************************) (* Skipping stuff, find next "synchronisation" point *) (*****************************************************************************) (* todo: do something if find Parser_c.Eof ? *) let rec find_next_synchro ~next ~already_passed = (* Maybe because not enough }, because for example an ifdef contains * in both branch some opening {, we later eat too much, "on deborde * sur la fonction d'apres". So already_passed may be too big and * looking for next synchro point starting from next may not be the * best. So maybe we can find synchro point inside already_passed * instead of looking in next. * * But take care! must progress. We must not stay in infinite loop! * For instance now I have as a error recovery to look for * a "start of something", corresponding to start of function, * but must go beyond this start otherwise will loop. * So look at premier(external_declaration2) in parser.output and * pass at least those first tokens. * * I have chosen to start search for next synchro point after the * first { I found, so quite sure we will not loop. *) let last_round = List.rev already_passed in if is_defined_passed_bis last_round then find_next_synchro_define (last_round ++ next) [] else let (before, after) = last_round +> Common.span (fun tok -> match tok with (* by looking at TOBrace we are sure that the "start of something" * will not arrive too early *) | Parser_c.TOBrace _ -> false | Parser_c.TDefine _ -> false | _ -> true ) in find_next_synchro_orig (after ++ next) (List.rev before) and find_next_synchro_define next already_passed = match next with | [] -> pr2_err "ERROR-RECOV: end of file while in recovery mode"; already_passed, [] | (Parser_c.TDefEOL i as v)::xs -> pr2_err ("ERROR-RECOV: found sync end of #define, line "^i_to_s(TH.line_of_tok v)); v::already_passed, xs | v::xs -> find_next_synchro_define xs (v::already_passed) and find_next_synchro_orig next already_passed = match next with | [] -> pr2_err "ERROR-RECOV: end of file while in recovery mode"; already_passed, [] | (Parser_c.TCBrace i as v)::xs when TH.col_of_tok v =|= 0 -> pr2_err ("ERROR-RECOV: found sync '}' at line "^i_to_s (TH.line_of_tok v)); (match xs with | [] -> raise (Impossible 94) (* there is a EOF token normally *) (* still useful: now parser.mly allow empty ';' so normally no pb *) | Parser_c.TPtVirg iptvirg::xs -> pr2_err "ERROR-RECOV: found sync bis, eating } and ;"; (Parser_c.TPtVirg iptvirg)::v::already_passed, xs | Parser_c.TIdent x::Parser_c.TPtVirg iptvirg::xs -> pr2_err "ERROR-RECOV: found sync bis, eating ident, }, and ;"; (Parser_c.TPtVirg iptvirg)::(Parser_c.TIdent x)::v::already_passed, xs | Parser_c.TCommentSpace sp::Parser_c.TIdent x::Parser_c.TPtVirg iptvirg ::xs -> pr2_err "ERROR-RECOV: found sync bis, eating ident, }, and ;"; (Parser_c.TPtVirg iptvirg):: (Parser_c.TIdent x):: (Parser_c.TCommentSpace sp):: v:: already_passed, xs | Parser_c.TCommentNewline sp::Parser_c.TIdent x::Parser_c.TPtVirg iptvirg ::xs -> pr2_err "ERROR-RECOV: found sync bis, eating ident, }, and ;"; (Parser_c.TPtVirg iptvirg):: (Parser_c.TIdent x):: (Parser_c.TCommentNewline sp):: v:: already_passed, xs | _ -> v::already_passed, xs ) | v::xs when TH.col_of_tok v =|= 0 && TH.is_start_of_something v -> pr2_err ("ERROR-RECOV: found sync col 0 at line "^ i_to_s(TH.line_of_tok v)); already_passed, v::xs | v::xs -> find_next_synchro_orig xs (v::already_passed) coccinelle-1.0.0-rc19/parsing_c/parse_c.ml0000644000175000017500000010747512247437436017321 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common module TH = Token_helpers module LP = Lexer_parser module Stat = Parsing_stat (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2_err, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing (*****************************************************************************) (* Helpers *) (*****************************************************************************) let lexbuf_to_strpos lexbuf = (Lexing.lexeme lexbuf, Lexing.lexeme_start lexbuf) let token_to_strpos tok = (TH.str_of_tok tok, TH.pos_of_tok tok) let mk_info_item2 filename toks = let buf = Buffer.create 100 in let s = (* old: get_slice_file filename (line1, line2) *) begin toks +> List.iter (fun tok -> match TH.pinfo_of_tok tok with | Ast_c.OriginTok _ -> Buffer.add_string buf (TH.str_of_tok tok) | Ast_c.AbstractLineTok _ -> raise (Impossible 79) | _ -> () ); Buffer.contents buf end in (s, toks) let mk_info_item a b = Common.profile_code "C parsing.mk_info_item" (fun () -> mk_info_item2 a b) let info_same_line line xs = xs +> List.filter (fun info -> Ast_c.line_of_info info =|= line) (* move in cpp_token_c ? *) let is_define_passed passed = let xs = passed +> List.rev +> List.filter TH.is_not_comment in if List.length xs >= 2 then (match Common.head_middle_tail xs with | Parser_c.TDefine _, _, Parser_c.TDefEOL _ -> true | _ -> false ) else begin pr2_err "WEIRD: length list of error recovery tokens < 2 "; false end (*****************************************************************************) (* Error diagnostic *) (*****************************************************************************) let error_msg_tok tok = let file = TH.file_of_tok tok in if !Flag_parsing_c.verbose_parsing then Common.error_message file (token_to_strpos tok) else ("error in " ^ file ^ "; set verbose_parsing for more info") let print_bad line_error (start_line, end_line) filelines = begin pr2 ("badcount: " ^ i_to_s (end_line - start_line)); for i = start_line to end_line do let line = filelines.(i) in if i =|= line_error then pr2 ("BAD:!!!!!" ^ " " ^ line) else pr2 ("bad:" ^ " " ^ line) done end (*****************************************************************************) (* Stats on what was passed/commentized *) (*****************************************************************************) let commentized xs = xs +> Common.tail_map_filter (function | Parser_c.TCommentCpp (cppkind, ii) -> let s = Ast_c.str_of_info ii in let legal_passing = match !Flag_parsing_c.filter_passed_level with | 0 -> false | 1 -> List.mem cppkind [Token_c.CppAttr] || (s =~ "__.*") | 2 -> List.mem cppkind [Token_c.CppAttr;Token_c.CppPassingNormal] || (s =~ "__.*") | 3 -> (match cppkind with Token_c.CppAttr | Token_c.CppPassingNormal | Token_c.CppDirective | Token_c.CppIfDirective _ -> true | _ -> false) || (s =~ "__.*") | 4 -> List.mem cppkind [Token_c.CppAttr;Token_c.CppPassingNormal;Token_c.CppMacro] || (s =~ "__.*") | 5 -> (match cppkind with Token_c.CppAttr | Token_c.CppPassingNormal | Token_c.CppDirective | Token_c.CppIfDirective _ | Token_c.CppMacro -> true | _ -> false) || (s =~ "__.*") | _ -> failwith "not valid level passing number" in if legal_passing then None else Some (ii.Ast_c.pinfo) (* | Ast_c.CppOther -> (match s with | s when s =~ "KERN_.*" -> None | s when s =~ "__.*" -> None | _ -> Some (ii.Ast_c.pinfo) ) *) | Parser_c.TCommentMisc ii | Parser_c.TAction ii -> Some (ii.Ast_c.pinfo) | _ -> None ) let count_lines_commentized xs = let line = ref (-1) in let count = ref 0 in begin commentized xs +> List.iter (function Ast_c.OriginTok pinfo | Ast_c.ExpandedTok (_,(pinfo,_)) -> let newline = pinfo.Common.line in if newline <> !line then begin line := newline; incr count end | _ -> ()); !count end let print_commentized xs = let line = ref (-1) in begin let ys = commentized xs in ys +> List.iter (function Ast_c.OriginTok pinfo | Ast_c.ExpandedTok (_,(pinfo,_)) -> let newline = pinfo.Common.line in let s = pinfo.Common.str in let s = Str.global_substitute (Str.regexp "\n") (fun s -> "") s in if newline =|= !line then prerr_string (s ^ " ") else begin if !line =|= -1 then pr2_no_nl "passed:" else pr2_no_nl "\npassed:"; line := newline; pr2_no_nl (s ^ " "); end | _ -> ()); if not (null ys) then pr2 ""; end (*****************************************************************************) (* Lexing only *) (*****************************************************************************) (* called by parse_print_error_heuristic *) let tokens2 file = let table = Common.full_charpos_to_pos_large file in Common.with_open_infile file (fun chan -> let lexbuf = Lexing.from_channel chan in try let rec tokens_aux acc = let tok = Lexer_c.token lexbuf in (* fill in the line and col information *) let tok = tok +> TH.visitor_info_of_tok (fun ii -> { ii with Ast_c.pinfo= (* could assert pinfo.filename = file ? *) match Ast_c.pinfo_of_info ii with Ast_c.OriginTok pi -> Ast_c.OriginTok (Common.complete_parse_info_large file table pi) | Ast_c.ExpandedTok (pi,vpi) -> Ast_c.ExpandedTok((Common.complete_parse_info_large file table pi),vpi) | Ast_c.FakeTok (s,vpi) -> Ast_c.FakeTok (s,vpi) | Ast_c.AbstractLineTok pi -> failwith "should not occur" }) in if TH.is_eof tok then List.rev (tok::acc) else tokens_aux (tok::acc) in tokens_aux [] with | Lexer_c.Lexical s -> failwith ("lexical error " ^ s ^ "\n =" ^ (Common.error_message file (lexbuf_to_strpos lexbuf))) | e -> raise e ) let time_lexing ?(profile=true) a = if profile then Common.profile_code_exclusif "LEXING" (fun () -> tokens2 a) else tokens2 a let tokens ?profile a = Common.profile_code "C parsing.tokens" (fun () -> time_lexing ?profile a) let tokens_of_string string = let lexbuf = Lexing.from_string string in try let rec tokens_s_aux () = let tok = Lexer_c.token lexbuf in if TH.is_eof tok then [tok] else tok::(tokens_s_aux ()) in tokens_s_aux () with | Lexer_c.Lexical s -> failwith ("lexical error " ^ s ^ "\n =" ) | e -> raise e (*****************************************************************************) (* Parsing, but very basic, no more used *) (*****************************************************************************) (* * !!!Those function use refs, and are not reentrant !!! so take care. * It use globals defined in Lexer_parser. * * update: because now lexer return comments tokens, those functions * may not work anymore. *) let parse file = let lexbuf = Lexing.from_channel (open_in file) in let result = Parser_c.main Lexer_c.token lexbuf in result let parse_print_error file = let chan = (open_in file) in let lexbuf = Lexing.from_channel chan in let error_msg () = Common.error_message file (lexbuf_to_strpos lexbuf) in try lexbuf +> Parser_c.main Lexer_c.token with | Lexer_c.Lexical s -> failwith ("lexical error " ^s^ "\n =" ^ error_msg ()) | Parsing.Parse_error -> failwith ("parse error \n = " ^ error_msg ()) | Semantic_c.Semantic (s, i) -> failwith ("semantic error " ^ s ^ "\n =" ^ error_msg ()) | e -> raise e (*****************************************************************************) (* Parsing subelements, useful to debug parser *) (*****************************************************************************) (* * !!!Those function use refs, and are not reentrant !!! so take care. * It use globals defined in Lexer_parser. *) (* old: * let parse_gen parsefunc s = * let lexbuf = Lexing.from_string s in * let result = parsefunc Lexer_c.token lexbuf in * result *) let parse_gen parsefunc s = let toks = tokens_of_string s +> List.filter TH.is_not_comment in (* Why use this lexing scheme ? Why not classically give lexer func * to parser ? Because I now keep comments in lexer. Could * just do a simple wrapper that when comment ask again for a token, * but maybe simpler to use cur_tok technique. *) let all_tokens = ref toks in let cur_tok = ref (List.hd !all_tokens) in let lexer_function = (fun _ -> if TH.is_eof !cur_tok then (pr2_err "LEXER: ALREADY AT END"; !cur_tok) else let v = Common.pop2 all_tokens in cur_tok := v; !cur_tok ) in let lexbuf_fake = Lexing.from_function (fun buf n -> raise (Impossible 80)) in let result = parsefunc lexer_function lexbuf_fake in result let type_of_string = parse_gen Parser_c.type_name let statement_of_string = parse_gen Parser_c.statement let expression_of_string = parse_gen Parser_c.expr (* ex: statement_of_string "(struct us_data* )psh->hostdata = NULL;" *) (*****************************************************************************) (* Parsing default define macros, usually in a standard.h file *) (*****************************************************************************) let extract_macros2 file = Common.save_excursion Flag_parsing_c.verbose_lexing (fun () -> Flag_parsing_c.verbose_lexing := false; let toks = tokens ~profile:false file in let toks = Parsing_hacks.fix_tokens_define toks in Cpp_token_c.extract_macros toks ) let extract_macros a = Common.profile_code_exclusif "HACK" (fun () -> extract_macros2 a) (*****************************************************************************) (* Helper for main entry point *) (*****************************************************************************) (* The use of local refs (remaining_tokens, passed_tokens, ...) makes * possible error recovery. Indeed, they allow to skip some tokens and * still be able to call again the ocamlyacc parser. It is ugly code * because we cannot modify ocamllex and ocamlyacc. As we want some * extended lexing tricks, we have to use such refs. * * Those refs are now also used for my lalr(k) technique. Indeed They * store the futur and previous tokens that were parsed, and so * provide enough context information for powerful lex trick. * * - passed_tokens_last_ckp stores the passed tokens since last * checkpoint. Used for NotParsedCorrectly and also to build the * info_item attached to each program_element. * - passed_tokens_clean is used for lookahead, in fact for lookback. * - remaining_tokens_clean is used for lookahead. Now remaining_tokens * contain some comments and so would make pattern matching difficult * in lookahead. Hence this variable. We would like also to get rid * of cpp instruction because sometimes a cpp instruction is between * two tokens and makes a pattern matching fail. But lookahead also * transform some cpp instruction (in comment) so can't remove them. * * So remaining_tokens, passed_tokens_last_ckp contain comment-tokens, * whereas passed_tokens_clean and remaining_tokens_clean does not contain * comment-tokens. * * Normally we have: * toks = (reverse passed_tok) ++ cur_tok ++ remaining_tokens * after the call to pop2. * toks = (reverse passed_tok) ++ remaining_tokens * at the and of the lexer_function call. * At the very beginning, cur_tok and remaining_tokens overlap, but not after. * At the end of lexer_function call, cur_tok overlap with passed_tok. * * convention: I use "tr" for "tokens refs" * * I now also need this lexing trick because the lexer return comment * tokens. *) type tokens_state = { mutable rest : Parser_c.token list; mutable rest_clean : Parser_c.token list; mutable current : Parser_c.token; (* it's passed since last "checkpoint", not passed from the beginning *) mutable passed : Parser_c.token list; mutable passed_clean : Parser_c.token list; } let mk_tokens_state toks = { rest = toks; rest_clean = (toks +> List.filter TH.is_not_comment); current = (List.hd toks); passed = []; passed_clean = []; } let clone_tokens_state tr = { rest = tr.rest; rest_clean = tr.rest_clean; current = tr.current; passed = tr.passed; passed_clean = tr.passed_clean; } let copy_tokens_state ~src ~dst = dst.rest <- src.rest; dst.rest_clean <- src.rest_clean; dst.current <- src.current; dst.passed <- src.passed; dst.passed_clean <- src.passed_clean; () (* todo? agglomerate the x##b ? *) let rec filter_noise n xs = match n, xs with | _, [] -> [] | 0, xs -> xs | n, x::xs -> (match x with | Parser_c.TMacroAttr _ -> filter_noise (n-1) xs | _ -> x::filter_noise (n-1) xs ) let clean_for_lookahead xs = match xs with | [] -> [] | [x] -> [x] | x::xs -> x::filter_noise 10 xs (* Hacked lex. This function use refs passed by parse_print_error_heuristic * tr means token refs. *) let rec lexer_function ~pass tr = fun lexbuf -> match tr.rest with | [] -> pr2_err "ALREADY AT END"; tr.current | v::xs -> tr.rest <- xs; tr.current <- v; if !Flag_parsing_c.debug_lexer then Common.pr2_gen v; if TH.is_comment v then begin tr.passed <- v::tr.passed; lexer_function ~pass tr lexbuf end else begin let x = List.hd tr.rest_clean in tr.rest_clean <- List.tl tr.rest_clean; assert (x =*= v); (match v with (* fix_define1. * * Why not in parsing_hacks lookahead and do passing like * I do for some ifdef directives ? Because here I also need to * generate some tokens sometimes and so I need access to the * tr.passed, tr.rest, etc. *) | Parser_c.TDefine (tok) -> if not (LP.current_context () =*= LP.InTopLevel) && (!Flag_parsing_c.cpp_directive_passing || (pass >= 2)) then begin incr Stat.nDefinePassing; pr2_once ("CPP-DEFINE: inside function, I treat it as comment"); let v' = Parser_c.TCommentCpp (Token_c.CppDirective,TH.info_of_tok v) in tr.passed <- v'::tr.passed; tr.rest <- Parsing_hacks.comment_until_defeol tr.rest; tr.rest_clean <- Parsing_hacks.drop_until_defeol tr.rest_clean; lexer_function ~pass tr lexbuf end else begin tr.passed <- v::tr.passed; tr.passed_clean <- v::tr.passed_clean; v end | Parser_c.TUndef (tok) -> if not (LP.current_context () =*= LP.InTopLevel) && (!Flag_parsing_c.cpp_directive_passing || (pass >= 2)) then begin incr Stat.nUndefPassing; pr2_once ("CPP-UNDEF: inside function, I treat it as comment"); let v' = Parser_c.TCommentCpp (Token_c.CppDirective,TH.info_of_tok v) in tr.passed <- v'::tr.passed; tr.rest <- Parsing_hacks.comment_until_defeol tr.rest; tr.rest_clean <- Parsing_hacks.drop_until_defeol tr.rest_clean; lexer_function ~pass tr lexbuf end else begin tr.passed <- v::tr.passed; tr.passed_clean <- v::tr.passed_clean; v end | Parser_c.TInclude (includes, filename, inifdef, info) -> if not (LP.current_context () =*= LP.InTopLevel) && (!Flag_parsing_c.cpp_directive_passing || (pass >= 2)) then begin incr Stat.nIncludePassing; pr2_once ("CPP-INCLUDE: inside function, I treat it as comment"); let v = Parser_c.TCommentCpp(Token_c.CppDirective, info) in tr.passed <- v::tr.passed; lexer_function ~pass tr lexbuf end else begin let (v,new_tokens) = Parsing_hacks.tokens_include(info, includes, filename, inifdef) in let new_tokens_clean = new_tokens +> List.filter TH.is_not_comment in tr.passed <- v::tr.passed; tr.passed_clean <- v::tr.passed_clean; tr.rest <- new_tokens ++ tr.rest; tr.rest_clean <- new_tokens_clean ++ tr.rest_clean; v end | _ -> (* typedef_fix1 *) let v = match v with | Parser_c.TIdent (s, ii) -> if LP.is_typedef s && not (!Flag_parsing_c.disable_add_typedef) && pass =|= 1 then Parser_c.TypedefIdent (s, ii) else Parser_c.TIdent (s, ii) | x -> x in let v = Parsing_hacks.lookahead ~pass (clean_for_lookahead (v::tr.rest_clean)) tr.passed_clean in tr.passed <- v::tr.passed; (* the lookahead may have changed the status of the token and * consider it as a comment, for instance some #include are * turned into comments, hence this code. *) match v with | Parser_c.TCommentCpp _ -> lexer_function ~pass tr lexbuf | v -> tr.passed_clean <- v::tr.passed_clean; v ) end let max_pass = 4 let get_one_elem ~pass tr (file, filelines) = if not (LP.is_enabled_typedef()) && !Flag_parsing_c.debug_typedef then pr2_err "TYPEDEF:_handle_typedef=false. Not normal if dont come from exn"; (* normally have to do that only when come from an exception in which * case the dt() may not have been done * TODO but if was in scoped scope ? have to let only the last scope * so need do a LP.lexer_reset_typedef (); *) LP.enable_typedef(); LP._lexer_hint := (LP.default_hint ()); LP.save_typedef_state(); tr.passed <- []; let lexbuf_fake = Lexing.from_function (fun buf n -> raise (Impossible 81)) in (try (* -------------------------------------------------- *) (* Call parser *) (* -------------------------------------------------- *) Common.profile_code_exclusif "YACC" (fun () -> Left (Parser_c.celem (lexer_function ~pass tr) lexbuf_fake) ) with e -> LP.restore_typedef_state(); (* must keep here, before the code that adjusts the tr fields *) let line_error = TH.line_of_tok tr.current in let passed_before_error = tr.passed in let current = tr.current in (* error recovery, go to next synchro point *) let (passed', rest') = Parsing_recovery_c.find_next_synchro tr.rest tr.passed in tr.rest <- rest'; tr.passed <- passed'; tr.current <- List.hd passed'; tr.passed_clean <- []; (* enough ? *) (* with error recovery, rest and rest_clean may not be in sync *) tr.rest_clean <- (tr.rest +> List.filter TH.is_not_comment); let info_of_bads = Common.map_eff_rev TH.info_of_tok tr.passed in Right (info_of_bads, line_error, tr.passed, passed_before_error, current, e) ) (* Macro problem recovery *) (* used by the multi-pass error recovery expand-on-demand *) (* val candidate_macros_in_passed: defs: (string, define_def) Hashtbl.t -> Parser_c.token list -> (string * define_def) list *) let candidate_macros_in_passed2 ~defs passed = let res = ref [] in let res2 = ref [] in passed +> List.iter (function | Parser_c.TIdent (s,_) (* bugfix: may have to undo some infered things *) | Parser_c.TMacroIterator (s,_) | Parser_c.TypedefIdent (s,_) -> (match Common.hfind_option s defs with | Some def -> if s ==~ Parsing_hacks.regexp_macro then (* pr2 (spf "candidate: %s" s); *) Common.push2 (s, def) res else Common.push2 (s, def) res2 | None -> () ) | _ -> () ); if null !res then !res2 else !res let candidate_macros_in_passed ~defs b = Common.profile_code "MACRO managment" (fun () -> candidate_macros_in_passed2 ~defs b) let find_optional_macro_to_expand2 ~defs toks = let defs = Common.hash_of_list defs in let toks = toks +> Common.tail_map (function (* special cases to undo *) | Parser_c.TMacroIterator (s, ii) -> if Hashtbl.mem defs s then Parser_c.TIdent (s, ii) else Parser_c.TMacroIterator (s, ii) | Parser_c.TypedefIdent (s, ii) -> if Hashtbl.mem defs s then Parser_c.TIdent (s, ii) else Parser_c.TypedefIdent (s, ii) | x -> x ) in let tokens = toks in Parsing_hacks.fix_tokens_cpp ~macro_defs:defs tokens (* just calling apply_macro_defs and having a specialized version * of the code in fix_tokens_cpp is not enough as some work such * as the passing of the body of attribute in Parsing_hacks.find_macro_paren * will not get the chance to be run on the new expanded tokens. * Hence even if it's expensive, it's currently better to * just call directly fix_tokens_cpp again here. let tokens2 = ref (tokens +> Common.acc_map TV.mk_token_extended) in let cleaner = !tokens2 +> Parsing_hacks.filter_cpp_stuff in let paren_grouped = TV.mk_parenthised cleaner in Cpp_token_c.apply_macro_defs ~msg_apply_known_macro:(fun s -> pr2 (spf "APPLYING: %s" s)) ~msg_apply_known_macro_hint:(fun s -> pr2 "hint") defs paren_grouped; (* because the before field is used by apply_macro_defs *) tokens2 := TV.rebuild_tokens_extented !tokens2; Parsing_hacks.insert_virtual_positions (!tokens2 +> Common.acc_map (fun x -> x.TV.tok)) *) let find_optional_macro_to_expand ~defs a = Common.profile_code "MACRO managment" (fun () -> find_optional_macro_to_expand2 ~defs a) (*****************************************************************************) (* Main entry points *) (*****************************************************************************) let (_defs : (string, Cpp_token_c.define_def) Hashtbl.t ref) = ref (Hashtbl.create 101) let (_defs_builtins : (string, Cpp_token_c.define_def) Hashtbl.t ref) = ref (Hashtbl.create 101) (* can not be put in parsing_hack, cos then mutually recursive problem as * we also want to parse the standard.h file. *) let init_defs_macros std_h = if not (Common.lfile_exists std_h) then pr2 ("warning: Can't find default macro file: " ^ std_h) else begin pr2 ("init_defs: " ^ std_h); _defs := Common.hash_of_list (extract_macros std_h); end let init_defs_builtins file_h = if not (Common.lfile_exists file_h) then pr2 ("warning: Can't find macro file: " ^ file_h) else begin pr2 ("init_defs_builtins: " ^ file_h); _defs_builtins := Common.hash_of_list (extract_macros file_h); end type info_item = string * Parser_c.token list type program2 = toplevel2 list and extended_program2 = toplevel2 list * (string, Lexer_parser.identkind) Common.scoped_h_env (* type defs *) * (string, Cpp_token_c.define_def) Hashtbl.t (* macro defs *) and toplevel2 = Ast_c.toplevel * info_item let program_of_program2 xs = xs +> List.map fst let with_program2 f program2 = program2 +> Common.unzip +> (fun (program, infos) -> f program, infos ) +> Common.uncurry Common.zip (* note: as now we go in 2 passes, there is first all the error message of * the lexer, and then the error of the parser. It is not anymore * interwinded. * * !!!This function use refs, and is not reentrant !!! so take care. * It use globals defined in Lexer_parser and also the _defs global * in parsing_hack.ml. * * This function uses internally some semi globals in the * tokens_stat record and parsing_stat record. *) let parse_print_error_heuristic2 saved_typedefs saved_macros parse_strings file = let filelines = Common.cat_array file in let stat = Parsing_stat.default_stat file in (* -------------------------------------------------- *) (* call lexer and get all the tokens *) (* -------------------------------------------------- *) LP.lexer_reset_typedef saved_typedefs; Parsing_hacks.ifdef_paren_cnt := 0; let toks_orig = tokens file in let toks = Parsing_hacks.fix_tokens_define toks_orig in let toks = Parsing_hacks.fix_tokens_cpp ~macro_defs:!_defs_builtins toks in let toks = if parse_strings then Parsing_hacks.fix_tokens_strings toks else toks in (* expand macros on demand trick, preparation phase *) let macros = Common.profile_code "MACRO mgmt prep 1" (fun () -> let macros = match saved_macros with None -> Hashtbl.copy !_defs | Some h -> h in (* include also builtins as some macros may generate some builtins too * like __decl_spec or __stdcall *) !_defs_builtins +> Hashtbl.iter (fun s def -> Hashtbl.replace macros s def; ); macros ) in Common.profile_code "MACRO mgmt prep 2" (fun () -> let local_macros = extract_macros file in local_macros +> List.iter (fun (s, def) -> Hashtbl.replace macros s def; ); ); let tr = mk_tokens_state toks in let rec loop tr = (* todo?: I am not sure that it represents current_line, cos maybe * tr.current partipated in the previous parsing phase, so maybe tr.current * is not the first token of the next parsing phase. Same with checkpoint2. * It would be better to record when we have a } or ; in parser.mly, * cos we know that they are the last symbols of external_declaration2. * * bugfix: may not be equal to 'file' as after macro expansions we can * start to parse a new entity from the body of a macro, for instance * when parsing a define_machine() body, cf standard.h *) let checkpoint = TH.line_of_tok tr.current in let checkpoint_file = TH.file_of_tok tr.current in (* call the parser *) let elem = let pass1 = Common.profile_code "Parsing: 1st pass" (fun () -> get_one_elem ~pass:1 tr (file, filelines) ) in match pass1 with | Left e -> Left e | Right (info,line_err, passed, passed_before_error, cur, exn) -> if !Flag_parsing_c.disable_multi_pass then pass1 else begin Common.profile_code "Parsing: multi pass" (fun () -> pr2_err "parsing pass2: try again"; let toks = List.rev passed ++ tr.rest in let new_tr = mk_tokens_state toks in copy_tokens_state ~src:new_tr ~dst:tr; let passx = get_one_elem ~pass:2 tr (file, filelines) in (match passx with | Left e -> passx | Right (info,line_err,passed,passed_before_error,cur,exn) -> let candidates = candidate_macros_in_passed ~defs:macros passed in if is_define_passed passed || null candidates then passx else begin (* todo factorize code *) pr2_err "parsing pass3: try again"; let toks = List.rev passed ++ tr.rest in let toks' = find_optional_macro_to_expand ~defs:candidates toks in let new_tr = mk_tokens_state toks' in copy_tokens_state ~src:new_tr ~dst:tr; let passx = get_one_elem ~pass:3 tr (file, filelines) in (match passx with | Left e -> passx | Right (info,line_err,passed,passed_before_error,cur,exn) -> pr2_err "parsing pass4: try again"; let candidates = candidate_macros_in_passed ~defs:macros passed in let toks = List.rev passed ++ tr.rest in let toks' = find_optional_macro_to_expand ~defs:candidates toks in let new_tr = mk_tokens_state toks' in copy_tokens_state ~src:new_tr ~dst:tr; let passx = get_one_elem ~pass:4 tr (file, filelines) in passx ) end ) ) end in (* again not sure if checkpoint2 corresponds to end of bad region *) let checkpoint2 = TH.line_of_tok tr.current in (* <> line_error *) let checkpoint2_file = TH.file_of_tok tr.current in let diffline = if (checkpoint_file =$= checkpoint2_file) && (checkpoint_file =$= file) then (checkpoint2 - checkpoint) else 0 (* TODO? so if error come in middle of something ? where the * start token was from original file but synchro found in body * of macro ? then can have wrong number of lines stat. * Maybe simpler just to look at tr.passed and count * the lines in the token from the correct file ? *) in let info = mk_info_item file (List.rev tr.passed) in (* some stat updates *) stat.Stat.commentized <- stat.Stat.commentized + count_lines_commentized (snd info); let elem = match elem with | Left e -> stat.Stat.correct <- stat.Stat.correct + diffline; e | Right (info_of_bads, line_error, toks_of_bads, _passed_before_error, cur, exn) -> let was_define = is_define_passed tr.passed in if was_define && !Flag_parsing_c.filter_msg_define_error then () else begin (match exn with | Lexer_c.Lexical _ | Parsing.Parse_error | Semantic_c.Semantic _ -> () | e -> raise e ); if !Flag_parsing_c.show_parsing_error then begin (match exn with (* Lexical is not anymore launched I think *) | Lexer_c.Lexical s -> pr2 ("lexical error " ^s^ "\n =" ^ error_msg_tok cur) | Parsing.Parse_error -> pr2 ("parse error \n = " ^ error_msg_tok cur) | Semantic_c.Semantic (s, i) -> pr2 ("semantic error " ^s^ "\n ="^ error_msg_tok cur) | e -> raise (Impossible 82) ); (* bugfix: *) if (checkpoint_file =$= checkpoint2_file) && checkpoint_file =$= file then print_bad line_error (checkpoint, checkpoint2) filelines else pr2 "PB: bad: but on tokens not from original file" end; let pbline = toks_of_bads +> Common.filter (TH.is_same_line_or_close line_error) +> Common.filter TH.is_ident_like in let error_info = (pbline +> List.map TH.str_of_tok), line_error in stat.Stat.problematic_lines <- error_info::stat.Stat.problematic_lines; end; if was_define && !Flag_parsing_c.filter_define_error then stat.Stat.correct <- stat.Stat.correct + diffline else stat.Stat.bad <- stat.Stat.bad + diffline; Ast_c.NotParsedCorrectly info_of_bads in (match elem with | Ast_c.FinalDef x -> [(Ast_c.FinalDef x, info)] | xs -> (xs, info):: loop tr (* recurse *) ) in let v = loop tr in let v = with_program2 Parsing_consistency_c.consistency_checking v in let v = let new_td = ref (Common.clone_scoped_h_env !LP._typedef) in Common.clean_scope_h new_td; (v, !new_td, macros) in (v, stat) let time_total_parsing a b c d = Common.profile_code "TOTAL" (fun () -> parse_print_error_heuristic2 a b c d) let parse_print_error_heuristic a b c d = Common.profile_code "C parsing" (fun () -> time_total_parsing a b c d) (* alias *) let parse_c_and_cpp parse_strings a = let ((c,_,_),stat) = parse_print_error_heuristic None None parse_strings a in (c,stat) let parse_c_and_cpp_keep_typedefs td macs parse_strings a = parse_print_error_heuristic td macs parse_strings a (*****************************************************************************) (* Same but faster cos memoize stuff *) (*****************************************************************************) let parse_cache parse_strings file = if not !Flag_parsing_c.use_cache then parse_print_error_heuristic None None parse_strings file else let _ = pr2_once "TOFIX: use_cache is not sensitive to changes in the considered macros, include files, etc" in let need_no_changed_files = (* should use Sys.argv.(0), would be safer. *) [ (* TOFIX Config.path ^ "/parsing_c/c_parser.cma"; (* we may also depend now on the semantic patch because the SP may use macro and so we will disable some of the macro expansions from standard.h. *) !Config.std_h; *) ] in let need_no_changed_variables = (* could add some of the flags of flag_parsing_c.ml *) [] in Common.cache_computation_robust_in_dir !Flag_parsing_c.cache_prefix file ".ast_raw" (need_no_changed_files, need_no_changed_variables) ".depend_raw" (fun () -> (* check whether to clear the cache *) (match (!Flag_parsing_c.cache_limit,!Flag_parsing_c.cache_prefix) with (None,_) | (_,None) -> () | (Some limit,Some prefix) -> let count = Common.cmd_to_list (Printf.sprintf "test -e %s && find %s -name \"*_raw\" | wc -l" prefix prefix) in match count with [c] -> if int_of_string c >= limit then let _ = Sys.command (Printf.sprintf "find %s -name \"*_raw\" -exec /bin/rm {} \\;" prefix) in () | _ -> ()); (* recompute *) parse_print_error_heuristic None None true file) (*****************************************************************************) (* Some special cases *) (*****************************************************************************) let no_format s = try let _ = Str.search_forward (Str.regexp_string "%") s 0 in false with Not_found -> true (* no point to parse strings in these cases. never applied to a format string *) let (cstatement_of_string: string -> Ast_c.statement) = fun s -> assert (no_format s); let tmpfile = Common.new_temp_file "cocci_stmt_of_s" "c" in Common.write_file tmpfile ("void main() { \n" ^ s ^ "\n}"); let program = parse_c_and_cpp false tmpfile +> fst in program +> Common.find_some (fun (e,_) -> match e with | Ast_c.Definition ({Ast_c.f_body = [Ast_c.StmtElem st]},_) -> Some st | _ -> None ) let (cexpression_of_string: string -> Ast_c.expression) = fun s -> assert (no_format s); let tmpfile = Common.new_temp_file "cocci_expr_of_s" "c" in Common.write_file tmpfile ("void main() { \n" ^ s ^ ";\n}"); let program = parse_c_and_cpp false tmpfile +> fst in program +> Common.find_some (fun (e,_) -> match e with | Ast_c.Definition ({Ast_c.f_body = compound},_) -> (match compound with | [Ast_c.StmtElem st] -> (match Ast_c.unwrap_st st with | Ast_c.ExprStatement (Some e) -> Some e | _ -> None ) | _ -> None ) | _ -> None ) coccinelle-1.0.0-rc19/parsing_c/Makefile0000644000175000017500000001062612247437436017002 0ustar eugeneugenifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif ############################################################################## # Variables ############################################################################## TARGET=parsing_c # - type_cocci.ml ast_cocci.ml # + unparse_hrule SRC= token_annot.ml flag_parsing_c.ml parsing_stat.ml \ token_c.ml ast_c.ml control_flow_c.ml \ visitor_c.ml lib_parsing_c.ml \ control_flow_c_build.ml \ pretty_print_c.ml \ semantic_c.ml lexer_parser.ml parser_c.ml lexer_c.ml \ parse_string_c.ml token_helpers.ml token_views_c.ml \ cpp_token_c.ml \ parsing_hacks.ml \ cpp_analysis_c.ml \ unparse_cocci.ml unparse_c.ml unparse_hrule.ml \ parsing_recovery_c.ml parsing_consistency_c.ml \ parse_c.ml type_c.ml \ cpp_ast_c.ml \ type_annoter_c.ml comment_annotater_c.ml \ compare_c.ml \ test_parsing_c.ml # ast_cocci.ml and unparse_cocci.ml should be deleted in the future # to make parsing_c really independent of coccinelle. # control_flow_c have also coccinelle dependencies. # old: parsing_c now depends on cocci_parser because in addition to decorate # the token in Ast_c with some parse info, we now also make some place to # welcome some mcodekind of Ast_cocci. LIBS=../commons/commons.cma ../globals/globals.cma \ ../parsing_cocci/cocci_parser.cma INCLUDESDEP= -I ../commons -I ../commons/ocamlextra -I ../commons/ocollection \ -I ../globals -I ../parsing_cocci INCLUDES=$(INCLUDESDEP) $(TARZANINCLUDE) SYSLIBS= str.cma unix.cma num.cma ############################################################################## # Generic variables ############################################################################## #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLCFLAGS ?= -g OPTFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDESDEP) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ############################################################################## # Top rules ############################################################################## ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).cma: $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) $(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa) $(OCAMLOPT_CMD) -a -o $(TARGET).cmxa $(OPTOBJS) $(TARGET).top: $(OBJS) $(LIBS) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) clean:: rm -f $(TARGET).top lexer_c.ml: lexer_c.mll $(OCAMLLEX) $< clean:: rm -f lexer_c.ml parser_c.ml parser_c.mli: parser_c.mly $(OCAMLYACC) -v $< clean:: rm -f parser_c.ml parser_c.mli parser_c.output else all: cd .. && $(OCAMLBUILD) parsing_c/parsing_c.cma all.opt: cd .. && $(OCAMLBUILD) parsing_c/parsing_c.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif ############################################################################## # Pad's rules ############################################################################## # visitor_c.ml lib_parsing_c.ml \ # type_annoter_c.ml \ # statistics_c.ml \ # pretty_print_c.ml unparse_c.ml \ # test_parsing_c.ml #toreput: compare_c.ml ast_to_flow.ml COREPARSING= flag_parsing_c.ml parsing_stat.ml \ ast_cocci.ml \ ast_c.ml control_flow_c.ml \ semantic_c.ml lexer_parser.ml parser_c.mly lexer_c.mll \ token_helpers.ml parsing_hacks.ml parse_c.ml \ locparsing: wc -l $(COREPARSING) locindiv: wc -l lexer_c.mll wc -l parser_c.mly wc -l parsing_hacks.ml wc -l ast_c.ml wc -l parse_c.ml ############################################################################## # Literate Programming rules ############################################################################## ############################################################################## # Generic rules ############################################################################## .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< clean:: rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# rm -f .depend distclean: clean .depend depend: lexer_c.ml parser_c.ml parser_c.mli $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/parsing_c/type_annoter_c.ml0000644000175000017500000013543212247437436020710 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2007, 2008 Ecole des Mines de Nantes, * Copyright (C) 2009 University of Urbana Champaign * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. *) open Common open Ast_c module Lib = Lib_parsing_c (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* History: * - Done a first type checker in 2002, cf typing-semantic/, but * was assuming that have all type info, and so was assuming had called * cpp and everything was right. * - Wrote this file, in 2006?, as we added pattern matching on type * in coccinelle. Partial type annotater. * - Julia extended it in 2008? to have localvar/notlocalvar and * test/notest information, again used by coccinelle. * - I extended it in Fall 2008 to have more type information for the * global analysis. I also added some optimisations to process * included code faster. * * * Design choices. Can either do: * - a kind of inferer * - can first do a simple inferer, that just pass context * - then a real inferer, managing partial info. * type context = fullType option * * - extract the information from the .h files * (so no inference at all needed) * * Difference with julia's code in parsing_cocci/type_infer.ml: * - She handles just the variable namespace. She does not type * field access or enum or macros. This is because cocci programs are * usually simple and have no structure definition or macro definitions * that we need to type anyway. * - She does more propagation. * - She does not have to handle the typedef isomorphism which force me * to use those typedef_fix and type_unfold_one_step * - She does not handle I think the function pointer C isomorphism. * * - She has a cleaner type_cocci without any info. In my case * I need to do those ugly al_type, or generate fake infos. * - She has more compact code. Perhaps because she does not have to * handle the extra exp_info that she added on me :) So I need those * do_with_type, make_info_xxx, etc. * * Note: if need to debug this annotater, use -show_trace_profile, it can * help. You can also set the typedef_debug flag below. * * * * todo: expression contain types, and statements, which in turn can contain * expression, so need recurse. Need define an annote_statement and * annotate_type. * * todo: how deal with typedef isomorphisms ? How store them in Ast_c ? * store all possible variations in ast_c ? a list of type instead of just * the type ? * * todo: how to handle multiple possible definitions for entities like * struct or typedefs ? Because of ifdef, we should store list of * possibilities sometimes. * * todo: define a new type ? like type_cocci ? where have a bool ? * * semi: How handle scope ? When search for type of field, we return * a type, but this type makes sense only in a certain scope. * We could add a tag to each typedef, structUnionName to differentiate * them and also associate in ast_c to the type the scope * of this type, the env that were used to define this type. * * todo: handle better the search in previous env, the env'. Cf the * termination problem in typedef_fix when I was searching in the same * env. * *) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_type (*****************************************************************************) (* Environment *) (*****************************************************************************) (* The different namespaces from stdC manual: * * You introduce two new name spaces with every block that you write. * * One name space includes all * - functions, * - objects, * - type definitions, * - and enumeration constants * that you declare or define within the block. * * The other name space includes all * - enumeration, * - structure, * - and union * *tags* that you define within the block. * * You introduce a new member name space with every structure or union * whose content you define. You identify a member name space by the * type of left operand that you write for a member selection * operator, as in x.y or p->y. A member name space ends with the end * of the block in which you declare it. * * You introduce a new goto label name space with every function * definition you write. Each goto label name space ends with its * function definition. *) (* But I don't try to do a type-checker, I try to "resolve" type of var * so don't need make difference between namespaces here. * * But, why not make simply a (string, kindstring) assoc ? * Because we don't want that a variable shadow a struct definition, because * they are still in 2 different namespace. But could for typedef, * because VarOrFunc and Typedef are in the same namespace. * But could do a record as in c_info.ml *) (* This type contains all "ident" like notion of C. Each time in Ast_c * you have a string type (as in expression, function name, fields) * then you need to manage the scope of this ident. * * The wrap for StructUnionNameDef contain the whole ii, the i for * the string, the structUnion and the structType. * * Put Macro here ? after all the scoping rules for cpp macros is different * and so does not vanish after the closing '}'. * * todo: EnumDef *) type namedef = | VarOrFunc of string * Ast_c.exp_type | EnumConstant of string * string option (* also used for macro type aliases *) | TypeDef of string * fullType (* the structType contains nested "idents" with struct scope *) | StructUnionNameDef of string * (structUnion * structType) wrap (* cppext: *) | Macro of string * (define_kind * define_val) let print_scoped_env e = List.iter (function e -> List.iter (function VarOrFunc(s,_) -> Printf.printf "%s " s | EnumConstant(s,_) -> Printf.printf "%s " s | TypeDef(s,t) -> Printf.printf "%s" s | StructUnionNameDef(s,_) -> Printf.printf "%s " s | Macro(s,_) -> Printf.printf "%s " s) e; Printf.printf "\n") e (* Because have nested scope, have nested list, hence the list list. * * opti? use a hash to accelerate ? hmm but may have some problems * with hash to handle recursive lookup. For instance for the typedef * example where have mutually recursive definition of the type, * we must take care to not loop by starting the second search * from the previous environment. With the list scheme in * lookup_env below it's quite easy to do. With hash it may be * more complicated. *) type environment = namedef list list (* ------------------------------------------------------------ *) (* can be modified by the init_env function below, by * the file environment_unix.h *) let initial_env = ref [ [VarOrFunc("NULL", (Lib.al_type (Parse_c.type_of_string "void *"), Ast_c.NotLocalVar)); (* VarOrFunc("malloc", (Lib.al_type(Parse_c.type_of_string "void* ( * )(int size)"), Ast_c.NotLocalVar)); VarOrFunc("free", (Lib.al_type(Parse_c.type_of_string "void ( * )(void *ptr)"), Ast_c.NotLocalVar)); *) ] ] let typedef_debug = ref false (* ------------------------------------------------------------ *) (* generic, lookup and also return remaining env for further lookup *) let rec lookup_env2 f env = match env with | [] -> raise Not_found | []::zs -> lookup_env2 f zs | (x::xs)::zs -> (match f x with | None -> lookup_env2 f (xs::zs) | Some y -> y, xs::zs ) let lookup_env a b = Common.profile_code "TAC.lookup_env" (fun () -> lookup_env2 a b) let member_env lookupf env = try let _ = lookupf env in true with Not_found -> false (* ------------------------------------------------------------ *) let lookup_var s env = let f = function | VarOrFunc (s2, typ) -> if s2 =$= s then Some typ else None | _ -> None in lookup_env f env let lookup_typedef s env = if !typedef_debug then pr2 ("looking for: " ^ s); let f = function | TypeDef (s2, typ) -> if s2 =$= s then Some typ else None | _ -> None in lookup_env f env let lookup_structunion (_su, s) env = let f = function | StructUnionNameDef (s2, typ) -> if s2 =$= s then Some typ else None | _ -> None in lookup_env f env let lookup_macro s env = let f = function | Macro (s2, typ) -> if s2 =$= s then Some typ else None | _ -> None in lookup_env f env let lookup_enum s env = let f = function | EnumConstant (s2, typ) -> if s2 =$= s then Some typ else None | _ -> None in lookup_env f env let lookup_typedef a b = Common.profile_code "TAC.lookup_typedef" (fun () -> lookup_typedef a b) (*****************************************************************************) (* "type-lookup" *) (*****************************************************************************) (* find_final_type is used to know to what type a field correspond in * x.foo. Sometimes the type of x is a typedef or a structName in which * case we must look in environment to find the complete type, here * structUnion that contains the information. * * Because in C one can redefine in nested blocks some typedefs, * struct, or variables, we have a static scoping resolving process. * So, when we look for the type of a var, if this var is in an * enclosing block, then maybe its type refer to a typdef of this * enclosing block, so must restart the "type-resolving" of this * typedef from this enclosing block, not from the bottom. So our * "resolving-type functions" take an env and also return an env from * where the next search must be performed. *) (* let rec find_final_type ty env = match Ast_c.unwrap_typeC ty with | BaseType x -> (BaseType x) +> Ast_c.rewrap_typeC ty | Pointer t -> (Pointer (find_final_type t env)) +> Ast_c.rewrap_typeC ty | Array (e, t) -> Array (e, find_final_type t env) +> Ast_c.rewrap_typeC ty | StructUnion (sopt, su) -> StructUnion (sopt, su) +> Ast_c.rewrap_typeC ty | FunctionType t -> (FunctionType t) (* todo ? *) +> Ast_c.rewrap_typeC ty | Enum (s, enumt) -> (Enum (s, enumt)) (* todo? *) +> Ast_c.rewrap_typeC ty | EnumName s -> (EnumName s) (* todo? *) +> Ast_c.rewrap_typeC ty | StructUnionName (su, s) -> (try let ((structtyp,ii), env') = lookup_structunion (su, s) env in Ast_c.nQ, (StructUnion (Some s, structtyp), ii) (* old: +> Ast_c.rewrap_typeC ty * but must wrap with good ii, otherwise pretty_print_c * will be lost and raise some Impossible *) with Not_found -> ty ) | TypeName s -> (try let (t', env') = lookup_typedef s env in find_final_type t' env' with Not_found -> ty ) | ParenType t -> find_final_type t env | Typeof e -> failwith "typeof" *) (* ------------------------------------------------------------ *) let rec type_unfold_one_step ty env = let rec loop seen ty env = match Ast_c.unwrap_typeC ty with | NoType -> ty | BaseType x -> ty | Pointer t -> ty | Array (e, t) -> ty | Decimal (len,prec_opt) -> ty | StructUnion (sopt, su, fields) -> ty | FunctionType t -> ty | Enum (s, enumt) -> ty | EnumName s -> ty (* todo: look in env when will have EnumDef *) | StructUnionName (su, s) -> (try let (((su,fields),ii), env') = lookup_structunion (su, s) env in Ast_c.mk_ty (StructUnion (su, Some s, fields)) ii (* old: +> Ast_c.rewrap_typeC ty * but must wrap with good ii, otherwise pretty_print_c * will be lost and raise some Impossible *) with Not_found -> ty ) | TypeName (name, _typ) -> let s = Ast_c.str_of_name name in (try if !typedef_debug then pr2 "type_unfold_one_step: lookup_typedef"; let (t', env') = lookup_typedef s env in if List.mem s seen (* avoid pb with recursive typedefs *) then type_unfold_one_step t' env' else loop (s::seen) t' env with Not_found -> ty ) | ParenType t -> type_unfold_one_step t env | TypeOfExpr e -> pr2_once ("Type_annoter: not handling typeof"); ty | TypeOfType t -> type_unfold_one_step t env in loop [] ty env (* normalizer. can be seen as the opposite of the previous function as * we "fold" at least for the structUnion. Should return something that * Type_c.is_completed_fullType likes, something that makes it easier * for the programmer to work on, that has all the needed information * for most tasks. *) let rec typedef_fix ty env = let rec loop seen ty env = match Ast_c.unwrap_typeC ty with | NoType -> ty | BaseType x -> ty | Pointer t -> Pointer (typedef_fix t env) +> Ast_c.rewrap_typeC ty | Array (e, t) -> Array (e, typedef_fix t env) +> Ast_c.rewrap_typeC ty | StructUnion (su, sopt, fields) -> (* normalize, fold. * todo? but what if correspond to a nested struct def ? *) Type_c.structdef_to_struct_name ty | FunctionType ft -> (FunctionType ft) (* todo ? *) +> Ast_c.rewrap_typeC ty | Enum (s, enumt) -> (Enum (s, enumt)) (* todo? *) +> Ast_c.rewrap_typeC ty | EnumName s -> (EnumName s) (* todo? *) +> Ast_c.rewrap_typeC ty | Decimal(l,p) -> (Decimal(l,p)) (* todo? *) +> Ast_c.rewrap_typeC ty (* we prefer StructUnionName to StructUnion when it comes to typed metavar *) | StructUnionName (su, s) -> ty (* keep the typename but complete with more information *) | TypeName (name, typ) -> let s = Ast_c.str_of_name name in (match typ with | Some _ -> pr2 ("typedef value already there:" ^ s); ty | None -> (try if !typedef_debug then pr2 "typedef_fix: lookup_typedef"; let (t', env') = lookup_typedef s env in (* bugfix: termination bug if use env instead of env' below, because * can have some weird mutually recursive typedef which * each new type alias search for its mutual def. * seen is an attempt to do better. *) let fixed = if List.mem s seen then loop (s::seen) t' env else typedef_fix t' env' in TypeName (name, Some fixed) +> Ast_c.rewrap_typeC ty with Not_found -> ty)) (* remove paren for better matching with typed metavar. kind of iso again *) | ParenType t -> typedef_fix t env | TypeOfExpr e -> pr2_once ("Type_annoter: not handling typeof"); ty | TypeOfType t -> typedef_fix t env in loop [] ty env (*****************************************************************************) (* Helpers, part 1 *) (*****************************************************************************) let type_of_s2 s = (Lib.al_type (Parse_c.type_of_string s)) let type_of_s a = Common.profile_code "Type_c.type_of_s" (fun () -> type_of_s2 a) (* pad: pb on: * /home/pad/software-os-src2/freebsd/contrib/ipfilter/netinet/ip_fil_freebsd.c * because in the code there is: * static iss_seq_off = 0; * which in the parser was generating a default int without a parse_info. * I now add a fake parse_info for such default int so no more failwith * normally. *) let rec is_simple_expr expr = match Ast_c.unwrap_expr expr with (* todo? handle more special cases ? *) | Ident _ -> true | Constant (_) -> true | Unary (op, e) -> true | Binary (e1, op, e2) -> true | Cast (t, e) -> true | ParenExpr (e) -> is_simple_expr e | _ -> false (*****************************************************************************) (* Typing rules *) (*****************************************************************************) (* now in type_c.ml *) (*****************************************************************************) (* (Semi) Globals, Julia's style *) (*****************************************************************************) (* opti: cache ? use hash ? *) let _scoped_env = ref !initial_env (* memoise unnanoted var, to avoid too much warning messages *) let _notyped_var = ref (Hashtbl.create 100) let new_scope() = _scoped_env := []::!_scoped_env let del_scope() = _scoped_env := List.tl !_scoped_env let do_in_new_scope f = begin new_scope(); let res = f() in del_scope(); res end let add_in_scope namedef = let (current, older) = Common.uncons !_scoped_env in _scoped_env := (namedef::current)::older (* ------------------------------------------------------------ *) (* sort of hackish... *) let islocal info = if List.length (!_scoped_env) =|= List.length !initial_env then Ast_c.NotLocalVar else Ast_c.LocalVar info (* ------------------------------------------------------------ *) (* the warning argument is here to allow some binding to overwrite an * existing one. With function, we first have the prototype and then the def, * and the def binding with the same string is not an error. * * todo?: but if we define two times the same function, then we will not * detect it :( it would require to make a diff between adding a binding * from a prototype and from a definition. * * opti: disabling the check_annotater flag have some important * performance benefit. * *) let add_binding2 namedef warning = let (current_scope, _older_scope) = Common.uncons !_scoped_env in if !Flag_parsing_c.check_annotater then begin (match namedef with | VarOrFunc (s, typ) -> if Hashtbl.mem !_notyped_var s then pr2 ("warning: found typing information for a variable that was" ^ "previously unknown:" ^ s); | _ -> () ); let (memberf, s) = (match namedef with | VarOrFunc (s, typ) -> member_env (lookup_var s), s | TypeDef (s, typ) -> member_env (lookup_typedef s), s | StructUnionNameDef (s, (su, typ)) -> member_env (lookup_structunion (su, s)), s | Macro (s, body) -> member_env (lookup_macro s), s | EnumConstant (s, body) -> member_env (lookup_enum s), s ) in if memberf [current_scope] && warning then pr2 ("Type_annoter: warning, " ^ s ^ " is already in current binding" ^ "\n" ^ " so there is a weird shadowing"); end; add_in_scope namedef let add_binding namedef warning = Common.profile_code "TAC.add_binding" (fun () -> add_binding2 namedef warning) (*****************************************************************************) (* Helpers, part 2 *) (*****************************************************************************) let lookup_opt_env lookupf s = Common.optionise (fun () -> lookupf s !_scoped_env ) let unwrap_unfold_env2 typ = Ast_c.unwrap_typeC (type_unfold_one_step typ !_scoped_env) let unwrap_unfold_env typ = Common.profile_code "TAC.unwrap_unfold_env" (fun () -> unwrap_unfold_env2 typ) let typedef_fix a b = Common.profile_code "TAC.typedef_fix" (fun () -> typedef_fix a b) let make_info_def_fix x = Type_c.make_info_def (typedef_fix x !_scoped_env) let make_info_fix (typ, local) = Type_c.make_info ((typedef_fix typ !_scoped_env),local) let make_info_def = Type_c.make_info_def (*****************************************************************************) (* Main typer code, put later in a visitor *) (*****************************************************************************) let annotater_expr_visitor_subpart = (fun (k,bigf) expr -> let ty = match Ast_c.unwrap_expr expr with (* -------------------------------------------------- *) (* todo: should analyse the 's' for int to know if unsigned or not *) | StringConstant (s,os,kind) -> make_info_def (type_of_s "char []") | Constant (String (s,kind)) -> make_info_def (type_of_s "char []") | Constant MultiString _ -> make_info_def (type_of_s "char []") | Constant (Char (s,kind)) -> make_info_def (type_of_s "char") | Constant (Int (s,kind)) -> (* this seems really unpleasant, but perhaps the type needs to be set up in some way that allows pretty printing *) make_info_def (match kind with (* matches limited by what is generated in lexer_c.mll *) Si(Signed,CInt) -> type_of_s "int" | Si(UnSigned,CInt) -> type_of_s "unsigned int" | Si(Signed,CLong) -> type_of_s "long" | Si(UnSigned,CLong) -> type_of_s "unsigned long" | Si(Signed,CLongLong) -> type_of_s "long long" | Si(UnSigned,CLongLong) -> type_of_s "unsigned long long" | _ -> failwith "unexpected kind for constant") | Constant (Float (s,kind)) -> let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake = Ast_c.rewrap_str "float" fake in let iinull = [fake] in make_info_def (Ast_c.mk_ty (BaseType (FloatType kind)) iinull) | Constant (DecimalConst(s,n,p)) -> let fake = Ast_c.fakeInfo (Common.fake_parse_info) in let fake1 = Ast_c.rewrap_str "decimal" fake in let fake2 = Ast_c.rewrap_str "(" fake in let fake3 = Ast_c.rewrap_str "," fake in let fake4 = Ast_c.rewrap_str ")" fake in let iinull = [fake1;fake2;fake3;fake4] in let faken = Ast_c.rewrap_str n fake in let fakep = Ast_c.rewrap_str p fake in let sign = Ast_c.Si(Ast_c.Signed,CInt) in let n = mk_e(Ast_c.Constant(Ast_c.Int (n, sign))) [faken] in let p = mk_e(Ast_c.Constant(Ast_c.Int (p, sign))) [fakep] in make_info_def (Ast_c.mk_ty (Decimal(n,Some p)) iinull) (* -------------------------------------------------- *) (* note: could factorize this code with the code for Ident * and the other code for Funcall below. But as the Ident can be * a macro-func, I prefer to handle it separately. So * this rule can handle the macro-func, the Ident-rule can handle * the macro-var, and the other FunCall-rule the regular * function calls through fields. * Also as I don't want a warning on the Ident that are a FunCall, * easier to have a rule separate from the Ident rule. *) | FunCall (e1, args) -> (match Ast_c.unwrap_expr e1 with | Ident (ident) -> (* recurse *) args +> List.iter (fun (e,ii) -> (* could typecheck if arguments agree with prototype *) Visitor_c.vk_argument bigf e ); let s = Ast_c.str_of_name ident in (match lookup_opt_env lookup_var s with | Some ((typ,local),_nextenv) -> (* set type for ident *) let tyinfo = make_info_fix (typ, local) in Ast_c.set_type_expr e1 tyinfo; (match unwrap_unfold_env typ with | FunctionType (ret, params) -> make_info_def ret (* can be function pointer, C have an iso for that, * same pfn() syntax than regular function call. *) | Pointer (typ2) -> (match unwrap_unfold_env typ2 with | FunctionType (ret, params) -> make_info_def ret | _ -> Type_c.noTypeHere ) | _ -> Type_c.noTypeHere ) | None -> (match lookup_opt_env lookup_macro s with | Some ((defkind, defval), _nextenv) -> (match defkind, defval with | DefineFunc _, DefineExpr e -> let rettype = Ast_c.get_onlytype_expr e in (* todo: could also set type for ident ? have return type and at least type of concrete parameters so can generate a fake FunctionType *) let macrotype_opt = Type_c.fake_function_type rettype args in macrotype_opt +> Common.do_option (fun t -> pr2 ("Type_annotater: generate fake function type" ^ "for macro: " ^ s); let tyinfo = make_info_def_fix t in Ast_c.set_type_expr e1 tyinfo; ); Ast_c.get_type_expr e | DefineVar, _ -> pr2 ("Type_annoter: not a macro-func: " ^ s); Type_c.noTypeHere | Undef, _ -> pr2 ("Type_annoter: not a macro-func: " ^ s); Type_c.noTypeHere | DefineFunc _, _ -> (* normally the FunCall case should have caught it *) pr2 ("Type_annoter: not a macro-func-expr: " ^ s); Type_c.noTypeHere ) | None -> pr2_once ("type_annotater: no type for function ident: " ^ s); Type_c.noTypeHere ) ) | _e -> k expr; (Ast_c.get_type_expr e1) +> Type_c.do_with_type (fun typ -> (* copy paste of above *) (match unwrap_unfold_env typ with | FunctionType (ret, params) -> make_info_def ret | Pointer (typ) -> (match unwrap_unfold_env typ with | FunctionType (ret, params) -> make_info_def ret | _ -> Type_c.noTypeHere ) | _ -> Type_c.noTypeHere ) ) ) (* -------------------------------------------------- *) | Ident (ident) -> let s = Ast_c.str_of_name ident in (match lookup_opt_env lookup_var s with | Some ((typ,local),_nextenv) -> make_info_fix (typ,local) | None -> (match lookup_opt_env lookup_macro s with | Some ((defkind, defval), _nextenv) -> (match defkind, defval with | DefineVar, DefineExpr e -> Ast_c.get_type_expr e | DefineVar, _ -> pr2 ("Type_annoter: not a expression: " ^ s); Type_c.noTypeHere | DefineFunc _, _ -> (* normally the FunCall case should have catch it *) pr2 ("Type_annoter: not a macro-var: " ^ s); Type_c.noTypeHere | Undef, _ -> pr2 ("Type_annoter: not a expression: " ^ s); Type_c.noTypeHere ) | None -> (match lookup_opt_env lookup_enum s with | Some (_, _nextenv) -> make_info_def (type_of_s "int") | None -> if not (s =~ "[A-Z_]+") (* if macro then no warning *) then if !Flag_parsing_c.check_annotater then if not (Hashtbl.mem !_notyped_var s) then begin pr2 ("Type_annoter: no type found for: " ^ s); Hashtbl.add !_notyped_var s true; end else () else pr2 ("Type_annoter: no type found for: " ^ s) ; Type_c.noTypeHere ) ) ) (* -------------------------------------------------- *) (* C isomorphism on type on array and pointers *) | Unary (e, DeRef) | ArrayAccess (e, _) -> k expr; (* recurse to set the types-ref of sub expressions *) (Ast_c.get_type_expr e) +> Type_c.do_with_type (fun t -> (* todo: maybe not good env !! *) match unwrap_unfold_env t with | Pointer x | Array (_, x) -> make_info_def_fix x | _ -> Type_c.noTypeHere ) | Unary (e, GetRef) -> k expr; (* recurse to set the types-ref of sub expressions *) (Ast_c.get_type_expr e) +> Type_c.do_with_type (fun t -> (* must generate an element so that '=' can be used * to compare type ? *) let fake = Ast_c.fakeInfo Common.fake_parse_info in let fake = Ast_c.rewrap_str "*" fake in let ft = Ast_c.mk_ty (Pointer t) [fake] in make_info_def_fix ft ) (* -------------------------------------------------- *) (* fields *) | RecordAccess (e, namefld) | RecordPtAccess (e, namefld) as x -> let fld = Ast_c.str_of_name namefld in k expr; (* recurse to set the types-ref of sub expressions *) (Ast_c.get_type_expr e) +> Type_c.do_with_type (fun t -> let topt = match x with | RecordAccess _ -> Some t | RecordPtAccess _ -> (match unwrap_unfold_env t with | Pointer (t) -> Some t | _ -> None ) | _ -> raise (Impossible 159) in (match topt with | None -> Type_c.noTypeHere | Some t -> match unwrap_unfold_env t with | StructUnion (su, sopt, fields) -> (try (* todo: which env ? *) make_info_def_fix (Type_c.type_field fld (su, fields)) with | Not_found -> pr2 (spf "TYPE-ERROR: field '%s' does not belong in struct %s" fld (match sopt with Some s -> s |_ -> "")); Type_c.noTypeHere | Multi_found -> pr2 "TAC:MultiFound"; Type_c.noTypeHere ) | _ -> Type_c.noTypeHere ) ) (* -------------------------------------------------- *) | Cast (t, e) -> k expr; (* todo: if infer, can "push" info ? add_types_expr [t] e ? *) make_info_def_fix (Lib.al_type t) (* todo? lub, hmm maybe not, cos type must be e1 *) | Assignment (e1, op, e2) -> k expr; (* value of an assignment is the value of the RHS expression, but its type is the type of the lhs expression. Use the rhs exp if no information is available *) (match Ast_c.get_type_expr e1 with (None,_) -> Ast_c.get_type_expr e2 | (Some ty,t) -> (Some ty,t)) | Sequence (e1, e2) -> k expr; Ast_c.get_type_expr e2 | Binary (e1, Logical _, e2) -> k expr; make_info_def (type_of_s "int") (* todo: lub *) | Binary (e1, Arith op, e2) -> k expr; Type_c.lub op (Type_c.get_opt_type e1) (Type_c.get_opt_type e2) | CondExpr (cond, e1opt, e2) -> k expr; Ast_c.get_type_expr e2 | ParenExpr e -> k expr; Ast_c.get_type_expr e | Infix (e, op) | Postfix (e, op) -> k expr; Ast_c.get_type_expr e (* pad: julia wrote this ? *) | Unary (e, UnPlus) -> k expr; (* recurse to set the types-ref of sub expressions *) make_info_def (type_of_s "int") (* todo? can convert from unsigned to signed if UnMinus ? *) | Unary (e, UnMinus) -> k expr; (* recurse to set the types-ref of sub expressions *) make_info_def (type_of_s "int") | SizeOfType _|SizeOfExpr _ -> k expr; (* recurse to set the types-ref of sub expressions *) make_info_def (type_of_s "size_t") | Constructor (ft, ini) -> k expr; (* recurse to set the types-ref of sub expressions *) make_info_def (Lib.al_type ft) | Unary (e, Not) -> k expr; (* recurse to set the types-ref of sub expressions *) (* the result of ! is always 0 or 1, not the argument type *) make_info_def (type_of_s "int") | Unary (e, Tilde) -> k expr; (* recurse to set the types-ref of sub expressions *) Ast_c.get_type_expr e (* -------------------------------------------------- *) (* todo *) | Unary (_, GetRefLabel) -> k expr; (* recurse to set the types-ref of sub expressions *) pr2_once "Type annotater:not handling GetRefLabel"; Type_c.noTypeHere (* todo *) | StatementExpr _ -> k expr; (* recurse to set the types-ref of sub expressions *) pr2_once "Type annotater:not handling StatementExpr"; Type_c.noTypeHere (* | _ -> k expr; Type_c.noTypeHere *) | New (_, ty) -> k expr; pr2_once "Type annotater:not handling New"; Type_c.noTypeHere (* TODO *) | Delete e -> k expr; pr2_once "Type annotater:not handling Delete"; Type_c.noTypeHere (* TODO *) in Ast_c.set_type_expr expr ty ) (*****************************************************************************) (* Visitor *) (*****************************************************************************) (* Processing includes that were added after a cpp_ast_c makes the * type annotater quite slow, especially when the depth of cpp_ast_c is * big. But for such includes the only thing we really want is to modify * the environment to have enough type information. We don't need * to type the expressions inside those includes (they will be typed * when we process the include file directly). Here the goal is * to not recurse. * * Note that as usually header files contain mostly structure * definitions and defines, that means we still have to do lots of work. * We only win on function definition bodies, but usually header files * have just prototypes, or inline function definitions which anyway have * usually a small body. But still, we win. It also makes clearer * that when processing include as we just need the environment, the caller * of this module can do further optimisations such as memorising the * state of the environment after each header files. * * * For sparse its makes the annotating speed goes from 9s to 4s * For Linux the speedup is even better, from ??? to ???. * * Because There would be some copy paste with annotate_program, it is * better to factorize code hence the just_add_in_env parameter below. * * todo? alternative optimization for the include problem: * - processing all headers files one time and construct big env * - use hashtbl for env (but apparently not biggest problem) *) let rec visit_toplevel ~just_add_in_env ~depth elem = let need_annotate_body = not just_add_in_env in let bigf = { Visitor_c.default_visitor_c with (* ------------------------------------------------------------ *) Visitor_c.kcppdirective = (fun (k, bigf) directive -> match directive with (* do error messages for type annotater only for the real body of the * file, not inside include. *) | Include {i_content = opt} -> opt +> Common.do_option (fun (filename, program) -> Common.save_excursion Flag_parsing_c.verbose_type (fun () -> Flag_parsing_c.verbose_type := false; (* old: Visitor_c.vk_program bigf program; * opti: set the just_add_in_env *) program +> List.iter (fun elem -> visit_toplevel ~just_add_in_env:true ~depth:(depth+1) elem ) ) ) | Define ((s,ii), (defkind, defval)) -> (* even if we are in a just_add_in_env phase, such as when * we process include, as opposed to the body of functions, * with macros we still to type the body of the macro as * the macro has no type and so we infer its type from its * body (and one day later maybe from its use). *) (match defval with (* can try to optimize and recurse only when the define body * is simple ? *) | DefineExpr expr -> (* prevent macro-declared variables from leaking out *) do_in_new_scope (fun () -> if is_simple_expr expr (* even if not need_annotate_body, still recurse*) then k directive else if need_annotate_body then k directive) | _ -> do_in_new_scope (fun () -> if need_annotate_body then k directive) ); add_binding (Macro (s, (defkind, defval) )) true; | Pragma((s,ii), pragmainfo) -> (match pragmainfo with PragmaTuple(args,ii) -> args +> List.iter (fun (e,ii) -> Visitor_c.vk_argument bigf e) | PragmaIdList _ -> ()) | OtherDirective _ -> () ); (* ------------------------------------------------------------ *) (* main typer code *) (* ------------------------------------------------------------ *) Visitor_c.kexpr = annotater_expr_visitor_subpart; (* ------------------------------------------------------------ *) Visitor_c.kstatement = (fun (k, bigf) st -> match Ast_c.unwrap_st st with | Compound statxs -> do_in_new_scope (fun () -> k st); | _ -> k st ); (* ------------------------------------------------------------ *) Visitor_c.kdecl = (fun (k, bigf) d -> (match d with | (DeclList (xs, ii)) -> xs +> List.iter (fun ({v_namei = var; v_type = t; v_storage = sto; v_local = local} as x , iicomma) -> (* to add possible definition in type found in Decl *) Visitor_c.vk_type bigf t; let local = match (sto,local) with | (_,Ast_c.NotLocalDecl) -> Ast_c.NotLocalVar | ((Ast_c.Sto Ast_c.Static, _), Ast_c.LocalDecl) -> (match Ast_c.info_of_type t with (* if there is no info about the type it must not be present, so we don't know what the variable is *) None -> Ast_c.NotLocalVar | Some ii -> Ast_c.StaticLocalVar ii) | (_,Ast_c.LocalDecl) -> (match Ast_c.info_of_type t with (* if there is no info about the type it must not be present, so we don't know what the variable is *) None -> Ast_c.NotLocalVar | Some ii -> Ast_c.LocalVar ii) in var +> Common.do_option (fun (name, iniopt) -> let s = Ast_c.str_of_name name in let t = match Ast_c.unwrap_typeC t with | Ast_c.Decimal (len,None) -> let newp = Ast_c.rewrap_expr len (Ast_c.Constant (Ast_c.Int ("0",Ast_c.Si(Ast_c.Signed,Ast_c.CInt)))) in Ast_c.rewrap_typeC t (Ast_c.Decimal (len,Some newp)) | _ -> t in match sto with | StoTypedef, _inline -> add_binding (TypeDef (s,Lib.al_type t)) true; | _ -> add_binding (VarOrFunc (s, (Lib.al_type t, local))) true; x.v_type_bis := Some (typedef_fix (Lib.al_type t) !_scoped_env); if need_annotate_body then begin (* int x = sizeof(x) is legal so need process ini *) match iniopt with Ast_c.NoInit -> () | Ast_c.ValInit(iini,init) -> Visitor_c.vk_ini bigf init | Ast_c.ConstrInit((args,_)) -> args +> List.iter (fun (e,ii) -> Visitor_c.vk_argument bigf e ) end ); ); | MacroDecl _ | MacroDeclInit _ -> if need_annotate_body then k d ); ); (* ------------------------------------------------------------ *) Visitor_c.ktype = (fun (k, bigf) typ -> (* bugfix: have a 'Lib.al_type typ' before, but because we can * have enum with possible expression, we don't want to change * the ref of abstract-lined types, but the real one, so * don't al_type here *) let (_q, tbis) = typ in match Ast_c.unwrap_typeC typ with | StructUnion (su, Some s, structType) -> let structType' = Lib.al_fields structType in let ii = Ast_c.get_ii_typeC_take_care tbis in let ii' = Lib.al_ii ii in add_binding (StructUnionNameDef (s, ((su, structType'),ii'))) true; if need_annotate_body then k typ (* todo: restrict ? new scope so use do_in_scope ? *) | Enum (sopt, enums) -> enums +> List.iter (fun ((name, eopt), iicomma) -> let s = Ast_c.str_of_name name in if need_annotate_body then eopt +> Common.do_option (fun (ieq, e) -> Visitor_c.vk_expr bigf e ); add_binding (EnumConstant (s, sopt)) true; ); (* TODO: if have a TypeName, then maybe can fill the option * information. *) | _ -> if need_annotate_body then k typ ); (* ------------------------------------------------------------ *) Visitor_c.ktoplevel = (fun (k, bigf) elem -> _notyped_var := Hashtbl.create 100; match elem with | Definition def -> let {f_name = name; f_type = ((returnt, (paramst, b)) as ftyp); f_storage = sto; f_body = statxs; f_old_c_style = oldstyle; },ii = def in let (i1, i2) = match ii with (* what is iifunc1? it should be a type. jll * pad: it's the '(' in the function definition. The * return type is part of f_type. *) | iifunc1::iifunc2::ibrace1::ibrace2::ifakestart::isto -> iifunc1, iifunc2 | _ -> raise (Impossible 160) in let funcs = Ast_c.str_of_name name in (match oldstyle with | None -> let typ' = Lib.al_type (Ast_c.mk_ty (FunctionType ftyp) [i1;i2]) in add_binding (VarOrFunc (funcs, (typ',islocal i1.Ast_c.pinfo))) false; if need_annotate_body then do_in_new_scope (fun () -> paramst +> List.iter (fun ({p_namei= nameopt; p_type= t},_)-> match nameopt with | Some name -> let s = Ast_c.str_of_name name in let local = (match Ast_c.info_of_type t with (* if there is no info about the type it must not be present, so we don't know what the variable is *) None -> Ast_c.NotLocalVar | Some ii -> Ast_c.LocalVar ii) in add_binding (VarOrFunc (s,(Lib.al_type t,local))) true | None -> pr2 "no type, certainly because Void type ?" ); (* recurse *) k elem ); | Some oldstyle -> (* generate regular function type *) pr2 "TODO generate type for function"; (* add bindings *) if need_annotate_body then do_in_new_scope (fun () -> (* recurse. should naturally call the kdecl visitor and * add binding *) k elem; ); ); | CppTop x -> (match x with | Define ((s,ii), (DefineVar, DefineType t)) -> add_binding (TypeDef (s,Lib.al_type t)) true; | _ -> k elem ) | Declaration _ | IfdefTop _ | MacroTop _ | EmptyDef _ | NotParsedCorrectly _ | FinalDef _ | Namespace _ -> k elem ); } in if just_add_in_env then if depth > 1 then Visitor_c.vk_toplevel bigf elem else Common.profile_code "TAC.annotate_only_included" (fun () -> Visitor_c.vk_toplevel bigf elem ) else Visitor_c.vk_toplevel bigf elem (*****************************************************************************) (* Entry point *) (*****************************************************************************) (* catch all the decl to grow the environment *) let rec (annotate_program2 : environment -> toplevel list -> (toplevel * environment Common.pair) list) = fun env prog -> (* globals (re)initialialisation *) _scoped_env := env; _notyped_var := (Hashtbl.create 100); prog +> List.map (fun elem -> let beforeenv = !_scoped_env in visit_toplevel ~just_add_in_env:false ~depth:0 elem; let afterenv = !_scoped_env in (elem, (beforeenv, afterenv)) ) (*****************************************************************************) (* Annotate test *) (*****************************************************************************) (* julia: for coccinelle *) let annotate_test_expressions prog = let rec propagate_test e = let ((e_term,info),_) = e in let (ty,_) = !info in info := (ty,Test); match e_term with Binary(e1,Logical(AndLog),e2) | Binary(e1,Logical(OrLog),e2) -> propagate_test e1; propagate_test e2 | Unary(e1,Not) -> propagate_test e1 | ParenExpr(e) -> propagate_test e | FunCall(e,args) -> (* not very nice, but so painful otherwise *) (match (unwrap e,args) with ((Ident(i),_),[(Left a,_)]) -> let nm = str_of_name i in if List.mem nm ["likely";"unlikely"] then propagate_test a else () | _ -> ()) | _ -> () in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kexpr = (fun (k,bigf) expr -> (match unwrap_expr expr with CondExpr(e,_,_) -> propagate_test e | Binary(e1,Logical(AndLog),e2) | Binary(e1,Logical(OrLog),e2) -> propagate_test e1; propagate_test e2 | Unary(e1,Not) -> propagate_test e1 | _ -> () ); k expr ); Visitor_c.kstatement = (fun (k, bigf) st -> match unwrap_st st with Selection(s) -> (match s with If(e1,s1,s2) -> propagate_test e1 | _ -> ()); k st; | Iteration(i) -> (match i with While(e,s) -> propagate_test e | DoWhile(s,e) -> propagate_test e | For(_,es,_,_) -> (match unwrap es with Some e -> propagate_test e | None -> ()) | _ -> ()); k st | _ -> k st ) } in (prog +> List.iter (fun elem -> Visitor_c.vk_toplevel bigf elem )) (*****************************************************************************) (* Annotate types *) (*****************************************************************************) let annotate_program env prog = Common.profile_code "TAC.annotate_program" (fun () -> let res = annotate_program2 env prog in annotate_test_expressions prog; res ) let annotate_type_and_localvar env prog = Common.profile_code "TAC.annotate_type" (fun () -> annotate_program2 env prog) (*****************************************************************************) (* changing default typing environment, do concatenation *) (* not clear that anyone uses this function... *) let init_env_unused filename = pr2 ("init_env: " ^ filename); let (ast2, _stat) = Parse_c.parse_c_and_cpp false filename in let ast = Parse_c.program_of_program2 ast2 in let res = annotate_type_and_localvar !initial_env ast in match List.rev res with | [] -> pr2 "empty environment" | (_top,(env1,env2))::xs -> initial_env := !initial_env ++ env2; () coccinelle-1.0.0-rc19/parsing_c/token_views_c.mli0000644000175000017500000000456012247437436020704 0ustar eugeneugen type context = InFunction | InEnum | InStruct | InInitializer | NoContext type token_extended = { mutable tok : Parser_c.token; mutable where : context; mutable new_tokens_before : Parser_c.token list; line : int; col : int; } val mk_token_extended : Parser_c.token -> token_extended val rebuild_tokens_extented : token_extended list -> token_extended list (* ---------------------------------------------------------------------- *) type paren_grouped = Parenthised of paren_grouped list list * token_extended list | PToken of token_extended type brace_grouped = Braceised of brace_grouped list list * token_extended * token_extended option | BToken of token_extended type ifdef_grouped = Ifdef of ifdef_grouped list list * token_extended list | Ifdefbool of bool * ifdef_grouped list list * token_extended list | NotIfdefLine of token_extended list type 'a line_grouped = Line of 'a list type body_function_grouped = BodyFunction of token_extended list | NotBodyLine of token_extended list (* ---------------------------------------------------------------------- *) val mk_parenthised : token_extended list -> paren_grouped list val mk_braceised : token_extended list -> brace_grouped list val mk_ifdef : token_extended list -> ifdef_grouped list val mk_line_parenthised : paren_grouped list -> paren_grouped line_grouped list val mk_body_function_grouped : token_extended list -> body_function_grouped list val line_of_paren : paren_grouped -> int val span_line_paren : int -> paren_grouped list -> paren_grouped list * paren_grouped list (* ---------------------------------------------------------------------- *) val iter_token_paren : (token_extended -> unit) -> paren_grouped list -> unit val iter_token_brace : (token_extended -> unit) -> brace_grouped list -> unit val iter_token_ifdef : (token_extended -> unit) -> ifdef_grouped list -> unit val tokens_of_paren : paren_grouped list -> token_extended list val tokens_of_paren_ordered : paren_grouped list -> token_extended list (* ---------------------------------------------------------------------- *) val set_context_tag: brace_grouped list -> unit (* ---------------------------------------------------------------------- *) val set_as_comment : Token_c.cppcommentkind -> token_extended -> unit val save_as_comment : (Token_c.ifdef -> Token_c.cppcommentkind)-> token_extended -> unit coccinelle-1.0.0-rc19/parsing_c/semantic_c.ml0000644000175000017500000000006112247437436017771 0ustar eugeneugenexception Semantic of string * Common.parse_info coccinelle-1.0.0-rc19/parsing_c/parse_string_c.mli0000644000175000017500000000023212247437436021037 0ustar eugeneugen(* the result is reversed, as that is what is useful for the caller *) val parse_string : (string * Ast_c.isWchar) -> Ast_c.info -> Parser_c.token list coccinelle-1.0.0-rc19/parsing_c/type_c.mli0000644000175000017500000000266212247437436017331 0ustar eugeneugen type finalType = Ast_c.fullType (* completed TypeName, removed ParenType, use StructUnionName when can *) type completed_and_simplified = Ast_c.fullType type completed_typedef = Ast_c.fullType type removed_typedef = Ast_c.fullType val is_completed_and_simplified: finalType -> bool val is_completed_typedef_fullType : finalType -> bool val is_removed_typedef_fullType: finalType -> bool val remove_typedef: completed_typedef -> removed_typedef (* lookup *) val type_field: string -> (Ast_c.structUnion * Ast_c.structType) -> Ast_c.fullType (* typing rules *) val lub: Ast_c.arithOp -> finalType option -> finalType option -> Ast_c.exp_info (* helpers *) val structdef_to_struct_name: finalType -> finalType val fake_function_type: finalType option -> Ast_c.argument Ast_c.wrap2 list -> finalType option (* return normalize types ? *) val type_of_function: Ast_c.definition -> finalType val type_of_decl: Ast_c.declaration -> finalType val structdef_of_decl: Ast_c.declaration -> Ast_c.structUnion * Ast_c.structType (* builders *) val make_info_def: finalType -> Ast_c.exp_info val make_info: Ast_c.exp_type -> Ast_c.exp_info val noTypeHere: Ast_c.exp_info val do_with_type: (finalType -> Ast_c.exp_info) -> Ast_c.exp_info -> Ast_c.exp_info val get_opt_type: Ast_c.expression -> finalType option (* helpers bis *) val is_function_type: finalType -> bool val function_pointer_type_opt: finalType -> Ast_c.functionType option coccinelle-1.0.0-rc19/parsing_c/unparse_c.ml0000644000175000017500000020662112247437436017655 0ustar eugeneugen(* Yoann Padioleau, Julia Lawall * * Copyright (C) 2012, INRIA. * Copyright (C) 2010, 2011, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * file license.txt for more details. * * * Modifications by Julia Lawall for better newline handling. *) open Common module TH = Token_helpers (* should keep comments and directives in between adjacent deleted terms, but not comments and directives within deleted terms. should use the labels found in the control-flow graph *) (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = mk_pr2_wrappers Flag_parsing_c.verbose_unparsing (*****************************************************************************) (* Types used during the intermediate phases of the unparsing *) (*****************************************************************************) type token1 = | Fake1 of Ast_c.info | T1 of Parser_c.token (* The cocci_tag of the token should always be a NOTHING. The mark of * the token can only be OriginTok or ExpandedTok. Why not get rid of * token and get something simpler ? because we need to know if the * info is a TCommentCpp or TCommentSpace, etc for some of the further * analysis so easier to keep with the token. * * This type contains the whole information. Have all the tokens with this * type. *) type min = | Min of (int list (* match numbers from witness trees *) * Ast_cocci.adjacency (* adjacency information *)) | Ctx type token2 = | T2 of Parser_c.token * min * int option (* orig index, abstracting away comments and space *) * Unparse_cocci.nlhint option | Fake2 of min | Cocci2 of string * int (* line *) * int (* lcol *) * int (* rcol *) * Unparse_cocci.nlhint option | C2 of string | Comma of string | Indent_cocci2 | Unindent_cocci2 of bool (* true for permanent, false for temporary *) | EatSpace2 (* not used yet *) type token3 = | T3 of Parser_c.token | Cocci3 of string | C3 of string (* similar to the tech in parsing_hack *) type token_extended = { tok2 : token2; str : string; idx : int option; (* to know if 2 tokens were consecutive in orig file *) mutable new_tokens_before : token2 list; mutable remove : bool; } (*****************************************************************************) (* Helpers *) (*****************************************************************************) let info_of_token1 t = match t with | Fake1 info -> info | T1 tok -> TH.info_of_tok tok let print_token1 = function | T1 tok -> TH.str_of_tok tok | Fake1 info -> "fake" let str_of_token2 = function | T2 (t,_,_,_) -> TH.str_of_tok t | Cocci2 (s,_,_,_,_) | C2 s | Comma s -> s | Fake2 _ | Indent_cocci2 | Unindent_cocci2 _ | EatSpace2 -> "" let print_token2 = function | T2 (t,b,_,_) -> let t_str = match t with | Parser_c.TCommentSpace _ -> " sp " | Parser_c.TCommentNewline _ -> " nl " | Parser_c.TCommentCpp _ -> " cp " | Parser_c.TCommentMisc _ -> " misc " | Parser_c.TComment _ -> " comment " | _ -> "" in let b_str = match b with | Min (index,adj) -> Printf.sprintf "-.%d[%s]" (match adj with Ast_cocci.ADJ n -> n | _ -> -1) (String.concat " " (List.map string_of_int index)) | Ctx -> "" in "T2:"^b_str^t_str^TH.str_of_tok t | Fake2 b -> let b_str = match b with | Min (index,adj) -> Printf.sprintf "-%d[%s]" (match adj with Ast_cocci.ADJ n -> n | _ -> -1) (String.concat " " (List.map string_of_int index)) | Ctx -> "" in b_str^"fake" | Cocci2 (s,_,lc,rc,Some _) -> Printf.sprintf "Cocci2:%d:%d%s (H)" lc rc s | Cocci2 (s,_,lc,rc,_) -> Printf.sprintf "Cocci2:%d:%d%s" lc rc s | C2 s -> "C2:"^s | Comma s -> "Comma:"^s | Indent_cocci2 -> "Indent" | Unindent_cocci2 true -> "Unindent" | Unindent_cocci2 false -> "Unindent-false" | EatSpace2 -> "EatSpace" let str_of_token3 = function | T3 t -> TH.str_of_tok t | Cocci3 s | C3 s -> s let simple_print_all_tokens pr s l = Printf.printf "%s\n" s; List.iter (function x -> Printf.printf "|%s| " (pr x)) l; Printf.printf "\n" let simple_print_all_tokens1 = simple_print_all_tokens print_token1 let simple_print_all_tokens2 = simple_print_all_tokens print_token2 let simple_print_all_tokens3 = simple_print_all_tokens str_of_token3 let mk_token_extended x = let origidx = match x with | T2 (_,_,idx,_) -> idx | _ -> None in { tok2 = x; str = str_of_token2 x; idx = origidx; new_tokens_before = []; remove = false; } let rebuild_tokens_extented toks_ext = let _tokens = ref [] in toks_ext +> List.iter (fun tok -> tok.new_tokens_before +> List.iter (fun x -> push2 x _tokens); if not tok.remove then push2 tok.tok2 _tokens; ); let tokens = List.rev !_tokens in (tokens +> List.map mk_token_extended) let mcode_contain_plus = function | Ast_cocci.CONTEXT (_,Ast_cocci.NOTHING) -> false | Ast_cocci.CONTEXT _ -> true (* patch: when need full coccinelle transformation *) | Ast_cocci.MINUS (_,_,_,Ast_cocci.NOREPLACEMENT) -> false | Ast_cocci.MINUS (_,_,_,Ast_cocci.REPLACEMENT _) -> true(*REPL is not empty*) | Ast_cocci.PLUS _ -> raise (Impossible 132) let contain_plus info = let mck = Ast_c.mcode_of_info info in mcode_contain_plus mck (*****************************************************************************) (* Last fix on the ast *) (*****************************************************************************) (* Because of the ugly trick to handle initialiser, I generate fake ',' * for the last initializer element, but if there is nothing around it, * I don't want in the end to print it. *) let remove_useless_fakeInfo_struct program = let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kini_s = (fun (k,bigf) ini -> match k ini with | Ast_c.InitList args, ii -> (match ii with | [_;_] -> ini | i1 :: i2 :: iicommaopt :: tl when (not (contain_plus iicommaopt)) && (not (contain_plus i2)) && (Ast_c.is_fake iicommaopt) -> (* sometimes the guy put a normal iicommaopt *) Ast_c.InitList args, (i1 :: i2 :: tl) | ii -> Ast_c.InitList args, ii ) | x -> x) } in Visitor_c.vk_toplevel_s bigf program (*****************************************************************************) (* Tokens1 generation *) (*****************************************************************************) let get_fakeInfo_and_tokens celem toks = let toks_in = ref toks in let toks_out = ref [] in (* todo? verify good order of position ? *) let pr_elem info = match Ast_c.pinfo_of_info info with | Ast_c.FakeTok _ -> push2 (Fake1 info) toks_out | Ast_c.OriginTok _ | Ast_c.ExpandedTok _ -> (* get the associated comments/space/cppcomment tokens *) let (before, x, after) = !toks_in +> split_when (fun tok -> info =*= TH.info_of_tok tok) in assert(info =*= TH.info_of_tok x); (*old: assert(before +> List.for_all (TH.is_comment)); *) before +> List.iter (fun x -> if not (TH.is_comment x) then pr2 ("WEIRD: not a comment:" ^ TH.str_of_tok x) (* case such as int asm d3("x"); not yet in ast *) ); before +> List.iter (fun x -> push2 (T1 x) toks_out); push2 (T1 x) toks_out; toks_in := after; | Ast_c.AbstractLineTok _ -> (* can be called on type info when for instance use -type_c *) if !Flag_parsing_c.pretty_print_type_info then push2 (Fake1 info) toks_out else raise (Impossible 134) (* at this stage *) in let pr_space _ = () in (* use the spacing that is there already *) Pretty_print_c.pp_program_gen pr_elem pr_space celem; if not (null !toks_in) then failwith "WEIRD: unparsing not finished"; List.rev !toks_out (* Fake nodes that have BEFORE code or are - should be moved over any subsequent whitespace and newlines, but not any comments, to get as close to the affected code as possible. Similarly, fake nodes that have AFTER code should be moved backwards. No fake nodes should have both before and after code. *) let displace_fake_nodes toks = let is_fake = function Fake1 _ -> true | _ -> false in let is_whitespace = function | T1(Parser_c.TCommentSpace _) (* patch: cocci *) | T1(Parser_c.TCommentNewline _) -> true | _ -> false in let rec loop toks = let fake_info = try Some (split_when is_fake toks) with Not_found -> None in match fake_info with | Some(bef,((Fake1 info) as fake),aft) -> (match !(info.Ast_c.cocci_tag) with | Some x -> (match x with | (Ast_cocci.MINUS(_,_,_,Ast_cocci.REPLACEMENT _),_) (* for , replacement is more likely to be like after, but not clear... but treating it as after breaks a lot of tests. *) | (Ast_cocci.CONTEXT(_,Ast_cocci.BEFORE _),_) -> (* move the fake node forwards *) let (whitespace,rest) = span is_whitespace aft in bef @ whitespace @ fake :: (loop rest) | (Ast_cocci.CONTEXT(_,Ast_cocci.AFTER _),_) -> (* move the fake node backwards *) let revbef = List.rev bef in let (revwhitespace,revprev) = span is_whitespace revbef in let whitespace = List.rev revwhitespace in let prev = List.rev revprev in prev @ fake :: (loop (whitespace @ aft)) | (Ast_cocci.CONTEXT(_,Ast_cocci.BEFOREAFTER _),_) -> failwith "fake node should not be before-after" | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING),_) | _ -> bef @ fake :: (loop aft) (* old: was removed when have simpler yacfe *) ) | None -> bef @ fake :: (loop aft) ) | None -> toks | _ -> raise (Impossible 135) in loop toks (*****************************************************************************) (* Tokens2 generation *) (*****************************************************************************) let comment2t2 = function | (Token_c.TCommentCpp (* not sure iif the following list is exhaustive or complete *) (Token_c.CppAttr|Token_c.CppMacro|Token_c.CppPassingCosWouldGetError), (info : Token_c.info)) -> C2(info.Common.str) | (Token_c.TCommentCpp x,(info : Token_c.info)) -> C2("\n"^info.Common.str^"\n") | x -> failwith (Printf.sprintf "unexpected comment %s" (Dumper.dump x)) let expand_mcode toks = let toks_out = ref [] in let index = ref 0 in let add_elem t minus = match t with | Fake1 info -> let str = Ast_c.str_of_info info in let isminus = match minus with Min _ -> true | Ctx -> false in (* don't add fake string if the thing should be removed *) if str =$= "" or isminus then push2 (Fake2 minus) toks_out (* fx the fake "," at the end of a structure or enum. no idea what other fake info there can be... *) else push2 (Comma str) toks_out | T1 tok -> (*let (a,b) = !((TH.info_of_tok tok).cocci_tag) in*) (* no tag on expandedTok ! *) let modified = function | None -> false | Some (Ast_cocci.CONTEXT(pos,Ast_cocci.NOTHING),l) -> false | _ -> true in (if TH.is_expanded tok && modified !((TH.info_of_tok tok).Ast_c.cocci_tag) (*!((TH.info_of_tok tok).cocci_tag) <> Ast_c.emptyAnnot*) then failwith (Printf.sprintf "expanded token %s on line %d is either modified or stored in a metavariable" (TH.str_of_tok tok) (TH.line_of_tok tok))); let tok' = tok +> TH.visitor_info_of_tok (fun i -> { i with Ast_c.cocci_tag = ref Ast_c.emptyAnnot; } ) in let optindex = if TH.is_origin tok && not (TH.is_real_comment tok) then begin incr index; Some !index end else None in push2 (T2 (tok', minus, optindex, None)) toks_out in let expand_info t = let (mcode,env) = Ast_c.mcode_and_env_of_cocciref ((info_of_token1 t).Ast_c.cocci_tag) in let pr_cocci s ln col rcol hint = push2 (Cocci2 (s,ln,col,rcol,hint)) toks_out in let pr_c info = (match Ast_c.pinfo_of_info info with | Ast_c.AbstractLineTok _ -> push2 (C2 (Ast_c.str_of_info info)) toks_out | Ast_c.FakeTok (s,_) -> push2 (C2 s) toks_out | _ -> Printf.fprintf stderr "line: %s\n" (Dumper.dump info); failwith "not an abstract line" ); (!(info.Ast_c.comments_tag)).Ast_c.mafter +> List.iter (fun x -> push2 (comment2t2 x) toks_out) in let pr_barrier ln col = (* marks a position, used around C code *) push2 (Cocci2 ("",ln,col,col,None)) toks_out in let pr_nobarrier ln col = () in (* not needed for linux spacing *) let pr_cspace _ = push2 (C2 " ") toks_out in let pr_space _ = () (* rely on add_space in cocci code *) in let pr_arity _ = () (* not interested *) in let indent _ = push2 Indent_cocci2 toks_out in let unindent x = push2 (Unindent_cocci2 x) toks_out in let eat_space _ = push2 EatSpace2 toks_out in let args_pp = (env, pr_cocci, pr_c, pr_cspace, (match !Flag_parsing_c.spacing with | Flag_parsing_c.SMPL -> pr_space | _ -> pr_cspace), pr_arity, (match !Flag_parsing_c.spacing with | Flag_parsing_c.SMPL -> pr_barrier | _ -> pr_nobarrier), indent, unindent, eat_space) in (* old: when for yacfe with partial cocci: * add_elem t false; *) (* patch: when need full coccinelle transformation *) let unparser = Unparse_cocci.pp_list_list_any args_pp false in match mcode with | Ast_cocci.MINUS (_,inst,adj,any_xxs) -> (* Why adding ? because I want to have all the information, the whole * set of tokens, so I can then process and remove the * is_between_two_minus for instance *) add_elem t (Min (inst,adj)); (match any_xxs with | Ast_cocci.NOREPLACEMENT -> () | Ast_cocci.REPLACEMENT(any_xxs,_) -> unparser any_xxs Unparse_cocci.InPlace ) | Ast_cocci.CONTEXT (_,any_befaft) -> (match any_befaft with | Ast_cocci.NOTHING -> add_elem t Ctx | Ast_cocci.BEFORE (xxs,_) -> unparser xxs Unparse_cocci.Before; add_elem t Ctx | Ast_cocci.AFTER (xxs,_) -> add_elem t Ctx; unparser xxs Unparse_cocci.After; | Ast_cocci.BEFOREAFTER (xxs, yys, _) -> unparser xxs Unparse_cocci.Before; add_elem t Ctx; unparser yys Unparse_cocci.After; ) | Ast_cocci.PLUS _ -> raise (Impossible 136) in toks +> List.iter expand_info; List.rev !toks_out (*****************************************************************************) (* Tokens2 processing, filtering, adjusting *) (*****************************************************************************) let is_space = function | T2(Parser_c.TCommentSpace _,_b,_i,_h) -> true (* only whitespace *) | _ -> false let is_comment_or_space = function | T2(Parser_c.TCommentSpace _,_b,_i,_h) -> true (* only whitespace *) | T2(Parser_c.TComment _,_b,_i,_h) -> true (* only whitespace *) | _ -> false let is_added_space = function | C2(" ") -> true (* only whitespace *) | _ -> false let is_newline = function | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | T2(Parser_c.TComment _,_b,_i,_h) -> true (* only whitespace *) | _ -> false let is_newline_or_comment = function | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | _ -> false let is_whitespace x = is_space x or is_newline x let is_minusable_comment = function | (T2 (t,_b,_i,_h)) -> (match t with | Parser_c.TCommentSpace _ (* only whitespace *) (* patch: coccinelle *) | Parser_c.TCommentNewline _ (* newline plus whitespace *) -> true | Parser_c.TComment _ when !Flag_parsing_c.keep_comments -> false | Parser_c.TComment _ | Parser_c.TCommentCpp (Token_c.CppAttr, _) | Parser_c.TCommentCpp (Token_c.CppMacro, _) | Parser_c.TCommentCpp (Token_c.CppIfDirective _, _) | Parser_c.TCommentCpp (Token_c.CppDirective, _) -> (* result was false *) true (* | Parser_c.TCommentMisc _ | Parser_c.TCommentCpp (Token_c.CppPassingCosWouldGetError, _) -> false *) | _ -> false ) | _ -> false let is_minusable_comment_nocpp = function | (T2 (t,_b,_i,_h)) -> (match t with | Parser_c.TCommentSpace _ (* only whitespace *) (* patch: coccinelle *) | Parser_c.TCommentNewline _ (* newline plus whitespace *) -> true | Parser_c.TComment _ when !Flag_parsing_c.keep_comments -> false | Parser_c.TComment _ -> true (* | Parser_c.TCommentCpp (Token_c.CppAttr, _) | Parser_c.TCommentCpp (Token_c.CppMacro, _) | Parser_c.TCommentCpp (Token_c.CppIfDirective _, _) | Parser_c.TCommentCpp (Token_c.CppDirective, _) -> false | Parser_c.TCommentMisc _ | Parser_c.TCommentCpp (Token_c.CppPassingCosWouldGetError, _) -> false *) | _ -> false ) | _ -> false let all_coccis = function | Cocci2 _ | C2 _ | Comma _ | Indent_cocci2 | Unindent_cocci2 _ | EatSpace2 -> true | _ -> false (* previously gave up if the first character was a newline, but not clear why *) let is_minusable_comment_or_plus x = is_minusable_comment x or all_coccis x let set_minus_comment adj = function | T2 (t,Ctx,idx,hint) -> let str = TH.str_of_tok t in (match t with | Parser_c.TCommentSpace _ (* patch: coccinelle *) | Parser_c.TCommentNewline _ -> () | Parser_c.TComment _ | Parser_c.TCommentCpp (Token_c.CppAttr, _) | Parser_c.TCommentCpp (Token_c.CppMacro, _) | Parser_c.TCommentCpp (Token_c.CppIfDirective _, _) | Parser_c.TCommentCpp (Token_c.CppDirective, _) -> pr2 (Printf.sprintf "%d: ERASING_COMMENTS: %s" (TH.line_of_tok t) str) | _ -> raise (Impossible 137) ); T2 (t, Min adj, idx, hint) (* patch: coccinelle *) | T2 (t, Min adj, idx, hint) as x -> x | Fake2 _ as x -> x | _ -> raise (Impossible 138) (* don't touch ifdefs, done after *) let set_minus_comment_or_plus adj = function | Cocci2 _ | C2 _ | Comma _ | Indent_cocci2 | Unindent_cocci2 _ | EatSpace2 as x -> x | x -> set_minus_comment adj x let is_minus = function | T2 (_, Min _, _, _) -> true | _ -> false let drop_minus xs = xs +> exclude is_minus let drop_expanded xs = xs +> exclude (function | T2 (t,_,_,_) when TH.is_expanded t -> true | _ -> false ) let drop_fake xs = xs +> exclude (function | Fake2 _ -> true | _ -> false ) let remove_minus_and_between_and_expanded_and_fake1 xs = (* get rid of expanded tok *) let xs = drop_expanded xs in let minus_or_comment x = is_minus x or is_minusable_comment x in let minus_or_comment_nocpp x = is_minus x or is_minusable_comment_nocpp x in let common_adj (index1,adj1) (index2,adj2) = let same_adj = (* same adjacency info *) match (adj1,adj2) with | (Ast_cocci.ADJ adj1,Ast_cocci.ADJ adj2) -> adj1 = adj2 | (Ast_cocci.ALLMINUS,_) | (_,Ast_cocci.ALLMINUS) -> true in same_adj && (* non-empty intersection of witness trees *) not ((inter_set index1 index2) = []) in (* new idea: collects regions not containing non-space context code if two adjacent adjacent minus tokens satisfy common_adj then delete all spaces, comments etc between them if two adjacent minus tokens do not satisfy common_adj only delete the spaces between them if there are no comments, etc. if the region contain no plus code and is both preceded and followed by a newline, delete the initial newline. *) let rec adjust_around_minus = function | [] -> [] | (T2(Parser_c.TCommentNewline c,_b,_i,_h) as x):: ((Fake2(Min adj1) | T2(_,Min adj1,_,_)) as t1)::xs -> let (minus_list,rest) = span not_context (t1::xs) in let contains_plus = List.exists is_plus minus_list in let x = match List.rev minus_list with | (T2(Parser_c.TCommentNewline c,_b,_i,_h))::rest when List.for_all minus_or_comment minus_list -> set_minus_comment_or_plus adj1 x | _ -> x in x :: adjust_within_minus contains_plus minus_list @ adjust_around_minus rest | ((Fake2(Min adj1) | T2(_,Min adj1,_,_)) as t1)::xs -> let (minus_list,rest) = span not_context (t1::xs) in let contains_plus = List.exists is_plus minus_list in adjust_within_minus contains_plus minus_list @ adjust_around_minus rest | x::xs -> x :: adjust_around_minus xs and adjust_within_minus cp (* contains plus *) = function | ((Fake2(Min adj1) | T2(_,Min adj1,_,_)) as t1)::xs -> let not_minus = function T2(_,Min _,_,_) -> false | _ -> true in let (not_minus_list,rest) = span not_minus xs in t1 :: (match rest with | ((Fake2(Min adj2) | T2(_,Min adj2,_,_)) as t2)::xs -> if common_adj adj1 adj2 || not cp && List.for_all is_whitespace not_minus_list then (List.map (set_minus_comment_or_plus adj1) not_minus_list) @ (adjust_within_minus cp (t2::xs)) else not_minus_list @ (adjust_within_minus cp (t2::xs)) | _ -> if cp then xs else (* remove spaces after removed stuff, eg a comma after a function argument *) (let (spaces,rest) = span is_space xs in (List.map (set_minus_comment_or_plus adj1) spaces) @ rest) ) | xs -> failwith "should always start with minus" and not_context = function | (T2(_,Ctx,_,_) as x) when not (is_minusable_comment x) -> false | _ -> true and is_plus = function | C2 _ | Comma _ | Cocci2 _ -> true | _ -> false in let xs = adjust_around_minus xs in (* get rid of fake tok *) let xs = drop_fake xs in (* this drops blank lines after a brace introduced by removing code *) let minus_or_comment_nonl = function | T2(_,Min adj,_,_) -> true | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> false | x -> is_minusable_comment x in let rec adjust_after_brace = function | [] -> [] | ((T2(_,Ctx,_,_)) as x)::((T2(_,Min adj,_,_)::_) as xs) when str_of_token2 x =$= "{" -> let (between_minus,rest) = span minus_or_comment_nonl xs in let (newlines,rest) = span is_whitespace rest in let (drop_newlines,last_newline) = let rec loop = function | [] -> ([],[]) | ((T2(Parser_c.TCommentNewline _,_b,_i,_h)) as x) :: rest -> (List.rev rest,[x]) | x::xs -> let (drop_newlines,last_newline) = loop xs in (drop_newlines,x::last_newline) in loop (List.rev newlines) in x :: between_minus @ List.map (set_minus_comment adj) drop_newlines @ last_newline @ adjust_after_brace rest | x::xs -> x :: (adjust_after_brace xs) in let xs = adjust_after_brace xs in (* search backwards from context } over spaces until reaching a newline. then go back over all minus code until reaching some context or + code. get rid of all intervening spaces, newlines, and comments input is reversed *) let rec adjust_before_brace = function | [] -> [] | ((T2(t,Ctx,_,_)) as x)::xs when str_of_token2 x =$= "}" or is_newline x -> let (outer_spaces,rest) = span is_space xs in x :: outer_spaces @ (match rest with | ((T2 (Parser_c.TCommentNewline _,Ctx,_i,_h)) as h) :: (* the rest of this code is the same as from_newline below but merging them seems to be error prone... *) ((T2 (t, Min adj, idx, hint)) as m) :: rest -> let (spaces,rest) = span minus_or_comment_nocpp rest in h :: m :: (List.map (set_minus_comment adj) spaces) @ (adjust_before_brace rest) | _ -> adjust_before_brace rest ) | x::xs -> x :: (adjust_before_brace xs) in let from_newline = function | ((T2 (t, Min adj, idx, hint)) as m) :: rest -> let (spaces,rest) = span minus_or_comment_nocpp rest in m :: (List.map (set_minus_comment adj) spaces) @ (adjust_before_brace rest) | ((T2 (t0,Ctx, idx0,h0)) as m0) :: ((T2 (t,Min adj,idx,h)) as m) :: rest when TH.str_of_tok t0 = "" -> (* This is for the case of a #define that is completely deleted, because a #define has a strange EOL token at the end. We hope there i no other kind of token that is represented by "", but it seems like changing the kind of token might break the end of entity recognition in the C parser. See parsing_hacks.ml *) let (spaces,rest) = span minus_or_comment_nocpp rest in m0 :: m :: (List.map (set_minus_comment adj) spaces) @ (adjust_before_brace rest) | rest -> adjust_before_brace rest in let xs = List.rev (from_newline (List.rev xs)) in let cleanup_ifdefs toks = (* TODO: these functions are horrid, but using tokens caused circularity *) let is_ifdef = function | T2((Parser_c.TCommentCpp (Token_c.CppIfDirective Token_c.IfDef, _)),m,idx,_) -> true | T2((Parser_c.TCommentCpp (Token_c.CppIfDirective Token_c.IfDef0, _)),m,idx,_) -> true | t -> false in let is_else = function | T2((Parser_c.TCommentCpp (Token_c.CppIfDirective Token_c.Else, _)),m,idx,_) -> true | _ -> false in let is_endif = function | T2((Parser_c.TCommentCpp (Token_c.CppIfDirective Token_c.Endif, _)),m,idx,_) -> true | _ -> false in let add t = function | l::rest -> (t::l)::rest | _ -> failwith "not possible" in let rec parse_ifdef acc_keywords acc_code stack = function | [] -> (None,acc_keywords,acc_code) | t::rest when is_else t -> (match stack with | [] -> parse_ifdef (t::acc_keywords) ([]::acc_code) stack rest | _ -> parse_ifdef acc_keywords (add t acc_code) stack rest ) | t::rest when is_endif t -> (match stack with | [] -> ((Some (t,rest)),acc_keywords,acc_code) | _::stack -> parse_ifdef acc_keywords (add t acc_code) stack rest ) | t::rest when is_ifdef t -> parse_ifdef acc_keywords (add t acc_code) (()::stack) rest | t::rest -> parse_ifdef acc_keywords (add t acc_code) stack rest in let unminus = function | T2 (t,Min adj,idx,hint) -> T2 (t,Ctx,idx,hint) | x -> x in let rec loop = function | [] -> [] | t::rest when is_ifdef t -> let (ender,acc_keywords,acc_code) = parse_ifdef [t] [[]] [] rest in let acc_code = List.map loop acc_code in let merge = (* args reversed *) List.fold_left2 (fun prev kwd code -> kwd :: (List.rev code) @ prev) [] in (match ender with | None -> merge (List.map unminus acc_keywords) acc_code | Some(endif,rest) -> let rest = loop rest in if List.for_all is_minus (endif :: acc_keywords) then (merge acc_keywords acc_code) @ (endif :: rest) else (merge (List.map unminus acc_keywords) acc_code) @ ((unminus endif) :: rest) ) | x::xs -> x :: loop xs in loop toks in cleanup_ifdefs xs let remove_minus_and_between_and_expanded_and_fake2 xs = let xs = drop_minus xs in xs (* things that should not be followed by space - boundary between SmPL code and C code *) let adjust_eat_space toks = let rec loop = function | [] -> [] | EatSpace2 :: x :: rest when is_space x -> loop rest | EatSpace2 :: rest -> loop rest | x :: xs -> x :: loop xs in loop toks (* normally, in C code, a semicolon is not preceded by a space or newline *) let adjust_before_semicolon toks = let toks = List.rev toks in let rec search_semic = function | [] -> [] | ((T2(_,Ctx,_,_) | Cocci2 _) as x)::xs when List.mem (str_of_token2 x) [";";")";","] -> x :: search_semic (search_minus false xs) | x::xs -> x :: search_semic xs and search_minus seen_minus xs = (* drop spaces added by cocci, eg after attribute *) let (_, xs) = span is_added_space xs in let (spaces, rest) = span is_space xs in (* only delete spaces if something is actually deleted *) match rest with | ((T2(_,Min _,_,_)) as a)::rerest -> a :: search_minus true rerest | _ -> if seen_minus then rest else xs in List.rev (search_semic toks) (* normally, in C code, a ( is not followed by a space or newline *) let adjust_after_paren toks = let rec search_paren = function | [] -> [] | ((T2(_,Ctx,_,_) | Cocci2 _) as x)::xs when List.mem (str_of_token2 x) ["("] (* other things? *) -> x :: search_paren (search_minus false xs) | x::xs -> x :: search_paren xs and search_minus seen_minus xs = let (spaces, rest) = span is_whitespace xs in (* only delete spaces if something is actually deleted *) match rest with | ((T2(_,Min _,_,_)) as a)::rerest -> (* minus *) a :: search_minus true rerest | ((T2(_,Ctx,_,_)) as a)::rerest when seen_minus && str_of_token2 a = "," -> (* comma after ( will be deleted, so consider it as minus code already *) a :: search_minus true rerest | _ -> if seen_minus then rest else xs in (* drop trailing space *) search_paren toks (* this is for the case where braces are added around an if branch because of a change inside the branch *) let paren_then_brace toks = let rec search_paren = function | [] -> [] | ((T2(_,Ctx,_,_)) as x)::xs when List.mem (str_of_token2 x) [")";"else"] -> x :: search_paren (search_plus xs) | x::xs -> x :: search_paren xs and search_plus xs = let (spaces, rest) = span is_comment_or_space xs in let (nls, rest) = span is_newline rest in let after = match List.rev spaces with [] -> [(C2 " ")] | T2(Parser_c.TComment _,Ctx,_i,_h)::_ -> [(C2 " ")] | _ -> if List.exists (function T2(_,Ctx,_,_) -> true | _ -> false) spaces then [] (* use existing trailing spaces *) else [(C2 " ")] in match rest with (* move the brace up to the previous line *) | ((Cocci2("{",_,_,_,_)) as x) :: (((Cocci2 _) :: _) as rest) -> spaces @ after @ x :: rest | _ -> xs in search_paren toks let is_ident_like s = s ==~ regexp_alpha let rec drop_space_at_endline = function | [] -> [] | [x] -> [x] | (C2 " ") :: ((((T2(Parser_c.TCommentSpace _,Ctx,_,_)) | Cocci2("\n",_,_,_,_) | (T2(Parser_c.TCommentNewline _,Ctx,_,_))) :: _) as rest) -> (* when unparse_cocci doesn't know whether space is needed *) drop_space_at_endline rest | ((T2(Parser_c.TCommentSpace _,Ctx,_i,_h)) as a)::rest -> let (outer_spaces,rest) = span is_space rest in let minus_or_comment_or_space_nocpp = function | T2(_,Min adj,_,_) -> true | (T2(Parser_c.TCommentSpace _,Ctx,_i,_)) -> true | (T2(Parser_c.TCommentNewline _,Ctx,_i,_)) -> false | x -> false in let (minus,rest) = span minus_or_comment_or_space_nocpp rest in let fail _ = a :: outer_spaces @ minus @ (drop_space_at_endline rest) in if List.exists is_minus minus then match rest with | ((T2(Parser_c.TCommentNewline _,Ctx,_i,_h)) as a)::rest -> (* drop trailing spaces *) minus @ a :: (drop_space_at_endline rest) | _ -> fail () else fail () | a :: rest -> a :: drop_space_at_endline rest (* if a removed ( is between two tokens, then add a space *) let rec paren_to_space = function | [] -> [] | [x] -> [x] | [x;y] -> [x;y] | ((T2(_,Ctx,_,_)) as a):: ((T2(t,Min _,_,_)) as b):: ((T2(_,Ctx,_,_)) as c)::rest when not (is_whitespace a) && TH.str_of_tok t = "(" -> a :: b :: (C2 " ") :: (paren_to_space (c :: rest)) | a :: rest -> a :: (paren_to_space rest) let rec add_space xs = match xs with | [] -> [] | [x] -> [x] | (Cocci2(sx,lnx,_,rcolx,_) as x)::((Cocci2(sy,lny,lcoly,_,_)) as y)::xs when !Flag_parsing_c.spacing = Flag_parsing_c.SMPL && not (lnx = -1) && not (rcolx = -1) && lnx = lny && rcolx < lcoly -> (* this only works within a line. could consider whether something should be done to add newlines too, rather than printing them explicitly in unparse_cocci. *) x::C2 (String.make (lcoly-rcolx) ' ')::add_space (y::xs) | (Cocci2(sx,lnx,_,rcolx,_) as x)::((Cocci2(sy,lny,lcoly,_,_)) as y)::xs when !Flag_parsing_c.spacing = Flag_parsing_c.SMPL && not (lnx = -1) && not (rcolx = -1) && lnx < lny -> (* this only works within a line. could consider whether something should be done to add newlines too, rather than printing them explicitly in unparse_cocci. *) x::C2 (String.make (lny-lnx) '\n'):: C2 (String.make (lcoly-1) ' '):: (* -1 is for the + *) add_space (y::xs) | ((T2(_,Ctx,_,_)) as x)::((Cocci2 _) as y)::xs -> (* add space on boundary *) let sx = str_of_token2 x in let sy = str_of_token2 y in if is_ident_like sx && (is_ident_like sy or List.mem sy ["="]) then x::C2 " "::(add_space (y::xs)) else x::(add_space (y::xs)) | ((T2(_,Ctx,_,_)) as x)::((T2(_,Ctx,_,_)) as y)::xs -> (* don't touch *) x :: (add_space (y :: xs)) | x::y::xs -> (* not boundary, not sure if it is possible *) let sx = str_of_token2 x in let sy = str_of_token2 y in if is_ident_like sx && is_ident_like sy then x::C2 " "::(add_space (y::xs)) else x::(add_space (y::xs)) (* A fake comma is added at the end of an unordered initlist or a enum decl, if the initlist or enum doesn't already end in a comma. This is only needed if there is + code, ie if we see Cocci after it in the code sequence *) let rec drop_end_comma = function | [] -> [] | [x] -> [x] | ((Comma ",") as x) :: rest -> let (newlines,rest2) = span is_whitespace rest in (match rest2 with | (Cocci2 _) :: _ -> x :: drop_end_comma rest | (C2 _) :: _ -> x :: drop_end_comma rest | _ -> drop_end_comma rest ) | x :: xs -> x :: drop_end_comma xs (* add_newlines only works for the outermost function call. Stack records the column of all open parentheses. Space_cell contains the most recent comma in the outermost function call. The goal is to decide whether this should be followed by a space or a newline and indent. *) let string_length s count info = (* drops both space_cell and seen_cocci if there is a newline *) let l = list_of_string s in List.fold_left (function (count,info) -> function | '\t' -> (count + 8,info) | '\n' -> (0,(None,false)) | c -> (count + 1,info)) (count,info) l (*don't care about seen cocci - know no newline is possible, or don't care*) let simple_string_length s count = fst(string_length s count (None,false)) let add_newlines toks tabbing_unit = (* the following is for strings that may contain newline or tabs *) let create_indent n = let (tu,tlen) = match tabbing_unit with | Some "\t" -> ("\t",8) | Some "" -> ("\t",8) (* not sure why... *) | Some s -> (s,simple_string_length s 0)(*assuming only tabs or spaces*) | None -> ("\t",8) in let rec loop seen = if seen + tlen <= n then tu ^ loop (seen + tlen) else String.make (n-seen) ' ' in loop 0 in let check_for_newline count x = function | Some (start,space_cell) when count > Flag_parsing_c.max_width -> space_cell := "\n"^(create_indent x); Some (x + (count - start)) | _ -> None in let start_box stack space_cell count seen_cocci s = let seen_cocci = match stack with [] -> false | _ -> seen_cocci in let inside_count = simple_string_length s count in (inside_count,inside_count::stack,space_cell,seen_cocci) in let end_box stack space_cell count seen_cocci s = (* this assumes that start_box and end_box are matched, but this is not necessarily the case, if ( is modified and ) is context code *) let count = simple_string_length s count in match stack with | [x] when seen_cocci -> (match check_for_newline count x space_cell with | Some count -> (count,[],None,false) | None -> (count,[],None,false) ) | [] -> (count,stack,space_cell,false) | _ -> (count,List.tl stack,space_cell,seen_cocci) in let comma_in_box stack space_cell count s = let count = simple_string_length s count in match stack with | [x] -> (match check_for_newline count x space_cell with | Some count -> (count,None) | None -> (count,None) ) | [] -> (count,space_cell) | _ -> (count,space_cell) in let rec loop ((stack,space_cell,seen_cocci) as info) count = function | [] -> [] | ((T2(commatok,Ctx,_,_))::_) as xs when seen_cocci && length stack = 1 && (TH.str_of_tok commatok) = "," && not (space_cell = None) -> (* deal with any preceding space, and then redo comma token to deal with subsequent space *) let (count,newspacecell) = comma_in_box stack space_cell count "," in (* newspacecell should be None, so this case won't get picked up again *) loop (stack,newspacecell,seen_cocci) count xs | (T2(commatok,Ctx,_,_)) :: (T2(((Parser_c.TCommentSpace _) as sptok),Ctx,idx,_)) :: xs when (TH.str_of_tok commatok) = "," && (TH.str_of_tok sptok) = " " && List.length stack = 1 (* not super elegant... *) -> let sp = ref " " in let newcount = count + 2 in (* count including space *) let a = T2(commatok,Ctx,idx, Some (Unparse_cocci.SpaceOrNewline sp)) in a :: loop (stack,Some (newcount,sp),seen_cocci) newcount xs | ((T2(tok,Ctx,idx,_)) as a)::xs -> (match TH.str_of_tok tok with | "=" as s -> let (spaces,rest) = span is_space xs in (match rest with | ((T2(tok,Ctx,_,_)) as b)::ixs -> (match TH.str_of_tok tok with | "{" -> let (newcount,(space_cell,seen_cocci)) = List.fold_left (function (prev,info) -> function | (T2(tok,_b,_i,_h)) -> string_length (TH.str_of_tok tok) prev info | _ -> failwith "not possible") (count,(space_cell,seen_cocci)) spaces in let front = a :: spaces @ [b] in let (newcount,newstack,newspacecell,seen_cocci) = start_box stack space_cell newcount seen_cocci "{" in front @ loop (newstack,newspacecell,seen_cocci) newcount ixs | _ -> a :: loop info (simple_string_length s count) xs ) | _ -> a :: loop info (simple_string_length s count) xs ) | "(" as s -> let (newcount,newstack,newspacecell, seen_cocci) = start_box stack space_cell count seen_cocci s in a :: loop (newstack,newspacecell,seen_cocci) newcount xs | ")" as s -> let (newcount,newstack,newspacecell,seen_cocci) = end_box stack space_cell count seen_cocci s in a :: loop (newstack,newspacecell,seen_cocci) newcount xs | "{" as s when not (stack = []) -> (* [] case means statement braces *) let (newcount,newstack,newspacecell,seen_cocci) = start_box stack space_cell count seen_cocci s in a :: loop (newstack,newspacecell,seen_cocci) newcount xs | "}" as s when not (stack = []) -> (* [] case means statement braces *) let (newcount,newstack,newspacecell,seen_cocci) = end_box stack space_cell count seen_cocci s in a :: loop (newstack,newspacecell,seen_cocci) newcount xs | s -> let (count,(space_cell,seen_cocci)) = string_length s count (space_cell,seen_cocci) in a :: loop (stack,space_cell,seen_cocci) count xs ) | ((Cocci2(s,line,lcol,rcol,Some Unparse_cocci.StartBox)) as a)::xs -> let rest = let (newcount,newstack,newspacecell,seen_cocci) = start_box stack space_cell count seen_cocci s in loop (newstack,newspacecell,true) newcount xs in a :: rest | ((Cocci2(s,line,lcol,rcol,Some Unparse_cocci.EndBox)) as a)::xs -> let rest = let (newcount,newstack,newspacecell,seen_cocci) = end_box stack space_cell count true s in loop (newstack,newspacecell,seen_cocci) newcount xs in a :: rest | ((Cocci2(s,line,lcol,rcol,Some (Unparse_cocci.SpaceOrNewline sp))) as a):: (T2(((Parser_c.TCommentSpace _) as sptok),_,idx,_))::xs when (TH.str_of_tok sptok) = " " -> (* if there was a single space, contemplate turning it into a newline. By the way code is added, it would seem that this space has to be Ctx. *) let rest = let count = simple_string_length s (count + 1 (*space*)) in match stack with | [x] -> (match check_for_newline count x space_cell with | Some count -> loop (stack,Some (x,sp), true) count xs | None -> loop (stack,Some (count,sp),true) count xs) | _ -> loop (stack,space_cell,true) count xs in a :: rest | (Cocci2(s,line,lcol,rcol,_))::((T2 _) as a)::xs when is_newline_or_comment a -> (* if the added code is followed by any existing comment or newline, then just do nothing. *) (Cocci2(s,line,lcol,rcol,None)):: loop (stack,space_cell,true) (simple_string_length s count) (a::xs) | ((Cocci2(s,line,lcol,rcol,Some (Unparse_cocci.SpaceOrNewline sp))) as a):: xs -> (* if the added code is followed by more added code, then add the space *) let rest = let count = simple_string_length s (count + 1 (*space*)) in match stack with | [x] -> (match check_for_newline count x space_cell with | Some count -> loop (stack,Some (x,sp), true) count xs | None -> loop (stack,Some (count,sp),true) count xs) | _ -> loop (stack,space_cell,true) count xs in a :: rest | (Cocci2(s,line,lcol,rcol,_))::xs -> (Cocci2(s,line,lcol,rcol,None)):: loop (stack,space_cell,true) (simple_string_length s count) xs | ((T2(tok,_,_,_)) as a)::xs -> let s = TH.str_of_tok tok in let (count,(space_cell,seen_cocci)) = string_length s count (space_cell,seen_cocci) in a :: loop (stack,space_cell,seen_cocci) count xs | ((C2(s)) as a)::xs -> let (count,(space_cell,seen_cocci)) = string_length s count (space_cell,seen_cocci) in a :: loop (stack,space_cell,seen_cocci) count xs | ((Comma(s)) as a)::xs -> a :: loop info (simple_string_length s count) xs | Fake2 _ :: _ | Indent_cocci2 :: _ | Unindent_cocci2 _::_ | EatSpace2::_ -> failwith "unexpected fake, indent, unindent, or eatspace" in let redo_spaces prev = function | Cocci2(s,line,lcol,rcol,Some (Unparse_cocci.SpaceOrNewline sp)) -> C2 !sp :: Cocci2(s,line,lcol,rcol,None) :: prev | T2(tok,min,idx,Some (Unparse_cocci.SpaceOrNewline sp)) -> C2 !sp :: T2(tok,min,idx,None) :: prev | t -> t::prev in (match !Flag_parsing_c.spacing with | Flag_parsing_c.SMPL -> toks | _ -> let preres = loop ([],None,false) 0 toks in List.rev (List.fold_left redo_spaces [] preres) ) (* When insert some new code, because of a + in a SP, we must add this * code at the right place, with the good indentation. So each time we * encounter some spacing info, with some newline, we maintain the * current indentation level used. * * TODO problems: not accurate. ex: TODO * * TODO: if in #define region, should add a \ \n *) let new_tabbing2 space = list_of_string space +> List.rev +> take_until (fun c -> c =<= '\n') +> List.rev +> List.map string_of_char +> String.concat "" let new_tabbing a = profile_code "C unparsing.new_tabbing" (fun () -> new_tabbing2 a) (* ------------------------------------------------------------------------ *) type info = CtxNL of string * int (*depthmin*) * int (*depthplus*) * int (*inparen*) | MinNL of string * int (*depthmin*) * int (*depthplus*) * int (*inparen*) | PlusNL of int (* depthplus *) * int (* inparen *) | Other | Drop | Unindent let close_brace l = let (added,rest) = span all_coccis l in (added, match rest with [] -> false | t::_ -> (str_of_token2 t) = "}") let open_brace l = let (added,rest) = span all_coccis l in match rest with [] -> false | t::_ -> (str_of_token2 t) = "{" let cocci_close_brace = function [] -> false | t::_ -> (str_of_token2 t) = "}" let is_cocci = function [] -> false | (_,_,t)::_ -> all_coccis t let newline = function T2(Parser_c.TCommentNewline _,_,_,_)::_ -> true | _ -> false let parse_indentation xs = let rec loop n dmin dplus inparens ind endparen = function [] -> [] | (x::xs) as l -> let (front,x,xs) = let (newlines,rest) = span is_whitespace l in match List.rev newlines with nl::whitespace -> (List.rev whitespace, nl, rest) | [] -> ([],x,xs) in let (res,dmin,dplus,inparens,ind,endparen) = match x with T2(t,_,_,_) when TH.str_of_tok t = "(" -> (Other,dmin,dplus,inparens+1,ind,false) | T2(t,_,_,_) when TH.str_of_tok t = ")" -> (Other,dmin,dplus,inparens-1,ind,true) | T2(t,Ctx,_,_) -> (match t with Parser_c.TCommentNewline s -> let s = TH.str_of_tok t in (match Str.split_delim (Str.regexp "\n") s with | [before;after] -> let ind1 = simple_string_length after 0 in (match close_brace xs with ([],true) -> (CtxNL(after,dmin-1,dplus-1,inparens), dmin,dplus,inparens,ind1,false) | (_,true) -> (CtxNL(after,dmin-1,dplus,inparens), dmin,dplus,inparens,ind1,false) | _ -> if open_brace xs then (* do nothing *) (CtxNL(after,dmin,dplus,inparens), dmin,dplus,inparens,ind1,false) else let (dmin1,dplus1) = (* if, etc without {} *) if ind1 < ind && inparens = 0 then (dmin-1,dplus-1) else if endparen && ind1 > ind && inparens = 0 then (dmin+1,dplus+1) else (dmin,dplus) in (* dplus is kept in the second position, because that is what to use if we continue at the same indent level. *) (CtxNL(after,dmin1,dplus1,inparens), dmin1,dplus1,inparens,ind1,false)) | _ -> (Other,dmin,dplus,inparens,ind,false)) | _-> (match TH.str_of_tok t with "{" -> (Other,dmin+1,dplus+1,inparens,ind,false) | "}" -> (Other,dmin-1,dplus-1,inparens,ind,false) | _ -> (Other,dmin,dplus,inparens,ind,false))) | T2(t,Min _,_,_) -> (match t with Parser_c.TCommentNewline s -> let s = TH.str_of_tok t in (match Str.split_delim (Str.regexp "\n") s with [before;after] -> let ind1 = simple_string_length after 0 in (match close_brace xs with (_,true) -> (MinNL(after,dmin-1,dplus-1,inparens), dmin,dplus,inparens,ind1,false) | _ -> if open_brace xs (* do nothing *) then (MinNL(after,dmin,dplus,inparens), dmin,dplus,inparens,ind1,false) else let (dmin1,dplus1) = (* if, etc without {} *) if ind1 < ind && inparens = 0 then (dmin-1,dplus-1) else if endparen && ind1 > ind && inparens = 0 then (dmin+1,dplus+1) else (dmin,dplus) in (MinNL(after,dmin1,dplus1,inparens), dmin1,dplus1,inparens,ind1,false)) | _ -> (Other,dmin,dplus,inparens,ind,false)) | _-> (match TH.str_of_tok t with "{" -> (Other,dmin+1,dplus,inparens,ind,false) | "}" -> (Other,dmin-1,dplus,inparens,ind,false) | _ -> (Other,dmin,dplus,inparens,ind,false))) | Cocci2("\n",_,_,_,_) -> if cocci_close_brace xs then (PlusNL(dplus-1,inparens),dmin,dplus,inparens,ind,false) else (PlusNL(dplus,inparens),dmin,dplus,inparens,ind,false) | Cocci2("{",_,_,_,_) -> (Other,dmin,dplus+1,inparens,ind,false) | Cocci2("}",_,_,_,_) -> (Other,dmin,dplus-1,inparens,ind,false) | C2("{") -> (Other,dmin,dplus+1,inparens,ind,false) | C2("}") -> (Other,dmin,dplus-1,inparens,ind,false) | Indent_cocci2 -> (Drop,dmin,dplus+1,inparens,ind,false) | Unindent_cocci2 true -> (Drop,dmin,dplus-1,inparens,ind,false) | Unindent_cocci2 false -> if dplus = 0 then (* nothing to do *) (Drop,dmin,dplus,inparens,ind,false) else (Unindent,dmin,dplus,inparens,ind,false) | _ -> (Other,dmin,dplus,inparens,ind,false) in let front = let rec loop n = function [] -> [] | x::xs -> (n,Other,x) :: loop (n+1) xs in loop n front in front @ ((n+List.length front),res,x) :: loop (n+1) dmin dplus inparens ind endparen xs in loop 1 0 0 0 0 false xs exception NoInfo let get_tabbing_unit shorter longer = let old_tab = list_of_string shorter in let new_tab = list_of_string longer in let rec get_diff n l1 l2 = match (l1,l2) with ([],xs) -> String.sub longer n ((String.length longer)-n) | (x::xs,y::ys) -> if x = y then get_diff (n+1) xs ys else raise NoInfo | _ -> failwith "not possible" in try Some (get_diff 0 old_tab new_tab) with NoInfo -> None let update_indent tok indent = match tok with Cocci2("\n",ln,lcol,rcol,nlhint) -> Cocci2(("\n"^indent),ln,lcol,rcol,nlhint) | C2("\n") -> C2("\n"^indent) | _ -> failwith "bad newline" let update_entry map depth inparens n indent = let others = List.filter (function ((d,i),_) -> not((depth,inparens) = (d,i))) map in ((depth,inparens),(n,indent)) :: others let update_map_min n spaces tabbing_unit past_minus_map depthmin dmin inparens retab = let past_minus_map = (* gc *) List.filter (function ((_,ip),_) -> ip <= inparens) past_minus_map in let new_tabbing_unit = if retab then try let (_,oldspaces) = List.assoc (dmin,inparens) past_minus_map in if depthmin = dmin - 1 (* we have outdented *) then get_tabbing_unit spaces oldspaces else if depthmin = dmin + 1 (* we have indented *) then get_tabbing_unit oldspaces spaces else tabbing_unit with _ -> None else None in let new_map = update_entry past_minus_map depthmin inparens n spaces in (new_tabbing_unit,new_map) let times before n tabbing_unit ctr = (if n < 0 then failwith (Printf.sprintf "n is %d\n" n)); let tabbing_unit = match tabbing_unit with None -> "\t" | Some tu -> tu in let rec loop = function 0 -> before | n -> (loop (n-1)) ^ tabbing_unit in loop n let search_in_maps n depth inparens past_minmap minmap tu t = let get_answer fail map1 map2 = match (map1,map2) with (None,None) -> fail() | (Some(_,indent),None) | (None,Some(_,indent)) -> update_indent t indent | (Some(n1,indent1),Some(n2,indent2)) -> let d1 = abs(n - n1) in let d2 = abs(n2 - n) in let indent = if d1 < d2 then indent1 else indent2 in update_indent t indent in let find_recent map = List.fold_left (function (((pdepth,_),(pn,pindent)) as prev) -> function (((cdepth,_),(cn,cindent)) as cur) -> if cdepth < depth && cdepth >= pdepth then cur else prev) ((-1,-1),(-1,"")) map in let fail2 _ = (* should we consider inparens here??? *) let ((brecent,_),(bn,bindent)) = find_recent past_minmap in let ((arecent,_),(an,aindent)) = find_recent minmap in match (brecent,arecent) with (-1,-1) -> update_indent t (times "" depth tu 1) | (_,-1) -> update_indent t (times bindent (depth - brecent) tu 2) | (-1,_) -> update_indent t (times aindent (depth - arecent) tu 3) | (_,_) -> let d1 = depth - brecent in let d2 = depth - arecent in if d1 < d2 then update_indent t (times bindent d1 tu 4) else if d2 < d1 then update_indent t (times aindent d2 tu 5) else let n1 = abs(n - bn) in let n2 = abs(an - n) in let indent = if n1 < n2 then bindent else aindent in update_indent t (times indent d2 tu 6) in let map1 = try Some(List.assoc (depth,inparens) past_minmap) with _ -> None in let map2 = try Some(List.assoc (depth,inparens) minmap) with _ -> None in get_answer fail2 map1 map2 let adjust_indentation xs = let toks = parse_indentation xs in let rec loop tabbing_unit past_minmap dmin dplus = function [] -> (tabbing_unit,past_minmap,[]) | (n,CtxNL _,t)::(n1,Unindent,t1)::rest | (n,PlusNL _,t)::(n1,Unindent,t1)::rest -> (* Drop preceding spaces and just make a newline *) let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in (out_tu,minmap,(C2 "\n")::res) | (n,Unindent,t)::rest -> (* Add a newline *) let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in (out_tu,minmap,(C2 "\n")::res) | (n,CtxNL(spaces,depthmin,depthplus,inparens),t)::rest -> let (tabbing_unit,past_minmap) = update_map_min n spaces tabbing_unit past_minmap depthmin dmin inparens true in let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in let (_,minmap) = update_map_min n spaces tabbing_unit minmap depthmin dmin inparens false in let t = if not (depthmin = depthplus) (*&& is_cocci rest*) then search_in_maps n depthplus inparens past_minmap minmap tabbing_unit (C2 "\n") else t in (out_tu,minmap,t::res) | (n,MinNL(spaces,depthmin,depthplus,inparens),t)::rest -> let (tabbing_unit,past_minmap) = update_map_min n spaces tabbing_unit past_minmap depthmin dmin inparens true in let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in let (_,minmap) = update_map_min n spaces tabbing_unit minmap depthmin dmin inparens false in (out_tu,minmap,t::res) | (n,PlusNL(depth,inparens),t)::rest -> let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in let newtok = search_in_maps n depth inparens past_minmap minmap tabbing_unit t in (out_tu, minmap, newtok::res) | (n,Other,t)::rest -> let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in (out_tu,minmap,t::res) | (n,Drop,t)::rest -> let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in (out_tu,minmap,res) in let nulmap = [((0,0),(-1,""))] in let (out_tu,_,res) = loop None nulmap 0 0 toks in (res,out_tu) (* ------------------------------------------------------------------------ *) let rec old_adjust_indentation xs = let _current_tabbing = ref ([] : string list) in let tabbing_unit = ref None in let string_of_list l = String.concat "" (List.map string_of_char l) in (* try to pick a tabbing unit for the plus code *) let adjust_tabbing_unit old_tab new_tab = if !tabbing_unit =*= None && String.length new_tab > String.length old_tab then let old_tab = list_of_string old_tab in let new_tab = list_of_string new_tab in let rec loop = function | ([],new_tab) -> tabbing_unit := Some(string_of_list new_tab,List.rev new_tab) | (_,[]) -> failwith "not possible" | (o::os,n::ns) -> loop (os,ns) in (* could check for equality *) loop (old_tab,new_tab) in (* let remtab tu current_tab = let current_tab = List.rev(list_of_string current_tab) in let rec loop = function ([],new_tab) -> string_of_list (List.rev new_tab) | (_,[]) -> (-*weird; tabbing unit used up more than the current tab*-) "" | (t::ts,n::ns) when t =<= n -> loop (ts,ns) | (_,ns) -> (-* mismatch; remove what we can *-) string_of_list (List.rev ns) in loop (tu,current_tab) in *) let rec find_first_tab started = function | [] -> () | ((T2 (tok,_,_,_)) as x)::xs when str_of_token2 x =$= "{" -> find_first_tab true xs (* patch: coccinelle *) | ((T2 (Parser_c.TCommentNewline s, _, _, _)) as x)::_ when started -> let s = str_of_token2 x +> new_tabbing in tabbing_unit := Some (s,List.rev (list_of_string s)) | x::xs -> find_first_tab started xs in find_first_tab false xs; let rec balanced ct = function | [] -> ct >= 0 | ((T2(tok,_,_,_)) as x)::xs -> (match str_of_token2 x with | "(" -> balanced (ct+1) xs | ")" -> balanced (ct-1) xs | _ -> balanced ct xs ) | x::xs -> balanced ct xs in let update_tabbing started s x = let old_tabbing = !_current_tabbing in str_of_token2 x +> new_tabbing +> (fun s -> _current_tabbing := [s]); (* only trust the indentation after the first { *) if started then adjust_tabbing_unit (String.concat "" old_tabbing) (String.concat "" !_current_tabbing) in let rec aux started xs = match xs with | [] -> [] (* patch: coccinelle *) | ((T2 (Parser_c.TCommentNewline s,_,_,_)) as x):: Unindent_cocci2(false)::xs -> update_tabbing started s x; (C2 "\n")::aux started xs | (Cocci2("\n",_,_,_,_))::Unindent_cocci2(false)::xs -> (C2 "\n")::aux started xs | ((T2 (tok,_,_,_)) as x)::(T2 (Parser_c.TCommentNewline s, _, _, _)):: ((Cocci2 ("{",_,_,_,_)) as a)::xs when started && str_of_token2 x =$= ")" -> (* to be done for if, etc, but not for a function header *) x::(C2 " ")::a::(aux started xs) | ((T2 (Parser_c.TCommentNewline s, _, _, _)) as x)::xs when balanced 0 (fst(span (function x -> not(is_newline x)) xs)) -> update_tabbing started s x; let coccis_rest = span all_coccis xs in (match coccis_rest with | (_::_,((T2 (tok,_,_,_)) as y)::_) when str_of_token2 y =$= "}" -> (* the case where cocci code has been added before a close } *) x::aux started (Indent_cocci2::xs) | _ -> x::aux started xs ) | Indent_cocci2::((Cocci2(sy,lny,lcoly,_,_)) as y)::xs when !Flag_parsing_c.spacing = Flag_parsing_c.SMPL -> let tu = String.make (lcoly-1) ' ' in _current_tabbing := tu::(!_current_tabbing); C2 (tu)::aux started (y::xs) | Indent_cocci2::xs -> (match !tabbing_unit with | None -> aux started xs | Some (tu,_) -> _current_tabbing := tu::(!_current_tabbing); (* can't be C2, for later phases *) Cocci2 (tu,-1,-1,-1,None)::aux started xs ) | Unindent_cocci2(permanent)::((Cocci2("\n",_,_,_,_)) as x)::xs -> (* seems only relevant if there is a following cocci newline *) (match !_current_tabbing with | [] -> aux started xs | _::new_tabbing -> let s = String.concat "" new_tabbing in _current_tabbing := new_tabbing; x::Cocci2 (s,-1,-1,-1,None)::aux started xs ) | Unindent_cocci2(permanent)::xs -> aux started xs (* border between existing code and cocci code *) | ((T2 (tok,_,_,_)) as x)::((Cocci2("\n",_,_,_,_)) as y)::xs when str_of_token2 x =$= "{" -> x::aux true (y::Indent_cocci2::xs) | ((Cocci2 _) as x)::((T2 (tok,_,_,_)) as y)::xs when str_of_token2 y =$= "}" -> x::aux started (Unindent_cocci2 true::y::xs) (* starting the body of the function *) | ((T2 (tok,_,_,_)) as x)::xs when str_of_token2 x =$= "{" -> x::aux true xs | ((Cocci2("{",_,_,_,_)) as a)::xs -> a::aux true xs | ((Cocci2("\n",_,_,_,_)) as x)::xs -> (* don't inline in expr because of weird eval order of ocaml *) let s = String.concat "" !_current_tabbing in (* can't be C2, for later phases *) x::Cocci2 (s,-1,-1,-1,None)::aux started xs | x::xs -> x::aux started xs in let tu = match !tabbing_unit with Some(tu,_) -> Some tu | None -> None in (aux false xs,tu) let rec find_paren_comma = function | [] -> () (* do nothing if was like this in original file *) | { str = "("; idx = Some p1 } :: ({ str = ","; idx = Some p2} :: _ as xs) | { str = ","; idx = Some p1 } :: ({ str = ","; idx = Some p2} :: _ as xs) | { str = ","; idx = Some p1 } :: ({ str = ")"; idx = Some p2} :: _ as xs) when p2 =|= p1 + 1 -> find_paren_comma xs (* otherwise yes can adjust *) | { str = "(" } :: (({ str = ","} as rem) :: _ as xs) | ({ str = "," } as rem) :: ({ str = ","} :: _ as xs) | ({ str = "," } as rem) :: ({ str = ")"} :: _ as xs) -> rem.remove <- true; find_paren_comma xs | x::xs -> find_paren_comma xs let fix_tokens toks = let toks = toks +> List.map mk_token_extended in let cleaner = toks +> exclude (function | {tok2 = T2 (t,_,_,_)} -> TH.is_real_comment t (* I want the ifdef *) | _ -> false ) in find_paren_comma cleaner; let toks = rebuild_tokens_extented toks in toks +> List.map (fun x -> x.tok2) (* if we have to remove a '}' that is alone on a line, remove the line too *) let drop_line toks = let rec space_until_newline toks = match toks with | (T2(_, Min _, _, _) as hd) :: tl -> let (drop, tl) = space_until_newline tl in (drop, hd :: tl) | hd :: tl when is_space hd -> space_until_newline tl | Fake2 _ :: tl -> space_until_newline tl | hd :: tl when is_newline hd -> (true, toks) | _ -> (false, toks) in let rec loop toks = match toks with | (T2(_, Min _, _, _) as x) :: tl when str_of_token2 x =$= "}" -> let (drop, tl) = space_until_newline tl in (drop, x :: tl) | hd :: tl when is_whitespace hd -> let (drop, tl) = loop tl in if drop then (true, tl) else (false, toks) | _ -> (false, toks) in let rec find toks = let (_, toks) = loop toks in match toks with | [] -> [] | hd :: tl -> hd :: find tl in find toks (*****************************************************************************) (* Final unparsing (and debugging support) *) (*****************************************************************************) (* for debugging *) type kind_token2 = KFake | KCocci | KC | KExpanded | KOrigin let kind_of_token2 = function | Fake2 _ -> KFake | Cocci2 _ -> KCocci | C2 _ -> KC | Comma _ -> KC | T2 (t,_,_,_) -> (match TH.pinfo_of_tok t with | Ast_c.ExpandedTok _ -> KExpanded | Ast_c.OriginTok _ -> KOrigin | Ast_c.FakeTok _ -> raise (Impossible 139) (* now a Fake2 *) | Ast_c.AbstractLineTok _ -> raise (Impossible 140) (* now a KC *) ) | Unindent_cocci2 _ | Indent_cocci2 | EatSpace2 -> raise (Impossible 141) let end_mark = "!" let start_mark = function | KFake -> "!F!" | KCocci -> "!S!" | KC -> "!A!" | KExpanded -> "!E!" | KOrigin -> "" let print_all_tokens2 pr xs = if !Flag_parsing_c.debug_unparsing then let current_kind = ref KOrigin in xs +> List.iter (fun t -> let newkind = kind_of_token2 t in if newkind =*= !current_kind then pr (str_of_token2 t) else begin pr (end_mark); pr (start_mark newkind); pr (str_of_token2 t); current_kind := newkind end ); else let to_whitespace s = let r = String.copy s in for i = 1 to String.length r do let c = String.get r (i-1) in match c with | ' ' | '\t' | '\r' | '\n' -> () | _ -> String.set r (i-1) ' ' done; r in let hiding_level = ref 0 in let handle_token t = let s = str_of_token2 t in let hide_current = match t with | T2 (t,_,_,_) -> let i = TH.info_of_tok t in (match Ast_c.get_annot_info i Token_annot.Exclude_start with | None -> () | Some _ -> hiding_level := !hiding_level + 1 ); let hide_current = !hiding_level > 0 in (match Ast_c.get_annot_info i Token_annot.Exclude_end with | None -> () | Some _ -> hiding_level := max (!hiding_level - 1) 0 ); hide_current | _ -> !hiding_level > 0 in if hide_current then to_whitespace s else s in xs +> List.iter (fun x -> pr (handle_token x)) (*****************************************************************************) (* Entry points *) (*****************************************************************************) (* old: PPviatok was made in the beginning to allow to pretty print a * complete C file, including a modified C file by transformation.ml, * even if we don't handle yet in pretty_print_c.ml, ast_to_flow (and * maybe flow_to_ast) all the cases. Indeed we don't need to do some * fancy stuff when a function was not modified at all. Just need to * print the list of token as-is. But now pretty_print_c.ml handles * almost everything so maybe less useful. Maybe PPviatok allows to * optimize a little the pretty printing. * * update: now have PPviastr which goes even faster than PPviatok, so * PPviatok has disappeared. *) type ppmethod = PPnormal | PPviastr (* The pp_program function will call pretty_print_c.ml with a special * function to print the leaf components, the tokens. When we want to * print a token, we need to print also maybe the space and comments that * were close to it in the original file (and that was omitted during the * parsing phase), and honor what the cocci-info attached to the token says. * Maybe we will not print the token if it's a MINUS-token, and maybe we will * print it and also print some cocci-code attached in a PLUS to it. * So we will also maybe call unparse_cocci. Because the cocci-code may * contain metavariables, unparse_cocci will in fact sometimes call back * pretty_print_c (which will this time don't call back again unparse_cocci) *) let pp_program2 xs outfile = with_open_outfile outfile (fun (pr,chan) -> let pr s = if !Flag_parsing_c.debug_unparsing then begin pr2_no_nl s; flush stderr end else pr s (* flush chan; *) (* Common.pr2 ("UNPARSING: >" ^ s ^ "<"); *) in xs +> List.iter (fun ((e,(str, toks_e)), ppmethod) -> (* here can still work on ast *) let e = remove_useless_fakeInfo_struct e in match ppmethod with | PPnormal -> (* now work on tokens *) (* phase1: just get all the tokens, all the information *) assert(toks_e +> List.for_all (fun t -> TH.is_origin t or TH.is_expanded t )); let toks = get_fakeInfo_and_tokens e toks_e in let toks = displace_fake_nodes toks in (* assert Origin;ExpandedTok;Faketok *) let toks = expand_mcode toks in (* assert Origin;ExpandedTok; + Cocci + C (was AbstractLineTok) * and no tag endparen, just NOTHING. *) let toks = if !Flag.sgrep_mode2 then (* nothing else to do for sgrep *) drop_expanded(drop_fake(drop_minus toks)) else begin (* phase2: can now start to filter and adjust *) let toks = paren_then_brace toks in let toks = drop_space_at_endline toks in (* have to annotate droppable spaces early, so that can create the right minus and plus maps in adjust indentation. For the same reason, cannot actually remove the minus tokens. *) let toks = drop_line toks in let toks = remove_minus_and_between_and_expanded_and_fake1 toks in let (toks,tu) = adjust_indentation toks in let toks = adjust_eat_space toks in let toks = adjust_before_semicolon toks in(*before remove minus*) let toks = adjust_after_paren toks in(*also before remove minus*) let toks = paren_to_space toks in let toks = drop_end_comma toks in let toks = remove_minus_and_between_and_expanded_and_fake2 toks in (* assert Origin + Cocci + C and no minus *) let toks = add_space toks in let toks = add_newlines toks tu in let toks = fix_tokens toks in toks end in (* in theory here could reparse and rework the ast! or * apply some SP. Not before cos julia may have generated * not parsable file. Need do unparsing_tricks call before * being ready to reparse. *) print_all_tokens2 pr toks; | PPviastr -> pr str ) ) let pp_program a b = profile_code "C unparsing" (fun () -> pp_program2 a b) let pp_program_default xs outfile = let xs' = xs +> List.map (fun x -> x, PPnormal) in pp_program xs' outfile coccinelle-1.0.0-rc19/parsing_c/parsing_consistency_c.mli0000644000175000017500000000026412247437436022430 0ustar eugeneugen(* check consistency and possibly change some Ident expression into * TypeName, especially in argument to functions. *) val consistency_checking: Ast_c.program -> Ast_c.program coccinelle-1.0.0-rc19/engine/0000755000175000017500000000000012247442646014634 5ustar eugeneugencoccinelle-1.0.0-rc19/engine/check_reachability.ml0000644000175000017500000001735312247442615020770 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./check_reachability.ml" (* ---------------------------------------------------------------- *) (* code to check for ambiguities *) (* Idea: for each node that is said to be modified in any witness tree, we check that all backward paths end up at the root of some witness tree that says that the node should be modified. We then give a warning, if the node itself appears more than once in such a path, because then there could be some instances that are modified and some that are not. An example is as follows: f(); ... g(); ... - h(); with C code: f(); while(E) { h(); g(); } g(); h(); Then the h() in the while loop matches both the first ... and the - h(); Concretely, if a node 47 is in the witness tree rooted at 1 and the witness tree rooted at 2, then we give an error if 47 is not in the set of nodes satisfying AF[1v2] and give a warning if 47 is in the set of nodes satisfying EXEF(47 & EXEF(1v2)). (Note that the root of a witness tree here is the node causing the pattern to match; there might not be any witnesses associated with this node.) Another try on the exists formula: !(1v2) & EXE[!(1v2) U 47] The first !(1v2) is to discard immediately cases where the beginning and end of the path are the same. Afterwards, it would only seem necessary to serach up to the next occurrence of 47 (leaf), ensuring that there are not 1s or 2s (starting points) along the way. Then the second 47 would be in the path, but possible not transformed. *) module G = Ograph_extended module CTL = Ast_ctl (* Step 1: for each tree, make a mapping from the modified nodes to the root of the tree *) let modified = (Hashtbl.create(25) : (G.nodei, G.nodei list ref) Hashtbl.t) let build_modified (n,_,wits) = let rec loop = function CTL.Wit(st,[CTL.Subst(x,Wrapper_ctl.PredVal(CTL.Modif(v)))],anno,wit) -> let cell = try Hashtbl.find modified st with Not_found -> let cell = ref [] in Hashtbl.add modified st cell; cell in cell := n :: !cell; List.iter loop wit | CTL.Wit(st,_,anno,wit) -> List.iter loop wit | CTL.NegWit(wit) -> () in List.iter loop wits (* Step 2: For each node in the hash table, create the error and warning formulas *) type 'a nodes = Node of 'a | After let create_formulas _ = Hashtbl.fold (function node -> function roots -> function acc -> (*let exef f = wrap (Ast_ctl.EX (Ast_ctl.BACKWARD,wrap(Ast_ctl.EF(Ast_ctl.BACKWARD,f)))) in*) let match_node = Ast_ctl.Pred(Node(node)) in let match_roots = List.map (function n -> Ast_ctl.Pred(Node(n))) (List.sort compare !roots) in let or_roots = List.fold_left (function prev -> function cur -> Ast_ctl.Or(prev,cur)) (List.hd match_roots) (List.tl match_roots) in (* no point to search if no path, and the presence of after in the AF formula can make things slow *) if List.mem node !roots then acc else (node, Ast_ctl.AF(Ast_ctl.BACKWARD,Ast_ctl.NONSTRICT, Ast_ctl.Or(or_roots,Ast_ctl.Pred(After))), Ast_ctl.And (Ast_ctl.NONSTRICT, Ast_ctl.Not(or_roots), Ast_ctl.EX (Ast_ctl.BACKWARD, Ast_ctl.EU(Ast_ctl.BACKWARD,or_roots,match_node)))) (*exef (wrap(Ast_ctl.And(Ast_ctl.NONSTRICT,match_node,exef(roots))))*) :: acc) modified [] (* Step 3: check the formula on the control-flow graph *) module PRED = struct type t = Ograph_extended.nodei nodes let print_predicate = function After -> Format.print_string "after" | Node x -> Format.print_string (string_of_int x) end module ENV = struct type value = unit type mvar = unit let eq_mvar x x' = failwith "should not be invoked" let eq_val v v' = failwith "should not be invoked" let merge_val v v' = failwith "should not be invoked" let print_mvar s = failwith "should not be invoked" let print_value x = failwith "should not be invoked" end module CFG = struct type node = Ograph_extended.nodei type cfg = (Control_flow_c.node, Control_flow_c.edge) Ograph_extended.ograph_mutable let predecessors cfg n = List.map fst ((cfg#predecessors n)#tolist) let successors cfg n = List.map fst ((cfg#successors n)#tolist) let extract_is_loop cfg n = Control_flow_c.extract_is_loop (cfg#nodes#find n) let print_node i = Format.print_string (string_of_int i) let size cfg = cfg#nodes#length let print_graph cfg label border_nodes fill_nodes filename = () end module ENGINE = Ctl_engine.CTL_ENGINE (ENV) (CFG) (PRED) let test_formula state formula cfg = let label = function Node pred -> [(pred,[],[])] | After -> List.concat (List.map (fun (nodei, node) -> match Control_flow_c.unwrap node with Control_flow_c.AfterNode -> [(nodei,[],[])] | _ -> []) cfg#nodes#tolist) in let verbose = !Flag_ctl.verbose_ctl_engine in let pm = !Flag_ctl.partial_match in (* let gt = !Flag_ctl.graphical_trace in *) Flag_ctl.verbose_ctl_engine := false; Flag_ctl.partial_match := false; Flag_ctl.checking_reachability := true; (* Flag_ctl.graphical_trace := ""; *) let res = ENGINE.sat (cfg,label,List.map fst cfg#nodes#tolist) (CTL.And(CTL.NONSTRICT,CTL.Pred(Node(state)),formula)) [[Node(state)]] in Flag_ctl.verbose_ctl_engine := verbose; Flag_ctl.partial_match := pm; Flag_ctl.checking_reachability := false; (* Flag_ctl.graphical_trace := gt; *) match res with [] -> false | _ -> true (* ---------------------------------------------------------------- *) (* Entry point *) (* The argument is a list of triples with a node name, an empty environment and a witness tree *) type witness = (Ograph_extended.nodei, unit, (Ograph_extended.nodei, unit, unit) Ast_ctl.generic_ctl list) Ast_ctl.generic_witnesstree type ('a,'b,'c,'d,'e) triples = (Ograph_extended.nodei * 'a * (Ograph_extended.nodei, ('b, ('c, 'd) Wrapper_ctl.wrapped_binding) CTL.generic_subst list, 'e) CTL.generic_witnesstree list) list let check_reachability rulename triples cfg = Hashtbl.clear modified; List.iter build_modified triples; let formulas = create_formulas() in List.iter (function (node,af_formula,ef_formula) -> if test_formula node af_formula cfg then if test_formula node ef_formula cfg then let n = cfg#nodes#find node in Printf.printf "warning: %s, node %d: %s in %s may be inconsistently modified\n" rulename node (snd n) !Flag.current_element else () else let n = cfg#nodes#find node in failwith (Printf.sprintf "%s: node %d: %s in %s reachable by inconsistent control-flow paths" rulename node (snd n) !Flag.current_element)) formulas coccinelle-1.0.0-rc19/engine/lib_engine.ml0000644000175000017500000000667112247442615017267 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lib_engine.ml" open Ograph_extended (*****************************************************************************) (* the different ctl formula related types *) (*****************************************************************************) type mvar = Ast_cocci.meta_name type predicate = InLoop | TrueBranch | FalseBranch | After (* pointer to the code after an if or while *) | FallThrough | LoopFallThrough | Return (* any exit from the current function *) | FunHeader | UnsafeBrace | Top | Exit | ErrorExit | Goto | Paren of Ast_cocci.meta_name | Match of Ast_cocci.rule_elem | Label of Ast_cocci.meta_name | BCLabel of Ast_cocci.meta_name (* parent of break or continue *) | PrefixLabel of Ast_cocci.meta_name | BindGood of Ast_cocci.meta_name (* used to implement \+ *) | BindBad of Ast_cocci.meta_name | FakeBrace (* coccionly: *) type ctlcocci = (predicate, Ast_cocci.meta_name) Wrapper_ctl.wrapped_ctl (*****************************************************************************) (* the different binding types *) (*****************************************************************************) type metavars_binding = Ast_c.metavars_binding (* used in ctlcocci_integration *) type metavar_binding_kind2 = | NormalMetaVal of Ast_c.metavar_binding_kind | ParenVal of Ast_cocci.meta_name | LabelVal of labelval | GoodVal | BadVal (* used to implement \+ *) and labelval = Absolute of int list | Prefix of int list and metavars_binding2 = (mvar, metavar_binding_kind2) Common.assoc (*****************************************************************************) (* the CTL model related types *) (*****************************************************************************) (* coccionly: *) type label_ctlcocci = predicate -> (nodei * (predicate * (mvar, metavar_binding_kind2) Ast_ctl.generic_substitution)) list type model = Control_flow_c.cflow * label_ctlcocci * nodei list type transformation_info = (nodei * metavars_binding * Ast_cocci.rule_elem) list type numbered_transformation_info = (int list * (nodei * metavars_binding * Ast_cocci.rule_elem)) list (*****************************************************************************) (* comparing binding *) (*****************************************************************************) let equal_binding xs ys = List.sort compare xs = List.sort compare ys coccinelle-1.0.0-rc19/engine/pattern_c.mli0000644000175000017500000000247012247442615017315 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pattern_c.mli" val match_re_node : string list (* dropped isos *) -> Ast_cocci.rule_elem -> Control_flow_c.node -> Lib_engine.metavars_binding -> (Ast_cocci.rule_elem * Lib_engine.metavars_binding) list coccinelle-1.0.0-rc19/engine/c_vs_c.mli0000644000175000017500000000247312247442615016575 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./c_vs_c.mli" val eq_type : Ast_c.fullType -> Ast_c.fullType -> bool val merge_type : Ast_c.fullType -> Ast_c.fullType -> Ast_c.fullType val subexpression_of_expression : Ast_c.expression -> Ast_c.expression -> bool coccinelle-1.0.0-rc19/engine/pretty_print_engine.mli0000644000175000017500000000342412247442615021426 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_engine.mli" (* could be in pretty_print_c because dependent of ast_c but metavars * are in ast_c for "bad" reason, so better put the pretty_print * of metavars here *) val pp_binding_kind : Ast_c.metavar_binding_kind -> unit val pp_binding : Ast_c.metavars_binding -> unit val pp_binding_kind2 : Lib_engine.metavar_binding_kind2 -> unit val pp_binding2_ctlsubst : (Lib_engine.mvar, Lib_engine.metavar_binding_kind2) Ast_ctl.generic_substitution -> unit val pp_predicate : Lib_engine.predicate -> unit val predicate_to_string : Lib_engine.predicate -> string val pp_ctlcocci : bool (* show_plus *) -> bool (* inline_let *) -> Lib_engine.ctlcocci -> unit coccinelle-1.0.0-rc19/engine/ctltotex.ml0000644000175000017500000002633012247442615017034 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctltotex.ml" module CTL = Ast_ctl let prelude = "\\documentclass{article}\n"^ "\\usepackage{fullpage}\n\n"^ "\\newcommand{\\U}{\\,\\mbox{\\sf{U}}\\,}\n"^ "\\newcommand{\\A}{\\mbox{\\sf{A}}}\n"^ "\\newcommand{\\E}{\\mbox{\\sf{E}}}\n"^ "\\newcommand{\\AX}{\\mbox{\\sf{AX}}}\n"^ "\\newcommand{\\EX}{\\mbox{\\sf{EX}}}\n"^ "\\newcommand{\\AF}{\\mbox{\\sf{AF}}}\n"^ "\\newcommand{\\EF}{\\mbox{\\sf{EF}}}\n"^ "\\newcommand{\\AG}{\\mbox{\\sf{AG}}}\n"^ "\\newcommand{\\EG}{\\mbox{\\sf{EG}}}\n\n"^ "\\newcommand{\\mita}[1]{\\mbox{\\it{{#1}}}}\n"^ "\\newcommand{\\mtt}[1]{\\mbox{\\tt{{#1}}}}\n"^ "\\newcommand{\\msf}[1]{\\mbox{\\sf{{#1}}}}\n"^ "\\newcommand{\\mrm}[1]{\\mbox{\\rm{{#1}}}}\n"^ "\\newcommand{\\mth}[1]{\\({#1}\\)}\n\n"^ "\\newcommand{\\ttlb}{\\mbox{\\tt \\char'173}}\n"^ "\\newcommand{\\ttrb}{\\mbox{\\tt \\char'175}}\n\n"^ "\\begin{document}\n" let postlude = "\\end{document}" let check_ct ct res = if ct > 60 then (res^"\\\\\\mbox{}",0) else (res,ct) let texify s = let len = String.length s in let rec loop n = if n = len then "" else match String.get s n with '_' -> Printf.sprintf "\\_%s" (loop (n+1)) | '{' -> Printf.sprintf "{\\ttlb}%s" (loop (n+1)) | '}' -> Printf.sprintf "{\\ttrb}%s" (loop (n+1)) | '>' -> Printf.sprintf "\\mth{>}%s" (loop (n+1)) | c -> Printf.sprintf "%c%s" c (loop (n+1)) in (Printf.sprintf "\\mita{%s}" (loop 0),len) let modif2c pv = function CTL.Modif(v) -> let (s,n) = texify(pv v) in (Printf.sprintf "_{%s}" s,n) | CTL.UnModif(v) -> let (s,n) = texify(pv v) in (Printf.sprintf "_{%s}" s,n) | CTL.Control -> ("",0) let print_diamond ct = function CTL.FORWARD -> ("",ct) | CTL.BACKWARD -> ("\\Delta",ct+1) let rec ctl2c ct pp pv = function CTL.False -> ("\\msf{false}",5) | CTL.True -> ("\\msf{true}",4) | CTL.Pred(p,v) -> let (res,n) = pp p in let (resv,n1) = modif2c pv v in (res^resv,ct+n+n1) | CTL.Not(f) -> let (res,ct) = wrap (ct+1) pp pv f in ("\\neg "^res,ct) | CTL.Exists(_,v,f) -> let (res1,len) = texify(pv v) in let ct = ct + len in let (res1,ct) = check_ct ct res1 in let (res2,ct) = existswrap (ct+1) pp pv f in ("\\exists "^res1^" . "^res2,ct) | CTL.And(_,f1,f2) -> let (res1,ct) = andwrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = andwrap (ct+1) pp pv f2 in (res1^" \\wedge "^res2,ct) | CTL.AndAny(dir,_,f1,f2) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res1,ct) = andwrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = andwrap (ct+1) pp pv f2 in (res1^" \\wedge? "^diamond^res2,ct) | CTL.HackForStmt(dir,_,f1,f2) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res1,ct) = andwrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = andwrap (ct+1) pp pv f2 in (res1^" \\wedge{h} "^diamond^res2,ct) | CTL.Or(f1,f2) -> let (res1,ct) = orwrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = orwrap (ct+1) pp pv f2 in (res1^" \\vee "^res2,ct) | CTL.SeqOr(f1,f2) -> let (res1,ct) = orwrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = orwrap (ct+1) pp pv f2 in (res1^" \\mid "^res2,ct) | CTL.Implies(f1,f2) -> let (res1,ct) = wrap ct pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = wrap (ct+1) pp pv f2 in (res1^" \\rightarrow "^res2,ct) | CTL.AF(dir,_,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\AF"^diamond^res,ct) | CTL.AX(dir,_,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\AX"^diamond^res,ct) | CTL.AG(dir,_,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\AG"^diamond^res,ct) | CTL.AW(dir,_,f1,f2) -> let (diamond,ct) = print_diamond (ct+1) dir in let (res1,ct) = existswrap (ct+1) pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = existswrap (ct+3) pp pv f2 in ("\\"^diamond^"A["^res1^" W "^res2^"]\n",ct) | CTL.AU(dir,_,f1,f2) -> let (diamond,ct) = print_diamond (ct+1) dir in let (res1,ct) = existswrap (ct+1) pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = existswrap (ct+3) pp pv f2 in ("\\"^diamond^"A["^res1^" \\U "^res2^"]\n",ct) | CTL.EF(dir,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\EF"^diamond^res,ct) | CTL.EX(dir,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\EX"^diamond^res,ct) | CTL.EG(dir,f) -> let (diamond,ct) = print_diamond (ct+2) dir in let (res,ct) = pathwrap ct pp pv f in ("\\EG"^diamond^res,ct) | CTL.EU(dir,f1,f2) -> let (diamond,ct) = print_diamond (ct+1) dir in let (res1,ct) = existswrap (ct+1) pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = existswrap (ct+3) pp pv f2 in ("\\E"^diamond^"["^res1^" \\U "^res2^"]\n",ct) | CTL.Ref(v) -> let (v,len) = texify(pv (make_var v)) in (v,len+ct) | CTL.Let(v,f1,f2) -> let (v,len) = texify (pv (make_var v)) in let (res1,ct) = letwrap (ct+len+5) pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = letwrap (ct+3) pp pv f2 in let (res2,ct) = check_ct ct res2 in (Printf.sprintf "\\mita{\\sf{let}} \\, %s = %s \\, \\mita{\\sf{in}} \\, %s\n" v res1 res2, ct) | CTL.LetR(d,v,f1,f2) -> let (diamond,ct) = print_diamond (ct+2) d in let (v,len) = texify (pv (make_var v)) in let (res1,ct) = letwrap (ct+len+5) pp pv f1 in let (res1,ct) = check_ct ct res1 in let (res2,ct) = letwrap (ct+3) pp pv f2 in let (res2,ct) = check_ct ct res2 in (Printf.sprintf "\\mita{\\sf{let}}%s \\, %s = %s \\, \\mita{\\sf{in}} \\, %s\n" diamond v res1 res2, ct) | CTL.Uncheck(f) -> let (res,ct) = pathwrap ct pp pv f in (res^"^u",ct+1) | CTL.InnerAnd(f) -> let (res,ct) = pathwrap ct pp pv f in ("("^res^")^{innerAnd}",ct+10) | CTL.XX(_) -> failwith "should not be printed" and make_var x = ("",x) and wrap ct pp pv x = match x with CTL.Ref _ | CTL.False | CTL.True | CTL.Pred(_) -> ctl2c ct pp pv x | _ -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) and andwrap ct pp pv x = match x with CTL.Ref _ | CTL.And(_,_,_) | CTL.False | CTL.True | CTL.Pred(_) -> ctl2c ct pp pv x | _ -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) and orwrap ct pp pv x = match x with CTL.Ref _ | CTL.Or(_,_) | CTL.False | CTL.True | CTL.Pred(_) -> ctl2c ct pp pv x | _ -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) and pathwrap ct pp pv x = match x with CTL.Ref _ | CTL.AX(_,_,_) | CTL.AF(_,_,_) | CTL.AG(_,_,_) | CTL.AU(_,_,_,_) | CTL.EX(_,_) | CTL.EF(_,_) | CTL.EG(_,_) | CTL.EU(_,_,_) -> ctl2c ct pp pv x | _ -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) and existswrap ct pp pv x = match x with CTL.Ref _ | CTL.AX(_,_,_) | CTL.AF(_,_,_) | CTL.AG(_,_,_) | CTL.AU(_,_,_,_) | CTL.Pred(_) | CTL.EX(_,_) | CTL.EF(_,_) | CTL.EG(_,_) | CTL.EU(_,_,_) | CTL.Exists(_,_,_) | CTL.True | CTL.False | CTL.Not(_) -> ctl2c ct pp pv x | _ -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) and letwrap ct pp pv x = match x with CTL.Let(_,_,_) -> let (res,ct) = ctl2c (ct+1) pp pv x in (Printf.sprintf "(%s)" res,ct+1) | _ -> ctl2c ct pp pv x let ctltotex rule pp pv ctls o = Printf.fprintf o "\\begin{quote}\\begin{verbatim}\n"; Printf.fprintf o "%s\n" (Pretty_print_cocci.unparse_to_string rule); Printf.fprintf o "\\end{verbatim}\\end{quote}\n\n"; List.iter (function ctl -> Printf.fprintf o "\\[\\begin{array}{l}\n"; let (res,_) = ctl2c 0 pp pv ctl in Printf.fprintf o "%s\n" res) ctls; Printf.fprintf o "\\end{array}\\]\n\n" let make_prelude o = Printf.fprintf o "%s\n" prelude let make_postlude o = Printf.fprintf o "%s\n" postlude (* ----------------------------------------------------------------------- *) let meta2c (_,s) = s let pred2c = function Lib_engine.InLoop -> ("\\msf{InLoop}",6) | Lib_engine.TrueBranch -> ("\\msf{TrueBranch}",10) | Lib_engine.FalseBranch -> ("\\msf{FalseBranch}",11) | Lib_engine.After -> ("\\msf{After}",5) | Lib_engine.FallThrough -> ("\\msf{FallThrough}",11) | Lib_engine.LoopFallThrough -> ("\\msf{LoopFallThrough}",15) | Lib_engine.Return -> ("\\msf{Return}",6) | Lib_engine.FunHeader -> ("\\msf{FunHeader}",9) | Lib_engine.UnsafeBrace -> ("\\msf{UnsafeBrace}",11) | Lib_engine.Top -> ("\\msf{Top}",3) | Lib_engine.Exit -> ("\\msf{Exit}",4) | Lib_engine.ErrorExit -> ("\\msf{ErrorExit}",9) | Lib_engine.Paren(s) -> let s = meta2c s in ("\\msf{Paren}("^s^")",7+(String.length s)) | Lib_engine.Label(s) -> let s = meta2c s in ("\\msf{Label}("^s^")",7+(String.length s)) | Lib_engine.BCLabel(s) -> let s = meta2c s in ("\\msf{BreakContinueLabel}("^s^")",20+(String.length s)) | Lib_engine.PrefixLabel(s) -> let s = meta2c s in ("\\msf{PrefixLabel}("^s^")",13+(String.length s)) | Lib_engine.Match(re) -> let s = Pretty_print_cocci.rule_elem_to_string re in let (s,len) = texify s in (Printf.sprintf "%s" s,len) | Lib_engine.BindGood(nm) -> let s = meta2c nm in ("\\msf{Good}("^s^")",6+(String.length s)) | Lib_engine.BindBad(nm) -> let s = meta2c nm in ("\\msf{Bad}("^s^")",5+(String.length s)) | Lib_engine.Goto -> ("goto",4) | Lib_engine.FakeBrace -> ("fake\\_brace",10) let totex out_file rules ctls = let o = open_out out_file in make_prelude o; List.iter2 (function ast_list -> function ctls -> let (ctls,_) = List.split ctls in ctltotex ast_list pred2c (function (_,x) -> x) ctls o) rules ctls; make_postlude o; close_out o coccinelle-1.0.0-rc19/engine/transformation_c.ml0000644000175000017500000007073512247442615020546 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./transformation_c.ml" open Common module F = Control_flow_c (*****************************************************************************) (* The functor argument *) (*****************************************************************************) (* info passed recursively in monad in addition to binding *) type xinfo = { optional_storage_iso : bool; optional_qualifier_iso : bool; value_format_iso : bool; optional_declarer_semicolon_iso : bool; current_rule_name : string; (* used for errors *) index : int list (* witness tree indices *) } module XTRANS = struct (* ------------------------------------------------------------------------*) (* Combinators history *) (* ------------------------------------------------------------------------*) (* * version0: * type ('a, 'b) transformer = * 'a -> 'b -> Lib_engine.metavars_binding -> 'b * exception NoMatch * * version1: * type ('a, 'b) transformer = * 'a -> 'b -> Lib_engine.metavars_binding -> 'b option * use an exception monad * * version2: * type tin = Lib_engine.metavars_binding *) (* ------------------------------------------------------------------------*) (* Standard type and operators *) (* ------------------------------------------------------------------------*) type tin = { extra: xinfo; binding: Lib_engine.metavars_binding; binding0: Lib_engine.metavars_binding; (* inherited variable *) } type 'x tout = 'x option type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout let (>>=) m f = fun tin -> match m tin with | None -> None | Some (a,b) -> f a b tin let return = fun x -> fun tin -> Some x (* can have fail in transform now that the process is deterministic ? *) let fail = fun tin -> None let (>||>) m1 m2 = fun tin -> match m1 tin with | None -> m2 tin | Some x -> Some x (* stop as soon as have found something *) let (>|+|>) m1 m2 = m1 >||> m2 let (>&&>) f m = fun tin -> if f tin then m tin else fail tin let optional_storage_flag f = fun tin -> f (tin.extra.optional_storage_iso) tin let optional_qualifier_flag f = fun tin -> f (tin.extra.optional_qualifier_iso) tin let value_format_flag f = fun tin -> f (tin.extra.value_format_iso) tin let optional_declarer_semicolon_flag f = fun tin -> f (tin.extra.optional_declarer_semicolon_iso) tin let mode = Cocci_vs_c.TransformMode (* ------------------------------------------------------------------------*) (* Env *) (* ------------------------------------------------------------------------*) (* When env is used in + code, have to strip it more to avoid circular references due to local variable information *) let clean_env env = List.map (function (v,vl) -> match vl with | Ast_c.MetaExprVal(e,ml) -> (v,Ast_c.MetaExprVal(Lib_parsing_c.real_al_expr e,ml)) | Ast_c.MetaExprListVal(es) -> (v,Ast_c.MetaExprListVal(Lib_parsing_c.real_al_arguments es)) | Ast_c.MetaTypeVal(ty) -> (v,Ast_c.MetaTypeVal(Lib_parsing_c.real_al_type ty)) | Ast_c.MetaInitVal(i) -> (v,Ast_c.MetaInitVal(Lib_parsing_c.real_al_init i)) | Ast_c.MetaInitListVal(is) -> (v,Ast_c.MetaInitListVal(Lib_parsing_c.real_al_inits is)) | Ast_c.MetaDeclVal(d) -> (v,Ast_c.MetaDeclVal(Lib_parsing_c.real_al_decl d)) | Ast_c.MetaStmtVal(s) -> (v,Ast_c.MetaStmtVal(Lib_parsing_c.real_al_statement s)) | _ -> (v,vl)) env (* ------------------------------------------------------------------------*) (* Exp *) (* ------------------------------------------------------------------------*) let cocciExp = fun expf expa node -> fun tin -> let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kexpr_s = (fun (k, bigf) expb -> match expf expa expb tin with | None -> (* failed *) k expb | Some (x, expb) -> expb); } in Some (expa, Visitor_c.vk_node_s bigf node) (* same as cocciExp, but for expressions in an expression, not expressions in a node *) let cocciExpExp = fun mc expf expa expb -> fun tin -> match mc with Ast_cocci.MINUS _ -> Some (expa,expb) (* do nothing *) | _ -> let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kexpr_s = (fun (k, bigf) expb -> match expf expa expb tin with | None -> (* failed *) k expb | Some (x, expb) -> expb); } in Some (expa, Visitor_c.vk_expr_s bigf expb) let cocciTy = fun expf expa node -> fun tin -> let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.ktype_s = (fun (k, bigf) expb -> match expf expa expb tin with | None -> (* failed *) k expb | Some (x, expb) -> expb); } in Some (expa, Visitor_c.vk_node_s bigf node) let cocciInit = fun expf expa node -> fun tin -> let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kini_s = (fun (k, bigf) expb -> match expf expa expb tin with | None -> (* failed *) k expb | Some (x, expb) -> expb); } in Some (expa, Visitor_c.vk_node_s bigf node) (* ------------------------------------------------------------------------*) (* Tokens *) (* ------------------------------------------------------------------------*) let check_pos info mck pos = match mck with | Ast_cocci.PLUS _ -> raise (Impossible 51) | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) -> pos <= i2 && pos >= i1 | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) -> true | _ -> match info with Some info -> failwith (Printf.sprintf "weird: dont have position info for the mcodekind in line %d column %d" info.Ast_cocci.line info.Ast_cocci.column) | None -> failwith "weird: dont have position info for the mcodekind" (* these remove constraints, at least those that contain pcre regexps, which cannot be compared (problem in the unparser) *) let strip_anything anything = let donothing r k e = k e in let mcode mc = mc in let ident r k e = let e = k e in match Ast_cocci.unwrap e with Ast_cocci.MetaId(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaId(name,Ast_cocci.IdNoConstraint,u,i)) | Ast_cocci.MetaFunc(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaFunc(name,Ast_cocci.IdNoConstraint,u,i)) | Ast_cocci.MetaLocalFunc(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaLocalFunc(name,Ast_cocci.IdNoConstraint,u,i)) | _ -> e in let expression r k e = let e = k e in match Ast_cocci.unwrap e with Ast_cocci.MetaErr(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaErr(name,Ast_cocci.NoConstraint,u,i)) | Ast_cocci.MetaExpr(name,constraints,u,ty,form,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaExpr(name,Ast_cocci.NoConstraint,u,ty,form,i)) | _ -> e in let fn = Visitor_ast.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in fn.Visitor_ast.rebuilder_anything anything let strip_minus_code = function Ast_cocci.REPLACEMENT(l,c) -> Ast_cocci.REPLACEMENT(List.map (List.map strip_anything) l,c) | Ast_cocci.NOREPLACEMENT -> Ast_cocci.NOREPLACEMENT let strip_context_code = function Ast_cocci.BEFORE(l,c) -> Ast_cocci.BEFORE(List.map (List.map strip_anything) l,c) | Ast_cocci.AFTER(l,c) -> Ast_cocci.AFTER(List.map (List.map strip_anything) l,c) | Ast_cocci.BEFOREAFTER(l1,l2,c) -> Ast_cocci.BEFOREAFTER(List.map (List.map strip_anything) l1, List.map (List.map strip_anything) l2,c) | Ast_cocci.NOTHING -> Ast_cocci.NOTHING let strip_mck_code = function Ast_cocci.MINUS(p,l,a,repl) -> Ast_cocci.MINUS(p,l,a,strip_minus_code repl) | Ast_cocci.CONTEXT(p,ba) -> Ast_cocci.CONTEXT(p,strip_context_code ba) | Ast_cocci.PLUS(c) -> Ast_cocci.PLUS(c) let tag_with_mck mck ib = fun tin -> let cocciinforef = ib.Ast_c.cocci_tag in let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in let mck = (* coccionly: if !Flag_parsing_cocci.sgrep_mode then Sgrep.process_sgrep ib mck else *) mck in (match mck, Ast_c.pinfo_of_info ib with | _, Ast_c.AbstractLineTok _ -> raise (Impossible 52) | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ -> failwith (Printf.sprintf "%s: %d: try to delete an expanded token: %s" (Ast_c.file_of_info ib) (Ast_c.line_of_info ib) (Ast_c.str_of_info ib)) | _ -> () ); let many_context_count = function Ast_cocci.BEFORE(_,Ast_cocci.MANY) | Ast_cocci.AFTER(_,Ast_cocci.MANY) | Ast_cocci.BEFOREAFTER(_,_,Ast_cocci.MANY) -> true | _ -> false in let many_minus_count = function Ast_cocci.REPLACEMENT(_,Ast_cocci.MANY) -> true | _ -> false in (match (oldmcode,mck) with | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _) -> (* nothing there, so take the new stuff *) let update_inst inst = function Ast_cocci.MINUS (pos,_,adj,any_xxs) -> Ast_cocci.MINUS (pos,inst,adj,any_xxs) | mck -> mck in let mck = strip_mck_code (update_inst tin.extra.index mck) in (* clean_env actually only needed if there is an addition not sure the extra efficiency would be worth duplicating the code *) cocciinforef := Some (mck, [clean_env tin.binding]) | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) -> (* can this case occur? stay with the old stuff *) () | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,Ast_cocci.NOREPLACEMENT), Ast_cocci.MINUS(new_pos,new_inst,new_adj,Ast_cocci.NOREPLACEMENT)) when old_pos = new_pos (* not sure why the following condition is useful. should be ok to double remove even if the environments are different *) (* && (List.mem tin.binding oldenvs or !Flag.sgrep_mode2) *) (* no way to combine adjacency information, just drop one *) -> cocciinforef := Some (Ast_cocci.MINUS (old_pos,Common.union_set old_inst new_inst,old_adj, Ast_cocci.NOREPLACEMENT), [tin.binding]); (if !Flag_matcher.show_misc then pr2_once "already tagged but only removed, so safe") (* ++ cases *) | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,old_modif), Ast_cocci.MINUS(new_pos,new_inst,new_adj,new_modif)) when old_pos = new_pos && old_modif = strip_minus_code new_modif && many_minus_count old_modif -> cocciinforef := Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst, old_adj,old_modif), (clean_env tin.binding)::oldenvs) | (Ast_cocci.CONTEXT(old_pos,old_modif), Ast_cocci.CONTEXT(new_pos,new_modif)) when old_pos = new_pos && old_modif = strip_context_code new_modif && many_context_count old_modif -> (* iteration only allowed on context; no way to replace something more than once; now no need for iterable; just check a flag *) cocciinforef := Some(Ast_cocci.CONTEXT(old_pos,old_modif), (clean_env tin.binding)::oldenvs) (* non ++ but same modif for two reasons *) | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,old_modif), Ast_cocci.MINUS(new_pos,new_inst,new_adj,new_modif)) when old_pos = new_pos && old_modif = strip_minus_code new_modif && List.mem (clean_env tin.binding) oldenvs -> cocciinforef := Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst, old_adj,old_modif), oldenvs) | (Ast_cocci.CONTEXT(old_pos,old_modif), Ast_cocci.CONTEXT(new_pos,new_modif)) when old_pos = new_pos && old_modif = strip_context_code new_modif && List.mem (clean_env tin.binding) oldenvs -> (* iteration only allowed on context; no way to replace something more than once; now no need for iterable; just check a flag *) cocciinforef := Some(Ast_cocci.CONTEXT(old_pos,old_modif),oldenvs) | _ -> (* (match (oldmcode,mck) with | (Ast_cocci.CONTEXT(old_pos,old_modif), Ast_cocci.CONTEXT(new_pos,new_modif)) -> Printf.printf "failed because of %b %b %b\n" (old_pos = new_pos) (old_modif = strip_context_code new_modif) (many_context_count old_modif); Printf.printf "failed because of %s %s\n" (Dumper.dump old_modif) (Dumper.dump (strip_context_code new_modif)) | _ -> Printf.printf "other failure\n"); *) (* coccionly: if !Flag.sgrep_mode2 then ib (* safe *) else *) begin (* coccionly: pad: if don't want cocci write: failwith (match Ast_c.pinfo_of_info ib with Ast_c.FakeTok _ -> "already tagged fake token" *) let pm str mcode env = Printf.sprintf "%s modification:\n%s\nAccording to environment %d:\n%s\n" str (Common.format_to_string (function _ -> Pretty_print_cocci.print_mcodekind mcode)) (List.length env) (String.concat "\n" (List.map (function ((r,vr),vl) -> Printf.sprintf " %s.%s -> %s" r vr (Common.format_to_string (function _ -> Pretty_print_engine.pp_binding_kind vl))) env)) in flush stdout; flush stderr; Common.pr2 ("\n"^ (String.concat "\n" (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n" ^ (pm "current" mck tin.binding)); failwith (match Ast_c.pinfo_of_info ib with Ast_c.FakeTok _ -> Common.sprintf "%s: already tagged fake token\n" tin.extra.current_rule_name | _ -> Printf.sprintf "%s: already tagged token:\nC code context\n%s" tin.extra.current_rule_name (Common.error_message (Ast_c.file_of_info ib) (Ast_c.str_of_info ib, Ast_c.opos_of_info ib))) end); ib let tokenf ia ib = fun tin -> let (_,i,mck,_) = ia in let pos = Ast_c.info_to_fixpos ib in if check_pos (Some i) mck pos then return (ia, tag_with_mck mck ib tin) tin else fail tin let tokenf_mck mck ib = fun tin -> let pos = Ast_c.info_to_fixpos ib in if check_pos None mck pos then return (mck, tag_with_mck mck ib tin) tin else fail tin (* ------------------------------------------------------------------------*) (* Distribute mcode *) (* ------------------------------------------------------------------------*) (* When in the SP we attach something to a metavariable, or delete it, as in * - S * + foo(); * we have to minusize all the token that compose S in the C code, and * attach the 'foo();' to the right token, the one at the very right. *) type 'a distributer = (Ast_c.info -> Ast_c.info) * (* what to do on left *) (Ast_c.info -> Ast_c.info) * (* what to do on middle *) (Ast_c.info -> Ast_c.info) * (* what to do on right *) (Ast_c.info -> Ast_c.info) -> (* what to do on both *) 'a -> 'a let distribute_mck mcodekind distributef expr tin = match mcodekind with | Ast_cocci.MINUS (pos,_,adj,any_xxs) -> let inst = tin.extra.index in distributef ( (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin), (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin), (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin), (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin) ) expr | Ast_cocci.CONTEXT (pos,any_befaft) -> (match any_befaft with | Ast_cocci.NOTHING -> expr | Ast_cocci.BEFORE (xxs,c) -> distributef ( (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin), (fun x -> x), (fun x -> x), (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin) ) expr | Ast_cocci.AFTER (xxs,c) -> distributef ( (fun x -> x), (fun x -> x), (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin), (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin) ) expr | Ast_cocci.BEFOREAFTER (xxs, yys, c) -> distributef ( (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin), (fun x -> x), (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin), (fun ib -> tag_with_mck (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c))) ib tin) ) expr ) | Ast_cocci.PLUS _ -> raise (Impossible 53) (* use new strategy, collect ii, sort, recollect and tag *) let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) = let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kinfo_s = (fun (k,bigf) i -> let pos = Ast_c.info_to_fixpos i in match () with | _ when Ast_cocci.equal_pos pos maxpos && Ast_cocci.equal_pos pos minpos -> bop i | _ when Ast_cocci.equal_pos pos maxpos -> rop i | _ when Ast_cocci.equal_pos pos minpos -> lop i | _ -> mop i ) } in bigf let distribute_mck_expr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_expr_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_args (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_args_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_type (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_type_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_decl (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_decl_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_field (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_struct_field_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_ini (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_ini_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_inis (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_inis_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_fragments (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_string_fragments_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_format (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_string_format_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_node (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_enum_fields (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_enum_fields_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_struct_fields (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_cst (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_define_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_pragmainfo (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_pragmainfo_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_ident_list (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_ident_list_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let get_pos mck = match mck with | Ast_cocci.PLUS _ -> raise (Impossible 54) | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) -> Ast_cocci.FixPos (i1,i2) | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) -> Ast_cocci.DontCarePos | _ -> failwith "weird: dont have position info for the mcodekind 2" let distrf (ii_of_x_f, distribute_mck_x_f) = fun ia x -> fun tin -> let mck = Ast_cocci.get_mcodekind ia in let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x) in if (* bug: check_pos mck max && check_pos mck min * * if do that then if have - f(...); and in C f(1,2); then we * would get a "already tagged" because the '...' would sucess in * transformaing both '1' and '1,2'. So being in the range is not * enough. We must be equal exactly to the range! *) (match get_pos mck with | Ast_cocci.DontCarePos -> true | Ast_cocci.FixPos (i1, i2) -> i1 =*= min && i2 =*= max | _ -> raise (Impossible 55) ) then return ( ia, distribute_mck mck (distribute_mck_x_f (max,min)) x tin ) tin else fail tin let distrf_e = distrf (Lib_parsing_c.ii_of_expr, distribute_mck_expr) let distrf_args = distrf (Lib_parsing_c.ii_of_args, distribute_mck_args) let distrf_type = distrf (Lib_parsing_c.ii_of_type, distribute_mck_type) let distrf_param = distrf (Lib_parsing_c.ii_of_param, distribute_mck_param) let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params) let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini) let distrf_inis = distrf (Lib_parsing_c.ii_of_inis,distribute_mck_inis) let distrf_decl = distrf (Lib_parsing_c.ii_of_decl,distribute_mck_decl) let distrf_field = distrf (Lib_parsing_c.ii_of_field,distribute_mck_field) let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node) let distrf_fragments = distrf (Lib_parsing_c.ii_of_fragments,distribute_mck_fragments) let distrf_format = distrf (Lib_parsing_c.ii_of_format,distribute_mck_format) let distrf_enum_fields = distrf (Lib_parsing_c.ii_of_enum_fields, distribute_mck_enum_fields) let distrf_struct_fields = distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields) let distrf_cst = distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst) let distrf_define_params = distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params) let distrf_pragmainfo = distrf (Lib_parsing_c.ii_of_pragmainfo,distribute_mck_pragmainfo) let distrf_ident_list = distrf (Lib_parsing_c.ii_of_ident_list,distribute_mck_ident_list) (* ------------------------------------------------------------------------*) (* Environment *) (* ------------------------------------------------------------------------*) let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2 let envf keep inherited = fun (s, value, _) f tin -> let s = Ast_cocci.unwrap_mcode s in let v = if keep =*= Type_cocci.Saved then ( try Some (List.assoc s tin.binding) with Not_found -> pr2(sprintf "Don't find value for metavariable %s in the environment" (meta_name_to_str s)); None) else (* not raise Impossible! *) Some (value) in match v with | None -> fail tin | Some (value') -> (* Ex: in cocci_vs_c someone wants to add a binding. Here in * transformation3 the value for this var may be already in the * env, because for instance its value were fixed in a previous * SmPL rule. So here we want to check that this is the same value. * If forget to do the check, what can happen ? Because of Exp * and other disjunctive feature of cocci_vs_c (>||>), we * may accept a match at a wrong position. Maybe later this * will be detected via the pos system on tokens, but maybe * not. So safer to keep the check. *) (*f () tin*) let equal = if inherited then Cocci_vs_c.equal_inh_metavarval else Cocci_vs_c.equal_metavarval in if equal value value' then f () tin else fail tin let check_idconstraint matcher c id = fun f tin -> f () tin let check_constraints_ne matcher constraints exp = fun f tin -> f () tin (* ------------------------------------------------------------------------*) (* Environment, allbounds *) (* ------------------------------------------------------------------------*) let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin -> true (* in transform we don't care ? *) end (*****************************************************************************) (* Entry point *) (*****************************************************************************) module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS) let transform_re_node a b tin = match TRANS.rule_elem_node a b tin with | None -> raise (Impossible 56) | Some (_sp, b') -> b' let (transform2: string (* rule name *) -> string list (* dropped_isos *) -> Lib_engine.metavars_binding (* inherited bindings *) -> Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) = fun rule_name dropped_isos binding0 xs cflow -> let extra = { optional_storage_iso = not(List.mem "optional_storage" dropped_isos); optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos); value_format_iso = not(List.mem "value_format" dropped_isos); optional_declarer_semicolon_iso = not(List.mem "optional_declarer_semicolon" dropped_isos); current_rule_name = rule_name; index = []; } in (* find the node, transform, update the node, and iter for all elements *) xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) -> (* subtil: not cflow#nodes but acc#nodes *) let node = acc#nodes#assoc nodei in if !Flag.show_transinfo then pr2 (Printf.sprintf "transform one node: %d" nodei); let tin = { XTRANS.extra = {extra with index = index}; XTRANS.binding = binding0@binding; XTRANS.binding0 = []; (* not used - everything constant for trans *) } in let node' = transform_re_node rule_elem node tin in (* assert that have done something. But with metaruleElem sometimes dont modify fake nodes. So special case before on Fake nodes. *) (match F.unwrap node with | F.Enter | F.Exit | F.ErrorExit | F.EndStatement _ | F.CaseNode _ | F.Fake | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode -> () | _ -> () (* assert (not (node =*= node')); *) ); (* useless, we dont go back from flow to ast now *) (* let node' = lastfix_comma_struct node' in *) acc#replace_node (nodei, node'); acc ) cflow let transform a b c d e = Common.profile_code "Transformation3.transform" (fun () -> transform2 a b c d e) coccinelle-1.0.0-rc19/engine/pattern_c.ml0000644000175000017500000005031512247442615017145 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pattern_c.ml" open Common module Flag_engine = Flag_matcher (*****************************************************************************) (* The functor argument *) (*****************************************************************************) (* info passed recursively in monad in addition to binding *) type xinfo = { optional_storage_iso : bool; optional_qualifier_iso : bool; value_format_iso : bool; optional_declarer_semicolon_iso : bool; } module XMATCH = struct (* ------------------------------------------------------------------------*) (* Combinators history *) (* ------------------------------------------------------------------------*) (* * version0: * type ('a, 'b) matcher = 'a -> 'b -> bool * * version1: same but with a global variable holding the current binding * BUT bug * - can have multiple possibilities * - globals sux * - sometimes have to undo, cos if start match, then it binds, * and if later it does not match, then must undo the first binds. * ex: when match parameters, can try to match, but then we found far * later that the last argument of a function does not match * => have to uando the binding !!! * (can handle that too with a global, by saving the * global, ... but sux) * => better not use global * * version2: * type ('a, 'b) matcher = binding -> 'a -> 'b -> binding list * * Empty list mean failure (let matchfailure = []). * To be able to have pretty code, have to use partial application * powa, and so the type is in fact * * version3: * type ('a, 'b) matcher = 'a -> 'b -> binding -> binding list * * Then by defining the correct combinators, can have quite pretty code (that * looks like the clean code of version0). * * opti: return a lazy list of possible matchs ? * * version4: type tin = Lib_engine.metavars_binding *) (* ------------------------------------------------------------------------*) (* Standard type and operators *) (* ------------------------------------------------------------------------*) type tin = { extra: xinfo; binding: Lib_engine.metavars_binding; binding0: Lib_engine.metavars_binding; (* inherited bindings *) } (* 'x is a ('a * 'b) but in fact don't care about 'b, we just tag the SP *) (* opti? use set instead of list *) type 'x tout = ('x * Lib_engine.metavars_binding) list type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout (* was >&&> *) let (>>=) m1 m2 = fun tin -> let xs = m1 tin in let xxs = xs +> List.map (fun ((a,b), binding) -> m2 a b {tin with binding = binding} ) in List.flatten xxs (* Je compare les bindings retournés par les differentes branches. * Si la deuxieme branche amene a des bindings qui sont deja presents * dans la premiere branche, alors je ne les accepte pas. * * update: still useful now that julia better handle Exp directly via * ctl tricks using positions ? *) let (>|+|>) m1 m2 = fun tin -> (* CHOICE let xs = m1 tin in if null xs then m2 tin else xs *) let res1 = m1 tin in let res2 = m2 tin in let list_bindings_already = List.map snd res1 in res1 ++ (res2 +> List.filter (fun (x, binding) -> not (list_bindings_already +> List.exists (fun already -> Lib_engine.equal_binding binding already)) )) let (>||>) m1 m2 = fun tin -> (* CHOICE let xs = m1 tin in if null xs then m2 tin else xs *) (* opti? use set instead of list *) let l1 = m1 tin in let l2 = m2 tin in if l2 = [] then l1 else l1 ++ l2 (*a small benefit; avoid a trivial @*) let return res = fun tin -> [res, tin.binding] let fail = fun tin -> [] let (>&&>) f m = fun tin -> if f tin then m tin else fail tin let mode = Cocci_vs_c.PatternMode (* ------------------------------------------------------------------------*) (* Exp *) (* ------------------------------------------------------------------------*) let cocciExp = fun expf expa node -> fun tin -> let globals = ref [] in let bigf = { (* julia's style *) Visitor_c.default_visitor_c with Visitor_c.kexpr = (fun (k, bigf) expb -> match expf expa expb tin with | [] -> (* failed *) k expb | xs -> globals := xs @ !globals; if not !Flag_engine.disallow_nested_exps then k expb (* CHOICE *) ); (* pad's style. * push2 expr globals; k expr * ... * !globals +> List.fold_left (fun acc e -> acc >||> match_e_e expr e) * (return false) * *) } in Visitor_c.vk_node bigf node; !globals +> List.map (fun ((a, _exp), binding) -> (a, node), binding ) (* same as cocciExp, but for expressions in an expression, not expressions in a node *) let cocciExpExp = fun _ expf expa expb -> fun tin -> let globals = ref [] in let bigf = { (* julia's style *) Visitor_c.default_visitor_c with Visitor_c.kexpr = (fun (k, bigf) expb -> match expf expa expb tin with | [] -> (* failed *) k expb | xs -> globals := xs @ !globals; if not !Flag_engine.disallow_nested_exps then k expb (* CHOICE *) ); (* pad's style. * push2 expr globals; k expr * ... * !globals +> List.fold_left (fun acc e -> acc >||> match_e_e expr e) * (return false) * *) } in Visitor_c.vk_expr bigf expb; !globals +> List.map (fun ((a, _exp), binding) -> (a, expb), binding ) let cocciTy = fun expf expa node -> fun tin -> let globals = ref [] in let bigf = { Visitor_c.default_visitor_c with Visitor_c.ktype = (fun (k, bigf) expb -> match expf expa expb tin with | [] -> (* failed *) k expb | xs -> globals := xs @ !globals); } in Visitor_c.vk_node bigf node; !globals +> List.map (fun ((a, _exp), binding) -> (a, node), binding ) let cocciInit = fun expf expa node -> fun tin -> let globals = ref [] in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kini = (fun (k, bigf) expb -> match expf expa expb tin with | [] -> (* failed *) k expb | xs -> globals := xs @ !globals); } in Visitor_c.vk_node bigf node; !globals +> List.map (fun ((a, _exp), binding) -> (a, node), binding ) (* ------------------------------------------------------------------------*) (* Distribute mcode *) (* ------------------------------------------------------------------------*) let tag_mck_pos mck posmck = match mck with | Ast_cocci.PLUS c -> Ast_cocci.PLUS c | Ast_cocci.CONTEXT (pos, xs) -> assert (pos =*= Ast_cocci.NoPos || pos =*= Ast_cocci.DontCarePos); Ast_cocci.CONTEXT (posmck, xs) | Ast_cocci.MINUS (pos, inst, adj, xs) -> assert (pos =*= Ast_cocci.NoPos || pos =*= Ast_cocci.DontCarePos); Ast_cocci.MINUS (posmck, inst, adj, xs) let tag_mck_pos_mcode (x,info,mck,pos) posmck stuff = fun tin -> [((x, info, tag_mck_pos mck posmck, pos),stuff), tin.binding] let is_abstract ii = match Ast_c.pinfo_of_info ii with Ast_c.AbstractLineTok pi -> true | _ -> false let distrf (ii_of_x_f) = fun mcode x -> fun tin -> let iis = ii_of_x_f x in let all_abstract = (* this occurs when matching a metavar type against a type *) List.for_all is_abstract iis in if all_abstract then tag_mck_pos_mcode mcode Ast_cocci.NoPos x tin (* do nothing *) else let (max, min) = Lib_parsing_c.max_min_by_pos iis in let posmck = Ast_cocci.FixPos (min, max) (* subtil: and not max, min !!*) in tag_mck_pos_mcode mcode posmck x tin let distrf_e = distrf (Lib_parsing_c.ii_of_expr) let distrf_args = distrf (Lib_parsing_c.ii_of_args) let distrf_type = distrf (Lib_parsing_c.ii_of_type) let distrf_param = distrf (Lib_parsing_c.ii_of_param) let distrf_params = distrf (Lib_parsing_c.ii_of_params) let distrf_ini = distrf (Lib_parsing_c.ii_of_ini) let distrf_inis = distrf (Lib_parsing_c.ii_of_inis) let distrf_decl = distrf (Lib_parsing_c.ii_of_decl) let distrf_field = distrf (Lib_parsing_c.ii_of_field) let distrf_node = distrf (Lib_parsing_c.ii_of_node) let distrf_fragments = distrf (Lib_parsing_c.ii_of_fragments) let distrf_format = distrf (Lib_parsing_c.ii_of_format) let distrf_enum_fields = distrf (Lib_parsing_c.ii_of_enum_fields) let distrf_struct_fields = distrf (Lib_parsing_c.ii_of_struct_fields) let distrf_cst = distrf (Lib_parsing_c.ii_of_cst) let distrf_define_params = distrf (Lib_parsing_c.ii_of_define_params) let distrf_pragmainfo = distrf (Lib_parsing_c.ii_of_pragmainfo) let distrf_ident_list = distrf (Lib_parsing_c.ii_of_ident_list) (* ------------------------------------------------------------------------*) (* Constraints on metavariable values *) (* ------------------------------------------------------------------------*) let check_idconstraint matcher c id = fun f tin -> if matcher c id then (* success *) f () tin else (* failure *) fail tin let check_constraints_ne matcher constraints exp = fun f tin -> let rec loop = function [] -> f () tin (* success *) | c::cs -> match matcher c exp tin with [] (* failure *) -> loop cs | _ (* success *) -> fail tin in loop constraints let check_pos_constraints constraints pvalu f tin = check_constraints_ne (fun c exp tin -> let success = [[]] in let failure = [] in (* relies on the fact that constraints on pos variables must refer to inherited variables *) (match Common.optionise (fun () -> tin.binding0 +> List.assoc c) with Some valu' -> if Cocci_vs_c.equal_inh_metavarval exp valu' then success else failure | None -> (* if the variable is not there, it puts no constraints *) (* not sure this is still useful *) failure)) constraints pvalu f tin (* ------------------------------------------------------------------------*) (* Environment *) (* ------------------------------------------------------------------------*) (* pre: if have declared a new metavar that hide another one, then * must be passed with a binding that deleted this metavar * * Here we don't use the keep argument of julia. cf f(X,X), J'ai * besoin de garder le X en interne, meme si julia s'en fout elle du * X et qu'elle a mis X a DontSaved. *) let check_add_metavars_binding strip _keep inherited = fun (k, valu) tin -> if inherited then match Common.optionise (fun () -> tin.binding0 +> List.assoc k) with | Some (valu') -> if Cocci_vs_c.equal_inh_metavarval valu valu' then Some tin.binding else None | None -> None else match Common.optionise (fun () -> tin.binding +> List.assoc k) with | Some (valu') -> if Cocci_vs_c.equal_metavarval valu valu' then Some tin.binding else None | None -> let success valu' = Some (tin.binding +> Common.insert_assoc (k, valu')) in (match valu with Ast_c.MetaIdVal (a,c) -> (* c is a negated constraint *) let rec loop = function [] -> success(Ast_c.MetaIdVal(a,[])) | c::cs -> let tmp = Common.optionise (fun () -> tin.binding0 +> List.assoc c) in (match tmp with Some (Ast_c.MetaIdVal(v,_)) -> if a =$= v then None (* failure *) else success(Ast_c.MetaIdVal(a,[])) | Some _ -> failwith "Not possible" | None -> success(Ast_c.MetaIdVal(a,[]))) in loop c | Ast_c.MetaFuncVal a -> success(Ast_c.MetaFuncVal a) | Ast_c.MetaLocalFuncVal a -> success(Ast_c.MetaLocalFuncVal a) (*more?*) | Ast_c.MetaExprVal (a,c) -> (* c in the value is only to prepare for the future in which we figure out how to have subterm constraints on unbound variables. Now an environment will only contain expression values with empty constraints, as all constraints are resolved at binding time *) let stripped = if strip then Lib_parsing_c.al_expr a else Lib_parsing_c.semi_al_expr a in let inh_stripped = Lib_parsing_c.al_inh_expr a in let rec loop = function [] -> success(Ast_c.MetaExprVal(stripped,[])) | c::cs -> let tmp = Common.optionise (fun () -> tin.binding0 +> List.assoc c) in (match tmp with Some (Ast_c.MetaExprVal(v,_)) -> if C_vs_c.subexpression_of_expression inh_stripped v then loop cs (* forget satisfied constraints *) else None (* failure *) | Some _ -> failwith "not possible" (* fail if this should be a subterm of something that doesn't exist *) | None -> None) in loop c | Ast_c.MetaExprListVal a -> success (Ast_c.MetaExprListVal (if strip then Lib_parsing_c.al_arguments a else Lib_parsing_c.semi_al_arguments a)) | Ast_c.MetaDeclVal a -> success (Ast_c.MetaDeclVal (if strip then Lib_parsing_c.al_declaration a else Lib_parsing_c.semi_al_declaration a)) | Ast_c.MetaFieldVal a -> success (Ast_c.MetaFieldVal (if strip then Lib_parsing_c.al_field a else Lib_parsing_c.semi_al_field a)) | Ast_c.MetaFieldListVal a -> success (Ast_c.MetaFieldListVal (if strip then Lib_parsing_c.al_fields a else Lib_parsing_c.semi_al_fields a)) | Ast_c.MetaStmtVal a -> success (Ast_c.MetaStmtVal (if strip then Lib_parsing_c.al_statement a else Lib_parsing_c.semi_al_statement a)) | Ast_c.MetaTypeVal a -> success (Ast_c.MetaTypeVal (if strip then Lib_parsing_c.al_type a else Lib_parsing_c.semi_al_type a)) | Ast_c.MetaInitVal a -> success (Ast_c.MetaInitVal (if strip then Lib_parsing_c.al_init a else Lib_parsing_c.semi_al_init a)) | Ast_c.MetaInitListVal a -> success (Ast_c.MetaInitListVal (if strip then Lib_parsing_c.al_inits a else Lib_parsing_c.semi_al_inits a)) | Ast_c.MetaListlenVal a -> success(Ast_c.MetaListlenVal a) | Ast_c.MetaParamVal a -> success (Ast_c.MetaParamVal (if strip then Lib_parsing_c.al_param a else Lib_parsing_c.semi_al_param a)) | Ast_c.MetaParamListVal a -> success (Ast_c.MetaParamListVal (if strip then Lib_parsing_c.al_params a else Lib_parsing_c.semi_al_params a)) | Ast_c.MetaFragListVal a -> success (Ast_c.MetaFragListVal (if strip then Lib_parsing_c.al_string_fragments a else Lib_parsing_c.semi_al_string_fragments a)) | Ast_c.MetaFmtVal a -> success (Ast_c.MetaFmtVal (if strip then Lib_parsing_c.al_string_format a else Lib_parsing_c.semi_al_string_format a)) | Ast_c.MetaPosVal (pos1,pos2) -> success(Ast_c.MetaPosVal (pos1,pos2)) | Ast_c.MetaPosValList l -> success (Ast_c.MetaPosValList l)) let pos_variables tin ia get_pvalu finish = match Ast_cocci.get_pos_var ia with [] -> finish tin | positions -> let pvalu = Ast_c.MetaPosValList(get_pvalu()) in let rec loop tin = function [] -> finish tin | Ast_cocci.MetaPos(name,constraints,per,keep,inherited) :: rest -> check_pos_constraints constraints pvalu (function () -> (* constraints are satisfied, now see if we are compatible with existing bindings *) function new_tin -> let x = Ast_cocci.unwrap_mcode name in let new_binding = check_add_metavars_binding false keep inherited (x, pvalu) tin in (match new_binding with Some binding -> loop {tin with binding = binding} rest | None -> fail tin)) tin in loop tin positions let envf keep inherited = fun (k, valu, get_max_min) f tin -> let x = Ast_cocci.unwrap_mcode k in match check_add_metavars_binding true keep inherited (x, valu) tin with | Some binding -> let new_tin = {tin with binding = binding} in pos_variables new_tin k (function _ -> let (file,current_element,min,max) = get_max_min() in [(file,current_element,min,max)]) (f ()) | None -> fail tin (* ------------------------------------------------------------------------*) (* Environment, allbounds *) (* ------------------------------------------------------------------------*) (* all referenced inherited variables have to be bound. This would * be naturally checked for the minus or context ones in the * matching process, but have to check the plus ones as well. The * result of get_inherited contains all of these, but the potential * redundant checking for the minus and context ones is probably not * a big deal. If it's a problem, could fix free_vars to distinguish * between + variables and the other ones. *) let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin -> l +> List.for_all (fun inhvar -> match Common.optionise (fun () -> tin.binding0 +> List.assoc inhvar) with | Some _ -> true | None -> false ) let optional_storage_flag f = fun tin -> f (tin.extra.optional_storage_iso) tin let optional_qualifier_flag f = fun tin -> f (tin.extra.optional_qualifier_iso) tin let value_format_flag f = fun tin -> f (tin.extra.value_format_iso) tin let optional_declarer_semicolon_flag f = fun tin -> f (tin.extra.optional_declarer_semicolon_iso) tin (* ------------------------------------------------------------------------*) (* Tokens *) (* ------------------------------------------------------------------------*) let tokenf ia ib = fun tin -> if is_abstract ib then (* for meta var type against type case *) let posmck = Ast_cocci.NoPos in tag_mck_pos_mcode ia posmck ib tin else let pos = Ast_c.info_to_fixpos ib in let posmck = Ast_cocci.FixPos (pos, pos) in let finish tin = tag_mck_pos_mcode ia posmck ib tin in pos_variables tin ia (function _ -> [Lib_parsing_c.lin_col_by_pos [ib]]) finish let tokenf_mck mck ib = fun tin -> let pos = Ast_c.info_to_fixpos ib in let posmck = Ast_cocci.FixPos (pos, pos) in [(tag_mck_pos mck posmck, ib), tin.binding] end (*****************************************************************************) (* Entry point *) (*****************************************************************************) module MATCH = Cocci_vs_c.COCCI_VS_C (XMATCH) let match_re_node2 dropped_isos a b binding0 = let tin = { XMATCH.extra = { optional_storage_iso = not(List.mem "optional_storage" dropped_isos); optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos); value_format_iso = not(List.mem "value_format" dropped_isos); optional_declarer_semicolon_iso = not(List.mem "optional_declarer_semicolon" dropped_isos); }; XMATCH.binding = []; XMATCH.binding0 = binding0; } in MATCH.rule_elem_node a b tin (* take only the tagged-SP, the 'a' *) +> List.map (fun ((a,_b), binding) -> a, binding) let match_re_node a b c d = Common.profile_code "Pattern3.match_re_node" (fun () -> match_re_node2 a b c d) coccinelle-1.0.0-rc19/engine/cocci_vs_c.ml0000644000175000017500000047104612247442615017270 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci_vs_c.ml" open Common module A = Ast_cocci module B = Ast_c module F = Control_flow_c module FlagM = Flag_matcher (*****************************************************************************) (* Wrappers *) (*****************************************************************************) let pr2, pr2_once = Common.mk_pr2_wrappers FlagM.verbose_matcher let (+++) a b = match a with Some x -> Some x | None -> b let error ii str = match ii with [] -> failwith str | ii::_ -> failwith (Printf.sprintf "%s: %d: %s" (Ast_c.file_of_info ii) (Ast_c.line_of_info ii) str) (*****************************************************************************) (* Helpers *) (*****************************************************************************) type sequence = Ordered | Unordered let seqstyle eas = match A.unwrap eas with | A.DOTS _ -> Ordered | A.CIRCLES _ -> Unordered | A.STARS _ -> failwith "not handling stars" let (redots : 'a A.dots -> 'a list -> 'a A.dots)=fun eas easundots -> A.rewrap eas ( match A.unwrap eas with | A.DOTS _ -> A.DOTS easundots | A.CIRCLES _ -> A.CIRCLES easundots | A.STARS _ -> A.STARS easundots ) let (need_unordered_initialisers : B.initialiser B.wrap2 list -> bool) = fun ibs -> ibs +> List.exists (fun (ib, icomma) -> match B.unwrap ib with | B.InitDesignators _ | B.InitFieldOld _ | B.InitIndexOld _ -> true | B.InitExpr _ | B.InitList _ -> false) (* For the #include in the .cocci, need to find where is * the '+' attached to this element, to later find the first concrete * #include or last one in the series of #includes in the * .c. *) type include_requirement = | IncludeMcodeBefore | IncludeMcodeAfter | IncludeNothing (* todo? put in semantic_c.ml *) type info_ident = | Function | LocalFunction (* entails Function *) | DontKnow let term mc = A.unwrap_mcode mc let mcodekind mc = A.get_mcodekind mc let mcode_contain_plus = function | A.CONTEXT (_,A.NOTHING) -> false | A.CONTEXT _ -> true | A.MINUS (_,_,_,A.NOREPLACEMENT) -> false | A.MINUS (_,_,_,A.REPLACEMENT _) -> true (* repl is nonempty *) | A.PLUS _ -> raise (Impossible 13) let mcode_simple_minus = function | A.MINUS (_,_,_,A.NOREPLACEMENT) -> true | _ -> false (* In transformation.ml sometime I build some mcodekind myself and * julia has put None for the pos. But there is no possible raise * NoMatch in those cases because it is for the minusall trick or for * the distribute, so either have to build those pos, in fact a range, * because for the distribute have to erase a fullType with one * mcodekind, or add an argument to tag_with_mck such as "safe" that * don't do the check_pos. Hence this DontCarePos constructor. *) let minusizer = ("fake","fake"), {A.line = 0; A.column =0; A.strbef=[]; A.straft=[]}, (A.MINUS(A.DontCarePos,[],A.ALLMINUS,A.NOREPLACEMENT)), [] let generalize_mcode ia = let (s1, i, mck, pos) = ia in let new_mck = match mck with | A.PLUS _ -> raise (Impossible 14) | A.CONTEXT (A.NoPos,x) -> A.CONTEXT (A.DontCarePos,x) | A.MINUS (A.NoPos,inst,adj,x) -> A.MINUS (A.DontCarePos,inst,adj,x) | A.CONTEXT ((A.FixPos _|A.DontCarePos), _) | A.MINUS ((A.FixPos _|A.DontCarePos), _, _, _) -> raise (Impossible 15) in (s1, i, new_mck, pos) (*---------------------------------------------------------------------------*) (* 0x0 is equivalent to 0, value format isomorphism *) let equal_c_int s1 s2 = try int_of_string s1 =|= int_of_string s2 with Failure("int_of_string") -> s1 =$= s2 (*---------------------------------------------------------------------------*) (* Normally A should reuse some types of Ast_c, so those * functions should not exist. * * update: but now Ast_c depends on A, so can't make too * A depends on Ast_c, so have to stay with those equal_xxx * functions. *) let equal_unaryOp a b = match a, b with | A.GetRef , B.GetRef -> true | A.GetRefLabel, B.GetRefLabel -> true | A.DeRef , B.DeRef -> true | A.UnPlus , B.UnPlus -> true | A.UnMinus , B.UnMinus -> true | A.Tilde , B.Tilde -> true | A.Not , B.Not -> true | _, (B.Not|B.Tilde|B.UnMinus|B.UnPlus|B.DeRef|B.GetRef|B.GetRefLabel) -> false let equal_arithOp a b = match a, b with | A.Plus , B.Plus -> true | A.Minus , B.Minus -> true | A.Mul , B.Mul -> true | A.Div , B.Div -> true | A.Min , B.Min -> true | A.Max , B.Max -> true | A.Mod , B.Mod -> true | A.DecLeft , B.DecLeft -> true | A.DecRight , B.DecRight -> true | A.And , B.And -> true | A.Or , B.Or -> true | A.Xor , B.Xor -> true | _, (B.Xor|B.Or|B.And|B.DecRight|B.DecLeft|B.Mod|B.Div|B.Mul|B.Minus|B.Plus|B.Min|B.Max) -> false let equal_logicalOp a b = match a, b with | A.Inf , B.Inf -> true | A.Sup , B.Sup -> true | A.InfEq , B.InfEq -> true | A.SupEq , B.SupEq -> true | A.Eq , B.Eq -> true | A.NotEq , B.NotEq -> true | A.AndLog , B.AndLog -> true | A.OrLog , B.OrLog -> true | _, (B.OrLog|B.AndLog|B.NotEq|B.Eq|B.SupEq|B.InfEq|B.Sup|B.Inf) -> false let equal_assignOp a b = match a, b with | A.SimpleAssign, B.SimpleAssign -> true | A.OpAssign a, B.OpAssign b -> equal_arithOp a b | _, (B.OpAssign _|B.SimpleAssign) -> false let equal_fixOp a b = match a, b with | A.Dec, B.Dec -> true | A.Inc, B.Inc -> true | _, (B.Inc|B.Dec) -> false let equal_binaryOp a b = match a, b with | A.Arith a, B.Arith b -> equal_arithOp a b | A.Logical a, B.Logical b -> equal_logicalOp a b | _, (B.Logical _ | B.Arith _) -> false let equal_structUnion a b = match a, b with | A.Struct, B.Struct -> true | A.Union, B.Union -> true | _, (B.Struct|B.Union) -> false let equal_sign a b = match a, b with | A.Signed, B.Signed -> true | A.Unsigned, B.UnSigned -> true | _, (B.UnSigned|B.Signed) -> false let equal_storage a b = match a, b with | A.Static , B.Sto B.Static | A.Auto , B.Sto B.Auto | A.Register , B.Sto B.Register | A.Extern , B.Sto B.Extern -> true | _, (B.NoSto | B.StoTypedef) -> false | _, (B.Sto (B.Register|B.Static|B.Auto|B.Extern)) -> false (*---------------------------------------------------------------------------*) let equal_metavarval valu valu' = match valu, valu' with | Ast_c.MetaIdVal (a,_), Ast_c.MetaIdVal (b,_) -> a =$= b | Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b | Ast_c.MetaLocalFuncVal a, Ast_c.MetaLocalFuncVal b -> (* do something more ? *) a =$= b (* al_expr before comparing !!! and accept when they match. * Note that here we have Astc._expression, so it is a match * modulo isomorphism (there is no metavariable involved here, * just isomorphisms). => TODO call isomorphism_c_c instead of * =*=. Maybe would be easier to transform ast_c in ast_cocci * and call the iso engine of julia. *) | Ast_c.MetaExprVal (a,_), Ast_c.MetaExprVal (b,_) -> Lib_parsing_c.al_expr a =*= Lib_parsing_c.al_expr b | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> Lib_parsing_c.al_arguments a =*= Lib_parsing_c.al_arguments b | Ast_c.MetaFmtVal a, Ast_c.MetaFmtVal b -> Lib_parsing_c.al_string_format a =*= Lib_parsing_c.al_string_format b | Ast_c.MetaFragListVal a, Ast_c.MetaFragListVal b -> Lib_parsing_c.al_string_fragments a =*= Lib_parsing_c.al_string_fragments b | Ast_c.MetaDeclVal a, Ast_c.MetaDeclVal b -> Lib_parsing_c.al_declaration a =*= Lib_parsing_c.al_declaration b | Ast_c.MetaFieldVal a, Ast_c.MetaFieldVal b -> Lib_parsing_c.al_field a =*= Lib_parsing_c.al_field b | Ast_c.MetaFieldListVal a, Ast_c.MetaFieldListVal b -> Lib_parsing_c.al_fields a =*= Lib_parsing_c.al_fields b | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> Lib_parsing_c.al_statement a =*= Lib_parsing_c.al_statement b | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> Lib_parsing_c.al_init a =*= Lib_parsing_c.al_init b | Ast_c.MetaInitListVal a, Ast_c.MetaInitListVal b -> Lib_parsing_c.al_inits a =*= Lib_parsing_c.al_inits b | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b -> (* old: Lib_parsing_c.al_type a =*= Lib_parsing_c.al_type b *) C_vs_c.eq_type a b | Ast_c.MetaListlenVal a, Ast_c.MetaListlenVal b -> a =|= b | Ast_c.MetaParamVal a, Ast_c.MetaParamVal b -> Lib_parsing_c.al_param a =*= Lib_parsing_c.al_param b | Ast_c.MetaParamListVal a, Ast_c.MetaParamListVal b -> Lib_parsing_c.al_params a =*= Lib_parsing_c.al_params b | Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) -> Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2 | Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 -> List.exists (function (fla,cea,posa1,posa2) -> List.exists (function (flb,ceb,posb1,posb2) -> fla =$= flb && cea =$= ceb && Ast_c.equal_posl posa1 posb1 && Ast_c.equal_posl posa2 posb2) l2) l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _ |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaInitListVal _ |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _ |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _ |B.MetaFmtVal _|B.MetaFragListVal _ ), _ -> raise (Impossible 16) (* probably only one argument needs to be stripped, because inherited metavariables containing expressions are stripped in advance. But don't know which one is which... *) let equal_inh_metavarval valu valu'= match valu, valu' with | Ast_c.MetaIdVal (a,_), Ast_c.MetaIdVal (b,_) -> a =$= b | Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b | Ast_c.MetaLocalFuncVal a, Ast_c.MetaLocalFuncVal b -> (* do something more ? *) a =$= b (* al_expr before comparing !!! and accept when they match. * Note that here we have Astc._expression, so it is a match * modulo isomorphism (there is no metavariable involved here, * just isomorphisms). => TODO call isomorphism_c_c instead of * =*=. Maybe would be easier to transform ast_c in ast_cocci * and call the iso engine of julia. *) | Ast_c.MetaExprVal (a,_), Ast_c.MetaExprVal (b,_) -> Lib_parsing_c.al_inh_expr a =*= Lib_parsing_c.al_inh_expr b | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b -> Lib_parsing_c.al_inh_arguments a =*= Lib_parsing_c.al_inh_arguments b | Ast_c.MetaFmtVal a, Ast_c.MetaFmtVal b -> Lib_parsing_c.al_inh_string_format a =*= Lib_parsing_c.al_inh_string_format b | Ast_c.MetaFragListVal a, Ast_c.MetaFragListVal b -> Lib_parsing_c.al_inh_string_fragments a =*= Lib_parsing_c.al_inh_string_fragments b | Ast_c.MetaDeclVal a, Ast_c.MetaDeclVal b -> Lib_parsing_c.al_inh_declaration a =*= Lib_parsing_c.al_inh_declaration b | Ast_c.MetaFieldVal a, Ast_c.MetaFieldVal b -> Lib_parsing_c.al_inh_field a =*= Lib_parsing_c.al_inh_field b | Ast_c.MetaFieldListVal a, Ast_c.MetaFieldListVal b -> Lib_parsing_c.al_inh_field_list a =*= Lib_parsing_c.al_inh_field_list b | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b -> Lib_parsing_c.al_inh_statement a =*= Lib_parsing_c.al_inh_statement b | Ast_c.MetaInitVal a, Ast_c.MetaInitVal b -> Lib_parsing_c.al_inh_init a =*= Lib_parsing_c.al_inh_init b | Ast_c.MetaInitListVal a, Ast_c.MetaInitListVal b -> Lib_parsing_c.al_inh_inits a =*= Lib_parsing_c.al_inh_inits b | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b -> (* old: Lib_parsing_c.al_inh_type a =*= Lib_parsing_c.al_inh_type b *) C_vs_c.eq_type a b | Ast_c.MetaListlenVal a, Ast_c.MetaListlenVal b -> a =|= b | Ast_c.MetaParamVal a, Ast_c.MetaParamVal b -> Lib_parsing_c.al_param a =*= Lib_parsing_c.al_param b | Ast_c.MetaParamListVal a, Ast_c.MetaParamListVal b -> Lib_parsing_c.al_params a =*= Lib_parsing_c.al_params b | Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) -> Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2 | Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 -> List.exists (function (fla,cea,posa1,posa2) -> List.exists (function (flb,ceb,posb1,posb2) -> fla =$= flb && cea =$= ceb && Ast_c.equal_posl posa1 posb1 && Ast_c.equal_posl posa2 posb2) l2) l1 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ |B.MetaDeclVal _ |B.MetaFieldVal _ |B.MetaFieldListVal _ |B.MetaTypeVal _ |B.MetaInitVal _ |B.MetaInitListVal _ |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _ |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _ |B.MetaFmtVal _|B.MetaFragListVal _ ), _ -> raise (Impossible 17) (*---------------------------------------------------------------------------*) (* could put in ast_c.ml, next to the split/unsplit_comma *) let split_signb_baseb_ii (baseb, ii) = let iis = ii +> List.map (fun info -> (B.str_of_info info), info) in match baseb, iis with | B.Void, ["void",i1] -> None, [i1] | B.FloatType (B.CFloat),["float",i1] -> None, [i1] | B.FloatType (B.CDouble),["double",i1] -> None, [i1] | B.FloatType (B.CLongDouble),["long",i1;"double",i2] -> None,[i1;i2] | B.IntType (B.CChar), ["char",i1] -> None, [i1] | B.IntType (B.Si (sign, base)), xs -> let (signed,rest) = match (sign,xs) with (_,[]) -> None,[] | (B.Signed,(("signed",i1)::rest)) -> (Some (B.Signed,i1),rest) | (B.Signed,rest) -> (None,rest) | (B.UnSigned,(("unsigned",i1)::rest)) -> (Some (B.UnSigned,i1),rest) | (B.UnSigned,rest) -> (* is this case possible? *) (None,rest) in (* The original code only allowed explicit signed and unsigned for char, while this code allows char by itself. Not sure that needs to be checked for here. If it does, then add a special case. *) let base_res = match (base,rest) with B.CInt, ["int",i1] -> [i1] | B.CInt, [] -> [] | B.CInt, ["",i1] -> (* no type is specified at all *) (match i1.B.pinfo with B.FakeTok(_,_) -> [] | _ -> error [i1] ("unrecognized signed int: "^ (String.concat " "(List.map fst iis)))) | B.CChar2, ["char",i2] -> [i2] | B.CShort, ["short",i1] -> [i1] | B.CShort, ["short",i1;"int",i2] -> [i1;i2] | B.CLong, ["long",i1] -> [i1] | B.CLong, ["long",i1;"int",i2] -> [i1;i2] | B.CLongLong, ["long",i1;"long",i2] -> [i1;i2] | B.CLongLong, ["long",i1;"long",i2;"int",i3] -> [i1;i2;i3] | _ -> error (List.map snd iis) ("strange type1, maybe because of weird order: "^ (String.concat " " (List.map fst iis))) in (signed,base_res) | B.SizeType, ["size_t",i1] -> None, [i1] | B.SSizeType, ["ssize_t",i1] -> None, [i1] | B.PtrDiffType, ["ptrdiff_t",i1] -> None, [i1] | _ -> error (List.map snd iis) ("strange type2, maybe because of weird order: "^ (String.concat " " (List.map fst iis))) (*---------------------------------------------------------------------------*) let rec unsplit_icomma xs = match xs with | [] -> [] | x::y::xs -> (match A.unwrap y with | A.IComma mcode -> (x, y)::unsplit_icomma xs | _ -> failwith "wrong ast_cocci in initializer" ) | _ -> failwith ("wrong ast_cocci in initializer, should have pair " ^ "number of Icomma") let resplit_initialiser ibs iicomma = match iicomma, ibs with | [], [] -> [] | [], _ -> failwith "should have a iicomma, do you generate fakeInfo in parser?" | iicommas, [] -> error iicommas "shouldn't have a iicomma" | [iicomma], x::xs -> let elems = List.map fst (x::xs) in let commas = List.map snd (x::xs) +> List.flatten in let commas = commas @ [iicomma] in zip elems commas | _ -> raise (Impossible 18) let rec split_icomma xs = match xs with | [] -> [] | (x,y)::xs -> x::y::split_icomma xs let rec unsplit_initialiser ibs_unsplit = match ibs_unsplit with | [] -> [], [] (* empty iicomma *) | (x, commax)::xs -> let (xs, lastcomma) = unsplit_initialiser_bis commax xs in (x, [])::xs, lastcomma and unsplit_initialiser_bis comma_before = function | [] -> [], [comma_before] | (x, commax)::xs -> let (xs, lastcomma) = unsplit_initialiser_bis commax xs in (x, [comma_before])::xs, lastcomma (*---------------------------------------------------------------------------*) (* coupling: same in type_annotater_c.ml *) let structdef_to_struct_name ty = match ty with | qu, (B.StructUnion (su, sopt, fields), iis) -> (match sopt,iis with | Some s , [i1;i2;i3;i4] -> qu, (B.StructUnionName (su, s), [i1;i2]) | None, _ -> ty | x -> raise (Impossible 19) ) | _ -> raise (Impossible 20) (*---------------------------------------------------------------------------*) let one_initialisation_to_affectation x = let ({B.v_namei = var; B.v_type = returnType; B.v_type_bis = tybis; B.v_storage = storage; B.v_local = local}, iisep) = x in match var with | Some (name, iniopt) -> (match iniopt with | B.ValInit (iini, (B.InitExpr e, ii_empty2)) -> let local = match local with Ast_c.NotLocalDecl -> Ast_c.NotLocalVar | Ast_c.LocalDecl -> (match Ast_c.info_of_type returnType with None -> failwith "no returnType info" | Some ii -> Ast_c.LocalVar ii) in let typexp = (* old: Lib_parsing_c.al_type returnType * but this type has not the typename completed so * instead try to use tybis *) match !tybis with | Some ty_with_typename_completed -> ty_with_typename_completed | None -> raise (Impossible 21) in let typ = ref (Some (typexp,local), Ast_c.NotTest) in let ident = name in let idexpr = Ast_c.mk_e_bis (B.Ident ident) typ Ast_c.noii in let assign = Ast_c.mk_e (B.Assignment (idexpr,B.SimpleAssign, e)) [iini] in Some assign | _ -> None) | _ -> None let initialisation_to_affectation decl = match decl with | B.MacroDecl _ -> F.Decl decl | B.MacroDeclInit _ -> F.Decl decl (* not sure... *) | B.DeclList (xs, iis) -> (* todo?: should not do that if the variable is an array cos * will have x[] = , mais de toute facon ca sera pas un InitExp *) let possible_assignment = List.fold_left (function prev -> function x -> match prev,one_initialisation_to_affectation x with _,None -> prev | None,Some x -> Some x | Some prev,Some x -> (* [] is clearly an invalid ii value for a sequence. hope that no one looks at it, since nothing will match the sequence. Fortunately, SmPL doesn't support , expressions. *) Some (Ast_c.mk_e (Ast_c.Sequence (prev, x)) [])) None xs in match possible_assignment with Some x -> F.DefineExpr x | None -> F.Decl decl (*****************************************************************************) (* Functor parameter combinators *) (*****************************************************************************) (* monad like stuff * src: papers on parser combinators in haskell (cf a pearl by meijer in ICFP) * * version0: was not tagging the SP, so just tag the C * val (>>=): * (tin -> 'c tout) -> ('c -> (tin -> 'b tout)) -> (tin -> 'b tout) * val return : 'b -> tin -> 'b tout * val fail : tin -> 'b tout * * version1: now also tag the SP so return a ('a * 'b) *) type mode = PatternMode | TransformMode module type PARAM = sig type tin type 'x tout type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout val mode : mode val (>>=): (tin -> ('a * 'b) tout) -> ('a -> 'b -> (tin -> ('c * 'd) tout)) -> (tin -> ('c * 'd) tout) val return : ('a * 'b) -> tin -> ('a *'b) tout val fail : tin -> ('a * 'b) tout val (>||>) : (tin -> 'x tout) -> (tin -> 'x tout) -> (tin -> 'x tout) val (>|+|>) : (tin -> 'x tout) -> (tin -> 'x tout) -> (tin -> 'x tout) val (>&&>) : (tin -> bool) -> (tin -> 'x tout) -> (tin -> 'x tout) val tokenf : ('a A.mcode, B.info) matcher val tokenf_mck : (A.mcodekind, B.info) matcher val distrf_e : (A.meta_name A.mcode, B.expression) matcher val distrf_args : (A.meta_name A.mcode, (Ast_c.argument, Ast_c.il) either list) matcher val distrf_type : (A.meta_name A.mcode, Ast_c.fullType) matcher val distrf_params : (A.meta_name A.mcode, (Ast_c.parameterType, Ast_c.il) either list) matcher val distrf_param : (A.meta_name A.mcode, Ast_c.parameterType) matcher val distrf_ini : (A.meta_name A.mcode, Ast_c.initialiser) matcher val distrf_inis : (A.meta_name A.mcode, (Ast_c.initialiser, Ast_c.il) either list) matcher val distrf_decl : (A.meta_name A.mcode, Ast_c.declaration) matcher val distrf_field : (A.meta_name A.mcode, Ast_c.field) matcher val distrf_node : (A.meta_name A.mcode, Control_flow_c.node) matcher val distrf_fragments : (A.meta_name A.mcode, (Ast_c.string_fragment, Ast_c.il) either list) matcher val distrf_format : (A.meta_name A.mcode, Ast_c.string_format) matcher val distrf_define_params : (A.meta_name A.mcode, (string Ast_c.wrap, Ast_c.il) either list) matcher val distrf_pragmainfo : (A.meta_name A.mcode, Ast_c.pragmainfo) matcher val distrf_ident_list : (A.meta_name A.mcode, (Ast_c.name, Ast_c.il) either list) matcher val distrf_enum_fields : (A.meta_name A.mcode, (B.oneEnumType, B.il) either list) matcher val distrf_struct_fields : (A.meta_name A.mcode, B.field list) matcher val distrf_cst : (A.meta_name A.mcode, (B.constant, string) either B.wrap) matcher val cocciExp : (A.expression, B.expression) matcher -> (A.expression, F.node) matcher val cocciExpExp : A.mcodekind -> (A.expression, B.expression) matcher -> (A.expression, B.expression) matcher val cocciTy : (A.fullType, B.fullType) matcher -> (A.fullType, F.node) matcher val cocciInit : (A.initialiser, B.initialiser) matcher -> (A.initialiser, F.node) matcher val envf : A.keep_binding -> A.inherited -> A.meta_name A.mcode * Ast_c.metavar_binding_kind * (unit -> Common.filename * string * Ast_c.posl * Ast_c.posl) -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val check_idconstraint : ('a -> 'b -> bool) -> 'a -> 'b -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val check_constraints_ne : ('a, 'b) matcher -> 'a list -> 'b -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val all_bound : A.meta_name list -> (tin -> bool) val optional_storage_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val optional_qualifier_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val value_format_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val optional_declarer_semicolon_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) end (*****************************************************************************) (* Functor code, "Cocci vs C" *) (*****************************************************************************) module COCCI_VS_C = functor (X : PARAM) -> struct type ('a, 'b) matcher = 'a -> 'b -> X.tin -> ('a * 'b) X.tout let (>>=) = X.(>>=) let return = X.return let fail = X.fail let (>||>) = X.(>||>) let (>|+|>) = X.(>|+|>) let (>&&>) = X.(>&&>) let tokenf = X.tokenf (* should be raise Impossible when called from transformation.ml *) let fail2 () = match X.mode with | PatternMode -> fail | TransformMode -> raise (Impossible 22) let (option: ('a,'b) matcher -> ('a option,'b option) matcher)= fun f t1 t2 -> match (t1,t2) with | (Some t1, Some t2) -> f t1 t2 >>= (fun t1 t2 -> return (Some t1, Some t2) ) | (None, None) -> return (None, None) | _ -> fail (* Dots are sometimes used as metavariables, since like metavariables they can match other things. But they no longer have the same type. Perhaps these functions could be avoided by introducing an appropriate level of polymorphism, but I don't know how to declare polymorphism across functors *) let dots2metavar (_,info,mcodekind,pos) = (("","..."),info,mcodekind,pos) let metavar2dots (_,info,mcodekind,pos) = ("...",info,mcodekind,pos) let metavar2ndots (_,info,mcodekind,pos) = ("<+...",info,mcodekind,pos) let satisfies_regexpconstraint c id : bool = match c with A.IdRegExp (_,recompiled) -> Regexp.string_match recompiled id | A.IdNotRegExp (_,recompiled) -> not (Regexp.string_match recompiled id) let satisfies_iconstraint c id : bool = not (List.mem id c) let satisfies_econstraint c exp : bool = let warning s = pr2_once ("WARNING: "^s); false in match Ast_c.unwrap_expr exp with Ast_c.Ident (name) -> (match name with Ast_c.RegularName rname -> satisfies_regexpconstraint c (Ast_c.unwrap_st rname) | Ast_c.CppConcatenatedName _ -> warning "Unable to apply a constraint on a CppConcatenatedName identifier!" | Ast_c.CppVariadicName _ -> warning "Unable to apply a constraint on a CppVariadicName identifier!" | Ast_c.CppIdentBuilder _ -> warning "Unable to apply a constraint on a CppIdentBuilder identifier!") | Ast_c.Constant cst -> (match cst with | Ast_c.String (str, _) -> satisfies_regexpconstraint c str | Ast_c.MultiString strlist -> warning "Unable to apply a constraint on a multistring constant!" | Ast_c.Char (char , _) -> satisfies_regexpconstraint c char | Ast_c.Int (int , _) -> satisfies_regexpconstraint c int | Ast_c.Float (float, _) -> satisfies_regexpconstraint c float | Ast_c.DecimalConst (d, n, p) -> warning "Unable to apply a constraint on a decimal constant!") | Ast_c.StringConstant (cst,orig,w) -> satisfies_regexpconstraint c orig | _ -> warning "Unable to apply a constraint on an expression!" (* ------------------------------------------------------------------------- *) (* This has to be up here to allow adequate polymorphism *) let list_matcher match_dots rebuild_dots match_comma rebuild_comma match_metalist rebuild_metalist mktermval special_cases element distrf split_comma unsplit_comma get_iis lenfilter = fun eas ebs -> let rec loop = function [], [] -> return ([], []) | [], eb::ebs -> fail | ea::eas, ebs -> X.all_bound (A.get_inherited ea) >&&> let try_matches = (match match_dots ea, ebs with Some (mcode, optexpr), ys -> (* todo: if optexpr, then a WHEN and so may have to filter yys *) if optexpr <> None then failwith "not handling when in a list"; (* '...' can take more or less the beginnings of the arguments *) let startendxs = (* if eas is empty there is only one possible match. the same if eas is just a comma *) match eas with [] -> [(ys,[])] | [c] when not(ys=[]) && (match match_comma c with Some _ -> true | None -> false) -> let r = List.rev ys in [(List.rev(List.tl r),[List.hd r])] | _ -> Common.zip (Common.inits ys) (Common.tails ys) in Some (startendxs +> List.fold_left (fun acc (startxs, endxs) -> acc >||> ( (* allow '...', and maybe its associated ',' to match nothing. * for the associated ',' see below how we handle the EComma * to match nothing. *) (if null startxs then if mcode_contain_plus (mcodekind mcode) then fail (*failwith "I have no token that I could accroche myself on"*) else return (dots2metavar mcode, []) else (* subtil: we don't want the '...' to match until the * comma. cf -test pb_params_iso. We would get at * "already tagged" error. * this is because both f (... x, ...) and f (..., x, ...) * would match a f(x,3) with our "optional-comma" strategy. *) (match Common.last startxs with | Right _ -> fail | Left _ -> distrf (dots2metavar mcode) startxs)) >>= (fun mcode startxs -> let mcode = metavar2dots mcode in loop (eas, endxs) >>= (fun eas endxs -> return ( (rebuild_dots (mcode, optexpr) +> A.rewrap ea) ::eas, startxs ++ endxs ))) ) ) fail) | None,_ -> None) +++ (match match_comma ea, ebs with | Some ia1, Right ii::ebs -> Some (let ib1 = tuple_of_list1 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> loop (eas, ebs) >>= (fun eas ebs -> return ( (rebuild_comma ia1 +> A.rewrap ea)::eas, (Right [ib1])::ebs ) ))) | Some ia1, ebs -> (* allow ',' to matching nothing. optional comma trick *) Some (if mcode_contain_plus (mcodekind ia1) then fail else loop (eas, ebs)) | None,_ -> None) +++ (match match_metalist ea, ebs with Some (ida,leninfo,keep,inherited,extra), ys -> let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in Some (startendxs +> List.fold_left (fun acc (startxs, endxs) -> acc >||> ( let ok = if null startxs then if mcode_contain_plus (mcodekind ida) then false (* failwith "no token that I could accroche myself on" *) else true else (match Common.last startxs with | Right _ -> false | Left _ -> true) in if not ok then fail else let startxs' = unsplit_comma startxs in (match lenfilter startxs' with None -> (function _ -> fail) | Some infos -> let len = List.length infos in (match leninfo with | A.MetaListLen (lenname,lenkeep,leninherited) -> let max_min _ = failwith "no pos" in X.envf lenkeep leninherited (lenname, Ast_c.MetaListlenVal (len), max_min) | A.CstListLen n -> if len = n then (function f -> f()) else (function f -> fail) | A.AnyListLen -> function f -> f())) (fun () -> let max_min _ = Lib_parsing_c.lin_col_by_pos (get_iis startxs) in (match extra with Some extra -> extra startxs' max_min (fun _ -> return ((),())) | None -> return ((),())) >>= (fun _ _ -> X.envf keep inherited (ida, mktermval startxs', max_min) (fun () -> if null startxs then return (ida, []) else distrf ida (split_comma startxs')) >>= (fun ida startxs -> loop (eas, endxs) >>= (fun eas endxs -> return ( (rebuild_metalist ea (ida,leninfo,keep,inherited)) +> A.rewrap ea::eas, startxs ++ endxs ))) ) ) )) fail) | None,_ -> None) +++ special_cases ea eas ebs in match try_matches with Some res -> res | None -> (match ebs with | (Left eb)::ebs -> element ea eb >>= (fun ea eb -> loop (eas, ebs) >>= (fun eas ebs -> return (ea::eas, Left eb::ebs))) | (Right y)::ys -> raise (Impossible 23) | [] -> fail) in loop (eas,ebs) (*---------------------------------------------------------------------------*) (* toc: * - expression * - ident * - arguments * - parameters * - declaration * - initialisers * - type * - node *) (*---------------------------------------------------------------------------*) let rec (expression: (A.expression, Ast_c.expression) matcher) = fun ea eb -> if A.get_test_exp ea && not (Ast_c.is_test eb) then fail else X.all_bound (A.get_inherited ea) >&&> let wa x = A.rewrap ea x in match A.unwrap ea, eb with (* general case: a MetaExpr can match everything *) | A.MetaExpr (ida,constraints,keep,opttypa,form,inherited), (((expr, opttypb), ii) as expb) -> (* old: before have a MetaConst. Now we factorize and use 'form' to * differentiate between different cases *) let rec matches_id = function B.Ident(name) -> true | B.Cast(ty,e) -> matches_id (B.unwrap_expr e) | _ -> false in let form_ok = match (form,expr) with (A.ANY,_) -> true | (A.CONST,e) -> let rec matches = function B.Constant(c) -> true | B.Ident (nameidb) -> let s = Ast_c.str_of_name nameidb in if s =~ "^[A-Z_][A-Z_0-9]*$" then begin pr2_once ("warning: " ^ s ^ " treated as a constant"); true end else false | B.Cast(ty,e) -> matches (B.unwrap_expr e) | B.Unary(e,B.UnMinus) -> matches (B.unwrap_expr e) | B.SizeOfExpr(exp) -> true | B.SizeOfType(ty) -> true | _ -> false in matches e | (A.LocalID,e) -> (matches_id e) && (match !opttypb with (Some (_,Ast_c.LocalVar _),_) -> true | _ -> false) | (A.ID,e) -> matches_id e in if form_ok then (let (opttypb,_testb) = !opttypb in match opttypa, opttypb with | None, _ -> return ((),()) | Some _, None -> pr2_once ("Missing type information. Certainly a pb in " ^ "annotate_typer.ml"); fail | Some tas, Some tb -> tas +> List.fold_left (fun acc ta -> acc >|+|> compatible_type ta tb) fail ) >>= (fun () () -> let meta_expr_val l x = Ast_c.MetaExprVal(x,l) in match constraints with Ast_cocci.NoConstraint -> return (meta_expr_val [],()) | Ast_cocci.NotIdCstrt cstrt -> X.check_idconstraint satisfies_econstraint cstrt eb (fun () -> return (meta_expr_val [],())) | Ast_cocci.NotExpCstrt cstrts -> X.check_constraints_ne expression cstrts eb (fun () -> return (meta_expr_val [],())) | Ast_cocci.SubExpCstrt cstrts -> return (meta_expr_val cstrts,())) >>= (fun wrapper () -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in X.envf keep inherited (ida, wrapper expb, max_min) (fun () -> X.distrf_e ida expb >>= (fun ida expb -> return ( A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+> A.rewrap ea, expb )) )) else fail (* old: * | A.MetaExpr(ida,false,opttypa,_inherited), expb -> * D.distribute_mck (mcodekind ida) D.distribute_mck_e expb binding * * but bug! because if have not tagged SP, then transform without doing * any checks. Hopefully now have tagged SP technique. *) | A.AsExpr(exp,asexp), expb -> expression exp expb >>= (fun exp expb -> expression asexp expb >>= (fun asexp expb -> return( ((A.AsExpr(exp,asexp)) +> wa, expb)))) (* old: * | A.Edots _, _ -> raise Impossible. * * In fact now can also have the Edots inside normal expression, not * just in arg lists. in 'x[...];' less: in if(<... x ... y ...>) *) | A.Edots (mcode, None), expb -> X.distrf_e (dots2metavar mcode) expb >>= (fun mcode expb -> return ( A.Edots (metavar2dots mcode, None) +> A.rewrap ea , expb )) | A.Edots (_, Some expr), _ -> failwith "not handling when on Edots" | A.Ident ida, ((B.Ident (nameidb), typ),noii) -> assert (null noii); ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> return ( ((A.Ident ida)) +> wa, ((B.Ident (nameidb), typ),Ast_c.noii) )) | A.MetaErr _, _ -> failwith "not handling MetaErr" (* todo?: handle some isomorphisms in int/float ? can have different * format : 1l can match a 1. * * todo: normally string can contain some metavar too, so should * recurse on the string *) | A.Constant (ia1), ((B.Constant (ib) , typ),ii) -> (* for everything except the String case where can have multi elems *) let do1 () = let ib1 = tuple_of_list1 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( ((A.Constant ia1)) +> wa, ((B.Constant (ib), typ),[ib1]) )) in (match term ia1, ib with | A.Int x, B.Int (y,_) -> X.value_format_flag (fun use_value_equivalence -> if use_value_equivalence then if equal_c_int x y then do1() else fail else if x =$= y then do1() else fail ) | A.Char x, B.Char (y,_) when x =$= y (* todo: use kind ? *) -> do1() | A.Float x, B.Float (y,_) when x =$= y (* todo: use floatType ? *) -> do1() | A.DecimalConst (x,lx,px),B.DecimalConst (y,ly,py) when x =$= y && lx =$= ly && px =$= py(*lx etc perhaps implied by x=y*) -> do1() | A.String sa, B.String (sb,_kind) when sa =$= sb -> (match ii with | [ib1] -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( ((A.Constant ia1)) +> wa, ((B.Constant (ib), typ),[ib1]) )) | _ -> fail (* multi string, not handled *) ) | _, B.MultiString _ -> (* todo cocci? *) fail | _, (B.String _ | B.Float _ | B.Char _ | B.Int _ | B.DecimalConst _) -> fail ) | A.StringConstant (lq,frags1,rq), ((B.StringConstant (frags2,os,w), typ), ii) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf lq ib1 >>= (fun lq ib1 -> tokenf rq ib2 >>= (fun rq ib2 -> string_fragments (A.undots frags1) (B.split_nocomma frags2) >>= (fun frags1undots frags2splitted -> let frags1 = redots frags1 frags1undots in let frags2 = Ast_c.unsplit_nocomma frags2splitted in return ( ((A.StringConstant (lq,frags1,rq)) +> wa, ((B.StringConstant (frags2,os,w), typ), [ib1; ib2])))))) | A.FunCall (ea, ia1, eas, ia2), ((B.FunCall (eb, ebs), typ),ii) -> (* todo: do special case to allow IdMetaFunc, cos doing the * recursive call will be too late, match_ident will not have the * info whether it was a function. todo: but how detect when do * x.field = f; how know that f is a Func ? By having computed * some information before the matching! * * Allow match with FunCall containing types. Now ast_cocci allow * type in parameter, and morover ast_cocci allow f(...) and those * ... could match type. *) let (ib1, ib2) = tuple_of_list2 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( ((A.FunCall (ea, ia1, eas, ia2)) +> wa, ((B.FunCall (eb, ebs),typ), [ib1;ib2]) )))))) | A.Assignment (ea1, opa, ea2, simple), ((B.Assignment (eb1, opb, eb2), typ),ii) -> let (opbi) = tuple_of_list1 ii in if equal_assignOp (term opa) opb then expression ea1 eb1 >>= (fun ea1 eb1 -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> return ( (A.Assignment (ea1, opa, ea2, simple)) +> wa, ((B.Assignment (eb1, opb, eb2), typ), [opbi]) )))) else fail | A.Sequence (ea1, opa, ea2), ((B.Sequence (eb1, eb2), typ),ii) -> let (opbi) = tuple_of_list1 ii in expression ea1 eb1 >>= (fun ea1 eb1 -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> return ( (A.Sequence (ea1, opa, ea2)) +> wa, ((B.Sequence (eb1, eb2), typ), [opbi]) )))) | A.CondExpr(ea1,ia1,ea2opt,ia2,ea3),((B.CondExpr(eb1,eb2opt,eb3),typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in expression ea1 eb1 >>= (fun ea1 eb1 -> option expression ea2opt eb2opt >>= (fun ea2opt eb2opt -> expression ea3 eb3 >>= (fun ea3 eb3 -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( ((A.CondExpr(ea1,ia1,ea2opt,ia2,ea3))) +> wa, ((B.CondExpr (eb1, eb2opt, eb3),typ), [ib1;ib2]) )))))) (* todo?: handle some isomorphisms here ? *) | A.Postfix (ea, opa), ((B.Postfix (eb, opb), typ),ii) -> let opbi = tuple_of_list1 ii in if equal_fixOp (term opa) opb then expression ea eb >>= (fun ea eb -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Postfix (ea, opa))) +> wa, ((B.Postfix (eb, opb), typ),[opbi]) ))) else fail | A.Infix (ea, opa), ((B.Infix (eb, opb), typ),ii) -> let opbi = tuple_of_list1 ii in if equal_fixOp (term opa) opb then expression ea eb >>= (fun ea eb -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Infix (ea, opa))) +> wa, ((B.Infix (eb, opb), typ),[opbi]) ))) else fail | A.Unary (ea, opa), ((B.Unary (eb, opb), typ),ii) -> let opbi = tuple_of_list1 ii in if equal_unaryOp (term opa) opb then expression ea eb >>= (fun ea eb -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Unary (ea, opa))) +> wa, ((B.Unary (eb, opb), typ),[opbi]) ))) else fail | A.Binary (ea1, opa, ea2), ((B.Binary (eb1, opb, eb2), typ),ii) -> let opbi = tuple_of_list1 ii in if equal_binaryOp (term opa) opb then expression ea1 eb1 >>= (fun ea1 eb1 -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Binary (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] ))))) else fail | A.Nested (ea1, opa, ea2), eb -> let rec loop eb = expression ea1 eb >|+|> (match eb with ((B.Binary (eb1, opb, eb2), typ),ii) when equal_binaryOp (term opa) opb -> let opbi = tuple_of_list1 ii in let left_to_right = (expression ea1 eb1 >>= (fun ea1 eb1 -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in let right_to_left = (expression ea2 eb1 >>= (fun ea2 eb1 -> expression ea1 eb2 >>= (fun ea1 eb2 -> tokenf opa opbi >>= (fun opa opbi -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in let in_left = (expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> (* be last, to be sure the rest is marked *) loop eb1 >>= (fun ea1 eb1 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in let in_right = (expression ea2 eb1 >>= (fun ea2 eb1 -> tokenf opa opbi >>= (fun opa opbi -> (* be last, to be sure the rest is marked *) loop eb2 >>= (fun ea1 eb2 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[opbi] )))))) in left_to_right >|+|> right_to_left >|+|> in_left >|+|> in_right | _ -> fail) in loop eb (* todo?: handle some isomorphisms here ? (with pointers = Unary Deref) *) | A.ArrayAccess (ea1, ia1, ea2, ia2),((B.ArrayAccess (eb1, eb2), typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in expression ea1 eb1 >>= (fun ea1 eb1 -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( ((A.ArrayAccess (ea1, ia1, ea2, ia2))) +> wa, ((B.ArrayAccess (eb1, eb2),typ), [ib1;ib2]) ))))) (* todo?: handle some isomorphisms here ? *) | A.RecordAccess (ea, ia1, ida), ((B.RecordAccess (eb, idb), typ),ii) -> let (ib1) = tuple_of_list1 ii in ident_cpp DontKnow ida idb >>= (fun ida idb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> expression ea eb >>= (fun ea eb -> return ( ((A.RecordAccess (ea, ia1, ida))) +> wa, ((B.RecordAccess (eb, idb), typ), [ib1]) )))) | A.RecordPtAccess (ea,ia1,ida),((B.RecordPtAccess (eb, idb), typ), ii) -> let (ib1) = tuple_of_list1 ii in ident_cpp DontKnow ida idb >>= (fun ida idb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> expression ea eb >>= (fun ea eb -> return ( ((A.RecordPtAccess (ea, ia1, ida))) +> wa, ((B.RecordPtAccess (eb, idb), typ), [ib1]) )))) (* todo?: handle some isomorphisms here ? * todo?: do some iso-by-absence on cast ? * by trying | ea, B.Case (typb, eb) -> match_e_e ea eb ? *) | A.Cast (ia1, typa, ia2, ea), ((B.Cast (typb, eb), typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in fullType typa typb >>= (fun typa typb -> expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( ((A.Cast (ia1, typa, ia2, ea))) +> wa, ((B.Cast (typb, eb),typ),[ib1;ib2]) ))))) | A.SizeOfExpr (ia1, ea), ((B.SizeOfExpr (eb), typ),ii) -> let ib1 = tuple_of_list1 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( ((A.SizeOfExpr (ia1, ea))) +> wa, ((B.SizeOfExpr (eb), typ),[ib1]) ))) | A.SizeOfType (ia1, ia2, typa, ia3), ((B.SizeOfType typb, typ),ii) -> let (ib1,ib2,ib3) = tuple_of_list3 ii in fullType typa typb >>= (fun typa typb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> return ( ((A.SizeOfType (ia1, ia2, typa, ia3))) +> wa, ((B.SizeOfType (typb),typ),[ib1;ib2;ib3]) ))))) (* todo? iso ? allow all the combinations ? *) | A.Paren (ia1, ea, ia2), ((B.ParenExpr (eb), typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( ((A.Paren (ia1, ea, ia2))) +> wa, ((B.ParenExpr (eb), typ), [ib1;ib2]) )))) | A.NestExpr(starter,exps,ender,None,true), eb -> (match A.unwrap exps with A.DOTS [exp] -> (* if minus and trafo do nothing *) X.cocciExpExp (A.get_mcodekind starter) expression exp eb >>= (fun exp eb -> (* minus and trafo will do something here *) X.distrf_e (dots2metavar starter) eb >>= (fun mcode eb -> return ( (A.NestExpr (metavar2ndots mcode, A.rewrap exps (A.DOTS [exp]),ender,None,true)) +> wa, eb ) )) | _ -> failwith "for nestexpr, only handling the case with dots and only one exp") | A.NestExpr _, _ -> failwith "only handling multi and no when code in a nest expr" (* only in arg lists or in define body *) | A.TypeExp _, _ -> fail | A.Constructor (ia1, typa, ia2, ia), ((B.Constructor (typb, ib), typ),ii) -> let (ib1, ib2) = tuple_of_list2 ii in fullType typa typb >>= (fun typa typb -> initialiser ia ib >>= (fun ia ib -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( ((A.Constructor (ia1, typa, ia2, ia))) +> wa, ((B.Constructor (typb, ib),typ),[ib1;ib2]) ))))) (* only in arg lists *) | A.MetaExprList _, _ | A.EComma _, _ | A.Ecircles _, _ | A.Estars _, _ -> raise (Impossible 24) | A.DisjExpr eas, eb -> eas +> List.fold_left (fun acc ea -> acc >|+|> (expression ea eb)) fail | A.UniqueExp _,_ | A.OptExp _,_ -> failwith "not handling Opt/Unique/Multi on expr" (* Because of Exp cant put a raise Impossible; have to put a fail *) (* have not a counter part in coccinelle, for the moment *) | _, ((B.Sequence _,_),_) | _, ((B.StatementExpr _,_),_) | _, ((B.New _,_),_) | _, ((B.Delete _,_),_) -> fail | _, (((B.Cast (_, _)|B.ParenExpr _|B.SizeOfType _|B.SizeOfExpr _| B.Constructor (_, _)| B.RecordPtAccess (_, _)| B.RecordAccess (_, _)|B.ArrayAccess (_, _)| B.Binary (_, _, _)|B.Unary (_, _)| B.Infix (_, _)|B.Postfix (_, _)| B.Assignment (_, _, _)|B.CondExpr (_, _, _)| B.FunCall (_, _)|B.Constant _|B.StringConstant _|B.Ident _), _),_) -> fail and string_fragments eas ebs = let match_dots ea = match A.unwrap ea with A.Strdots(mcode) -> Some (mcode, None) | _ -> None in let build_dots (mcode,_) = A.Strdots(mcode) in let match_comma ea = None in let build_comma _ = failwith "no commas" in let match_metalist ea = match A.unwrap ea with A.MetaFormatList(pct,ida,leninfo,keep,inherited) -> Some(ida,leninfo,keep,inherited,None) | _ -> None in let build_metalist ea (ida,leninfo,keep,inherited) = match A.unwrap ea with A.MetaFormatList(pct,_,_,_,_) -> A.MetaFormatList(pct,ida,leninfo,keep,inherited) | _ -> failwith "not possible" in let mktermval v = Ast_c.MetaFragListVal v in let list_filter_function l = Some (List.filter (function B.FormatFragment _,_ -> true | _ -> false) l) in let special_cases ea eas ebs = None in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases string_fragment X.distrf_fragments B.split_nocomma B.unsplit_nocomma Lib_parsing_c.ii_of_fragments list_filter_function eas ebs and string_fragment ea (eb,ii) = X.all_bound (A.get_inherited ea) >&&> let wa x = A.rewrap ea x in match A.unwrap ea,eb with A.ConstantFragment(str1), B.ConstantFragment(str2) when A.unwrap_mcode str1 =$= str2 -> let ib1 = tuple_of_list1 ii in tokenf str1 ib1 >>= (fun str1 ib1 -> return (A.ConstantFragment(str1) +> wa, (B.ConstantFragment(str2),[ib1]))) | A.FormatFragment(pct1,fmt1), B.FormatFragment(fmt2) -> let ib1 = tuple_of_list1 ii in tokenf pct1 ib1 >>= (fun pct1 ib1 -> string_format fmt1 fmt2 >>= (fun fmt1 fmt2 -> return (A.FormatFragment(pct1,fmt1) +> wa, (B.FormatFragment(fmt2), [ib1])))) | A.Strdots dots, eb -> failwith "not possible" | A.MetaFormatList(pct1,name1,lenname1,_,_), eb -> failwith "not possible" | _,_ -> fail and string_format ea eb = let check_constraints constraints idb = match constraints with A.IdNoConstraint -> return ((),()) | A.IdRegExpConstraint re -> X.check_idconstraint satisfies_regexpconstraint re idb (fun () -> return ((),())) | _ -> failwith "no nonid constraint for string format" in X.all_bound (A.get_inherited ea) >&&> let wa x = A.rewrap ea x in match A.unwrap ea,eb with A.ConstantFormat(str1), (B.ConstantFormat(str2),ii) -> let ib1 = tuple_of_list1 ii in tokenf str1 ib1 >>= (fun str1 ib1 -> return (A.ConstantFormat(str1) +> wa, (B.ConstantFormat(str2),[ib1]))) | A.MetaFormat(ida,constraints,keep,inherited),(B.ConstantFormat(str2),ii) -> check_constraints constraints str2 >>= (fun () () -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_format eb) in X.envf keep inherited (ida,Ast_c.MetaFmtVal eb,max_min) (fun () -> X.distrf_format ida eb ) >>= (fun ida eb -> return (A.MetaFormat(ida,constraints,keep,inherited) +> wa,eb))) (* ------------------------------------------------------------------------- *) and (ident_cpp: info_ident -> (A.ident, B.name) matcher) = fun infoidb ida idb -> match idb with | B.RegularName (s, iis) -> let iis = tuple_of_list1 iis in ident infoidb ida (s, iis) >>= (fun ida (s,iis) -> return ( ida, (B.RegularName (s, [iis])) )) | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _ -> (* This should be moved to the Id case of ident. Metavariables should be allowed to be bound to such variables. But doing so would require implementing an appropriate distr function *) fail and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) = fun infoidb ida ((idb, iib) as ib) -> (* (idb, iib) as ib *) let check_constraints constraints idb = let meta_id_val l x = Ast_c.MetaIdVal(x,l) in match constraints with A.IdNoConstraint -> return (meta_id_val [],()) | A.IdNegIdSet (str,meta) -> X.check_idconstraint satisfies_iconstraint str idb (fun () -> return (meta_id_val meta,())) | A.IdRegExpConstraint re -> X.check_idconstraint satisfies_regexpconstraint re idb (fun () -> return (meta_id_val [],())) in X.all_bound (A.get_inherited ida) >&&> match A.unwrap ida with | A.Id sa -> if (term sa) =$= idb then tokenf sa iib >>= (fun sa iib -> return ( ((A.Id sa)) +> A.rewrap ida, (idb, iib) )) else fail | A.MetaId(mida,constraints,keep,inherited) -> check_constraints constraints idb >>= (fun wrapper () -> let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in (* use drop_pos for ids so that the pos is not added a second time in the call to tokenf *) X.envf keep inherited (A.drop_pos mida, wrapper idb, max_min) (fun () -> tokenf mida iib >>= (fun mida iib -> return ( ((A.MetaId (mida, constraints, keep, inherited)) +> A.rewrap ida, (idb, iib) ))) )) | A.MetaFunc(mida,constraints,keep,inherited) -> let is_function _ = check_constraints constraints idb >>= (fun wrapper () -> let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in X.envf keep inherited (A.drop_pos mida,Ast_c.MetaFuncVal idb,max_min) (fun () -> tokenf mida iib >>= (fun mida iib -> return ( ((A.MetaFunc(mida,constraints,keep,inherited)))+>A.rewrap ida, (idb, iib) )) )) in (match infoidb with | LocalFunction | Function -> is_function() | DontKnow -> failwith "MetaFunc, need more semantic info about id" (* the following implementation could possibly be useful, if one follows the convention that a macro is always in capital letters and that a macro is not a function. (if idb =~ "^[A-Z_][A-Z_0-9]*$" then fail else is_function())*) ) | A.MetaLocalFunc(mida,constraints,keep,inherited) -> (match infoidb with | LocalFunction -> check_constraints constraints idb >>= (fun wrapper () -> let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in X.envf keep inherited (A.drop_pos mida,Ast_c.MetaLocalFuncVal idb, max_min) (fun () -> tokenf mida iib >>= (fun mida iib -> return ( ((A.MetaLocalFunc(mida,constraints,keep,inherited))) +> A.rewrap ida, (idb, iib) )) )) | Function -> fail | DontKnow -> failwith "MetaLocalFunc, need more semantic info about id" ) | A.AsIdent(id,asid) -> ident infoidb id ib >>= (fun id ib -> ident infoidb asid ib >>= (fun asid ib -> return( ((A.AsIdent(id,asid)) +> A.rewrap ida, ib)))) (* not clear why disj things are needed, after disjdistr? *) | A.DisjId ias -> ias +> List.fold_left (fun acc ia -> acc >|+|> (ident infoidb ia ib)) fail | A.OptIdent _ | A.UniqueIdent _ -> failwith "not handling Opt/Unique for ident" (* ------------------------------------------------------------------------- *) and (arguments: sequence -> (A.expression list, Ast_c.argument Ast_c.wrap2 list) matcher) = fun seqstyle eas ebs -> match seqstyle with | Unordered -> failwith "not handling ooo" | Ordered -> arguments_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> return (eas, (Ast_c.unsplit_comma ebs_splitted)) ) (* because '...' can match nothing, need to take care when have * ', ...' or '...,' as in f(..., X, Y, ...). It must match * f(1,2) for instance. * So I have added special cases such as (if startxs = []) and code * in the Ecomma matching rule. * * old: Must do some try, for instance when f(...,X,Y,...) have to * test the transfo for all the combinations and if multiple transfo * possible ? pb ? => the type is to return a expression option ? use * some combinators to help ? * update: with the tag-SP approach, no more a problem. *) and arguments_bis = fun eas ebs -> let match_dots ea = match A.unwrap ea with A.Edots(mcode, optexpr) -> Some (mcode, optexpr) | _ -> None in let build_dots (mcode, optexpr) = A.Edots(mcode, optexpr) in let match_comma ea = match A.unwrap ea with A.EComma ia1 -> Some ia1 | _ -> None in let build_comma ia1 = A.EComma ia1 in let match_metalist ea = match A.unwrap ea with A.MetaExprList(ida,leninfo,keep,inherited) -> Some(ida,leninfo,keep,inherited,None) | _ -> None in let build_metalist _ (ida,leninfo,keep,inherited) = A.MetaExprList(ida,leninfo,keep,inherited) in let mktermval v = Ast_c.MetaExprListVal v in let special_cases ea eas ebs = None in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases argument X.distrf_args B.split_comma B.unsplit_comma Lib_parsing_c.ii_of_args (function x -> Some x) eas ebs and argument arga argb = X.all_bound (A.get_inherited arga) >&&> match A.unwrap arga, argb with | A.TypeExp tya, Right (B.ArgType {B.p_register=b,iib; p_namei=sopt;p_type=tyb}) -> if b || sopt <> None then (* failwith "the argument have a storage and ast_cocci does not have"*) fail else (* b = false and sopt = None *) fullType tya tyb >>= (fun tya tyb -> return ( (A.TypeExp tya) +> A.rewrap arga, (Right (B.ArgType {B.p_register=(b,iib); p_namei=sopt; p_type=tyb;})) )) | A.TypeExp tya, _ -> fail | _, Right (B.ArgType _) -> fail | _, Left argb -> expression arga argb >>= (fun arga argb -> return (arga, Left argb) ) | _, Right (B.ArgAction y) -> fail and (ident_list : (A.ident list, Ast_c.name Ast_c.wrap2 list) matcher) = fun eas ebs -> ident_list_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> return (eas, (Ast_c.unsplit_comma ebs_splitted)) ) and ident_list_bis = fun eas ebs -> let match_dots ea = None in let build_dots (mcode, optexpr) = failwith "no dots in ident list" in let match_comma ea = None in let build_comma ia1 = failwith "no comma in ident list" in let match_metalist ea = None in let build_metalist _ (ida,leninfo,keep,inherited) = failwith "no metalist in ident list" in let mktermval v = failwith "no metalist in ident list" in let special_cases ea eas ebs = None in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases (ident_cpp DontKnow) X.distrf_ident_list B.split_comma B.unsplit_comma Lib_parsing_c.ii_of_ident_list (function x -> Some x) eas ebs (* ------------------------------------------------------------------------- *) (* todo? facto code with argument ? *) and (parameters: sequence -> (A.parameterTypeDef list, Ast_c.parameterType Ast_c.wrap2 list) matcher) = fun seqstyle eas ebs -> match seqstyle with | Unordered -> failwith "not handling ooo" | Ordered -> parameters_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> return (eas, (Ast_c.unsplit_comma ebs_splitted)) ) and parameters_bis eas ebs = let match_dots ea = match A.unwrap ea with A.Pdots(mcode) -> Some (mcode, None) | _ -> None in let build_dots (mcode, _optexpr) = A.Pdots(mcode) in let match_comma ea = match A.unwrap ea with A.PComma ia1 -> Some ia1 | _ -> None in let build_comma ia1 = A.PComma ia1 in let match_metalist ea = let rec loop acc p = match A.unwrap p with A.AsParam(p,e) -> loop (e :: acc) p | A.MetaParamList(ida,leninfo,keep,inherited) -> Some ((ida,leninfo,keep,inherited),acc) | _ -> None in match loop [] ea with Some ((ida,leninfo,keep,inherited),ids) -> (match ids with [] -> Some(ida,leninfo,keep,inherited,None) | _ -> let extra vl max_min k = let vl = Ast_c.MetaExprListVal (List.map (function (v,i) -> match v.Ast_c.p_namei with Some name -> (Left(Ast_c.mk_e (B.Ident name) Ast_c.noii),i) | None -> failwith "no name in parameter list") vl) in let rec loop = function [] -> k () | x::xs -> (match A.unwrap x with A.MetaExprList(ida,A.AnyListLen,keep,inherited) -> X.envf keep inherited (ida, vl, max_min) (fun () -> loop xs) | A.MetaExprList _ -> failwith "length not supported" | _ -> failwith "unexpected expression") in loop ids in Some(ida,leninfo,keep,inherited,Some extra)) | None -> None in let rec build_metalist ea (ida,leninfo,keep,inherited) = match A.unwrap ea with A.MetaParamList _ -> A.MetaParamList(ida,leninfo,keep,inherited) | A.AsParam(p,e) -> A.AsParam(A.rewrap p (build_metalist p (ida,leninfo,keep,inherited)), e) | _ -> failwith "not possible" in let mktermval v = Ast_c.MetaParamListVal v in let special_cases ea eas ebs = (* a case where one smpl parameter matches a list of C parameters *) match A.unwrap ea,ebs with A.VoidParam ta, ys -> Some (match eas, ebs with | [], [Left eb] -> let {B.p_register=(hasreg,iihasreg); p_namei = idbopt; p_type=tb; } = eb in if idbopt =*= None && not hasreg then match tb with | (qub, (B.BaseType B.Void,_)) -> fullType ta tb >>= (fun ta tb -> return ( [(A.VoidParam ta) +> A.rewrap ea], [Left {B.p_register=(hasreg, iihasreg); p_namei = idbopt; p_type = tb;}] )) | _ -> fail else fail | _ -> fail) | _ -> None in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases parameter X.distrf_params B.split_comma B.unsplit_comma Lib_parsing_c.ii_of_params (function x -> Some x) eas ebs (* let split_register_param = fun (hasreg, idb, ii_b_s) -> match hasreg, idb, ii_b_s with | false, Some s, [i1] -> Left (s, [], i1) | true, Some s, [i1;i2] -> Left (s, [i1], i2) | _, None, ii -> Right ii | _ -> raise Impossible *) and parameter = fun parama paramb -> match A.unwrap parama, paramb with A.MetaParam (ida,keep,inherited), eb -> (* todo: use quaopt, hasreg ? *) let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_param eb) in X.envf keep inherited (ida,Ast_c.MetaParamVal eb,max_min) (fun () -> X.distrf_param ida eb ) >>= (fun ida eb -> return (A.MetaParam(ida,keep,inherited)+> A.rewrap parama,eb)) | A.Param (typa, idaopt), eb -> let {B.p_register = (hasreg,iihasreg); p_namei = nameidbopt; p_type = typb;} = paramb in fullType typa typb >>= (fun typa typb -> match idaopt, nameidbopt with | Some ida, Some nameidb -> (* todo: if minus on ida, should also minus the iihasreg ? *) ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> return ( A.Param (typa, Some ida)+> A.rewrap parama, {B.p_register = (hasreg, iihasreg); p_namei = Some (nameidb); p_type = typb} )) | None, None -> return ( A.Param (typa, None)+> A.rewrap parama, {B.p_register=(hasreg,iihasreg); p_namei = None; p_type = typb;} ) (* why handle this case ? because of transform_proto ? we may not * have an ident in the proto. * If have some plus on ida ? do nothing about ida ? *) (* not anymore !!! now that julia is handling the proto. | _, Right iihasreg -> return ( (idaopt, typa), ((hasreg, None, typb), iihasreg) ) *) | Some _, None -> fail | None, Some _ -> fail) | (A.OptParam _ | A.UniqueParam _), _ -> failwith "not handling Opt/Unique for Param" | A.Pcircles (_), ys -> raise (Impossible 25) (* in Ordered mode *) | _ -> fail (* ------------------------------------------------------------------------- *) and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) = fun (mckstart, allminus, decla) declb -> X.all_bound (A.get_inherited decla) >&&> match A.unwrap decla, declb with (* Un MetaDecl est introduit dans l'asttoctl pour sauter au dessus * de toutes les declarations qui sont au debut d'un fonction et * commencer le reste du match au premier statement. Alors, ca matche * n'importe quelle declaration. On n'a pas besoin d'ajouter * quoi que ce soit dans l'environnement. C'est une sorte de DDots. * * When the SP want to remove the whole function, the minus is not * on the MetaDecl but on the MetaRuleElem. So there should * be no transform of MetaDecl, just matching are allowed. *) | A.MetaDecl (ida,keep,inherited), _ -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_decl declb) in X.envf keep inherited (ida, Ast_c.MetaDeclVal declb, max_min) (fun () -> X.distrf_decl ida declb ) >>= (fun ida declb -> return ((mckstart, allminus, (A.MetaDecl (ida, keep, inherited))+> A.rewrap decla), declb)) | A.AsDecl(dec,asdec), decb -> declaration (mckstart, allminus, dec) decb >>= (fun (mckstart, allminus, dec) decb -> let asmckstart = A.CONTEXT(A.NoPos,A.NOTHING) in declaration (asmckstart,false,asdec) decb >>= (fun (_,_,asdec) decb -> return( ((mckstart, allminus, (A.AsDecl(dec,asdec)) +> A.rewrap decla), decb)))) | _, (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) -> onedecl allminus decla (var,iiptvirgb,iisto) >>= (fun decla (var,iiptvirgb,iisto)-> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> return ( (mckstart, allminus, decla), (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) ))) | _, (B.DeclList (xs, (iiptvirgb::iifakestart::iisto))) -> let indexify l = let rec loop n = function [] -> [] | x::xs -> (n,x)::(loop (n+1) xs) in loop 0 l in let rec repln n vl cur = function [] -> [] | x::xs -> if n = cur then vl :: xs else x :: (repln n vl (cur+1) xs) in if !Flag.sgrep_mode2(*X.mode =*= PatternMode *) || A.get_safe_decl decla then (indexify xs) +> List.fold_left (fun acc (n,var) -> (* consider all possible matches *) acc >||> (function tin -> ( X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> onedecl allminus decla (var, iiptvirgb, iisto) >>= (fun decla (var, iiptvirgb, iisto) -> return ( (mckstart, allminus, decla), (* adjust the variable that was chosen *) (B.DeclList (repln n var 0 xs, iiptvirgb::iifakestart::iisto)) )))) tin)) fail else begin (* rather clunky... we only want to print the warning message if there is a match *) let firstii = iiptvirgb in let contextified_decla = let mcode (x,info,mc,pos) = let newmc = match mc with A.MINUS(pos,_,_,_) | A.CONTEXT(pos,_) -> A.CONTEXT(pos,A.NOTHING) | _ -> failwith "only minus/context expected in pattern" in (x,info,newmc,pos) in let donothing r k e = k e in let v = Visitor_ast.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in v.Visitor_ast.rebuilder_declaration decla in (indexify xs) +> List.fold_left (fun acc (n,var) -> (* consider all possible matches *) acc >||> (function tin -> ( onedecl allminus contextified_decla (var, iiptvirgb, iisto) >>= (fun _ _ -> pr2_once (Printf.sprintf "%s: %d: %s" (Ast_c.file_of_info firstii) (Ast_c.line_of_info firstii) "More than one variable in the declaration, and so it cannot be transformed. Check that there is no transformation on the type or the ;"); fail)) tin)) fail end | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs,true),ii) -> let (iisb, lpb, rpb, iiendb, iifakestart, iistob) = (match ii with | iisb::lpb::rpb::iiendb::iifakestart::iisto -> (iisb,lpb,rpb,iiendb, iifakestart,iisto) | _ -> raise (Impossible 26) ) in (if allminus then minusize_list iistob else return ((), iistob) ) >>= (fun () iistob -> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) -> tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> tokenf enda iiendb >>= (fun enda iiendb -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( (mckstart, allminus, (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), (B.MacroDecl ((sb,ebs,true), [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob)) )))))))) | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs,false),ii) -> X.optional_declarer_semicolon_flag (fun optional_declarer_semicolon -> match mcodekind enda, optional_declarer_semicolon with A.CONTEXT (_,A.NOTHING), true -> let (iisb, lpb, rpb, iifakestart, iistob) = (match ii with | iisb::lpb::rpb::iifakestart::iisto -> (iisb,lpb,rpb,iifakestart,iisto) | _ -> raise (Impossible 27)) in (if allminus then minusize_list iistob else return ((), iistob)) >>= (fun () iistob -> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) -> tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( (mckstart, allminus, (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla), (B.MacroDecl ((sb,ebs,false), [iisb;lpb;rpb;iifakestart] ++ iistob)) ))))))) | _ -> fail) | A.MacroDeclInit (sa,lpa,eas,rpa,weqa,inia,enda), B.MacroDeclInit ((sb,ebs,inib),ii) -> let (iisb, lpb, rpb, weqb, iiendb, iifakestart, iistob) = (match ii with | iisb::lpb::rpb::weqb::iiendb::iifakestart::iisto -> (iisb,lpb,rpb,weqb,iiendb, iifakestart,iisto) | _ -> raise (Impossible 28) ) in (if allminus then minusize_list iistob else return ((), iistob) ) >>= (fun () iistob -> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) -> tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> tokenf weqa weqb >>= (fun weqa weqb -> tokenf enda iiendb >>= (fun enda iiendb -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> initialiser inia inib >>= (fun inia inib -> let eas = redots eas easundots in return ( (mckstart, allminus, (A.MacroDeclInit(sa,lpa,eas,rpa,weqa,inia,enda)) +> A.rewrap decla), (B.MacroDeclInit ((sb,ebs,inib), [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob)) )))))))))) | A.MacroDeclInit (sa,lpa,eas,rpa,weqa,inia,enda), _ -> fail | _, (B.MacroDecl _ |B.MacroDeclInit _ |B.DeclList _) -> fail and onedecl = fun allminus decla (declb, iiptvirgb, iistob) -> X.all_bound (A.get_inherited decla) >&&> match A.unwrap decla, declb with (* kind of typedef iso, we must unfold, it's for the case * T { }; that we want to match against typedef struct { } xx_t; *) | A.TyDecl (tya0, ptvirga), ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; B.v_attr = attrs; B.v_type_bis = typb0bis; }, iivirg) -> (match A.unwrap tya0, typb0 with | A.Type(allminus,cv1,tya1), ((qu,il),typb1) -> (* allminus doesn't seem useful here - nothing done with cv1 *) (match A.unwrap tya1, typb1 with | A.StructUnionDef(tya2, lba, declsa, rba), (B.StructUnion (sub, sbopt, declsb), ii) -> let (iisub, iisbopt, lbb, rbb) = match sbopt with | None -> let (iisub, lbb, rbb) = tuple_of_list3 ii in (iisub, [], lbb, rbb) | Some s -> pr2 (sprintf "warning: both a typedef (%s) and struct name introduction (%s)" (Ast_c.str_of_name nameidb) s ); pr2 "warning: I will consider only the typedef"; let (iisub, iisb, lbb, rbb) = tuple_of_list4 ii in (iisub, [iisb], lbb, rbb) in let structnameb = structdef_to_struct_name (Ast_c.nQ, (B.StructUnion (sub, sbopt, declsb), ii)) in let fake_typeb = Ast_c.nQ,((B.TypeName (nameidb, Some (Lib_parsing_c.al_type structnameb))), []) in tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> tokenf lba lbb >>= (fun lba lbb -> tokenf rba rbb >>= (fun rba rbb -> struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb -> let declsa = redots declsa undeclsa in (match A.unwrap tya2 with | A.Type(allminus, cv3, tya3) -> (* again allminus not used *) (match A.unwrap tya3 with | A.MetaType(ida,keep, inherited) -> fullType tya2 fake_typeb >>= (fun tya2 fake_typeb -> let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in let tya0 = A.Type(allminus, cv1, tya1) +> A.rewrap tya0 in let typb1 = B.StructUnion (sub,sbopt, declsb), [iisub] @ iisbopt @ [lbb;rbb] in let typb0 = ((qu, il), typb1) in match fake_typeb with | _nQ, ((B.TypeName (nameidb, _typ)),[]) -> return ( (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla, (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; B.v_attr = attrs; B.v_type_bis = typb0bis; }, iivirg),iiptvirgb,iistob) ) | _ -> raise (Impossible 29) ) (* do we need EnumName here too? *) | A.StructUnionName(sua, sa) -> fullType tya2 structnameb >>= (fun tya2 structnameb -> let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in let tya0 = A.Type(allminus, cv1, tya1) +> A.rewrap tya0 in match structnameb with | _nQ, (B.StructUnionName (sub, s), [iisub;iisbopt]) -> let typb1 = B.StructUnion (sub,sbopt, declsb), [iisub;iisbopt;lbb;rbb] in let typb0 = ((qu, il), typb1) in return ( (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla, (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb0; B.v_storage = (B.StoTypedef, inl); B.v_local = local; B.v_attr = attrs; B.v_type_bis = typb0bis; }, iivirg),iiptvirgb,iistob) ) | _ -> raise (Impossible 30) ) | _ -> raise (Impossible 31) ) | _ -> fail ))))) | _ -> fail ) | _ -> fail ) | A.UnInit (stoa, typa, ida, ptvirga), ({B.v_namei= Some (nameidb, _);B.v_storage= (B.StoTypedef,_);}, iivirg) -> fail | A.Init (stoa, typa, ida, eqa, inia, ptvirga), ({B.v_namei=Some(nameidb, _);B.v_storage=(B.StoTypedef,_);}, iivirg) -> fail (* could handle iso here but handled in standard.iso *) | A.UnInit (stoa, typa, ida, ptvirga), ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg) -> tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> fullType typa typb >>= (fun typa typb -> ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> storage_optional_allminus allminus stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> return ( (A.UnInit (stoa, typa, ida, ptvirga)) +> A.rewrap decla, (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; },iivirg), iiptvirgb,iistob) ))))) | A.Init (stoa, typa, ida, eqa, inia, ptvirga), ({B.v_namei = Some(nameidb, B.ValInit (iieqb, inib)); B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; },iivirg) -> tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> tokenf eqa iieqb >>= (fun eqa iieqb -> fullType typa typb >>= (fun typa typb -> ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> storage_optional_allminus allminus stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> initialiser inia inib >>= (fun inia inib -> return ( (A.Init (stoa, typa, ida, eqa, inia, ptvirga)) +> A.rewrap decla, (({B.v_namei = Some(nameidb, B.ValInit (iieqb, inib)); B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; },iivirg), iiptvirgb,iistob) ))))))) | A.Init (stoa, typa, ida, eqa, inia, ptvirga), ({B.v_namei = Some(nameidb, B.ConstrInit _); B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; },iivirg) -> fail (* C++ constructor declaration not supported in SmPL *) (* do iso-by-absence here ? allow typedecl and var ? *) | A.TyDecl (typa, ptvirga), ({B.v_namei = None; B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg) -> if stob =*= (B.NoSto, false) then tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> fullType typa typb >>= (fun typa typb -> return ( (A.TyDecl (typa, ptvirga)) +> A.rewrap decla, (({B.v_namei = None; B.v_type = typb; B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg), iiptvirgb, iistob) ))) else fail | A.Typedef (stoa, typa, ida, ptvirga), ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = (B.StoTypedef,inline); B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; },iivirg) -> tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb -> fullType typa typb >>= (fun typa typb -> (match iistob with | [iitypedef] -> tokenf stoa iitypedef >>= (fun stoa iitypedef -> return (stoa, [iitypedef]) ) | _ -> error iistob "weird, have both typedef and inline or nothing"; ) >>= (fun stoa iistob -> (match A.unwrap ida with | A.MetaType(_,_,_) -> let fake_typeb = Ast_c.nQ, ((B.TypeName (nameidb, Ast_c.noTypedefDef())), []) in fullTypebis ida fake_typeb >>= (fun ida fake_typeb -> match fake_typeb with | _nQ, ((B.TypeName (nameidb, _typ)), []) -> return (ida, nameidb) | _ -> raise (Impossible 32) ) | A.TypeName sa -> (match nameidb with | B.RegularName (sb, iidb) -> let iidb1 = tuple_of_list1 iidb in if (term sa) =$= sb then tokenf sa iidb1 >>= (fun sa iidb1 -> return ( (A.TypeName sa) +> A.rewrap ida, B.RegularName (sb, [iidb1]) )) else fail | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _ -> raise Todo ) | _ -> raise (Impossible 33) ) >>= (fun ida nameidb -> return ( (A.Typedef (stoa, typa, ida, ptvirga)) +> A.rewrap decla, (({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = (B.StoTypedef,inline); B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg), iiptvirgb, iistob) ) )))) | _, ({B.v_namei = None;}, _) -> (* old: failwith "no variable in this declaration, weird" *) fail | A.DisjDecl declas, declb -> declas +> List.fold_left (fun acc decla -> acc >|+|> (* (declaration (mckstart, allminus, decla) declb) *) (onedecl allminus decla (declb,iiptvirgb, iistob)) ) fail (* only in struct type decls *) | A.Ddots(dots,whencode), _ -> raise (Impossible 34) | A.OptDecl _, _ | A.UniqueDecl _, _ -> failwith "not handling Opt/Unique Decl" | _, ({B.v_namei=Some _}, _) -> fail (* ------------------------------------------------------------------------- *) and (initialiser: (A.initialiser, Ast_c.initialiser) matcher) = fun ia ib -> X.all_bound (A.get_inherited ia) >&&> match (A.unwrap ia,ib) with | (A.MetaInit(ida,keep,inherited), ib) -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_ini ib) in X.envf keep inherited (ida, Ast_c.MetaInitVal ib, max_min) (fun () -> X.distrf_ini ida ib >>= (fun ida ib -> return ( A.MetaInit (ida,keep,inherited) +> A.rewrap ia, ib )) ) | A.AsInit(ini,asini), inib -> initialiser ini inib >>= (fun ini inib -> initialiser asini inib >>= (fun asini inib -> return( ((A.AsInit(ini,asini)) +> A.rewrap ia, inib)))) | (A.InitExpr expa, ib) -> (match A.unwrap expa, ib with | A.Edots (mcode, None), ib -> X.distrf_ini (dots2metavar mcode) ib >>= (fun mcode ib -> return ( A.InitExpr (A.Edots (metavar2dots mcode, None) +> A.rewrap expa) +> A.rewrap ia, ib )) | A.Edots (_, Some expr), _ -> failwith "not handling when on Edots" | _, (B.InitExpr expb, ii) -> assert (null ii); expression expa expb >>= (fun expa expb -> return ( (A.InitExpr expa) +> A.rewrap ia, (B.InitExpr expb, ii) )) | _ -> fail ) | (A.ArInitList (ia1, ias, ia2), (B.InitList ibs, ii)) -> (match ii with | ib1::ib2::iicommaopt -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> ar_initialisers (A.undots ias) (ibs, iicommaopt) >>= (fun iasundots (ibs,iicommaopt) -> return ( (A.ArInitList (ia1, redots ias iasundots, ia2)) +> A.rewrap ia, (B.InitList ibs, ib1::ib2::iicommaopt) )))) | _ -> raise (Impossible 35) ) | (A.StrInitList (allminus, ia1, ias, ia2, []), (B.InitList ibs, ii)) -> (match ii with | ib1::ib2::iicommaopt -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> str_initialisers allminus ias (ibs, iicommaopt) >>= (fun ias (ibs,iicommaopt) -> return ( (A.StrInitList (allminus, ia1, ias, ia2, [])) +> A.rewrap ia, (B.InitList ibs, ib1::ib2::iicommaopt) )))) | _ -> raise (Impossible 36) ) | (A.StrInitList (allminus, i1, ias, i2, whencode), (B.InitList ibs, _ii)) -> failwith "TODO: not handling whencode in initialisers" | (A.InitGccExt (designatorsa, ia2, inia), (B.InitDesignators (designatorsb, inib), ii2))-> let iieq = tuple_of_list1 ii2 in tokenf ia2 iieq >>= (fun ia2 iieq -> designators designatorsa designatorsb >>= (fun designatorsa designatorsb -> initialiser inia inib >>= (fun inia inib -> return ( (A.InitGccExt (designatorsa, ia2, inia)) +> A.rewrap ia, (B.InitDesignators (designatorsb, inib), [iieq]) )))) | (A.InitGccName (ida, ia1, inia), (B.InitFieldOld (idb, inib), ii)) -> (match ii with | [iidb;iicolon] -> ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> initialiser inia inib >>= (fun inia inib -> tokenf ia1 iicolon >>= (fun ia1 iicolon -> return ( (A.InitGccName (ida, ia1, inia)) +> A.rewrap ia, (B.InitFieldOld (idb, inib), [iidb;iicolon]) )))) | _ -> fail ) | A.IComma(comma), _ -> raise (Impossible 37) | A.UniqueIni _,_ | A.OptIni _,_ -> failwith "not handling Opt/Unique on initialisers" | _, (B.InitIndexOld (_, _), _) -> fail | _, (B.InitFieldOld (_, _), _) -> fail | _, ((B.InitDesignators (_, _)|B.InitList _|B.InitExpr _), _) -> fail and designators dla dlb = match (dla,dlb) with ([],[]) -> return ([], []) | ([],_) | (_,[]) -> fail | (da::dla,db::dlb) -> designator da db >>= (fun da db -> designators dla dlb >>= (fun dla dlb -> return (da::dla, db::dlb))) and designator da db = match (da,db) with (A.DesignatorField (ia1, ida), (B.DesignatorField idb,ii1)) -> let (iidot, iidb) = tuple_of_list2 ii1 in tokenf ia1 iidot >>= (fun ia1 iidot -> ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> return ( A.DesignatorField (ia1, ida), (B.DesignatorField idb, [iidot;iidb]) ))) | (A.DesignatorIndex (ia1,ea,ia2), (B.DesignatorIndex eb, ii1)) -> let (ib1, ib2) = tuple_of_list2 ii1 in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> expression ea eb >>= (fun ea eb -> return ( A.DesignatorIndex (ia1,ea,ia2), (B.DesignatorIndex eb, [ib1;ib2]) )))) | (A.DesignatorRange (ia1,e1a,ia2,e2a,ia3), (B.DesignatorRange (e1b, e2b), ii1)) -> let (ib1, ib2, ib3) = tuple_of_list3 ii1 in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> expression e1a e1b >>= (fun e1a e1b -> expression e2a e2b >>= (fun e2a e2b -> return ( A.DesignatorRange (ia1,e1a,ia2,e2a,ia3), (B.DesignatorRange (e1b, e2b), [ib1;ib2;ib3]) )))))) | (_, ((B.DesignatorField _|B.DesignatorIndex _|B.DesignatorRange _), _)) -> fail and str_initialisers = fun allminus ias (ibs, iicomma) -> let ias_unsplit = unsplit_icomma ias in let ibs_split = resplit_initialiser ibs iicomma in if need_unordered_initialisers ibs then initialisers_unordered2 allminus ias_unsplit ibs_split >>= (fun ias_unsplit ibs_split -> return ( split_icomma ias_unsplit, unsplit_initialiser ibs_split)) else fail and ar_initialisers = fun ias (ibs, iicomma) -> (* this doesn't check need_unordered_initialisers because ... can be implemented as ordered, even if it matches unordered initializers *) let ibs = resplit_initialiser ibs iicomma in let ibs = List.concat (List.map (function (elem,comma) -> [Left elem; Right [comma]]) ibs) in initialisers_ordered2 ias ibs >>= (fun ias ibs_split -> let ibs,iicomma = match List.rev ibs_split with (Right comma)::rest -> (Ast_c.unsplit_comma (List.rev rest),comma) | (Left _)::_ -> (Ast_c.unsplit_comma ibs_split,[]) (* possible *) | [] -> ([],[]) in return (ias, (ibs,iicomma))) and initialisers_ordered2 = fun ias ibs -> let match_dots ea = match A.unwrap ea with A.Idots(mcode, optexpr) -> Some (mcode, optexpr) | _ -> None in let build_dots (mcode, optexpr) = A.Idots(mcode, optexpr) in let match_comma ea = match A.unwrap ea with A.IComma ia1 -> Some ia1 | _ -> None in let build_comma ia1 = A.IComma ia1 in let match_metalist ea = match A.unwrap ea with A.MetaInitList(ida,leninfo,keep,inherited) -> Some(ida,leninfo,keep,inherited,None) | _ -> None in let build_metalist _ (ida,leninfo,keep,inherited) = A.MetaInitList(ida,leninfo,keep,inherited) in let mktermval v = Ast_c.MetaInitListVal v in let special_cases ea eas ebs = None in let no_ii x = failwith "not possible" in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases initialiser X.distrf_inis B.split_comma B.unsplit_comma no_ii (function x -> Some x) ias ibs and initialisers_unordered2 = fun allminus ias ibs -> match ias, ibs with | [], ys -> if allminus then let rec loop = function [] -> return ([],[]) | (ib,comma)::ibs -> X.distrf_ini minusizer ib >>= (fun _ ib -> tokenf minusizer comma >>= (fun _ comma -> loop ibs >>= (fun l ibs -> return(l,(ib,comma)::ibs)))) in loop ibs else return ([], ys) | x::xs, ys -> let permut = Common.uncons_permut_lazy ys in permut +> List.fold_left (fun acc ((e, pos), rest) -> acc >||> (initialiser_comma x e >>= (fun x e -> let rest = Lazy.force rest in initialisers_unordered2 allminus xs rest >>= (fun xs rest -> return ( x::xs, Common.insert_elem_pos (e, pos) rest )))) ) fail and initialiser_comma (x,xcomma) (y, commay) = match A.unwrap xcomma with A.IComma commax -> tokenf commax commay >>= (fun commax commay -> initialiser x y >>= (fun x y -> return ( (x, (A.IComma commax) +> A.rewrap xcomma), (y, commay)))) | _ -> raise (Impossible 38) (* unsplit_iicomma wrong *) (* ------------------------------------------------------------------------- *) and (struct_fields: (A.declaration list, B.field list) matcher) = fun eas ebs -> let match_dots ea = match A.unwrap ea with A.Ddots(mcode, optexpr) -> Some (mcode, optexpr) | _ -> None in let build_dots (mcode, optexpr) = A.Ddots(mcode, optexpr) in let match_comma ea = None in let build_comma ia1 = failwith "not possible" in let match_metalist ea = match A.unwrap ea with A.MetaFieldList(ida,leninfo,keep,inherited) -> Some(ida,leninfo,keep,inherited,None) | _ -> None in let build_metalist _ (ida,leninfo,keep,inherited) = A.MetaFieldList(ida,leninfo,keep,inherited) in let mktermval v = (* drop empty ii information, because nothing between elements *) let v = List.map Ast_c.unwrap v in Ast_c.MetaFieldListVal v in let special_cases ea eas ebs = None in let no_ii x = failwith "not possible" in let make_ebs ebs = List.map (function x -> Left x) ebs in let unmake_ebs ebs = List.map (function Left x -> x | Right x -> failwith "no right") ebs in let distrf mcode startxs = let startxs = unmake_ebs startxs in X.distrf_struct_fields mcode startxs >>= (fun mcode startxs -> return (mcode,make_ebs startxs)) in let filter_fields l = Some (List.filter (function x -> match Ast_c.unwrap x with Ast_c.DeclarationField fld -> true | Ast_c.EmptyField info -> true | Ast_c.MacroDeclField decl -> true | Ast_c.CppDirectiveStruct cpp -> false | Ast_c.IfdefStruct ifdef -> false) l) in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases struct_field distrf B.split_comma B.unsplit_comma no_ii filter_fields eas (make_ebs ebs) >>= (fun eas ebs -> return (eas,unmake_ebs ebs)) and (struct_field: (A.declaration, B.field) matcher) = fun fa fb -> match A.unwrap fa,fb with | A.MetaField (ida,keep,inherited), _ -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_field fb) in X.envf keep inherited (ida, Ast_c.MetaFieldVal fb, max_min) (fun () -> X.distrf_field ida fb ) >>= (fun ida fb -> return ((A.MetaField (ida, keep, inherited))+> A.rewrap fa, fb)) | _,B.DeclarationField (B.FieldDeclList (onefield_multivars,iiptvirg)) -> let iiptvirgb = tuple_of_list1 iiptvirg in (match onefield_multivars with | [] -> raise (Impossible 39) | [onevar,iivirg] -> assert (null iivirg); (match onevar with | B.BitField (sopt, typb, _, expr) -> pr2_once "warning: bitfield not handled by ast_cocci"; fail | B.Simple (None, typb) -> pr2_once "warning: unnamed struct field not handled by ast_cocci"; fail | B.Simple (Some nameidb, typb) -> (* build a declaration from a struct field *) let allminus = false in let iisto = [] in let stob = B.NoSto, false in let fake_var = ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; B.v_local = Ast_c.NotLocalDecl; B.v_attr = Ast_c.noattr; B.v_type_bis = ref None; (* the struct field should also get expanded ? no it's not * important here, we will rematch very soon *) }, iivirg) in onedecl allminus fa (fake_var,iiptvirgb,iisto) >>= (fun fa (var,iiptvirgb,iisto) -> match fake_var with | ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; }, iivirg) -> let onevar = B.Simple (Some nameidb, typb) in return ( (fa), ((B.DeclarationField (B.FieldDeclList ([onevar, iivirg], [iiptvirgb]))) ) ) | _ -> raise (Impossible 40) ) ) | x::y::xs -> pr2_once "PB: More that one variable in decl. Have to split"; fail ) | _,B.EmptyField _iifield -> fail | A.MacroDecl (sa,lpa,eas,rpa,enda),B.MacroDeclField ((sb,ebs),ii) -> raise Todo | _,B.MacroDeclField ((sb,ebs),ii) -> fail | _,B.CppDirectiveStruct directive -> fail | _,B.IfdefStruct directive -> fail and enum_fields = fun eas ebs -> let match_dots ea = match A.unwrap ea with A.Edots(mcode, optexpr) -> Some (mcode, optexpr) | _ -> None in let build_dots (mcode, optexpr) = A.Edots(mcode, optexpr) in let match_comma ea = match A.unwrap ea with A.EComma ia1 -> Some ia1 | _ -> None in let build_comma ia1 = A.EComma ia1 in let match_metalist ea = None in let build_metalist _ (ida,leninfo,keep,inherited) = failwith "not possible" in let mktermval v = failwith "not possible" in let special_cases ea eas ebs = None in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases enum_field X.distrf_enum_fields B.split_comma B.unsplit_comma Lib_parsing_c.ii_of_enum_fields (function x -> Some x) eas ebs and enum_field ida idb = X.all_bound (A.get_inherited ida) >&&> match A.unwrap ida, idb with A.Ident(id),(nameidb,None) -> ident_cpp DontKnow id nameidb >>= (fun id nameidb -> return ((A.Ident id) +> A.rewrap ida, (nameidb,None))) | A.Ident(id),(nameidb,Some _) -> fail (* should we have an iso? *) | A.Assignment(ea1,opa,ea2,init),(nameidb,Some(opbi,eb2)) -> (match A.unwrap ea1 with A.Ident(id) -> ident_cpp DontKnow id nameidb >>= (fun id nameidb -> expression ea2 eb2 >>= (fun ea2 eb2 -> tokenf opa opbi >>= (fun opa opbi -> (* only one kind of assignop *) return ( (A.Assignment((A.Ident(id))+>A.rewrap ea1,opa,ea2,init)) +> A.rewrap ida, (nameidb,Some(opbi,eb2)))))) | _ -> failwith "not possible") | A.Assignment(ea1,opa,ea2,init),(nameidb,None) -> fail | _ -> failwith ("not possible: "^(Dumper.dump (A.unwrap ida))) (* ------------------------------------------------------------------------- *) and (fullType: (A.fullType, Ast_c.fullType) matcher) = fun typa typb -> X.optional_qualifier_flag (fun optional_qualifier -> X.all_bound (A.get_inherited typa) >&&> match A.unwrap typa, typb with | A.Type(allminus,cv,ty1), ((qu,il),ty2) -> if qu.B.const && qu.B.volatile then pr2_once ("warning: the type is both const & volatile but cocci " ^ "does not handle that"); (* Drop out the const/volatile part that has been matched. * This is because a SP can contain const T v; in which case * later in match_t_t when we encounter a T, we must not add in * the environment the whole type. *) (match cv with (* "iso-by-absence" *) | None -> let do_stuff () = fullTypebis ty1 ((qu,il), ty2) >>= (fun ty1 ((qu,il), ty2) -> (if allminus then minusize_list il else return ((), il) ) >>= (fun () il -> return ( (A.Type(allminus, None, ty1)) +> A.rewrap typa, ((qu,il), ty2) ))) in (match optional_qualifier, qu.B.const || qu.B.volatile with | false, false -> do_stuff () | false, true -> fail | true, false -> do_stuff () | true, true -> if !FlagM.show_misc then pr2_once "USING optional_qualifier builtin isomorphism"; do_stuff() ) | Some x -> (* todo: can be __const__ ? can be const & volatile so * should filter instead ? *) (match term x, il with | A.Const, [i1] when qu.B.const -> tokenf x i1 >>= (fun x i1 -> fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> return ( (A.Type(allminus, Some x, ty1)) +> A.rewrap typa, ((qu, [i1]), ty2) ))) | A.Volatile, [i1] when qu.B.volatile -> tokenf x i1 >>= (fun x i1 -> fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) -> return ( (A.Type(allminus, Some x, ty1)) +> A.rewrap typa, ((qu, [i1]), ty2) ))) | _ -> fail ) ) | A.AsType(ty,asty), tyb -> fullType ty tyb >>= (fun ty tyb -> fullType asty tyb >>= (fun asty tyb -> return( ((A.AsType(ty,asty)) +> A.rewrap typa, tyb)))) | A.DisjType typas, typb -> typas +> List.fold_left (fun acc typa -> acc >|+|> (fullType typa typb)) fail | A.OptType(_), _ | A.UniqueType(_), _ -> failwith "not handling Opt/Unique on type" ) (* * Why not (A.typeC, Ast_c.typeC) matcher ? * because when there is MetaType, we want that T record the whole type, * including the qualifier, and so this type (and the new_il function in * preceding function). *) and (fullTypebis: (A.typeC, Ast_c.fullType) matcher) = fun ta tb -> X.all_bound (A.get_inherited ta) >&&> match A.unwrap ta, tb with (* cas general *) | A.MetaType(ida,keep, inherited), typb -> let type_present = let (tyq, (ty, tyii)) = typb in match ty with B.NoType -> false | _ -> true in let position_required_but_unavailable = match A.get_pos_var ida with [] -> false | _ -> let (tyq, (ty, tyii)) = typb in let tyii = match ty with B.TypeName(name,typ) -> (* promoted typedef has ii information in the type name *) let (_s, iis) = B.get_s_and_info_of_name name in [iis] | _ -> tyii in List.for_all Ast_c.is_fake tyii in if type_present && not position_required_but_unavailable then let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in X.envf keep inherited (ida, B.MetaTypeVal typb, max_min) (fun () -> X.distrf_type ida typb >>= (fun ida typb -> return ( A.MetaType(ida,keep, inherited) +> A.rewrap ta, typb))) else fail (* K&R, or macro, or C++? *) | unwrap, (qub, typb) -> typeC ta typb >>= (fun ta typb -> return (ta, (qub, typb)) ) and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda = (* In ii there is a list, sometimes of length 1 or 2 or 3. * And even if in baseb we have a Signed Int, that does not mean * that ii is of length 2, cos Signed is the default, so if in signa * we have Signed explicitly ? we cannot "accrocher" this mcode to * something :( So for the moment when there is signed in cocci, * we force that there is a signed in c too (done in pattern.ml). *) let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in (* handle some iso on type ? (cf complex C rule for possible implicit casting) *) match basea, baseb with | A.VoidType, B.Void | A.FloatType, B.FloatType (B.CFloat) | A.DoubleType, B.FloatType (B.CDouble) | A.SizeType, B.SizeType | A.SSizeType, B.SSizeType | A.PtrDiffType,B.PtrDiffType -> assert (signaopt =*= None); let stringa = tuple_of_list1 stringsa in let (ibaseb) = tuple_of_list1 ii in tokenf stringa ibaseb >>= (fun stringa ibaseb -> return ( (rebuilda ([stringa], signaopt)) +> A.rewrap ta, (B.BaseType baseb, [ibaseb]) )) | A.CharType, B.IntType B.CChar when signaopt =*= None -> let stringa = tuple_of_list1 stringsa in let ibaseb = tuple_of_list1 ii in tokenf stringa ibaseb >>= (fun stringa ibaseb -> return ( (rebuilda ([stringa], signaopt)) +> A.rewrap ta, (B.BaseType (B.IntType B.CChar), [ibaseb]) )) | A.CharType,B.IntType (B.Si (_sign, B.CChar2)) when signaopt <> None -> let stringa = tuple_of_list1 stringsa in let ibaseb = tuple_of_list1 iibaseb in sign signaopt signbopt >>= (fun signaopt iisignbopt -> tokenf stringa ibaseb >>= (fun stringa ibaseb -> return ( (rebuilda ([stringa], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ [ibaseb]) ))) | A.ShortType, B.IntType (B.Si (_, B.CShort)) | A.IntType, B.IntType (B.Si (_, B.CInt)) | A.LongType, B.IntType (B.Si (_, B.CLong)) -> let stringa = tuple_of_list1 stringsa in (match iibaseb with | [] -> (* iso-by-presence ? *) (* when unsigned int in SP, allow have just unsigned in C ? *) if mcode_contain_plus (mcodekind stringa) then fail else sign signaopt signbopt >>= (fun signaopt iisignbopt -> return ( (rebuilda ([stringa], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ []) )) | [x;y] -> (*pr2_once "warning: long int or short int not handled by ast_cocci";*) fail | [ibaseb] -> sign signaopt signbopt >>= (fun signaopt iisignbopt -> tokenf stringa ibaseb >>= (fun stringa ibaseb -> return ( (rebuilda ([stringa], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ [ibaseb]) ))) | _ -> raise (Impossible 41) ) | A.LongLongIntType, B.IntType (B.Si (_, B.CLongLong)) -> let (string1a,string2a,string3a) = tuple_of_list3 stringsa in (match iibaseb with [ibase1b;ibase2b;ibase3b] -> sign signaopt signbopt >>= (fun signaopt iisignbopt -> tokenf string1a ibase1b >>= (fun base1a ibase1b -> tokenf string2a ibase2b >>= (fun base2a ibase2b -> tokenf string3a ibase3b >>= (fun base3a ibase3b -> return ( (rebuilda ([base1a;base2a;base3a], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b;ibase3b]) ))))) | [ibase1b;ibase2b] -> fail (* int omitted *) | [] -> fail (* should something be done in this case? *) | _ -> raise (Impossible 42)) | A.LongLongType, B.IntType (B.Si (_, B.CLongLong)) | A.LongIntType, B.IntType (B.Si (_, B.CLong)) | A.ShortIntType, B.IntType (B.Si (_, B.CShort)) | A.LongDoubleType, B.FloatType B.CLongDouble -> let (string1a,string2a) = tuple_of_list2 stringsa in (match iibaseb with [ibase1b;ibase2b] -> sign signaopt signbopt >>= (fun signaopt iisignbopt -> tokenf string1a ibase1b >>= (fun base1a ibase1b -> tokenf string2a ibase2b >>= (fun base2a ibase2b -> return ( (rebuilda ([base1a;base2a], signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b]) )))) | [ibase1b] -> fail (* short or long *) | [ibase1b;ibase2b;ibase3b] -> fail (* long long case *) | [] -> fail (* should something be done in this case? *) | _ -> raise (Impossible 43)) | _, (B.Void|B.FloatType _|B.IntType _ |B.SizeType|B.SSizeType|B.PtrDiffType) -> fail and simulate_signed_meta ta basea signaopt tb baseb ii rebuilda = (* In ii there is a list, sometimes of length 1 or 2 or 3. * And even if in baseb we have a Signed Int, that does not mean * that ii is of length 2, cos Signed is the default, so if in signa * we have Signed explicitly ? we cannot "accrocher" this mcode to * something :( So for the moment when there is signed in cocci, * we force that there is a signed in c too (done in pattern.ml). *) let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in let match_to_type rebaseb = sign signaopt signbopt >>= (fun signaopt iisignbopt -> let fta = A.rewrap basea (A.Type(false(*don't know*),None,basea)) in let ftb = Ast_c.nQ,(B.BaseType (rebaseb), iibaseb) in fullType fta ftb >>= (fun fta (_,tb) -> (match A.unwrap fta,tb with A.Type(_,_,basea), (B.BaseType baseb, ii) -> return ( (rebuilda (basea, signaopt)) +> A.rewrap ta, (B.BaseType (baseb), iisignbopt ++ ii) ) | _ -> failwith "not possible"))) in (* handle some iso on type ? (cf complex C rule for possible implicit casting) *) match baseb with | B.IntType (B.Si (_sign, B.CChar2)) -> match_to_type (B.IntType B.CChar) | B.IntType (B.Si (_, ty)) -> (match iibaseb with | [] -> fail (* metavariable has to match something *) | _ -> match_to_type (B.IntType (B.Si (B.Signed, ty))) ) | (B.Void|B.FloatType _|B.IntType _ |B.SizeType|B.SSizeType|B.PtrDiffType) -> fail and (typeC: (A.typeC, Ast_c.typeC) matcher) = fun ta tb -> match A.unwrap ta, tb with | A.BaseType (basea,stringsa), (B.BaseType baseb, ii) -> simulate_signed ta basea stringsa None tb baseb ii (function (stringsa, signaopt) -> A.BaseType (basea,stringsa)) | A.SignedT (signaopt, Some basea), (B.BaseType baseb, ii) -> (match A.unwrap basea with A.BaseType (basea1,strings1) -> simulate_signed ta basea1 strings1 (Some signaopt) tb baseb ii (function (strings1, Some signaopt) -> A.SignedT (signaopt, Some (A.rewrap basea (A.BaseType (basea1,strings1)))) | _ -> failwith "not possible") | A.MetaType(ida,keep,inherited) -> simulate_signed_meta ta basea (Some signaopt) tb baseb ii (function (basea, Some signaopt) -> A.SignedT(signaopt,Some basea) | _ -> failwith "not possible") | _ -> failwith "not possible") | A.SignedT (signa,None), (B.BaseType baseb, ii) -> let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in (match iibaseb, baseb with | [], B.IntType (B.Si (_sign, B.CInt)) -> sign (Some signa) signbopt >>= (fun signaopt iisignbopt -> match signaopt with | None -> raise (Impossible 45) | Some signa -> return ( (A.SignedT (signa,None)) +> A.rewrap ta, (B.BaseType baseb, iisignbopt) ) ) | _ -> fail ) (* todo? iso with array *) | A.Pointer (typa, iamult), (B.Pointer typb, ii) -> let (ibmult) = tuple_of_list1 ii in fullType typa typb >>= (fun typa typb -> tokenf iamult ibmult >>= (fun iamult ibmult -> return ( (A.Pointer (typa, iamult)) +> A.rewrap ta, (B.Pointer typb, [ibmult]) ))) | A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa), (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), ii) -> let (lpb, rpb) = tuple_of_list2 ii in if isvaargs then pr2_once ("Not handling well variable length arguments func. "^ "You have been warned"); tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> fullType_optional_allminus allminus tyaopt tyb >>= (fun tyaopt tyb -> parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>= (fun paramsaundots paramsb -> let paramsa = redots paramsa paramsaundots in return ( (A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa) +> A.rewrap ta, (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), [lpb;rpb]) ) ))))) | A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), (B.ParenType t1, ii) -> let (lp1b, rp1b) = tuple_of_list2 ii in let (qu1b, t1b) = t1 in (match t1b with | B.Pointer t2, ii -> let (starb) = tuple_of_list1 ii in let (qu2b, t2b) = t2 in (match t2b with | B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))), ii -> let (lp2b, rp2b) = tuple_of_list2 ii in if isvaargs then pr2_once ("Not handling well variable length arguments func. "^ "You have been warned"); fullType tya tyb >>= (fun tya tyb -> tokenf lp1a lp1b >>= (fun lp1a lp1b -> tokenf rp1a rp1b >>= (fun rp1a rp1b -> tokenf lp2a lp2b >>= (fun lp2a lp2b -> tokenf rp2a rp2b >>= (fun rp2a rp2b -> tokenf stara starb >>= (fun stara starb -> parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>= (fun paramsaundots paramsb -> let paramsa = redots paramsa paramsaundots in let t2 = (qu2b, (B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))), [lp2b;rp2b])) in let t1 = (qu1b, (B.Pointer t2, [starb])) in return ( (A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a)) +> A.rewrap ta, (B.ParenType t1, [lp1b;rp1b]) ) ))))))) | _ -> fail ) | _ -> fail ) (* todo: handle the iso on optional size specification ? *) | A.Array (typa, ia1, eaopt, ia2), (B.Array (ebopt, typb), ii) -> let (ib1, ib2) = tuple_of_list2 ii in fullType typa typb >>= (fun typa typb -> option expression eaopt ebopt >>= (fun eaopt ebopt -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( (A.Array (typa, ia1, eaopt, ia2)) +> A.rewrap ta, (B.Array (ebopt, typb), [ib1;ib2]) ))))) | A.Decimal(dec,lp,length,Some comma,Some precision,rp), (B.Decimal (len, Some prec), ii) -> let (ib1, ib2, ib3, ib4) = tuple_of_list4 ii in expression length len >>= (fun length len -> expression precision prec >>= (fun precision prec -> tokenf dec ib1 >>= (fun dec ib1 -> tokenf lp ib2 >>= (fun lp ib2 -> tokenf comma ib3 >>= (fun comma ib3 -> tokenf rp ib4 >>= (fun rp ib4 -> return ( (A.Decimal(dec,lp,length,Some comma,Some precision,rp)) +> A.rewrap ta, (B.Decimal (len, Some prec), [ib1;ib2;ib3;ib4]) ))))))) | A.Decimal(dec,lp,length,None,None,rp), (B.Decimal (len, None), ii) -> let (ib1, ib2, ib3) = tuple_of_list3 ii in expression length len >>= (fun length len -> tokenf dec ib1 >>= (fun dec ib1 -> tokenf lp ib2 >>= (fun lp ib2 -> tokenf rp ib3 >>= (fun rp ib3 -> return ( (A.Decimal(dec,lp,length,None,None,rp)) +> A.rewrap ta, (B.Decimal (len,None), [ib1;ib2;ib3]) ))))) (* todo: could also match a Struct that has provided a name *) (* This is for the case where the SmPL code contains "struct x", without a definition. In this case, the name field is always present. This case is also called from the case for A.StructUnionDef when a name is present in the C code. *) | A.StructUnionName(sua, Some sa), (B.StructUnionName (sub, sb), ii) -> (* sa is now an ident, not an mcode, old: ... && (term sa) =$= sb *) let (ib1, ib2) = tuple_of_list2 ii in if equal_structUnion (term sua) sub then ident DontKnow sa (sb, ib2) >>= (fun sa (sb, ib2) -> tokenf sua ib1 >>= (fun sua ib1 -> return ( (A.StructUnionName (sua, Some sa)) +> A.rewrap ta, (B.StructUnionName (sub, sb), [ib1;ib2]) ))) else fail | A.StructUnionDef(ty, lba, declsa, rba), (B.StructUnion (sub, sbopt, declsb), ii) -> let (ii_sub_sb, lbb, rbb) = match ii with [iisub; lbb; rbb] -> (Common.Left iisub,lbb,rbb) | [iisub; iisb; lbb; rbb] -> (Common.Right (iisub,iisb),lbb,rbb) | _ -> error ii "list of length 3 or 4 expected" in let process_type = match (sbopt,ii_sub_sb) with (None,Common.Left iisub) -> (* the following doesn't reconstruct the complete SP code, just the part that matched *) let rec loop s = match A.unwrap s with A.Type(allminus,None,ty) -> (match A.unwrap ty with A.StructUnionName(sua, None) -> (match (term sua, sub) with (A.Struct,B.Struct) | (A.Union,B.Union) -> return ((),()) | _ -> fail) >>= (fun _ _ -> tokenf sua iisub >>= (fun sua iisub -> let ty = A.Type(allminus,None, A.StructUnionName(sua, None) +> A.rewrap ty) +> A.rewrap s in return (ty,[iisub]))) | _ -> fail) | A.DisjType(disjs) -> disjs +> List.fold_left (fun acc disj -> acc >|+|> (loop disj)) fail | _ -> fail in loop ty | (Some sb,Common.Right (iisub,iisb)) -> (* build a StructUnionName from a StructUnion *) let fake_su = B.nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) in fullType ty fake_su >>= (fun ty fake_su -> match fake_su with | _nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) -> return (ty, [iisub; iisb]) | _ -> raise (Impossible 46)) | _ -> fail in process_type >>= (fun ty ii_sub_sb -> tokenf lba lbb >>= (fun lba lbb -> tokenf rba rbb >>= (fun rba rbb -> struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb -> let declsa = redots declsa undeclsa in return ( (A.StructUnionDef(ty, lba, declsa, rba)) +> A.rewrap ta, (B.StructUnion (sub, sbopt, declsb),ii_sub_sb@[lbb;rbb]) ))))) (* todo? handle isomorphisms ? because Unsigned Int can be match on a * uint in the C code. But some CEs consists in renaming some types, * so we don't want apply isomorphisms every time. *) | A.TypeName sa, (B.TypeName (nameb, typb), noii) -> assert (null noii); (match nameb with | B.RegularName (sb, iidb) -> let iidb1 = tuple_of_list1 iidb in if (term sa) =$= sb then tokenf sa iidb1 >>= (fun sa iidb1 -> return ( (A.TypeName sa) +> A.rewrap ta, (B.TypeName (B.RegularName (sb, [iidb1]), typb), noii) )) else fail | B.CppConcatenatedName _ | B.CppVariadicName _ |B.CppIdentBuilder _ -> raise Todo ) | _, (B.NoType, ii) -> fail | _, (B.TypeOfExpr e, ii) -> fail | _, (B.TypeOfType e, ii) -> fail | _, (B.ParenType e, ii) -> fail (* todo ?*) | A.EnumName(en,Some namea), (B.EnumName nameb, ii) -> let (ib1,ib2) = tuple_of_list2 ii in ident DontKnow namea (nameb, ib2) >>= (fun namea (nameb, ib2) -> tokenf en ib1 >>= (fun en ib1 -> return ( (A.EnumName (en, Some namea)) +> A.rewrap ta, (B.EnumName nameb, [ib1;ib2]) ))) | A.EnumDef(ty, lba, idsa, rba), (B.Enum (sbopt, idsb), ii) -> let (ii_sub_sb, lbb, rbb, comma_opt) = match ii with [iisub; lbb; rbb; comma_opt] -> (Common.Left iisub,lbb,rbb,comma_opt) | [iisub; iisb; lbb; rbb; comma_opt] -> (Common.Right (iisub,iisb),lbb,rbb,comma_opt) | _ -> error ii "list of length 4 or 5 expected" in let process_type = match (sbopt,ii_sub_sb) with (None,Common.Left iisub) -> (* the following doesn't reconstruct the complete SP code, just the part that matched *) let rec loop s = match A.unwrap s with A.Type(allminus,None,ty) -> (match A.unwrap ty with A.EnumName(sua, None) -> tokenf sua iisub >>= (fun sua iisub -> let ty = A.Type(allminus,None,A.EnumName(sua, None) +> A.rewrap ty) +> A.rewrap s in return (ty,[iisub])) | _ -> fail) | A.DisjType(disjs) -> disjs +> List.fold_left (fun acc disj -> acc >|+|> (loop disj)) fail | _ -> fail in loop ty | (Some sb,Common.Right (iisub,iisb)) -> (* build an EnumName from an Enum *) let fake_su = B.nQ, (B.EnumName sb, [iisub;iisb]) in fullType ty fake_su >>= (fun ty fake_su -> match fake_su with | _nQ, (B.EnumName sb, [iisub;iisb]) -> return (ty, [iisub; iisb]) | _ -> raise (Impossible 47)) | _ -> fail in process_type >>= (fun ty ii_sub_sb -> tokenf lba lbb >>= (fun lba lbb -> tokenf rba rbb >>= (fun rba rbb -> let idsb = resplit_initialiser idsb [comma_opt] in let idsb = List.concat (List.map (function (elem,comma) -> [Left elem; Right [comma]]) idsb) in enum_fields (A.undots idsa) idsb >>= (fun unidsa idsb -> let idsa = redots idsa unidsa in let idsb,iicomma = match List.rev idsb with (Right comma)::rest -> (Ast_c.unsplit_comma (List.rev rest),comma) | (Left _)::_ -> (Ast_c.unsplit_comma idsb,[]) (* possible *) | [] -> ([],[]) in return ( (A.EnumDef(ty, lba, idsa, rba)) +> A.rewrap ta, (B.Enum (sbopt, idsb),ii_sub_sb@[lbb;rbb]@iicomma) )) ))) | _, (B.Enum _, _) -> fail (* todo cocci ?*) | _, ((B.TypeName _ | B.StructUnionName (_, _) | B.EnumName _ | B.StructUnion (_, _, _) | B.FunctionType _ | B.Array (_, _) | B.Decimal(_, _) | B.Pointer _ | B.BaseType _), _) -> fail (* todo: iso on sign, if not mentioned then free. tochange? * but that require to know if signed int because explicit * signed int, or because implicit signed int. *) and sign signa signb = match signa, signb with | None, None -> return (None, []) | Some signa, Some (signb, ib) -> if equal_sign (term signa) signb then tokenf signa ib >>= (fun signa ib -> return (Some signa, [ib]) ) else fail | _, _ -> fail and minusize_list iixs = iixs +> List.fold_left (fun acc ii -> acc >>= (fun xs ys -> tokenf minusizer ii >>= (fun minus ii -> return (minus::xs, ii::ys) ))) (return ([],[])) >>= (fun _xsminys ys -> return ((), List.rev ys) ) and storage_optional_allminus allminus stoa (stob, iistob) = (* "iso-by-absence" for storage, and return type. *) X.optional_storage_flag (fun optional_storage -> match stoa, stob with | None, (stobis, inline) -> let do_minus () = if allminus then minusize_list iistob >>= (fun () iistob -> return (None, (stob, iistob)) ) else return (None, (stob, iistob)) in (match optional_storage, stobis with | false, B.NoSto -> do_minus () | false, _ -> fail | true, B.NoSto -> do_minus () | true, _ -> if !FlagM.show_misc then pr2_once "USING optional_storage builtin isomorphism"; do_minus() ) | Some x, ((stobis, inline)) -> if equal_storage (term x) stobis then let rec loop acc = function [] -> fail | i1::iistob -> let str = B.str_of_info i1 in (match str with "static" | "extern" | "auto" | "register" -> (* not very elegant, but tokenf doesn't know what token to match with *) tokenf x i1 >>= (fun x i1 -> let rebuilt = (List.rev acc) @ i1 :: iistob in return (Some x, ((stobis, inline), rebuilt))) | _ -> loop (i1::acc) iistob) in loop [] iistob else fail ) and inline_optional_allminus allminus inla (stob, iistob) = (* "iso-by-absence" for storage, and return type. *) X.optional_storage_flag (fun optional_storage -> match inla, stob with | None, (stobis, inline) -> let do_minus () = if allminus then minusize_list iistob >>= (fun () iistob -> return (None, (stob, iistob)) ) else return (None, (stob, iistob)) in if inline then if optional_storage then begin if !FlagM.show_misc then pr2_once "USING optional_storage builtin isomorphism"; do_minus() end else fail (* inline not in SP and present in C code *) else do_minus() | Some x, ((stobis, inline)) -> if inline then let rec loop acc = function [] -> fail | i1::iistob -> let str = B.str_of_info i1 in (match str with "inline" -> (* not very elegant, but tokenf doesn't know what token to match with *) tokenf x i1 >>= (fun x i1 -> let rebuilt = (List.rev acc) @ i1 :: iistob in return (Some x, ((stobis, inline), rebuilt))) | _ -> loop (i1::acc) iistob) in loop [] iistob else fail (* SP has inline, but the C code does not *) ) and fullType_optional_allminus allminus tya retb = match tya with | None -> if allminus then X.distrf_type minusizer retb >>= (fun _x retb -> return (None, retb) ) else return (None, retb) | Some tya -> fullType tya retb >>= (fun tya retb -> return (Some tya, retb) ) (*---------------------------------------------------------------------------*) and compatible_base_type a signa b = let ok = return ((),()) in match a, b with | Type_cocci.VoidType, B.Void | Type_cocci.SizeType, B.SizeType | Type_cocci.SSizeType, B.SSizeType | Type_cocci.PtrDiffType, B.PtrDiffType -> assert (signa =*= None); ok | Type_cocci.CharType, B.IntType B.CChar when signa =*= None -> ok | Type_cocci.CharType, B.IntType (B.Si (signb, B.CChar2)) -> compatible_sign signa signb | Type_cocci.ShortType, B.IntType (B.Si (signb, B.CShort)) -> compatible_sign signa signb | Type_cocci.IntType, B.IntType (B.Si (signb, B.CInt)) -> compatible_sign signa signb | Type_cocci.LongType, B.IntType (B.Si (signb, B.CLong)) -> compatible_sign signa signb | Type_cocci.LongLongType, B.IntType (B.Si (signb, B.CLongLong)) -> compatible_sign signa signb | Type_cocci.FloatType, B.FloatType B.CFloat -> assert (signa =*= None); ok | Type_cocci.DoubleType, B.FloatType B.CDouble -> assert (signa =*= None); ok | _, B.FloatType B.CLongDouble -> pr2_once "no longdouble in cocci"; fail | Type_cocci.BoolType, _ -> failwith "no booltype in C" | _, (B.Void|B.FloatType _|B.IntType _ |B.SizeType|B.SSizeType|B.PtrDiffType) -> fail and compatible_base_type_meta a signa qua b ii local = match a, b with | Type_cocci.MetaType(ida,keep,inherited), B.IntType (B.Si (signb, B.CChar2)) -> compatible_sign signa signb >>= fun _ _ -> let newb = ((qua, (B.BaseType (B.IntType B.CChar),ii)),local) in compatible_type a newb | Type_cocci.MetaType(ida,keep,inherited), B.IntType (B.Si (signb, ty)) -> compatible_sign signa signb >>= fun _ _ -> let newb = ((qua, (B.BaseType (B.IntType (B.Si (B.Signed, ty))),ii)),local) in compatible_type a newb | _, B.FloatType B.CLongDouble -> pr2_once "no longdouble in cocci"; fail | _, (B.Void|B.FloatType _|B.IntType _ |B.SizeType|B.SSizeType|B.PtrDiffType) -> fail and compatible_type a (b,local) = let ok = return ((),()) in let rec loop = function | _, (qua, (B.NoType, _)) -> failwith "compatible_type: matching with NoType" | Type_cocci.BaseType a, (qua, (B.BaseType b,ii)) -> compatible_base_type a None b | Type_cocci.SignedT (signa,None), (qua, (B.BaseType b,ii)) -> compatible_base_type Type_cocci.IntType (Some signa) b | Type_cocci.SignedT (signa,Some ty), (qua, (B.BaseType b,ii)) -> (match ty with Type_cocci.BaseType ty -> compatible_base_type ty (Some signa) b | Type_cocci.MetaType(ida,keep,inherited) -> compatible_base_type_meta ty (Some signa) qua b ii local | _ -> failwith "not possible") | Type_cocci.Pointer a, (qub, (B.Pointer b, ii)) -> loop (a,b) | Type_cocci.FunctionPointer a, _ -> failwith "TODO: function pointer type doesn't store enough information to determine compatibility" | Type_cocci.Array a, (qub, (B.Array (eopt, b),ii)) -> (* no size info for cocci *) loop (a,b) | Type_cocci.Decimal(e1,e2), (qub, (B.Decimal(l,p),ii)) -> (match X.mode with TransformMode -> ok (* nothing to do here *) | PatternMode -> let tc2e = function Type_cocci.Name n -> A.make_term(A.Ident(A.make_term(A.Id(A.make_mcode n)))) | Type_cocci.Num n -> A.make_term(A.Constant(A.make_mcode(A.Int n))) | Type_cocci.MV(mv,keep,inh) -> A.make_term (A.MetaExpr (A.make_mcode mv,A.NoConstraint,keep,None,A.CONST,inh)) | _ -> failwith "unexpected name in decimal" in (* no size info for cocci *) expression (tc2e e1) l >>= (fun _ _ -> (* no transformation to record *) match p with None -> failwith "not allowed in a type" | Some p -> expression (tc2e e2) p >>= (fun _ _ -> (* no transformation to record *) ok))) | Type_cocci.StructUnionName (sua, name), (qub, (B.StructUnionName (sub, sb),ii)) -> if equal_structUnion_type_cocci sua sub then structure_type_name name sb ii else fail | Type_cocci.EnumName (name), (qub, (B.EnumName (sb),ii)) -> structure_type_name name sb ii | Type_cocci.TypeName sa, (qub, (B.TypeName (namesb, _typb),noii)) -> let sb = Ast_c.str_of_name namesb in if sa =$= sb then ok else fail | Type_cocci.ConstVol (qua, a), (qub, b) -> if (fst qub).B.const && (fst qub).B.volatile then begin pr2_once ("warning: the type is both const & volatile but cocci " ^ "does not handle that"); fail end else if (match qua with | Type_cocci.Const -> (fst qub).B.const | Type_cocci.Volatile -> (fst qub).B.volatile ) then loop (a,(Ast_c.nQ, b)) else fail | Type_cocci.MetaType (ida,keep,inherited), typb -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in X.envf keep inherited (A.make_mcode ida, B.MetaTypeVal typb, max_min) (fun () -> ok ) (* subtil: must be after the MetaType case *) | a, (qub, (B.TypeName (_namesb, Some b), noii)) -> (* kind of typedef iso *) loop (a,b) (* for metavariables of type expression *^* *) | Type_cocci.Unknown , _ -> ok | (_, (_, (( B.TypeOfType _|B.TypeOfExpr _|B.ParenType _| B.EnumName _|B.StructUnion (_, _, _)|B.Enum (_, _) ), _))) -> fail | (_, (_, (( B.StructUnionName (_, _)| B.FunctionType _| B.Array (_, _)|B.Decimal (_, _)|B.Pointer _|B.TypeName _| B.BaseType _ ), _))) -> fail (* and decimal_type_exp nm sb ii = match nm with Type_cocci.NoName -> failwith "unexpected NoName in decimal type" | Type_cocci.Name sa -> (match B.unwrap sb with B.Ident name -> let ida = A.make_term(A.Id(A.make_mcode n)) in ident_cpp DontKnow ida nameidb >>= (fun ida nameidb -> ok) | _ -> fail) | Type_cocci.Num sa -> | Type_cocci.MV(ida,keep,inherited) -> (* degenerate version of MetaId, no transformation possible *) let (ib1, ib2) = tuple_of_list2 ii in let max_min _ = Lib_parsing_c.lin_col_by_pos [ib2] in let mida = A.make_mcode ida in X.envf keep inherited (mida, B.MetaIdVal (sb,[]), max_min) (fun () -> ok) *) and structure_type_name nm sb ii = match nm with Type_cocci.NoName -> ok | Type_cocci.Name sa -> if sa =$= sb then ok else fail | Type_cocci.Num sa -> failwith "unexpected Num in structure type" | Type_cocci.MV(ida,keep,inherited) -> (* degenerate version of MetaId, no transformation possible *) let (ib1, ib2) = tuple_of_list2 ii in let max_min _ = Lib_parsing_c.lin_col_by_pos [ib2] in let mida = A.make_mcode ida in X.envf keep inherited (mida, B.MetaIdVal (sb,[]), max_min) (fun () -> ok) in loop (a,b) and compatible_sign signa signb = let ok = return ((),()) in match signa, signb with | None, B.Signed | Some Type_cocci.Signed, B.Signed | Some Type_cocci.Unsigned, B.UnSigned -> ok | _ -> fail and equal_structUnion_type_cocci a b = match a, b with | Type_cocci.Struct, B.Struct -> true | Type_cocci.Union, B.Union -> true | _, (B.Struct | B.Union) -> false (*---------------------------------------------------------------------------*) and inc_file (a, before_after) (b, h_rel_pos) = let rec aux_inc (ass, bss) passed = match ass, bss with | [], [] -> true | [A.IncDots], _ -> let passed = List.rev passed in (match before_after, !h_rel_pos with | IncludeNothing, _ -> true | IncludeMcodeBefore, Some x -> List.mem passed (x.Ast_c.first_of) | IncludeMcodeAfter, Some x -> List.mem passed (x.Ast_c.last_of) (* no info, maybe cos of a #include that was already in a .h *) | _, None -> false ) | (A.IncPath x)::xs, y::ys -> x =$= y && aux_inc (xs, ys) (x::passed) | _ -> failwith "IncDots not in last place or other pb" in match a, b with | A.Local ass, B.Local bss -> aux_inc (ass, bss) [] | A.NonLocal ass, B.NonLocal bss -> aux_inc (ass, bss) [] | _ -> false (*---------------------------------------------------------------------------*) and (define_params: sequence -> (A.define_param list, (string B.wrap) B.wrap2 list) matcher) = fun seqstyle eas ebs -> match seqstyle with | Unordered -> failwith "not handling ooo" | Ordered -> define_paramsbis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted -> return (eas, (Ast_c.unsplit_comma ebs_splitted)) ) (* todo? facto code with argument and parameters ? *) and define_paramsbis = fun eas ebs -> let match_dots ea = match A.unwrap ea with A.DPdots(mcode) -> Some (mcode, None) | _ -> None in let build_dots (mcode, _optexpr) = A.DPdots(mcode) in let match_comma ea = match A.unwrap ea with A.DPComma ia1 -> Some ia1 | _ -> None in let build_comma ia1 = A.DPComma ia1 in let match_metalist ea = None in let build_metalist _ (ida,leninfo,keep,inherited) = failwith "not possible" in let mktermval v = failwith "not possible" in let special_cases ea eas ebs = None in let no_ii x = failwith "not possible" in list_matcher match_dots build_dots match_comma build_comma match_metalist build_metalist mktermval special_cases define_parameter X.distrf_define_params B.split_comma B.unsplit_comma no_ii (function x -> Some x) eas ebs and define_parameter = fun parama paramb -> match A.unwrap parama, paramb with A.DParam ida, (idb, ii) -> let ib1 = tuple_of_list1 ii in ident DontKnow ida (idb, ib1) >>= (fun ida (idb, ib1) -> return ((A.DParam ida)+> A.rewrap parama,(idb, [ib1]))) | (A.OptDParam _ | A.UniqueDParam _), _ -> failwith "handling Opt/Unique for define parameters" | A.DPcircles (_), ys -> raise (Impossible 48) (* in Ordered mode *) | _ -> fail (*****************************************************************************) (* Entry points *) (*****************************************************************************) (* no global solution for positions here, because for a statement metavariable we want a MetaStmtVal, and for the others, it's not clear what we want *) let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) = fun re node -> let rewrap x = x >>= (fun a b -> return (A.rewrap re a, F.rewrap node b)) in X.all_bound (A.get_inherited re) >&&> rewrap ( match A.unwrap re, F.unwrap node with (* note: the order of the clauses is important. *) | _, F.Enter | _, F.Exit | _, F.ErrorExit -> fail2() (* the metaRuleElem contains just '-' information. We don't need to add * stuff in the environment. If we need stuff in environment, because * there is a + S somewhere, then this will be done via MetaStmt, not * via MetaRuleElem. * Can match TrueNode/FalseNode/... so must be placed before those cases. *) | A.MetaRuleElem(mcode,keep,inherited), unwrap_node -> let default = A.MetaRuleElem(mcode,keep,inherited), unwrap_node in (match unwrap_node with | F.CaseNode _ | F.TrueNode | F.FalseNode | F.AfterNode | F.LoopFallThroughNode | F.FallThroughNode | F.InLoopNode -> if X.mode =*= PatternMode then return default else if mcode_contain_plus (mcodekind mcode) then failwith "try add stuff on fake node" (* minusize or contextize a fake node is ok *) else return default | F.EndStatement None -> if X.mode =*= PatternMode then return default else (* DEAD CODE NOW ? only useful in -no_cocci_vs_c_3 ? if mcode_contain_plus (mcodekind mcode) then let fake_info = Ast_c.fakeInfo() in distrf distrf_node (mcodekind mcode) (F.EndStatement (Some fake_info)) else return unwrap_node *) raise Todo | F.EndStatement (Some i1) -> tokenf mcode i1 >>= (fun mcode i1 -> return ( A.MetaRuleElem (mcode,keep, inherited), F.EndStatement (Some i1) )) | F.FunHeader _ -> if X.mode =*= PatternMode then return default else failwith "a MetaRuleElem can't transform a headfunc" | _n -> if X.mode =*= PatternMode then return default else X.distrf_node (generalize_mcode mcode) node >>= (fun mcode node -> return ( A.MetaRuleElem(mcode,keep, inherited), F.unwrap node )) ) (* rene cannot have found that a state containing a fake/exit/... should be * transformed * TODO: and F.Fake ? *) | _, F.EndStatement _ | _, F.CaseNode _ | _, F.TrueNode | _, F.FalseNode | _, F.AfterNode | _, F.FallThroughNode | _, F.LoopFallThroughNode | _, F.InLoopNode -> fail2() (* really ? diff between pattern.ml and transformation.ml *) | _, F.Fake -> fail2() (* cas general: a Meta can match everything. It matches only * "header"-statement. We transform only MetaRuleElem, not MetaStmt. * So can't have been called in transform. *) | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited), F.Decl(_) -> fail | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited), unwrap_node -> (* todo: should not happen in transform mode *) (match Control_flow_c.extract_fullstatement node with | Some stb -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_stmt stb) in X.envf keep inherited (ida, Ast_c.MetaStmtVal stb, max_min) (fun () -> (* no need tag ida, we can't be called in transform-mode *) return ( A.MetaStmt (ida, keep, metainfoMaybeTodo, inherited), unwrap_node ) ) | None -> fail ) (* not me?: *) | A.MetaStmtList _, _ -> failwith "not handling MetaStmtList" | A.TopExp ea, F.DefineExpr eb -> expression ea eb >>= (fun ea eb -> return ( A.TopExp ea, F.DefineExpr eb )) | A.TopExp ea, F.DefineType eb -> (match A.unwrap ea with A.TypeExp(ft) -> fullType ft eb >>= (fun ft eb -> return ( A.TopExp (A.rewrap ea (A.TypeExp(ft))), F.DefineType eb )) | _ -> fail) (* It is important to put this case before the one that fails because * of the lack of the counter part of a C construct in SmPL (for instance * there is not yet a CaseRange in SmPL). Even if SmPL don't handle * yet certain constructs, those constructs may contain expression * that we still want and can transform. *) | A.Exp exp, nodeb -> (* kind of iso, initialisation vs affectation *) let node = match A.unwrap exp, nodeb with | A.Assignment (ea, op, eb, true), F.Decl decl -> initialisation_to_affectation decl +> F.rewrap node | _ -> node in (* Now keep fullstatement inside the control flow node, * so that can then get in a MetaStmtVar the fullstatement to later * pp back when the S is in a +. But that means that * Exp will match an Ifnode even if there is no such exp * inside the condition of the Ifnode (because the exp may * be deeper, in the then branch). So have to not visit * all inside a node anymore. * * update: j'ai choisi d'accrocher au noeud du CFG à la * fois le fullstatement et le partialstatement et appeler le * visiteur que sur le partialstatement. *) let expfn = match Ast_cocci.get_pos re with | None -> expression | Some pos -> (fun ea eb -> let (max,min) = Lib_parsing_c.max_min_by_pos (Lib_parsing_c.ii_of_expr eb) in let keep = Type_cocci.Unitary in let inherited = false in let max_min _ = failwith "no pos" in X.envf keep inherited (pos, B.MetaPosVal (min,max), max_min) (fun () -> expression ea eb ) ) in X.cocciExp expfn exp node >>= (fun exp node -> return ( A.Exp exp, F.unwrap node ) ) | A.Ty ty, nodeb -> X.cocciTy fullType ty node >>= (fun ty node -> return ( A.Ty ty, F.unwrap node ) ) | A.TopInit init, nodeb -> X.cocciInit initialiser init node >>= (fun init node -> return ( A.TopInit init, F.unwrap node ) ) | A.FunHeader (mckstart, allminus, fninfoa, ida, oparen, paramsa, cparen), F.FunHeader ({B.f_name = nameidb; f_type = (retb, (paramsb, (isvaargs, iidotsb))); f_storage = stob; f_attr = attrs; f_body = body; f_old_c_style = oldstyle; }, ii) -> assert (null body); if oldstyle <> None then pr2 "OLD STYLE DECL NOT WELL SUPPORTED"; (* fninfoa records the order in which the SP specified the various information, but this isn't taken into account in the matching. Could this be a problem for transformation? *) let stoa = match List.filter (function A.FStorage(s) -> true | _ -> false) fninfoa with [A.FStorage(s)] -> Some s | _ -> None in let tya = match List.filter (function A.FType(s) -> true | _ -> false) fninfoa with [A.FType(t)] -> Some t | _ -> None in let inla = match List.filter (function A.FInline(i) -> true | _ -> false) fninfoa with [A.FInline(i)] -> Some i | _ -> None in (match List.filter (function A.FAttr(a) -> true | _ -> false) fninfoa with [A.FAttr(a)] -> failwith "not checking attributes" | _ -> ()); (match ii with | ioparenb::icparenb::iifakestart::iistob -> (* maybe important to put ident as the first tokens to transform. * It's related to transform_proto. So don't change order * between the >>=. *) ident_cpp LocalFunction ida nameidb >>= (fun ida nameidb -> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> tokenf oparen ioparenb >>= (fun oparen ioparenb -> tokenf cparen icparenb >>= (fun cparen icparenb -> parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>= (fun paramsaundots paramsb -> let paramsa = redots paramsa paramsaundots in inline_optional_allminus allminus inla (stob, iistob) >>= (fun inla (stob, iistob) -> storage_optional_allminus allminus stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> ( if isvaargs then pr2_once ("Not handling well variable length arguments func. "^ "You have been warned"); if allminus then minusize_list iidotsb else return ((),iidotsb) ) >>= (fun () iidotsb -> fullType_optional_allminus allminus tya retb >>= (fun tya retb -> let fninfoa = (match stoa with Some st -> [A.FStorage st] | None -> []) ++ (match inla with Some i -> [A.FInline i] | None -> []) ++ (match tya with Some t -> [A.FType t] | None -> []) in return ( A.FunHeader(mckstart,allminus,fninfoa,ida,oparen, paramsa,cparen), F.FunHeader ({B.f_name = nameidb; f_type = (retb, (paramsb, (isvaargs, iidotsb))); f_storage = stob; f_attr = attrs; f_body = body; f_old_c_style = oldstyle; (* TODO *) }, ioparenb::icparenb::iifakestart::iistob) ) ))))))))) | _ -> raise (Impossible 49) ) | A.Decl (mckstart,allminus,decla), F.Decl declb -> declaration (mckstart,allminus,decla) declb >>= (fun (mckstart,allminus,decla) declb -> return ( A.Decl (mckstart,allminus,decla), F.Decl declb )) | A.SeqStart mcode, F.SeqStart (st, level, i1) -> tokenf mcode i1 >>= (fun mcode i1 -> return ( A.SeqStart mcode, F.SeqStart (st, level, i1) )) | A.SeqEnd mcode, F.SeqEnd (level, i1) -> tokenf mcode i1 >>= (fun mcode i1 -> return ( A.SeqEnd mcode, F.SeqEnd (level, i1) )) | A.ExprStatement (Some ea, ia1), F.ExprStatement (st, (Some eb, ii)) -> let ib1 = tuple_of_list1 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( A.ExprStatement (Some ea, ia1), F.ExprStatement (st, (Some eb, [ib1])) ) )) | A.ExprStatement (None, ia1), F.ExprStatement (st, (None, ii)) -> let ib1 = tuple_of_list1 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( A.ExprStatement (None, ia1), F.ExprStatement (st, (None, [ib1])) ) ) | A.IfHeader (ia1,ia2, ea, ia3), F.IfHeader (st, (eb,ii)) -> let (ib1, ib2, ib3) = tuple_of_list3 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> return ( A.IfHeader (ia1, ia2, ea, ia3), F.IfHeader (st, (eb,[ib1;ib2;ib3])) ))))) | A.Else ia, F.Else ib -> tokenf ia ib >>= (fun ia ib -> return (A.Else ia, F.Else ib) ) | A.WhileHeader (ia1, ia2, ea, ia3), F.WhileHeader (st, (eb, ii)) -> let (ib1, ib2, ib3) = tuple_of_list3 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> return ( A.WhileHeader (ia1, ia2, ea, ia3), F.WhileHeader (st, (eb, [ib1;ib2;ib3])) ))))) | A.DoHeader ia, F.DoHeader (st, ib) -> tokenf ia ib >>= (fun ia ib -> return ( A.DoHeader ia, F.DoHeader (st, ib) )) | A.WhileTail (ia1,ia2,ea,ia3,ia4), F.DoWhileTail (eb, ii) -> let (ib1, ib2, ib3, ib4) = tuple_of_list4 ii in expression ea eb >>= (fun ea eb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> tokenf ia4 ib4 >>= (fun ia4 ib4 -> return ( A.WhileTail (ia1,ia2,ea,ia3,ia4), F.DoWhileTail (eb, [ib1;ib2;ib3;ib4]) )))))) | A.IteratorHeader (ia1, ia2, eas, ia3), F.MacroIterHeader (st, ((s,ebs),ii)) -> let (ib1, ib2, ib3) = tuple_of_list3 ii in ident DontKnow ia1 (s, ib1) >>= (fun ia1 (s, ib1) -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( A.IteratorHeader (ia1, ia2, eas, ia3), F.MacroIterHeader (st, ((s,ebs), [ib1;ib2;ib3])) ))))) | A.ForHeader (ia1, ia2, firsta, ea2opt, ia4, ea3opt, ia5), F.ForHeader (st, ((firstb, (eb2opt,ib4s), (eb3opt,ib4vide)), ii)) -> assert (null ib4vide); let (ib1, ib2, ib5) = tuple_of_list3 ii in let ib4 = tuple_of_list1 ib4s in (match (firsta,firstb) with (A.ForExp(ea1opt, ia3),B.ForExp(eb1opt,ib3s)) -> let ib3 = tuple_of_list1 ib3s in tokenf ia3 ib3 >>= (fun ia3 ib3 -> option expression ea1opt eb1opt >>= (fun ea1opt eb1opt -> return (A.ForExp(ea1opt, ia3),B.ForExp(eb1opt,[ib3])))) | (A.ForDecl (mckstart,allminus,decla),B.ForDecl declb) -> declaration (mckstart,allminus,decla) declb >>= (fun (mckstart,allminus,decla) declb -> return ( A.ForDecl (mckstart,allminus,decla), B.ForDecl declb )) | _ -> fail) >>= (fun firsta firstb -> tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia4 ib4 >>= (fun ia4 ib4 -> tokenf ia5 ib5 >>= (fun ia5 ib5 -> option expression ea2opt eb2opt >>= (fun ea2opt eb2opt -> option expression ea3opt eb3opt >>= (fun ea3opt eb3opt -> return ( A.ForHeader(ia1, ia2, firsta, ea2opt, ia4, ea3opt, ia5), F.ForHeader(st,((firstb,(eb2opt,[ib4]),(eb3opt,[])),[ib1;ib2;ib5])) )))))))) | A.SwitchHeader(ia1,ia2,ea,ia3), F.SwitchHeader (st, (eb,ii)) -> let (ib1, ib2, ib3) = tuple_of_list3 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> tokenf ia3 ib3 >>= (fun ia3 ib3 -> expression ea eb >>= (fun ea eb -> return ( A.SwitchHeader(ia1,ia2,ea,ia3), F.SwitchHeader (st, (eb,[ib1;ib2;ib3])) ))))) | A.Break (ia1, ia2), F.Break (st, ((),ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( A.Break (ia1, ia2), F.Break (st, ((),[ib1;ib2])) ))) | A.Continue (ia1, ia2), F.Continue (st, ((),ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( A.Continue (ia1, ia2), F.Continue (st, ((),[ib1;ib2])) ))) | A.Return (ia1, ia2), F.Return (st, ((),ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> return ( A.Return (ia1, ia2), F.Return (st, ((),[ib1;ib2])) ))) | A.ReturnExpr (ia1, ea, ia2), F.ReturnExpr (st, (eb, ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf ia1 ib1 >>= (fun ia1 ib1 -> tokenf ia2 ib2 >>= (fun ia2 ib2 -> expression ea eb >>= (fun ea eb -> return ( A.ReturnExpr (ia1, ea, ia2), F.ReturnExpr (st, (eb, [ib1;ib2])) )))) | A.Include(incla,filea), F.Include {B.i_include = (fileb, ii); B.i_rel_pos = h_rel_pos; B.i_is_in_ifdef = inifdef; B.i_content = copt; } -> assert (copt =*= None); let include_requirment = match mcodekind incla, mcodekind filea with | A.CONTEXT (_, A.BEFORE _), _ -> IncludeMcodeBefore | _, A.CONTEXT (_, A.AFTER _) -> IncludeMcodeAfter | _ -> IncludeNothing in let (inclb, iifileb) = tuple_of_list2 ii in if inc_file (term filea, include_requirment) (fileb, h_rel_pos) then tokenf incla inclb >>= (fun incla inclb -> tokenf filea iifileb >>= (fun filea iifileb -> return ( A.Include(incla, filea), F.Include {B.i_include = (fileb, [inclb;iifileb]); B.i_rel_pos = h_rel_pos; B.i_is_in_ifdef = inifdef; B.i_content = copt; } ))) else fail | A.Undef(undefa,ida), F.DefineHeader ((idb, ii), B.Undef) -> let (defineb, iidb, ieol) = tuple_of_list3 ii in ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> tokenf undefa defineb >>= (fun undefa defineb -> return ( A.Undef(undefa,ida), F.DefineHeader ((idb,[defineb;iidb;ieol]),B.Undef) )) ) | A.DefineHeader(definea,ida,params), F.DefineHeader ((idb, ii), defkind) -> let (defineb, iidb, ieol) = tuple_of_list3 ii in ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> tokenf definea defineb >>= (fun definea defineb -> (match A.unwrap params, defkind with | A.NoParams, B.DefineVar -> return ( A.NoParams +> A.rewrap params, B.DefineVar ) | A.DParams(lpa,eas,rpa), (B.DefineFunc (ebs, ii)) -> let (lpb, rpb) = tuple_of_list2 ii in tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> define_params (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( A.DParams (lpa,eas,rpa) +> A.rewrap params, B.DefineFunc (ebs,[lpb;rpb]) ) ))) | _ -> fail ) >>= (fun params defkind -> return ( A.DefineHeader (definea, ida, params), F.DefineHeader ((idb,[defineb;iidb;ieol]),defkind) )) )) | A.Pragma(prga,ida,pragmainfoa), F.PragmaHeader ((idb, ii), pragmainfob) -> let (prgb, iidb, ieol) = tuple_of_list3 ii in ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) -> tokenf prga prgb >>= (fun prga prgb -> let wp x = A.rewrap pragmainfoa x in (match A.unwrap pragmainfoa, pragmainfob with A.PragmaTuple(lp,eas,rp), B.PragmaTuple(ebs,iib) -> let (ib1, ib2) = tuple_of_list2 iib in tokenf lp ib1 >>= (fun lp ib1 -> tokenf rp ib2 >>= (fun rp ib2 -> arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs -> let eas = redots eas easundots in return ( A.PragmaTuple(lp,eas,rp) +> wp, B.PragmaTuple(ebs,[ib1; ib2]) )))) | A.PragmaIdList(idsa), B.PragmaIdList(idsb) -> ident_list (A.undots idsa) idsb >>= (fun idsaundots idsb -> let idsa = redots idsa idsaundots in return( A.PragmaIdList(idsa) +> wp, B.PragmaIdList(idsb) )) | A.PragmaDots(mcode), _ -> X.distrf_pragmainfo (dots2metavar mcode) pragmainfob >>= (fun mcode pragmainfob -> return ( A.PragmaDots(metavar2dots mcode) +> wp, pragmainfob )) | _ -> fail ) >>= (fun pragmainfoa pragmainfob -> return ( A.Pragma(prga,ida,pragmainfoa), F.PragmaHeader ((idb, [prgb; iidb; ieol]), pragmainfob) )) )) | A.Default(def,colon), F.Default (st, ((),ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf def ib1 >>= (fun def ib1 -> tokenf colon ib2 >>= (fun colon ib2 -> return ( A.Default(def,colon), F.Default (st, ((),[ib1;ib2])) ))) | A.Case(case,ea,colon), F.Case (st, (eb,ii)) -> let (ib1, ib2) = tuple_of_list2 ii in tokenf case ib1 >>= (fun case ib1 -> expression ea eb >>= (fun ea eb -> tokenf colon ib2 >>= (fun colon ib2 -> return ( A.Case(case,ea,colon), F.Case (st, (eb,[ib1;ib2])) )))) (* only occurs in the predicates generated by asttomember *) | A.DisjRuleElem eas, _ -> (eas +> List.fold_left (fun acc ea -> acc >|+|> (rule_elem_node ea node)) fail) >>= (fun ea eb -> return (A.unwrap ea,F.unwrap eb)) | _, F.ExprStatement (_, (None, ii)) -> fail (* happen ? *) | A.Label(id,dd), F.Label (st, nameb, ((),ii)) -> let (ib2) = tuple_of_list1 ii in ident_cpp DontKnow id nameb >>= (fun ida nameb -> tokenf dd ib2 >>= (fun dd ib2 -> return ( A.Label (ida,dd), F.Label (st,nameb, ((),[ib2])) ))) | A.Goto(goto,id,sem), F.Goto (st,nameb, ((),ii)) -> let (ib1,ib3) = tuple_of_list2 ii in tokenf goto ib1 >>= (fun goto ib1 -> ident_cpp DontKnow id nameb >>= (fun id nameb -> tokenf sem ib3 >>= (fun sem ib3 -> return( A.Goto(goto,id,sem), F.Goto (st,nameb, ((),[ib1;ib3])) )))) (* have not a counter part in coccinelle, for the moment *) (* todo?: print a warning at least ? *) | _, F.CaseRange _ | _, F.Asm _ -> fail2() | _, F.MacroTop _ -> fail2() | _, (F.IfdefEndif _|F.IfdefElse _|F.IfdefHeader _) -> fail2 () | _, (F.MacroStmt (_, _)| F.DefineDoWhileZeroHeader _| F.EndNode|F.TopNode) -> fail | _, (F.Label (_, _, _)|F.Break (_, _)|F.Continue (_, _)|F.Default (_, _)| F.Case (_, _)|F.Include _|F.Goto _|F.ExprStatement _| F.DefineType _|F.DefineExpr _|F.DefineTodo| F.DefineHeader (_, _)|F.PragmaHeader (_, _)| F.ReturnExpr (_, _)|F.Return (_, _)| F.MacroIterHeader (_, _)| F.SwitchHeader (_, _)|F.ForHeader (_, _)|F.DoWhileTail _|F.DoHeader (_, _)| F.WhileHeader (_, _)|F.Else _|F.IfHeader (_, _)| F.SeqEnd (_, _)|F.SeqStart (_, _, _)| F.Decl _|F.FunHeader _) -> fail ) end coccinelle-1.0.0-rc19/engine/cocci_vs_c.mli0000644000175000017500000002175512247442615017437 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci_vs_c.mli" (*****************************************************************************) (* Cocci vs C *) (*****************************************************************************) (* This module was introduced to factorize code between * pattern.ml and transformation.ml. In both cases we need * to "compare" a piece of C with a piece of Cocci, and depending * if we want just to pattern or transform, we perform different * actions on the tokens. So, the common code is in this module * and the module specific actions are in pattern.ml and transformation.ml. * * We could have used a visitor approach as in visitor_c but I prefer * this time to use a functor. The specific actions are passed * via a module to the functor. * * If the functor is too complex too understand, you can look at * the comments in pattern.ml and transformation.ml to look at * how it was done before, which may help to understand how * it is done now. * * You can also look at the papers on parser combinators in haskell * (cf a pearl by meijer in ICFP) to understand our monadic * approach to matching/unifying. *) (* should be used as less as possible. Most of the time the code in * cocci_vs_c should be the same if we pattern or transform *) type mode = PatternMode | TransformMode (* used in both pattern and transform, in envf *) val equal_metavarval : Ast_c.metavar_binding_kind -> Ast_c.metavar_binding_kind -> bool (* for inherited metavariables. no declaration link on expressions *) val equal_inh_metavarval : Ast_c.metavar_binding_kind -> Ast_c.metavar_binding_kind -> bool (*****************************************************************************) (* The parameter of the functor (the specific actions) *) (*****************************************************************************) module type PARAM = sig type tin type 'a tout (* a matcher between 'a' and 'b' take 'a' and 'b' in parameter, * and "something" (tin; a state that is threaded across calls), * and return a new 'a' and 'b' encapsulated in "something" (tout) *) type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout val mode : mode (* -------------------------------------------------------------------- *) (* The monadic combinators *) (* -------------------------------------------------------------------- *) (* it kinds of take a matcher in parameter, and another matcher, * and returns a matcher, so =~ matcher -> matcher -> matcher *) val ( >>= ) : (tin -> ('a * 'b) tout) -> ('a -> 'b -> tin -> ('c * 'd) tout) -> tin -> ('c * 'd) tout val return : 'a * 'b -> tin -> ('a * 'b) tout val fail : tin -> ('a * 'b) tout val ( >||> ) : (tin -> 'a tout) -> (tin -> 'a tout) -> tin -> 'a tout val ( >|+|> ) : (tin -> 'a tout) -> (tin -> 'a tout) -> tin -> 'a tout val ( >&&> ) : (tin -> bool) -> (tin -> 'a tout) -> tin -> 'a tout (* -------------------------------------------------------------------- *) (* Tokens tagging *) (* -------------------------------------------------------------------- *) val tokenf : ('a Ast_cocci.mcode, Ast_c.info) matcher val tokenf_mck : (Ast_cocci.mcodekind, Ast_c.info) matcher (* -------------------------------------------------------------------- *) (* Distr_f functions, to tag a range of tokens *) (* -------------------------------------------------------------------- *) val distrf_e : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.expression) matcher val distrf_args : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.argument, Ast_c.il) Common.either list) matcher val distrf_type : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.fullType) matcher val distrf_params : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.parameterType, Ast_c.il) Common.either list) matcher val distrf_param : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.parameterType) matcher val distrf_ini : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.initialiser) matcher val distrf_inis : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.initialiser, Ast_c.il) Common.either list) matcher val distrf_decl : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.declaration) matcher val distrf_field : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.field) matcher val distrf_node : (Ast_cocci.meta_name Ast_cocci.mcode, Control_flow_c.node) matcher val distrf_fragments : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.string_fragment, Ast_c.il) Common.either list) matcher val distrf_format : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.string_format) matcher val distrf_define_params : (Ast_cocci.meta_name Ast_cocci.mcode, (string Ast_c.wrap, Ast_c.il) Common.either list) matcher val distrf_pragmainfo : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.pragmainfo) matcher val distrf_ident_list : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.name, Ast_c.il) Common.either list) matcher val distrf_enum_fields : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.oneEnumType, Ast_c.il) Common.either list) matcher val distrf_struct_fields : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.field list) matcher val distrf_cst : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.constant, string) Common.either Ast_c.wrap) matcher (* -------------------------------------------------------------------- *) (* Modifying nested expression and nested types, with Exp and Ty *) (* -------------------------------------------------------------------- *) val cocciExp : (Ast_cocci.expression, Ast_c.expression) matcher -> (Ast_cocci.expression, Control_flow_c.node) matcher val cocciExpExp : Ast_cocci.mcodekind -> (Ast_cocci.expression, Ast_c.expression) matcher -> (Ast_cocci.expression, Ast_c.expression) matcher val cocciTy : (Ast_cocci.fullType, Ast_c.fullType) matcher -> (Ast_cocci.fullType, Control_flow_c.node) matcher val cocciInit : (Ast_cocci.initialiser, Ast_c.initialiser) matcher -> (Ast_cocci.initialiser, Control_flow_c.node) matcher (* -------------------------------------------------------------------- *) (* Environment manipulation. Extract info from tin, the "something" *) (* -------------------------------------------------------------------- *) val envf : Ast_cocci.keep_binding -> Ast_cocci.inherited -> Ast_cocci.meta_name Ast_cocci.mcode * Ast_c.metavar_binding_kind * (* pos info, if needed *) (unit -> Common.filename * string * Ast_c.posl * Ast_c.posl) -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val check_idconstraint : ('a -> 'b -> bool) -> 'a -> 'b -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val check_constraints_ne : ('a, 'b) matcher -> 'a list -> 'b -> (unit -> tin -> 'x tout) -> (tin -> 'x tout) val all_bound : Ast_cocci.meta_name list -> tin -> bool val optional_storage_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val optional_qualifier_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) val value_format_flag: (bool -> tin -> 'x tout) -> (tin -> 'x tout) val optional_declarer_semicolon_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout) end (*****************************************************************************) (* The functor itself *) (*****************************************************************************) module COCCI_VS_C : functor (X : PARAM) -> sig type ('a, 'b) matcher = 'a -> 'b -> X.tin -> ('a * 'b) X.tout val rule_elem_node : (Ast_cocci.rule_elem, Control_flow_c.node) matcher val expression : (Ast_cocci.expression, Ast_c.expression) matcher (* there are far more functions in this functor but they do not have * to be exported *) end coccinelle-1.0.0-rc19/engine/ctlcocci_integration.mli0000644000175000017500000000356712247442615021534 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctlcocci_integration.mli" open Ograph_extended val labels_for_ctl : string list (* dropped isos *) -> (nodei * Control_flow_c.node) list -> Lib_engine.metavars_binding -> Lib_engine.label_ctlcocci val fix_flow_ctl : Control_flow_c.cflow -> Control_flow_c.cflow val model_for_ctl : string list (* dropped isos *) -> Control_flow_c.cflow -> Lib_engine.metavars_binding -> Lib_engine.model type pred = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif val mysat : Lib_engine.model -> (Lib_engine.ctlcocci * (pred list list)) -> (string (*rulename*) * Lib_engine.mvar list * Lib_engine.metavars_binding)-> (Lib_engine.numbered_transformation_info * bool * Lib_engine.metavars_binding * Lib_engine.metavars_binding list) val print_bench : unit -> unit coccinelle-1.0.0-rc19/engine/flag_engine.ml0000644000175000017500000000274012247442615017423 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_engine.ml" let debug_engine = ref false (* false = simpler formulas, only for debugging *) let useEU = ref true let disallow_nested_exps = ref false (* if this flag is not set, then break and continue are also error exits *) let only_return_is_error_exit = ref false (* a hack to allow adding code in some more sgrep-like uses *) let allow_inconsistent_paths = ref false coccinelle-1.0.0-rc19/engine/asttoctl2.mli0000644000175000017500000000324612247442615017257 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttoctl2.mli" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type top_formula = NONDECL of Lib_engine.ctlcocci | CODE of Lib_engine.ctlcocci val asttoctl : Ast_cocci.rule -> (Ast_cocci.meta_name list list (* used after *) * Ast_cocci.meta_name list list (* fresh used after *) * Ast_cocci.meta_name list list (* fresh used after seeds *)) -> Ast_cocci.meta_name list list (* positions *) -> top_formula list val pp_cocci_predicate : cocci_predicate -> unit val cocci_predicate_to_string : cocci_predicate -> string coccinelle-1.0.0-rc19/engine/transformation_c.mli0000644000175000017500000000266612247442615020715 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./transformation_c.mli" (* note that now we do the transformation via side effect on ast *) val transform : string (* rule name *) -> string list (* dropped isos *) -> Lib_engine.metavars_binding -> (* inherited bindings *) Lib_engine.numbered_transformation_info -> Control_flow_c.cflow -> Control_flow_c.cflow (* could be unit *) coccinelle-1.0.0-rc19/engine/externalanalysis.mli0000644000175000017500000000452412247442615020726 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./externalanalysis.mli" module Int64Set : Set.S with type elt = int64 type bound = int64 option type result = IntSet of Int64Set.t | IntBounds of bound * bound | Other of string val show_bound : bound -> string val show_result : result -> string val load_external_results : string -> unit val find_results : Common.filename -> Ast_c.posl -> Ast_c.posl -> result list val intersect_results : result -> result -> result option val satisfy : (result list -> bool) -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val satisfy1 : (result -> bool) -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val has_any_result : Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val for_all : (result -> bool) -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val for_all1 : (result -> bool) -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val exists : (result -> bool) -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val single_int : int64 -> result -> bool val contains_int : int64 -> result -> bool val has_only_nul : Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val has_also_nul : Common.filename -> Ast_c.posl -> Ast_c.posl -> bool val has_also_int : int64 -> Common.filename -> Ast_c.posl -> Ast_c.posl -> bool coccinelle-1.0.0-rc19/engine/engine.mldylib0000644000175000017500000000041312247437436017456 0ustar eugeneugenAsttoctl2 Asttomember C_vs_c Check_exhaustive_pattern Check_reachability Cocci_vs_c Ctlcocci_integration Ctltotex Externalanalysis Flag_engine Flag_matcher Isomorphisms_c_c Lib_engine Lib_matcher_c Pattern_c Postprocess_transinfo Pretty_print_engine Transformation_c coccinelle-1.0.0-rc19/engine/postprocess_transinfo.mli0000644000175000017500000000323512247442615022005 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./postprocess_transinfo.mli" val process : Ast_cocci.meta_name list (* used after *) -> (Ast_cocci.meta_name * Lib_engine.metavar_binding_kind2) list (*inherited env*)-> (Ograph_extended.nodei * (Ast_cocci.meta_name * Lib_engine.metavar_binding_kind2) list * Lib_engine.predicate) list list -> (int list (*index*) * (Ograph_extended.nodei * (Ast_cocci.meta_name * Lib_engine.metavar_binding_kind2) list * Lib_engine.predicate)) list * (Ast_cocci.meta_name * Lib_engine.metavar_binding_kind2) list list coccinelle-1.0.0-rc19/engine/ctlcocci_integration.ml0000644000175000017500000005152512247442615021360 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctlcocci_integration.ml" open Common open Ograph_extended module F = Control_flow_c (*****************************************************************************) (* Debugging functions *) (*****************************************************************************) let show_or_not_predicate pred = if !Flag_matcher.debug_engine then begin indent_do (fun () -> adjust_pp_with_indent_and_header "labeling: pred = " (fun () -> Pretty_print_engine.pp_predicate pred; ); ) end let show_or_not_nodes nodes = if !Flag_matcher.debug_engine then begin indent_do (fun () -> adjust_pp_with_indent_and_header "labeling: result = " (fun () -> Common.pp_do_in_box (fun () -> pp "{"; Common.print_between (fun () -> pp ";"; Format.print_cut()) (fun (nodei, (_predTODO, subst)) -> Format.print_int nodei; Common.pp_do_in_box (fun () -> Pretty_print_engine.pp_binding2_ctlsubst subst ) ) nodes; pp "}"; ); ) ) end let show_isos rule_elem = match Ast_cocci.get_isos rule_elem with [] -> () | isos -> let line = Ast_cocci.get_line rule_elem in Printf.printf "rule elem: "; Pretty_print_cocci.rule_elem "" rule_elem; Format.print_newline(); List.iter (function (nm,x) -> Printf.printf " iso: %s(%d): " nm line; Pretty_print_cocci.pp_print_anything x; Format.print_newline()) isos (*****************************************************************************) (* Labeling function *) (*****************************************************************************) let (-->) x v = Ast_ctl.Subst (x,v);; (* Take list of predicate and for each predicate returns where in the * control flow it matches, and the set of substitutions for this match. *) let (labels_for_ctl: string list (* dropped isos *) -> (nodei * F.node) list -> Lib_engine.metavars_binding -> Lib_engine.label_ctlcocci) = fun dropped_isos nodes binding -> (fun p -> show_or_not_predicate p; let nodes' = nodes +> List.map (fun (nodei, node) -> (* todo? put part of this code in pattern ? *) (match p, F.unwrap node with | Lib_engine.Paren s, (F.SeqStart (_, bracelevel, _)) -> let make_var x = ("",i_to_s x) in [(nodei, (p,[(s --> (Lib_engine.ParenVal (make_var bracelevel)))]))] | Lib_engine.Paren s, (F.SeqEnd (bracelevel, _)) -> let make_var x = ("",i_to_s x) in [(nodei, (p,[(s --> (Lib_engine.ParenVal (make_var bracelevel)))]))] | Lib_engine.Paren _, _ -> [] | Lib_engine.Label s, _ -> let labels = F.extract_labels node in [(nodei, (p,[(s --> (Lib_engine.LabelVal (Lib_engine.Absolute labels)))]))] | Lib_engine.BCLabel s, _ -> (match F.extract_bclabels node with [] -> [] (* null for all nodes that are not break or continue *) | labels -> [(nodei, (p,[(s --> (Lib_engine.LabelVal (Lib_engine.Absolute labels)))]))]) | Lib_engine.PrefixLabel s, _ -> let labels = F.extract_labels node in [(nodei, (p,[(s --> (Lib_engine.LabelVal (Lib_engine.Prefix labels)))]))] | Lib_engine.Match (re), _unwrapnode -> let substs = Pattern_c.match_re_node dropped_isos re node binding +> List.map (fun (re', subst) -> Lib_engine.Match (re'), subst ) in substs +> List.map (fun (p', subst) -> (nodei, (p', subst +> List.map (fun (s, meta) -> s --> Lib_engine.NormalMetaVal meta )))) | Lib_engine.InLoop, F.InLoopNode -> [nodei, (p,[])] | Lib_engine.TrueBranch , F.TrueNode -> [nodei, (p,[])] | Lib_engine.FalseBranch, F.FalseNode -> [nodei, (p,[])] | Lib_engine.After, F.AfterNode -> [nodei, (p,[])] | Lib_engine.FallThrough, F.FallThroughNode -> [nodei,(p,[])] | Lib_engine.LoopFallThrough, F.LoopFallThroughNode -> [nodei,(p,[])] | Lib_engine.FunHeader, F.FunHeader _ -> [nodei, (p,[])] | Lib_engine.Top, F.TopNode -> [nodei, (p,[])] | Lib_engine.Exit, F.Exit -> [nodei, (p,[])] | Lib_engine.ErrorExit, F.ErrorExit -> [nodei, (p,[])] | Lib_engine.Goto, F.Goto(_,_,_) -> [nodei, (p,[])] | Lib_engine.UnsafeBrace, node -> (* cases where it it not safe to put something on the outer side of braces *) (match node with F.FunHeader _ | F.DoHeader _ | F.TrueNode | F.Else _ | F.InLoopNode (* while, for *) | F.SwitchHeader _ -> [nodei, (p,[])] | _ -> []) | Lib_engine.InLoop , _ -> [] | Lib_engine.TrueBranch , _ -> [] | Lib_engine.FalseBranch, _ -> [] | Lib_engine.After, _ -> [] | Lib_engine.FallThrough, _ -> [] | Lib_engine.LoopFallThrough, _ -> [] | Lib_engine.FunHeader, _ -> [] | Lib_engine.Top, _ -> [] | Lib_engine.Exit, _ -> [] | Lib_engine.ErrorExit, _ -> [] | Lib_engine.Goto, _ -> [] | Lib_engine.BindGood s, _ -> [(nodei, (p,[(s --> Lib_engine.GoodVal)]))] | Lib_engine.BindBad s, _ -> [(nodei, (p,[(s --> Lib_engine.BadVal)]))] | Lib_engine.FakeBrace, _ -> if F.extract_is_fake node then [nodei, (p,[])] else [] | Lib_engine.Return, node -> (match node with (* todo? should match the Exit code ? * todo: one day try also to match the special function * such as panic(); *) | F.Return _ -> [nodei, (p,[])] | F.ReturnExpr _ -> [nodei, (p,[])] | _ -> [] ) ) ) +> List.concat in show_or_not_nodes nodes'; nodes' ) (*****************************************************************************) (* Some fix flow, for CTL, for unparse *) (*****************************************************************************) (* could erase info on nodes, and edge, because they are not used by rene *) let (control_flow_for_ctl: F.cflow -> ('a, 'b) ograph_mutable) = fun cflow -> cflow (* Just make the final node of the control flow loop over itself. * It seems that one hypothesis of the SAT algorithm is that each node as at * least a successor. * * update: do same for errorexit node. * * update: also erase the fake nodes (and adjust the edges accordingly), * so that AX in CTL can now work. * Indeed, la fin de la branche then (et else), on devrait aller directement * au suivant du endif, sinon si ecrit if(1) { foo(); }; bar(); * sans '...' entre le if et bar(), alors ca matchera pas car le CTL * generera un AX bar() qui il tombera d'abord sur le [endif] :( * Mais chiant de changer l'algo de generation, marche pas tres bien avec * ma facon de faire recursive et compositionnel. * => faire une fonction qui applique des fixes autour de ce control flow, * comme ca passe un bon flow a rene, mais garde un flow a moi pour pouvoir * facilement generate back the ast. * alt: faire un wrapper autourde mon graphe pour lui passer dans le module CFG * une fonction qui passe a travers les Fake, mais bof. * * update: also make loop the deadcode nodes, the one that have * no predecessor. *) let (fix_flow_ctl2: F.cflow -> F.cflow) = fun flow -> let g = ref flow in let topi = F.first_node !g in !g#add_arc ((topi, topi), F.Direct); (* for the #define CFG who have no Exit but have at least a EndNode *) (try let endi = F.find_node (fun x -> x =*= F.EndNode) !g in !g#add_arc ((endi, endi), F.Direct); with Not_found -> () ); (* for the regular functions *) (try let exitnodei = F.find_node (fun x -> x =*= F.Exit) !g in let errornodei = F.find_node (fun x -> x =*= F.ErrorExit) !g in !g#add_arc ((exitnodei, exitnodei), F.Direct); if null ((!g#successors errornodei)#tolist) && null ((!g#predecessors errornodei)#tolist) then !g#del_node errornodei else !g#add_arc ((errornodei, errornodei), F.Direct); with Not_found -> () ); let fake_nodes = !g#nodes#tolist +> List.filter (fun (nodei, node) -> match F.unwrap node with | F.CaseNode _ | F.Enter (*| F.Fake*) (* [endif], [endswitch], ... *) -> true | _ -> false ) in fake_nodes +> List.iter (fun (nodei, node) -> F.remove_one_node nodei !g); (* even when have deadcode, julia want loop over those nodes *) !g#nodes#tolist +> List.iter (fun (nodei, node) -> if (!g#predecessors nodei)#null then begin let fakei = !g#add_node (F.mk_node F.Fake [] [] "DEADCODELOOP") in !g#add_arc ((fakei, nodei), F.Direct); !g#add_arc ((fakei, fakei), F.Direct); end ); !g#nodes#tolist +> List.iter (fun (nodei, node) -> assert (List.length ((!g#successors nodei)#tolist) >= 1); (* no: && List.length ((!g#predecessors nodei)#tolist) >= 1 because the enter node at least have no predecessors *) ); !g let fix_flow_ctl a = Common.profile_code "fix_flow" (fun () -> fix_flow_ctl2 a) (*****************************************************************************) (* subtil: the label must operate on newflow, not (old) cflow * update: now I supposed that we give me a fixed_flow *) let model_for_ctl dropped_isos cflow binding = let newflow = cflow (* old: fix_flow_ctl (control_flow_for_ctl cflow) *) in let labels = labels_for_ctl dropped_isos (newflow#nodes#tolist) binding in let states = List.map fst newflow#nodes#tolist in newflow, labels, states (*****************************************************************************) module PRED = struct type t = Lib_engine.predicate let print_predicate x = Pretty_print_cocci.print_plus_flag := false; Pretty_print_cocci.print_minus_flag := false; Pretty_print_engine.pp_predicate x end (* prefix has to be nonempty *) let prefix l1 l2 = let rec loop = function ([],_) -> true | (_,[]) -> false | (x::xs,y::ys) when x = y -> loop (xs,ys) | _ -> false in loop(l1,l2) let compatible_labels l1 l2 = match (l1,l2) with (Lib_engine.Absolute(l1),Lib_engine.Absolute(l2)) -> l1 =*= l2 | (Lib_engine.Absolute(l1),Lib_engine.Prefix(l2)) -> prefix l1 l2 | (Lib_engine.Prefix(l1),Lib_engine.Absolute(l2)) -> prefix l2 l1 | (Lib_engine.Prefix(l1),Lib_engine.Prefix(l2)) -> not (l1 = []) && not (l2 = []) && List.hd l1 =*= List.hd l2 (* labels are never empty *) let merge_labels l1 l2 = match (l1,l2) with (* known to be compatible *) (Lib_engine.Absolute(_),Lib_engine.Absolute(_)) -> l1 | (Lib_engine.Absolute(_),Lib_engine.Prefix(_)) -> l1 | (Lib_engine.Prefix(_),Lib_engine.Absolute(_)) -> l2 | (Lib_engine.Prefix(l1),Lib_engine.Prefix(l2)) -> let rec max_prefix = function (x::xs,y::ys) when x = y -> x::(max_prefix(xs,ys)) | (l1,l2) -> [] in Lib_engine.Prefix(max_prefix(l1,l2)) module ENV = struct type value = Lib_engine.metavar_binding_kind2 type mvar = Ast_cocci.meta_name let eq_mvar x x' = x =*= x' let eq_val v v' = (* v = v' *) match (v,v') with (Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min1,max1)), Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min2,max2))) -> ((min1 <= min2) && (max1 >= max2)) or ((min2 <= min1) && (max2 >= max1)) | (Lib_engine.NormalMetaVal(Ast_c.MetaTypeVal a), Lib_engine.NormalMetaVal(Ast_c.MetaTypeVal b)) -> C_vs_c.eq_type a b | (Lib_engine.LabelVal(l1),Lib_engine.LabelVal(l2)) -> compatible_labels l1 l2 | _ -> v =*= v' let merge_val v v' = (* values guaranteed to be compatible *) (* v *) match (v,v') with (Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min1,max1)), Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min2,max2))) -> if (min1 <= min2) && (max1 >= max2) then Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min1,max1)) else if (min2 <= min1) && (max2 >= max1) then Lib_engine.NormalMetaVal(Ast_c.MetaPosVal(min2,max2)) else failwith "incompatible positions give to merge" | (Lib_engine.NormalMetaVal(Ast_c.MetaTypeVal a), Lib_engine.NormalMetaVal(Ast_c.MetaTypeVal b)) -> Lib_engine.NormalMetaVal (Ast_c.MetaTypeVal (C_vs_c.merge_type a b)) | (Lib_engine.LabelVal(l1),Lib_engine.LabelVal(l2)) -> Lib_engine.LabelVal(merge_labels l1 l2) | _ -> v let print_mvar (_,s) = Format.print_string s let print_value x = Pretty_print_engine.pp_binding_kind2 x end module CFG = struct type node = Ograph_extended.nodei type cfg = (F.node, F.edge) Ograph_extended.ograph_mutable let predecessors cfg n = List.map fst ((cfg#predecessors n)#tolist) let successors cfg n = List.map fst ((cfg#successors n)#tolist) let extract_is_loop cfg n = Control_flow_c.extract_is_loop (cfg#nodes#find n) let print_node i = Format.print_string (i_to_s i) let size cfg = cfg#nodes#length (* In ctl_engine, we use 'node' for the node but in the Ograph_extended * terminology, this 'node' is in fact an index to access the real * node information (that ctl/ wants to abstract away to be more generic), * the 'Ograph_extended.nodei'. *) let print_graph cfg label border_colors fill_colors filename = Ograph_extended.print_ograph_mutable_generic cfg label (fun (nodei, (node: F.node)) -> (* the string julia wants to put ? *) let bc = try Some(List.assoc nodei border_colors) with _ -> None in let fc = try Some(List.assoc nodei fill_colors) with _ -> None in (* the string yoann put as debug information in the cfg *) let str = snd node in (str,bc,fc) ) ~output_file:filename ~launch_gv:false end module WRAPPED_ENGINE = Wrapper_ctl.CTL_ENGINE_BIS (ENV) (CFG) (PRED) let print_bench _ = WRAPPED_ENGINE.print_bench() type pred = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif (*****************************************************************************) let metavars_binding2_to_binding binding2 = binding2 +> Common.map_filter (fun (s, kind2) -> match kind2 with | Lib_engine.NormalMetaVal kind -> Some (s, kind) (* I thought it was Impossible to have this when called from satbis_to_trans_info but it does not seems so *) | Lib_engine.ParenVal _ -> None | Lib_engine.LabelVal _ -> None | Lib_engine.BadVal -> None (* should not occur *) | Lib_engine.GoodVal -> None (* should not occur *) ) let metavars_binding_to_binding2 binding = binding +> List.map (fun (s, kind) -> s, Lib_engine.NormalMetaVal kind) let (satbis_to_trans_info: (int list * (nodei * Lib_engine.metavars_binding2 * Lib_engine.predicate)) list -> (int list * (nodei * Lib_engine.metavars_binding * Ast_cocci.rule_elem)) list) = fun xs -> xs +> List.fold_left (fun prev (index,(nodei, binding2, pred)) -> match pred with | Lib_engine.Match (rule_elem) -> if !Flag.track_iso_usage then show_isos rule_elem; (index, (nodei, metavars_binding2_to_binding binding2, rule_elem)) ::prev (* see BindGood in asttotctl2 *) | Lib_engine.BindGood (_) -> prev | _ -> raise (Impossible 50) ) [] (*****************************************************************************) let rec coalesce_positions = function [] -> [] | (x,Ast_c.MetaPosValList l)::rest -> let (same,others) = List.partition (function (x1,_) -> x =*= x1) rest in let ls = List.concat (List.map (function (_,Ast_c.MetaPosValList l) -> l | _ -> failwith "unexpected non-position") same) in let new_ls = List.sort compare (l@ls) in (x,Ast_c.MetaPosValList new_ls) :: coalesce_positions others | x::rest -> x :: coalesce_positions rest let strip env = List.map (function (v,vl) -> let vl = match vl with Ast_c.MetaExprVal (a,c) -> Ast_c.MetaExprVal(Lib_parsing_c.al_inh_expr a,c) | Ast_c.MetaExprListVal a -> Ast_c.MetaExprListVal(Lib_parsing_c.al_inh_arguments a) | Ast_c.MetaStmtVal a -> Ast_c.MetaStmtVal(Lib_parsing_c.al_inh_statement a) | Ast_c.MetaInitVal a -> Ast_c.MetaInitVal(Lib_parsing_c.al_inh_init a) | Ast_c.MetaInitListVal a -> Ast_c.MetaInitListVal(Lib_parsing_c.al_inh_inits a) | x -> (*don't contain binding info*) x in (v,vl)) env (* these remove constraints, at least those that contain pcre regexps, which cannot be compared (problem in the unparser) *) let strip_predicate re = let donothing r k e = k e in let mcode mc = mc in let ident r k e = let e = k e in match Ast_cocci.unwrap e with Ast_cocci.MetaId(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaId(name,Ast_cocci.IdNoConstraint,u,i)) | Ast_cocci.MetaFunc(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaFunc(name,Ast_cocci.IdNoConstraint,u,i)) | Ast_cocci.MetaLocalFunc(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaLocalFunc(name,Ast_cocci.IdNoConstraint,u,i)) | _ -> e in let expression r k e = let e = k e in match Ast_cocci.unwrap e with Ast_cocci.MetaErr(name,constraints,u,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaErr(name,Ast_cocci.NoConstraint,u,i)) | Ast_cocci.MetaExpr(name,constraints,u,ty,form,i) -> Ast_cocci.rewrap e (Ast_cocci.MetaExpr(name,Ast_cocci.NoConstraint,u,ty,form,i)) | _ -> e in let fn = Visitor_ast.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in fn.Visitor_ast.rebuilder_rule_elem re let clean_trans_info2 trans_info2 = List.map (function a -> (List.map (function (node,env,pred) -> let pred = match pred with Lib_engine.Match re -> Lib_engine.Match (strip_predicate re) | _ -> pred in (node,env,pred)) a)) trans_info2 let rec nub ls = match ls with [] -> [] | (x::xs) when (List.mem x xs) -> nub xs | (x::xs) -> x::(nub xs) (*****************************************************************************) (* Call ctl engine *) (***************************************************** ************************) let (mysat2: Lib_engine.model -> (Lib_engine.ctlcocci * (pred list list)) -> (string (*rulename*) * Lib_engine.mvar list*Lib_engine.metavars_binding) -> (Lib_engine.numbered_transformation_info * bool * Lib_engine.metavars_binding * Lib_engine.metavars_binding list)) = fun (flow, label, states) ctl (rulename, used_after, binding) -> let binding2 = metavars_binding_to_binding2 binding in let (triples,(trans_info2, returned_any_states, used_after_envs)) = WRAPPED_ENGINE.satbis (flow, label, states) ctl (used_after, binding2) in (* drop constraints in the predicate at the end of each match. constraints aren't needed for transformation, and they can contain regular expressions, which are incomparable. *) let trans_info2 = clean_trans_info2 trans_info2 in if not (!Flag_parsing_cocci.sgrep_mode || !Flag.sgrep_mode2 || !Flag_matcher.allow_inconsistent_paths) then Check_reachability.check_reachability rulename triples flow; let (trans_info2,used_after_fresh_envs) = Postprocess_transinfo.process used_after binding2 trans_info2 in let used_after_envs = Common.uniq(List.map2 (@) used_after_fresh_envs used_after_envs) in let trans_info = satbis_to_trans_info trans_info2 in let newbindings = List.map metavars_binding2_to_binding used_after_envs in let newbindings = List.map coalesce_positions newbindings in let newbindings = List.map strip newbindings in let newbindings = nub newbindings in (trans_info, returned_any_states, binding, newbindings) let mysat a b c = Common.profile_code "mysat" (fun () -> mysat2 a b c) coccinelle-1.0.0-rc19/engine/isomorphisms_c_c.ml0000644000175000017500000000502112247442615020520 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./isomorphisms_c_c.ml" open Common (* When in a semantic patch there is f(X) ... f(X) we want to force * the two X to be equal in the concrete code, but we would like that * there be equal modulo some isomorphisms, so that the following * concrete code also match: f(a && b) g(); f(b && a) * Maybe would be easier to transform ast_c in ast_cocci and call the * iso engine of julia. *) open Ast_c let rec (iso_e_e: expression -> expression -> bool) = fun a b -> raise Todo (* let rec (=~=) a b = match (a, b) with | (Ident a, typa, iia), (Ident b, typb, iib) -> a = b | (Constant a, typa, iia), (Constant b, typb, iib) -> a = b | (FunCall (ea, eas), typa, iia), (FunCall (eb, ebs), typb, iib) -> ea =~= eb && List.length eas = List.length ebs && List.for_all (fun (a, b) -> match (a, b) with | (Left ea, iia), (Left eb, iib) -> ea =~= eb | _ -> raise Todo ) (zip eas ebs) | (Binary (ea1,Logical AndLog,ea2),typa, iia), (Binary (eb1,Logical AndLog, eb2), typb, iib) -> (ea1 =~= eb1 && ea2 =~= eb2) || (ea1 =~= eb2 && ea2 =~= eb1) | _ -> raise Todo in a =~= b *) and (iso_st_st: statement -> statement -> bool) = fun a b -> raise Todo and (iso_t_t: fullType -> fullType -> bool) = fun a b -> raise Todo (* let _ = assert (iso_e_e (cexpression_of_string "a&&b") (cexpression_of_string "b&&a") *) coccinelle-1.0.0-rc19/engine/ctltotex.mli0000644000175000017500000000233112247442615017200 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ctltotex.mli" val totex : string -> Ast_cocci.rule list -> (Lib_engine.ctlcocci * 'a) list list -> unit coccinelle-1.0.0-rc19/engine/asttoctl.mli0000644000175000017500000000266712247442615017203 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttoctl.mli" type cocci_predicate = Lib_engine.predicate * string Ast_ctl.modif type formula = (cocci_predicate,string, Wrapper_ctl.info) Ast_ctl.generic_ctl val asttoctl : Ast_cocci.rule -> string list list -> formula list val pp_cocci_predicate : cocci_predicate -> unit val cocci_predicate_to_string : cocci_predicate -> string coccinelle-1.0.0-rc19/engine/obsolete/0000755000175000017500000000000012247437436016451 5ustar eugeneugencoccinelle-1.0.0-rc19/engine/obsolete/asttoctl.ml0000644000175000017500000014577512247437436020663 0ustar eugeneugen(* true = don't see all matched nodes, only modified ones *) let onlyModif = ref true(*false*) (* set to true for line numbers in the output of ctl_engine *) let line_numbers = ref false (* if true, only eg if header is included in not for ...s *) let simple_get_end = ref false(*true*) (* Question: where do we put the existential quantifier for or. At the moment, let it float inwards. *) (* nest shouldn't overlap with what comes after. not checked for. *) module Ast = Ast_cocci module V = Visitor_ast module CTL = Ast_ctl module FV = Free_vars let warning s = Printf.fprintf stderr "warning: %s\n" s type cocci_predicate = Lib_engine.predicate * string Ast_ctl.modif type formula = (cocci_predicate,string, Wrapper_ctl.info) Ast_ctl.generic_ctl let aftpred = (Lib_engine.After,CTL.Control) let retpred = (Lib_engine.Return,CTL.Control) let exitpred = (Lib_engine.ErrorExit,CTL.Control) let intersect l1 l2 = List.filter (function x -> List.mem x l2) l1 let subset l1 l2 = List.for_all (function x -> List.mem x l2) l1 (* --------------------------------------------------------------------- *) let rec drop_vs f = CTL.rewrap f (match CTL.unwrap f with CTL.False as x -> x | CTL.True as x -> x | CTL.Pred(p) as x -> x | CTL.Not(phi) -> CTL.Not(drop_vs phi) | CTL.Exists(v,phi) -> (match CTL.unwrap phi with CTL.Pred((x,CTL.Modif v1)) when v = v1 -> CTL.Pred((x,CTL.Control)) | _ -> CTL.Exists(v,drop_vs phi)) | CTL.And(phi1,phi2) -> CTL.And(drop_vs phi1,drop_vs phi2) | CTL.Or(phi1,phi2) -> CTL.Or(drop_vs phi1,drop_vs phi2) | CTL.SeqOr(phi1,phi2) -> CTL.SeqOr(drop_vs phi1,drop_vs phi2) | CTL.Implies(phi1,phi2) -> CTL.Implies(drop_vs phi1,drop_vs phi2) | CTL.AF(dir,phi1,phi2) -> CTL.AF(dir,drop_vs phi1,drop_vs phi2) | CTL.AX(dir,phi) -> CTL.AX(dir,drop_vs phi) | CTL.AG(dir,phi) -> CTL.AG(dir,drop_vs phi) | CTL.AU(dir,phi1,phi2,phi3,phi4) -> CTL.AU(dir,drop_vs phi1,drop_vs phi2,drop_vs phi3,drop_vs phi4) | CTL.EF(dir,phi) -> CTL.EF(dir,drop_vs phi) | CTL.EX(dir,phi) -> CTL.EX(dir,drop_vs phi) | CTL.EG(dir,phi) -> CTL.EG(dir,drop_vs phi) | CTL.EU(dir,phi1,phi2) -> CTL.EU(dir,drop_vs phi1,drop_vs phi2) | CTL.Ref(v) as x -> x | CTL.Let(v,term1,body) -> CTL.Let(v,drop_vs term1,drop_vs body)) (* --------------------------------------------------------------------- *) let wrap n ctl = (ctl,n) let aftret = wrap 0 (CTL.Or(wrap 0 (CTL.Pred aftpred),wrap 0 (CTL.Pred exitpred))) let wrapImplies n (x,y) = wrap n (CTL.Implies(x,y)) let wrapExists n (x,y) = wrap n (CTL.Exists(x,y)) let wrapAnd n (x,y) = wrap n (CTL.And(x,y)) let wrapOr n (x,y) = wrap n (CTL.Or(x,y)) let wrapSeqOr n (x,y) = wrap n (CTL.SeqOr(x,y)) let wrapAU n (x,y) = wrap n (CTL.AU(CTL.FORWARD,x,y,drop_vs x,drop_vs y)) let wrapEU n (x,y) = wrap n (CTL.EU(CTL.FORWARD,x,y)) let wrapAX n (x) = wrap n (CTL.AX(CTL.FORWARD,x)) let wrapBackAX n (x) = wrap n (CTL.AX(CTL.BACKWARD,x)) let wrapEX n (x) = wrap n (CTL.EX(CTL.FORWARD,x)) let wrapBackEX n (x) = wrap n (CTL.EX(CTL.BACKWARD,x)) let wrapAG n (x) = wrap n (CTL.AG(CTL.FORWARD,x)) let wrapEG n (x) = wrap n (CTL.EG(CTL.FORWARD,x)) let wrapAF n (x) = wrap n (CTL.AF(CTL.FORWARD,x,drop_vs x)) let wrapEF n (x) = wrap n (CTL.EF(CTL.FORWARD,x)) let wrapNot n (x) = wrap n (CTL.Not(x)) let wrapPred n (x) = wrap n (CTL.Pred(x)) let wrapLet n (x,y,z) = wrap n (CTL.Let(x,y,z)) let wrapRef n (x) = wrap n (CTL.Ref(x)) (* --------------------------------------------------------------------- *) let get_option fn = function None -> None | Some x -> Some (fn x) let get_list_option fn = function None -> [] | Some x -> fn x (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Eliminate OptStm *) (* for optional thing with nothing after, should check that the optional thing never occurs. otherwise the matching stops before it occurs *) let elim_opt = let mcode x = x in let donothing r k e = k e in let fvlist l = List.fold_left Common.union_set [] (List.map Ast.get_fvs l) in let rec dots_list unwrapped wrapped = match (unwrapped,wrapped) with ([],_) -> [] | (Ast.Dots(_,_,_)::Ast.OptStm(stm)::(Ast.Dots(_,_,_) as u)::urest, d0::_::d1::rest) | (Ast.Nest(_,_,_)::Ast.OptStm(stm)::(Ast.Dots(_,_,_) as u)::urest, d0::_::d1::rest) -> let l = Ast.get_line stm in let new_rest1 = stm :: (dots_list (u::urest) (d1::rest)) in let new_rest2 = dots_list urest rest in let fv_rest1 = fvlist new_rest1 in let fv_rest2 = fvlist new_rest2 in [d0;(Ast.Disj[(Ast.DOTS(new_rest1),l,fv_rest1,Ast.NoDots); (Ast.DOTS(new_rest2),l,fv_rest2,Ast.NoDots)], l,fv_rest1,Ast.NoDots)] | (Ast.OptStm(stm)::urest,_::rest) -> let l = Ast.get_line stm in let new_rest1 = dots_list urest rest in let new_rest2 = stm::new_rest1 in let fv_rest1 = fvlist new_rest1 in let fv_rest2 = fvlist new_rest2 in [(Ast.Disj[(Ast.DOTS(new_rest2),l,fv_rest2,Ast.NoDots); (Ast.DOTS(new_rest1),l,fv_rest1,Ast.NoDots)], l,fv_rest2,Ast.NoDots)] | ([Ast.Dots(_,_,_);Ast.OptStm(stm)],[d1;_]) -> let l = Ast.get_line stm in let fv_stm = Ast.get_fvs stm in let fv_d1 = Ast.get_fvs d1 in let fv_both = Common.union_set fv_stm fv_d1 in [d1;(Ast.Disj[(Ast.DOTS([stm]),l,fv_stm,Ast.NoDots); (Ast.DOTS([d1]),l,fv_d1,Ast.NoDots)], l,fv_both,Ast.NoDots)] | ([Ast.Nest(_,_,_);Ast.OptStm(stm)],[d1;_]) -> let l = Ast.get_line stm in let rw = Ast.rewrap stm in let rwd = Ast.rewrap stm in let dots = Ast.Dots(("...",{ Ast.line = 0; Ast.column = 0 }, Ast.CONTEXT(Ast.NOTHING)), Ast.NoWhen,[]) in [d1;rw(Ast.Disj[rwd(Ast.DOTS([stm])); (Ast.DOTS([rw dots]),l,[],Ast.NoDots)])] | (_::urest,stm::rest) -> stm :: (dots_list urest rest) | _ -> failwith "not possible" in let stmtdotsfn r k d = let d = k d in Ast.rewrap d (match Ast.unwrap d with Ast.DOTS(l) -> Ast.DOTS(dots_list (List.map Ast.unwrap l) l) | Ast.CIRCLES(l) -> failwith "elimopt: not supported" | Ast.STARS(l) -> failwith "elimopt: not supported") in V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing stmtdotsfn donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* --------------------------------------------------------------------- *) (* Count depth of braces. The translation of a closed brace appears deeply nested within the translation of the sequence term, so the name of the paren var has to take into account the names of the nested braces. On the other hand the close brace does not escape, so we don't have to take into account other paren variable names. *) (* called repetitively, which is inefficient, but less trouble than adding a new field to Seq and FunDecl *) let count_nested_braces s = let bind x y = max x y in let option_default = 0 in let stmt_count r k s = match Ast.unwrap s with Ast.Seq(_,_,_,_,_) | Ast.FunDecl(_,_,_,_,_,_) -> (k s) + 1 | _ -> k s in let donothing r k e = k e in let mcode r x = 0 in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing stmt_count donothing donothing in "p"^(string_of_int (recursor.V.combiner_statement s)) (* --------------------------------------------------------------------- *) (* Top-level code *) let ctr = ref 0 let fresh_var _ = let c = !ctr in (*ctr := !ctr + 1;*) Printf.sprintf "v%d" c let labctr = ref 0 let fresh_label_var s = let c = !labctr in labctr := !labctr + 1; Printf.sprintf "%s%d" s c let lctr = ref 0 let fresh_let_var _ = let c = !lctr in lctr := !lctr + 1; Printf.sprintf "l%d" c let sctr = ref 0 let fresh_metavar _ = let c = !sctr in (*sctr := !sctr + 1;*) Printf.sprintf "_S%d" c let get_unquantified quantified vars = List.filter (function x -> not (List.mem x quantified)) vars type after = After of formula | Guard of formula | Tail let make_seq n l = let rec loop = function [] -> failwith "not possible" | [x] -> x | x::xs -> wrapAnd n (x,wrapAX n (loop xs)) in loop l let make_seq_after2 n first = function After rest -> wrapAnd n (first,wrapAX n (wrapAX n rest)) | _ -> first let make_seq_after n first = function After rest -> make_seq n [first;rest] | _ -> first let a2n = function After f -> Guard f | x -> x let and_opt n first = function After rest -> wrapAnd n (first,rest) | _ -> first let contains_modif = let bind x y = x or y in let option_default = false in let mcode r (_,_,kind) = match kind with Ast.MINUS(_) -> true | Ast.PLUS -> failwith "not possible" | Ast.CONTEXT(info) -> not (info = Ast.NOTHING) in let do_nothing r k e = k e in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem let make_match n guard used_after code = if guard then wrapPred n (Lib_engine.Match(code),CTL.Control) else let v = fresh_var() in if contains_modif code then wrapExists n (v,wrapPred n (Lib_engine.Match(code),CTL.Modif v)) else let any_used_after = List.exists (function x -> List.mem x used_after) (Ast.get_fvs code) in if !onlyModif && not any_used_after then wrapPred n (Lib_engine.Match(code),CTL.Control) else wrapExists n (v,wrapPred n (Lib_engine.Match(code),CTL.UnModif v)) let make_raw_match n code = wrapPred n (Lib_engine.Match(code),CTL.Control) let rec seq_fvs quantified = function [] -> [] | fv1::fvs -> let t1fvs = get_unquantified quantified fv1 in let termfvs = List.fold_left Common.union_set [] (List.map (get_unquantified quantified) fvs) in let bothfvs = Common.inter_set t1fvs termfvs in let t1onlyfvs = Common.minus_set t1fvs bothfvs in let new_quantified = Common.union_set bothfvs quantified in (t1onlyfvs,bothfvs)::(seq_fvs new_quantified fvs) let seq_fvs2 quantified fv1 fv2 = match seq_fvs quantified [fv1;fv2] with [(t1fvs,bfvs);(t2fvs,[])] -> (t1fvs,bfvs,t2fvs) | _ -> failwith "impossible" let seq_fvs3 quantified fv1 fv2 fv3 = match seq_fvs quantified [fv1;fv2;fv3] with [(t1fvs,b12fvs);(t2fvs,b23fvs);(t3fvs,[])] -> (t1fvs,b12fvs,t2fvs,b23fvs,t3fvs) | _ -> failwith "impossible" let seq_fvs4 quantified fv1 fv2 fv3 fv4 = match seq_fvs quantified [fv1;fv2;fv3;fv4] with [(t1fvs,b12fvs);(t2fvs,b23fvs);(t3fvs,b34fvs);(t4fvs,[])] -> (t1fvs,b12fvs,t2fvs,b23fvs,t3fvs,b34fvs,t4fvs) | _ -> failwith "impossible" let seq_fvs5 quantified fv1 fv2 fv3 fv4 fv5 = match seq_fvs quantified [fv1;fv2;fv3;fv4;fv5] with [(t1fvs,b12fvs);(t2fvs,b23fvs);(t3fvs,b34fvs);(t4fvs,b45fvs);(t5fvs,[])] -> (t1fvs,b12fvs,t2fvs,b23fvs,t3fvs,b34fvs,t4fvs,b45fvs,t5fvs) | _ -> failwith "impossible" let quantify n = List.fold_right (function cur -> function code -> wrapExists n (cur,code)) let intersectll lst nested_list = List.filter (function x -> List.exists (List.mem x) nested_list) lst (* --------------------------------------------------------------------- *) (* annotate dots with before and after neighbors *) let rec get_before sl a = match Ast.unwrap sl with Ast.DOTS(x) -> let rec loop sl a = match sl with [] -> ([],a) | e::sl -> let (e,ea) = get_before_e e a in let (sl,sla) = loop sl ea in (e::sl,sla) in let (l,a) = loop x a in (Ast.rewrap sl (Ast.DOTS(l)),a) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" and get_before_e s a = match Ast.unwrap s with Ast.Dots(d,Ast.NoWhen,t) -> (Ast.rewrap s (Ast.Dots(d,Ast.NoWhen,a@t)),a) | Ast.Dots(d,Ast.WhenNot w,t) -> let (w,_) = get_before w [] in (Ast.rewrap s (Ast.Dots(d,Ast.WhenNot w,a@t)),a) | Ast.Dots(d,Ast.WhenAlways w,t) -> let (w,_) = get_before_e w [] in (Ast.rewrap s (Ast.Dots(d,Ast.WhenAlways w,a@t)),a) | Ast.Nest(stmt_dots,w,t) -> let (w,_) = List.split (List.map (function s -> get_before s []) w) in let (sd,_) = get_before stmt_dots a in let a = List.filter (function Ast.Other a -> let unifies = Unify_ast.unify_statement_dots (Ast.rewrap s (Ast.DOTS([a]))) stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | Ast.Other_dots a -> let unifies = Unify_ast.unify_statement_dots a stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | _ -> true) a in (Ast.rewrap s (Ast.Nest(sd,w,a@t)),[Ast.Other_dots stmt_dots]) | Ast.Disj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_before e a) stmt_dots_list) in (Ast.rewrap s (Ast.Disj(dsl)),List.fold_left Common.union_set [] dsla) | Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.MetaStmt(_,_,_) -> (s,[]) | _ -> (s,[Ast.Other s])) | Ast.Seq(lbrace,decls,dots,body,rbrace) -> let index = count_nested_braces s in let (de,dea) = get_before decls [Ast.WParen(lbrace,index)] in let (bd,_) = get_before body dea in (Ast.rewrap s (Ast.Seq(lbrace,de,dots,bd,rbrace)), [Ast.WParen(rbrace,index)]) | Ast.IfThen(ifheader,branch,aft) -> let (br,_) = get_before_e branch [] in (Ast.rewrap s (Ast.IfThen(ifheader,br,aft)), [Ast.Other s]) | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> let (br1,_) = get_before_e branch1 [] in let (br2,_) = get_before_e branch2 [] in (Ast.rewrap s (Ast.IfThenElse(ifheader,br1,els,br2,aft)),[Ast.Other s]) | Ast.While(header,body,aft) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.While(header,bd,aft)),[Ast.Other s]) | Ast.For(header,body,aft) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.For(header,bd,aft)),[Ast.Other s]) | Ast.FunDecl(header,lbrace,decls,dots,body,rbrace) -> let index = count_nested_braces s in let (de,dea) = get_before decls [Ast.WParen(lbrace,index)] in let (bd,_) = get_before body dea in (Ast.rewrap s (Ast.FunDecl(header,lbrace,de,dots,bd,rbrace)),[]) | _ -> failwith "not supported" let rec get_after sl a = match Ast.unwrap sl with Ast.DOTS(x) -> let rec loop sl = match sl with [] -> ([],a) | e::sl -> let (sl,sla) = loop sl in let (e,ea) = get_after_e e sla in (e::sl,ea) in let (l,a) = loop x in (Ast.rewrap sl (Ast.DOTS(l)),a) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" and get_after_e s a = match Ast.unwrap s with Ast.Dots(d,Ast.NoWhen,t) -> (Ast.rewrap s (Ast.Dots(d,Ast.NoWhen,a@t)),a) | Ast.Dots(d,Ast.WhenNot w,t) -> let (w,_) = get_after w [] in (Ast.rewrap s (Ast.Dots(d,Ast.WhenNot w,a@t)),a) | Ast.Dots(d,Ast.WhenAlways w,t) -> let (w,_) = get_after_e w [] in (Ast.rewrap s (Ast.Dots(d,Ast.WhenAlways w,a@t)),a) | Ast.Nest(stmt_dots,w,t) -> let (w,_) = List.split (List.map (function s -> get_after s []) w) in let (sd,_) = get_after stmt_dots a in let a = List.filter (function Ast.Other a -> let unifies = Unify_ast.unify_statement_dots (Ast.rewrap s (Ast.DOTS([a]))) stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | Ast.Other_dots a -> let unifies = Unify_ast.unify_statement_dots a stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | _ -> true) a in (Ast.rewrap s (Ast.Nest(sd,w,a@t)),[Ast.Other_dots stmt_dots]) | Ast.Disj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_after e a) stmt_dots_list) in (Ast.rewrap s (Ast.Disj(dsl)),List.fold_left Common.union_set [] dsla) | Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.MetaStmt(nm,Ast.SequencibleAfterDots _,i) -> (* check after information for metavar optimization *) (* if the error is not desired, could just return [], then the optimization (check for EF) won't take place *) List.iter (function Ast.Other x -> (match Ast.unwrap x with Ast.Dots(_,_,_) | Ast.Nest(_,_,_) -> failwith "dots/nest not allowed before and after stmt metavar" | _ -> ()) | Ast.Other_dots x -> (match Ast.undots x with x::_ -> (match Ast.unwrap x with Ast.Dots(_,_,_) | Ast.Nest(_,_,_) -> failwith ("dots/nest not allowed before and after stmt "^ "metavar") | _ -> ()) | _ -> ()) | _ -> ()) a; (Ast.rewrap s (Ast.Atomic (Ast.rewrap s (Ast.MetaStmt(nm,Ast.SequencibleAfterDots a,i)))),[]) | Ast.MetaStmt(_,_,_) -> (s,[]) | _ -> (s,[Ast.Other s])) | Ast.Seq(lbrace,decls,dots,body,rbrace) -> let index = count_nested_braces s in let (bd,bda) = get_after body [Ast.WParen(rbrace,index)] in let (de,_) = get_after decls bda in (Ast.rewrap s (Ast.Seq(lbrace,de,dots,bd,rbrace)), [Ast.WParen(lbrace,index)]) | Ast.IfThen(ifheader,branch,aft) -> let (br,_) = get_after_e branch a in (Ast.rewrap s (Ast.IfThen(ifheader,br,aft)),[Ast.Other s]) | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> let (br1,_) = get_after_e branch1 a in let (br2,_) = get_after_e branch2 a in (Ast.rewrap s (Ast.IfThenElse(ifheader,br1,els,br2,aft)),[Ast.Other s]) | Ast.While(header,body,aft) -> let (bd,_) = get_after_e body a in (Ast.rewrap s (Ast.While(header,bd,aft)),[Ast.Other s]) | Ast.For(header,body,aft) -> let (bd,_) = get_after_e body a in (Ast.rewrap s (Ast.For(header,bd,aft)),[Ast.Other s]) | Ast.FunDecl(header,lbrace,decls,dots,body,rbrace) -> let index = count_nested_braces s in let (bd,bda) = get_after body [Ast.WParen(rbrace,index)] in let (de,_) = get_after decls bda in (Ast.rewrap s (Ast.FunDecl(header,lbrace,de,dots,bd,rbrace)),[]) | _ -> failwith "not supported" let preprocess_dots sl = let (sl,_) = get_before sl [] in let (sl,_) = get_after sl [] in sl let preprocess_dots_e sl = let (sl,_) = get_before_e sl [] in let (sl,_) = get_after_e sl [] in sl (* --------------------------------------------------------------------- *) (* the main translation loop *) let decl_to_not_decl n dots stmt make_match f = if dots then f else let de = let md = Ast.make_meta_decl "_d" (Ast.CONTEXT(Ast.NOTHING)) in Ast.rewrap md (Ast.Decl md) in wrapAU n (make_match de, wrap n (CTL.And(wrap n (CTL.Not (make_match de)), f))) let rec statement_list stmt_list used_after after quantified guard = let n = if !line_numbers then Ast.get_line stmt_list else 0 in match Ast.unwrap stmt_list with Ast.DOTS(x) -> let rec loop quantified = function ([],_) -> (match after with After f -> f | _ -> wrap n CTL.True) | ([e],_) -> statement e used_after after quantified guard | (e::sl,fv::fvs) -> let shared = intersectll fv fvs in let unqshared = get_unquantified quantified shared in let new_quantified = Common.union_set unqshared quantified in quantify n unqshared (statement e used_after (After(loop new_quantified (sl,fvs))) new_quantified guard) | _ -> failwith "not possible" in loop quantified (x,List.map Ast.get_fvs x) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" and statement stmt used_after after quantified guard = let n = if !line_numbers then Ast.get_line stmt else 0 in let wrapExists = wrapExists n in let wrapAnd = wrapAnd n in let wrapOr = wrapOr n in let wrapSeqOr = wrapSeqOr n in let wrapAU = wrapAU n in let wrapAX = wrapAX n in let wrapBackAX = wrapBackAX n in let wrapEX = wrapEX n in let wrapBackEX = wrapBackEX n in let wrapAG = wrapAG n in let wrapAF = wrapAF n in let wrapEF = wrapEF n in let wrapNot = wrapNot n in let wrapPred = wrapPred n in let make_seq = make_seq n in let make_seq_after2 = make_seq_after2 n in let make_seq_after = make_seq_after n in let and_opt = and_opt n in let quantify = quantify n in let make_match = make_match n guard used_after in let make_raw_match = make_raw_match n in let make_meta_rule_elem d = let nm = fresh_metavar() in Ast.make_meta_rule_elem nm d in match Ast.unwrap stmt with Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.MetaStmt((s,i,(Ast.CONTEXT(Ast.BEFOREAFTER(_,_)) as d)),seqible,_) | Ast.MetaStmt((s,i,(Ast.CONTEXT(Ast.AFTER(_)) as d)),seqible,_) -> let label_var = (*fresh_label_var*) "_lab" in let label_pred = wrapPred(Lib_engine.Label(label_var),CTL.Control) in let prelabel_pred = wrapPred(Lib_engine.PrefixLabel(label_var),CTL.Control) in let matcher d = make_match (make_meta_rule_elem d) in let full_metamatch = matcher d in let first_metamatch = matcher (match d with Ast.CONTEXT(Ast.BEFOREAFTER(bef,_)) -> Ast.CONTEXT(Ast.BEFORE(bef)) | Ast.CONTEXT(_) -> Ast.CONTEXT(Ast.NOTHING) | Ast.MINUS(_) | Ast.PLUS -> failwith "not possible") in let middle_metamatch = matcher (match d with Ast.CONTEXT(_) -> Ast.CONTEXT(Ast.NOTHING) | Ast.MINUS(_) | Ast.PLUS -> failwith "not possible") in let last_metamatch = matcher (match d with Ast.CONTEXT(Ast.BEFOREAFTER(_,aft)) -> Ast.CONTEXT(Ast.AFTER(aft)) | Ast.CONTEXT(_) -> d | Ast.MINUS(_) | Ast.PLUS -> failwith "not possible") in let left_or = make_seq [full_metamatch; and_opt (wrapNot(prelabel_pred)) after] in let right_or = make_seq [first_metamatch; wrapAU(middle_metamatch, make_seq [wrapAnd(last_metamatch,label_pred); and_opt (wrapNot(prelabel_pred)) after])] in let body f = wrapAnd(label_pred, f (wrapAnd(make_raw_match ast, wrapOr(left_or,right_or)))) in let id x = x in (match seqible with Ast.Sequencible | Ast.SequencibleAfterDots [] -> quantify (label_var::get_unquantified quantified [s]) (body (function x -> (wrapAnd(wrapNot(wrapBackAX(label_pred)),x)))) | Ast.SequencibleAfterDots l -> let afts = List.map (process_bef_aft Tail quantified used_after n) l in let ors = List.fold_left (function x -> function y -> wrapOr(x,y)) (List.hd afts) (List.tl afts) in quantify (label_var::get_unquantified quantified [s]) (wrapAnd(wrapEF(wrapAnd(ors,wrapBackAX(label_pred))), body (function x -> wrapAnd(wrapNot(wrapBackAX(label_pred)),x)))) | Ast.NotSequencible -> quantify (label_var::get_unquantified quantified [s]) (body id)) | Ast.MetaStmt((s,i,d),seqible,_) -> let label_var = (*fresh_label_var*) "_lab" in let label_pred = wrapPred(Lib_engine.Label(label_var),CTL.Control) in let prelabel_pred = wrapPred(Lib_engine.PrefixLabel(label_var),CTL.Control) in let matcher d = make_match (make_meta_rule_elem d) in let first_metamatch = matcher d in let rest_metamatch = matcher (match d with Ast.MINUS(_) -> Ast.MINUS([]) | Ast.CONTEXT(_) -> Ast.CONTEXT(Ast.NOTHING) | Ast.PLUS -> failwith "not possible") in (* first_nodea and first_nodeb are separated here and above to improve let sharing - only first_nodea is unique to this site *) let first_nodeb = first_metamatch in let rest_nodes = wrapAnd(rest_metamatch,prelabel_pred) in let last_node = and_opt (wrapNot(prelabel_pred)) after in let body f = wrapAnd (label_pred, f (wrapAnd (make_raw_match ast, (make_seq [first_nodeb; wrapAU(rest_nodes,last_node)])))) in (match seqible with Ast.Sequencible | Ast.SequencibleAfterDots [] -> quantify (label_var::get_unquantified quantified [s]) (body (function x -> wrapAnd(wrapNot(wrapBackAX(label_pred)),x))) | Ast.SequencibleAfterDots l -> let afts = List.map (process_bef_aft Tail quantified used_after n) l in let ors = List.fold_left (function x -> function y -> wrapOr(x,y)) (List.hd afts) (List.tl afts) in quantify (label_var::get_unquantified quantified [s]) (wrapAnd(wrapEF(wrapAnd(ors,wrapBackAX(label_pred))), body (function x -> wrapAnd(wrapNot(wrapBackAX(label_pred)),x)))) | Ast.NotSequencible -> quantify (label_var::get_unquantified quantified [s]) (body (function x -> x))) | _ -> let stmt_fvs = Ast.get_fvs stmt in let fvs = get_unquantified quantified stmt_fvs in let between_dots = Ast.get_dots_bef_aft stmt in let term = make_match ast in let term = match between_dots with Ast.BetweenDots brace_term -> (match Ast.unwrap brace_term with Ast.Atomic(brace_ast) -> let case1 = wrapAnd (wrapOr (wrapBackEX (wrapPred(Lib_engine.TrueBranch,CTL.Control)), wrapBackEX (wrapBackEX(wrapPred(Lib_engine.FalseBranch, CTL.Control)))), make_match brace_ast) in let case2 = wrapAnd (wrapNot (wrapOr (wrapBackEX (wrapPred(Lib_engine.TrueBranch,CTL.Control)), wrapBackEX (wrapBackEX(wrapPred(Lib_engine.FalseBranch, CTL.Control))))), term) in wrapOr(case1,case2) | _ -> failwith "not possible") | Ast.NoDots -> term in make_seq_after (quantify fvs term) after) | Ast.Seq(lbrace,decls,dots,body,rbrace) -> let (lbfvs,b1fvs,_,b2fvs,_,b3fvs,rbfvs) = seq_fvs4 quantified (Ast.get_fvs lbrace) (Ast.get_fvs decls) (Ast.get_fvs body) (Ast.get_fvs rbrace) in let v = count_nested_braces stmt in let paren_pred = wrapPred(Lib_engine.Paren v,CTL.Control) in let start_brace = wrapAnd(quantify lbfvs (make_match lbrace),paren_pred) in let end_brace = wrapAnd(quantify rbfvs (make_match rbrace),paren_pred) in let new_quantified2 = Common.union_set b1fvs (Common.union_set b2fvs quantified) in let new_quantified3 = Common.union_set b3fvs new_quantified2 in wrapExists (v,quantify b1fvs (make_seq [start_brace; quantify b2fvs (statement_list decls used_after (After (decl_to_not_decl n dots stmt make_match (quantify b3fvs (statement_list body used_after (After (make_seq_after end_brace after)) new_quantified3 guard)))) new_quantified2 guard)])) | Ast.IfThen(ifheader,branch,aft) -> (* "if (test) thn" becomes: if(test) & AX((TrueBranch & AX thn) v FallThrough v After) "if (test) thn; after" becomes: if(test) & AX((TrueBranch & AX thn) v FallThrough v (After & AXAX after)) & EX After *) (* free variables *) let (efvs,bfvs,_) = seq_fvs2 quantified (Ast.get_fvs ifheader) (Ast.get_fvs branch) in let new_quantified = Common.union_set bfvs quantified in (* if header *) let if_header = quantify efvs (make_match ifheader) in (* then branch and after *) let true_branch = make_seq [wrapPred(Lib_engine.TrueBranch,CTL.Control); statement branch used_after (a2n after) new_quantified guard] in let fall_branch = wrapPred(Lib_engine.FallThrough,CTL.Control) in let after_pred = wrapPred(Lib_engine.After,CTL.Control) in let (aft_needed,after_branch) = match aft with Ast.CONTEXT(Ast.NOTHING) -> (false,make_seq_after2 after_pred after) | _ -> (true, make_seq_after after_pred (After (make_seq_after (make_match (make_meta_rule_elem aft)) after))) in let or_cases = wrapOr(true_branch,wrapOr(fall_branch,after_branch)) in (* the code *) (match (after,aft_needed) with (After _,_) (* pattern doesn't end here *) | (_,true) (* + code added after *) -> quantify bfvs (wrapAnd (if_header, wrapAnd(wrapAX or_cases, wrapEX after_pred))) | _ -> quantify bfvs (wrapAnd(if_header, wrapAX or_cases))) | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> (* "if (test) thn else els" becomes: if(test) & AX((TrueBranch & AX thn) v (FalseBranch & AX (else & AX els)) v After) & EX FalseBranch "if (test) thn else els; after" becomes: if(test) & AX((TrueBranch & AX thn) v (FalseBranch & AX (else & AX els)) v (After & AXAX after)) & EX FalseBranch & EX After Note that we rely on the well-formedness of C programs. For example, we do not use EX to check that there is at least one then branch, because there is always one. And we do not check that there is only one then or else branch, because these again are always the case in a well-formed C program. *) (* free variables *) let (e1fvs,b1fvs,s1fvs) = seq_fvs2 quantified (Ast.get_fvs ifheader) (Ast.get_fvs branch1) in let (e2fvs,b2fvs,s2fvs) = seq_fvs2 quantified (Ast.get_fvs ifheader) (Ast.get_fvs branch2) in let bothfvs = Common.union_set (Common.union_set b1fvs b2fvs) (Common.inter_set s1fvs s2fvs) in let exponlyfvs = Common.inter_set e1fvs e2fvs in let new_quantified = Common.union_set bothfvs quantified in (* if header *) let if_header = quantify exponlyfvs (make_match ifheader) in (* then and else branches *) let true_branch = make_seq [wrapPred(Lib_engine.TrueBranch,CTL.Control); statement branch1 used_after (a2n after) new_quantified guard] in let false_pred = wrapPred(Lib_engine.FalseBranch,CTL.Control) in let false_branch = make_seq [false_pred; make_match els; statement branch2 used_after (a2n after) new_quantified guard] in let after_pred = wrapPred(Lib_engine.After,CTL.Control) in let (aft_needed,after_branch) = match aft with Ast.CONTEXT(Ast.NOTHING) -> (false,make_seq_after2 after_pred after) | _ -> (true, make_seq_after after_pred (After (make_seq_after (make_match (make_meta_rule_elem aft)) after))) in let or_cases = wrapOr(true_branch,wrapOr(false_branch,after_branch)) in (* the code *) (match (after,aft_needed) with (After _,_) (* pattern doesn't end here *) | (_,true) (* + code added after *) -> quantify bothfvs (wrapAnd (if_header, wrapAnd(wrapAX or_cases, wrapAnd(wrapEX false_pred,wrapEX after_pred)))) | _ -> quantify bothfvs (wrapAnd (if_header, wrapAnd(wrapAX or_cases, wrapEX false_pred)))) | Ast.While(header,body,aft) | Ast.For(header,body,aft) -> (* the translation in this case is similar to that of an if with no else *) (* free variables *) let (efvs,bfvs,_) = seq_fvs2 quantified (Ast.get_fvs header) (Ast.get_fvs body) in let new_quantified = Common.union_set bfvs quantified in (* if header *) let header = quantify efvs (make_match header) in let body = make_seq [wrapPred(Lib_engine.TrueBranch,CTL.Control); statement body used_after (a2n after) new_quantified guard] in let after_pred = wrapPred(Lib_engine.FallThrough,CTL.Control) in let (aft_needed,after_branch) = match aft with Ast.CONTEXT(Ast.NOTHING) -> (false,make_seq_after2 after_pred after) | _ -> (true, make_seq_after after_pred (After (make_seq_after (make_match (make_meta_rule_elem aft)) after))) in let or_cases = wrapOr(body,after_branch) in (* the code *) (match (after,aft_needed) with (After _,_) (* pattern doesn't end here *) | (_,true) (* + code added after *) -> quantify bfvs (wrapAnd (header, wrapAnd(wrapAX or_cases, wrapEX after_pred))) | _ -> quantify bfvs (wrapAnd(header, wrapAX or_cases))) | Ast.Disj(stmt_dots_list) -> let processed = List.map (function x -> statement_list x used_after after quantified guard) stmt_dots_list in let rec loop = function [] -> wrap n CTL.True | [x] -> x | x::xs -> wrapSeqOr(x,loop xs) in loop processed (* let do_one e = statement_list e used_after (a2n after) quantified true in let add_nots l e = List.fold_left (function rest -> function cur -> wrapAnd(wrapNot(do_one cur),rest)) e l in let process_one nots cur = match Ast.unwrap cur with Ast.DOTS(x::xs) -> let on = List.map (function x -> Ast.OrOther_dots x) nots in (match Ast.unwrap x with Ast.Dots(d,w,t) -> List.iter (function x -> Printf.printf "a not\n"; Pretty_print_cocci.statement_dots x) nots; let cur = Ast.rewrap cur (Ast.DOTS((Ast.rewrap x (Ast.Dots(d,w,on@t)))::xs)) in statement_list cur used_after after quantified guard | Ast.Nest(sd,w,t) -> let cur = Ast.rewrap cur (Ast.DOTS((Ast.rewrap x (Ast.Nest(sd,w,on@t)))::xs)) in statement_list cur used_after after quantified guard | _ -> add_nots nots (statement_list cur used_after after quantified guard)) | Ast.DOTS([]) -> add_nots nots (statement_list cur used_after after quantified guard) | _ -> failwith "CIRCLES, STARS not supported" in let rec loop after = function [] -> failwith "disj shouldn't be empty" (*wrap n CTL.False*) | [(nots,cur)] -> process_one nots cur | (nots,cur)::rest -> wrapOr(process_one nots cur, loop after rest) in loop after (preprocess_disj stmt_dots_list) *) | Ast.Nest(stmt_dots,whencode,befaft) -> let dots_pattern = statement_list stmt_dots used_after (a2n after) quantified guard in let udots_pattern = let whencodes = List.map (function sl -> statement_list sl used_after (a2n after) quantified true) whencode in List.fold_left (function rest -> function cur -> wrapOr(cur,rest)) (statement_list stmt_dots used_after (a2n after) quantified true) whencodes in (match (after,guard&&(whencode=[])) with (After a,true) -> let nots = List.map (process_bef_aft after quantified used_after n) befaft in (match nots with [] -> wrapAF(wrapOr(a,aftret)) | x::xs -> let left = wrapNot (List.fold_left (function rest -> function cur -> wrapOr(cur,rest)) x xs) in wrapAU(left,wrapOr(a,aftret))) | (After a,false) -> let left = wrapOr(dots_pattern,wrapNot udots_pattern) in let nots = List.map (process_bef_aft after quantified used_after n) befaft in let left = match nots with [] -> left | x::xs -> wrapAnd (wrapNot (List.fold_left (function rest -> function cur -> wrapOr(cur,rest)) x xs), left) in wrapAU(left,wrapOr(a,aftret)) | (_,true) -> wrap n CTL.True | (_,false) -> wrapAG(wrapOr(dots_pattern,wrapNot udots_pattern))) | Ast.Dots((_,i,d),whencodes,t) -> let dot_code = match d with Ast.MINUS(_) -> (* no need for the fresh metavar, but ... is a bit weird as a variable name *) Some(make_match (make_meta_rule_elem d)) | _ -> None in let whencodes = (match whencodes with Ast.NoWhen -> [] | Ast.WhenNot whencodes -> [wrapNot (statement_list whencodes used_after (a2n after) quantified true)] | Ast.WhenAlways s -> [statement s used_after (a2n after) quantified true]) @ (List.map wrapNot (List.map (process_bef_aft after quantified used_after n) t)) in let phi2 = match whencodes with [] -> None | x::xs -> Some (List.fold_left (function rest -> function cur -> wrapAnd(cur,rest)) x xs) in let phi3 = match (dot_code,phi2) with (* add - on dots, if any *) (None,None) -> None | (Some dotcode,None) -> Some dotcode | (None,Some whencode) -> Some whencode | (Some dotcode,Some whencode) -> Some(wrapAnd (dotcode,whencode)) in let exit = wrap n (CTL.Pred (Lib_engine.Exit,CTL.Control)) in (* add in the after code to make the result *) (match (after,phi3) with (Tail,Some whencode) -> wrapAU(whencode,wrapOr(exit,aftret)) | (Tail,None) -> wrapAF(wrapOr(exit,aftret)) | (After f,Some whencode) | (Guard f,Some whencode) -> wrapAU(whencode,wrapOr(f,aftret)) | (After f,None) | (Guard f,None) -> wrapAF(wrapOr(f,aftret))) | Ast.FunDecl(header,lbrace,decls,dots,body,rbrace) -> let (hfvs,b1fvs,lbfvs,b2fvs,_,b3fvs,_,b4fvs,rbfvs) = seq_fvs5 quantified (Ast.get_fvs header) (Ast.get_fvs lbrace) (Ast.get_fvs decls) (Ast.get_fvs body) (Ast.get_fvs rbrace) in let function_header = quantify hfvs (make_match header) in let v = count_nested_braces stmt in let paren_pred = wrapPred(Lib_engine.Paren v,CTL.Control) in let start_brace = wrapAnd(quantify lbfvs (make_match lbrace),paren_pred) in let end_brace = let stripped_rbrace = match Ast.unwrap rbrace with Ast.SeqEnd((data,info,_)) -> Ast.rewrap rbrace (Ast.SeqEnd ((data,info,Ast.CONTEXT(Ast.NOTHING)))) | _ -> failwith "unexpected close brace" in let exit = wrap n (CTL.Pred (Lib_engine.Exit,CTL.Control)) in let errorexit = wrap n (CTL.Pred (Lib_engine.ErrorExit,CTL.Control)) in wrapAnd(quantify rbfvs (make_match rbrace), wrapAU(make_match stripped_rbrace, wrapOr(exit,errorexit))) in let new_quantified3 = Common.union_set b1fvs (Common.union_set b2fvs (Common.union_set b3fvs quantified)) in let new_quantified4 = Common.union_set b4fvs new_quantified3 in quantify b1fvs (make_seq [function_header; wrapExists (v, (quantify b2fvs (make_seq [start_brace; quantify b3fvs (statement_list decls used_after (After (decl_to_not_decl n dots stmt make_match (quantify b4fvs (statement_list body used_after (After (make_seq_after end_brace after)) new_quantified4 guard)))) new_quantified3 guard)])))]) | Ast.OptStm(stm) -> failwith "OptStm should have been compiled away\n"; | Ast.UniqueStm(stm) -> failwith "arities not yet supported" | Ast.MultiStm(stm) -> failwith "arities not yet supported" | _ -> failwith "not supported" and process_bef_aft after quantified used_after ln = function Ast.WParen (re,n) -> let paren_pred = wrapPred ln (Lib_engine.Paren n,CTL.Control) in wrapAnd ln (make_raw_match ln re,paren_pred) | Ast.Other s -> statement s used_after (a2n after) quantified true | Ast.Other_dots d -> statement_list d used_after (a2n after) quantified true | Ast.OrOther_dots d -> statement_list d used_after Tail quantified true (* Returns a triple for each disj element. The first element of the triple is Some v if the triple element needs a name, and None otherwise. The second element is a list of names whose negations should be conjuncted with the term. The third element is the original term *) and (preprocess_disj : Ast.statement Ast.dots list -> (Ast.statement Ast.dots list * Ast.statement Ast.dots) list) = function [] -> [] | [s] -> [([],s)] | cur::rest -> let template = List.map (function r -> Unify_ast.unify_statement_dots cur r) rest in let processed = preprocess_disj rest in if List.exists (function Unify_ast.MAYBE -> true | _ -> false) template then ([], cur) :: (List.map2 (function ((nots,r) as x) -> function Unify_ast.MAYBE -> (cur::nots,r) | Unify_ast.NO -> x) processed template) else ([], cur) :: processed (* --------------------------------------------------------------------- *) (* Letify: Phase 1: Use a hash table to identify formulas that appear more than once. Phase 2: Replace terms by variables. Phase 3: Drop lets to the point as close as possible to the uses of their variables *) let formula_table = (Hashtbl.create(50) : ((cocci_predicate,string,Wrapper_ctl.info) CTL.generic_ctl, int ref (* count *) * string ref (* name *) * bool ref (* processed *)) Hashtbl.t) let add_hash phi = let (cell,_,_) = try Hashtbl.find formula_table phi with Not_found -> let c = (ref 0,ref "",ref false) in Hashtbl.add formula_table phi c; c in cell := !cell + 1 let rec collect_duplicates f = add_hash f; match CTL.unwrap f with CTL.False -> () | CTL.True -> () | CTL.Pred(p) -> () | CTL.Not(phi) -> collect_duplicates phi | CTL.Exists(v,phi) -> collect_duplicates phi | CTL.And(phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.Or(phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.SeqOr(phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.Implies(phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.AF(_,phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.AX(_,phi) -> collect_duplicates phi | CTL.AG(_,phi) -> collect_duplicates phi | CTL.AU(_,phi1,phi2,phi3,phi4) -> collect_duplicates phi1; collect_duplicates phi2; collect_duplicates phi3; collect_duplicates phi4 | CTL.EF(_,phi) -> collect_duplicates phi | CTL.EX(_,phi) -> collect_duplicates phi | CTL.EG(_,phi) -> collect_duplicates phi | CTL.EU(_,phi1,phi2) -> collect_duplicates phi1; collect_duplicates phi2 | CTL.Uncheck(phi) -> collect_duplicates phi | _ -> failwith "not possible" let assign_variables _ = Hashtbl.iter (function formula -> function (cell,str,_) -> if !cell > 1 then str := fresh_let_var()) formula_table let rec replace_formulas dec f = let (ct,name,treated) = Hashtbl.find formula_table f in let real_ct = !ct - dec in if real_ct > 1 then if not !treated then begin treated := true; let (acc,new_f) = replace_subformulas (dec + (real_ct - 1)) f in ((!name,new_f) :: acc, CTL.rewrap f (CTL.Ref !name)) end else ([],CTL.rewrap f (CTL.Ref !name)) else replace_subformulas dec f and replace_subformulas dec f = match CTL.unwrap f with CTL.False -> ([],f) | CTL.True -> ([],f) | CTL.Pred(p) -> ([],f) | CTL.Not(phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.Not(new_phi))) | CTL.Exists(v,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.Exists(v,new_phi))) | CTL.And(phi1,phi2) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in (acc1@acc2,CTL.rewrap f (CTL.And(new_phi1,new_phi2))) | CTL.Or(phi1,phi2) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in (acc1@acc2,CTL.rewrap f (CTL.Or(new_phi1,new_phi2))) | CTL.SeqOr(phi1,phi2) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in (acc1@acc2,CTL.rewrap f (CTL.SeqOr(new_phi1,new_phi2))) | CTL.Implies(phi1,phi2) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in (acc1@acc2,CTL.rewrap f (CTL.Implies(new_phi1,new_phi2))) | CTL.AF(dir,phi1,phi2) -> let (acc,new_phi1) = replace_formulas dec phi1 in let (acc,new_phi2) = replace_formulas dec phi2 in (acc,CTL.rewrap f (CTL.AF(dir,new_phi1,new_phi2))) | CTL.AX(dir,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.AX(dir,new_phi))) | CTL.AG(dir,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.AG(dir,new_phi))) | CTL.AU(dir,phi1,phi2,phi3,phi4) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in let (acc3,new_phi3) = replace_formulas dec phi3 in let (acc4,new_phi4) = replace_formulas dec phi4 in (acc1@acc2@acc3@acc4, CTL.rewrap f (CTL.AU(dir,new_phi1,new_phi2,new_phi3,new_phi4))) | CTL.EF(dir,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.EF(dir,new_phi))) | CTL.EX(dir,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.EX(dir,new_phi))) | CTL.EG(dir,phi) -> let (acc,new_phi) = replace_formulas dec phi in (acc,CTL.rewrap f (CTL.EG(dir,new_phi))) | CTL.EU(dir,phi1,phi2) -> let (acc1,new_phi1) = replace_formulas dec phi1 in let (acc2,new_phi2) = replace_formulas dec phi2 in (acc1@acc2,CTL.rewrap f (CTL.EU(dir,new_phi1,new_phi2))) | _ -> failwith "not possible" let ctlfv_table = (Hashtbl.create(50) : ((cocci_predicate,string,Wrapper_ctl.info) CTL.generic_ctl, string list (* fvs *) * string list (* intersection of fvs of subterms *)) Hashtbl.t) let rec ctl_fvs f = try let (fvs,_) = Hashtbl.find ctlfv_table f in fvs with Not_found -> let ((fvs,_) as res) = match CTL.unwrap f with CTL.False | CTL.True | CTL.Pred(_) -> ([],[]) | CTL.Not(phi) | CTL.Exists(_,phi) | CTL.AX(_,phi) | CTL.AG(_,phi) | CTL.EF(_,phi) | CTL.EX(_,phi) | CTL.EG(_,phi) -> (ctl_fvs phi,[]) | CTL.AU(_,phi1,phi2,phi3,phi4) -> let phi1fvs = ctl_fvs phi1 in let phi2fvs = ctl_fvs phi2 in (* phi3 has the same fvs as phi1 and phi4 as phi2 *) (Common.union_set phi1fvs phi2fvs,intersect phi1fvs phi2fvs) | CTL.And(phi1,phi2) | CTL.Or(phi1,phi2) | CTL.SeqOr(phi1,phi2) | CTL.Implies(phi1,phi2) | CTL.AF(_,phi1,phi2) | CTL.EU(_,phi1,phi2) -> let phi1fvs = ctl_fvs phi1 in let phi2fvs = ctl_fvs phi2 in (Common.union_set phi1fvs phi2fvs,intersect phi1fvs phi2fvs) | CTL.Ref(v) -> ([v],[v]) | CTL.Let(v,term,body) -> let phi1fvs = ctl_fvs term in let phi2fvs = Common.minus_set (ctl_fvs body) [v] in (Common.union_set phi1fvs phi2fvs,intersect phi1fvs phi2fvs) in Hashtbl.add ctlfv_table f res; fvs let rev_order_bindings b = let b = List.map (function (nm,term) -> let (fvs,_) = Hashtbl.find ctlfv_table term in (nm,fvs,term)) b in let rec loop bound = function [] -> [] | unbound -> let (now_bound,still_unbound) = List.partition (function (_,fvs,_) -> subset fvs bound) unbound in let get_names = List.map (function (x,_,_) -> x) in now_bound @ (loop ((get_names now_bound) @ bound) still_unbound) in List.rev(loop [] b) let drop_bindings b f = (* innermost bindings first in b *) let process_binary f ffvs inter nm term fail = if List.mem nm inter then CTL.rewrap f (CTL.Let(nm,term,f)) else CTL.rewrap f (fail()) in let find_fvs f = let _ = ctl_fvs f in Hashtbl.find ctlfv_table f in let rec drop_one nm term f = match CTL.unwrap f with CTL.False -> f | CTL.True -> f | CTL.Pred(p) -> f | CTL.Not(phi) -> CTL.rewrap f (CTL.Not(drop_one nm term phi)) | CTL.Exists(v,phi) -> CTL.rewrap f (CTL.Exists(v,drop_one nm term phi)) | CTL.And(phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.And(drop_one nm term phi1,drop_one nm term phi2)) | CTL.Or(phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.Or(drop_one nm term phi1,drop_one nm term phi2)) | CTL.SeqOr(phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.SeqOr(drop_one nm term phi1,drop_one nm term phi2)) | CTL.Implies(phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.Implies(drop_one nm term phi1,drop_one nm term phi2)) | CTL.AF(dir,phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.AF(dir,drop_one nm term phi1,drop_one nm term phi2)) | CTL.AX(dir,phi) -> CTL.rewrap f (CTL.AX(dir,drop_one nm term phi)) | CTL.AG(dir,phi) -> CTL.rewrap f (CTL.AG(dir,drop_one nm term phi)) | CTL.AU(dir,phi1,phi2,phi3,phi4) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.AU(dir,drop_one nm term phi1,drop_one nm term phi2, drop_one nm term phi3,drop_one nm term phi4)) | CTL.EF(dir,phi) -> CTL.rewrap f (CTL.EF(dir,drop_one nm term phi)) | CTL.EX(dir,phi) -> CTL.rewrap f (CTL.EX(dir,drop_one nm term phi)) | CTL.EG(dir,phi) -> CTL.rewrap f (CTL.EG(dir,drop_one nm term phi)) | CTL.EU(dir,phi1,phi2) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.EU(dir,drop_one nm term phi1,drop_one nm term phi2)) | (CTL.Ref(v) as x) -> process_binary f [v] [v] nm term (function _ -> x) | CTL.Let(v,term1,body) -> let (ffvs,inter) = find_fvs f in process_binary f ffvs inter nm term (function _ -> CTL.Let(v,drop_one nm term term1,drop_one nm term body)) in List.fold_left (function processed -> function (nm,_,term) -> drop_one nm term processed) f b let letify f = failwith "this code should not be used!!!"(*; Hashtbl.clear formula_table; Hashtbl.clear ctlfv_table; (* create a count of the number of occurrences of each subformula *) collect_duplicates f; (* give names to things that appear more than once *) assign_variables(); (* replace duplicated formulas by their variables *) let (bindings,new_f) = replace_formulas 0 f in (* collect fvs of terms in bindings and new_f *) List.iter (function f -> let _ = ctl_fvs f in ()) (new_f::(List.map (function (_,term) -> term) bindings)); (* sort bindings with uses before defs *) let bindings = rev_order_bindings bindings in (* insert bindings as lets into the formula *) let res = drop_bindings bindings new_f in res*) (* --------------------------------------------------------------------- *) (* Function declaration *) let top_level used_after t = match Ast.unwrap t with Ast.DECL(decl) -> failwith "not supported decl" | Ast.INCLUDE(inc,s) -> (* no indication of whether inc or s is modified *) wrap 0 (CTL.Pred((Lib_engine.Include(inc,s),CTL.Control))) | Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo" | Ast.FUNCTION(stmt) -> (*Printf.printf "orig\n"; Pretty_print_cocci.statement "" stmt; Format.print_newline();*) let unopt = elim_opt.V.rebuilder_statement stmt in (*Printf.printf "unopt\n"; Pretty_print_cocci.statement "" unopt; Format.print_newline();*) let unopt = preprocess_dots_e unopt in (*letify*) (statement unopt used_after Tail [] false) | Ast.CODE(stmt_dots) -> let unopt = elim_opt.V.rebuilder_statement_dots stmt_dots in let unopt = preprocess_dots unopt in (*letify*) (statement_list unopt used_after Tail [] false) | Ast.ERRORWORDS(exps) -> failwith "not supported errorwords" (* --------------------------------------------------------------------- *) (* Contains dots *) let contains_dots = let bind x y = x or y in let option_default = false in let mcode r x = false in let statement r k s = match Ast.unwrap s with Ast.Dots(_,_,_) -> true | _ -> k s in let continue r k e = k e in let stop r k e = false in let res = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode continue continue continue stop stop stop stop stop stop stop statement continue continue in res.V.combiner_top_level (* --------------------------------------------------------------------- *) (* Entry points *) let asttoctl l used_after = ctr := 0; lctr := 0; sctr := 0; let l = List.filter (function t -> match Ast.unwrap t with Ast.ERRORWORDS(exps) -> false | _ -> true) l in List.map2 top_level used_after l let pp_cocci_predicate (pred,modif) = Pretty_print_engine.pp_predicate pred let cocci_predicate_to_string (pred,modif) = Pretty_print_engine.predicate_to_string pred coccinelle-1.0.0-rc19/engine/obsolete/sgrep.ml0000644000175000017500000001162312247437436020126 0ustar eugeneugen(* no longer used *) type marker = NoMark | BefMark of string | AftMark of string | BefAftMark of string * string let extract_sgrep_marker l = let rec inner_loop acc = function [] -> (acc,[]) | Ast_cocci.SgrepStartTag(s)::rest -> (match acc with NoMark -> inner_loop (BefMark(s)) rest | _ -> failwith "unexpected mark") | Ast_cocci.SgrepEndTag(s)::rest -> (match acc with NoMark -> inner_loop (AftMark(s)) rest | BefMark(m) -> inner_loop (BefAftMark(m,s)) rest | _ -> failwith "unexpected mark") | x::rest -> let (acc,rest) = inner_loop acc rest in (acc,x::rest) in let (acc,l) = List.fold_left (function (acc,prev) -> function cur -> let (acc,cur) = inner_loop acc cur in (acc,cur::prev)) (NoMark,[]) l in (acc,List.rev l) let process_sgrep ii mck = let file = Ast_c.file_of_info ii in let line = Ast_c.line_of_info ii in let col = Ast_c.col_of_info ii in let str = Ast_c.str_of_info ii in match mck with Ast_cocci.MINUS(pos,inst,adj,repl) -> (match extract_sgrep_marker repl with (NoMark,_) -> mck | (BefMark(marker),repl) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" marker file line col; Ast_cocci.MINUS(pos,inst,adj,repl) | (AftMark(marker),repl) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.MINUS(pos,inst,adj,repl) | (BefAftMark(bmarker,amarker),repl) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" bmarker file line col; Printf.printf "Match on line %s ending at %s: line %d offset %d\n" amarker file line (col + String.length str); Ast_cocci.MINUS(pos,inst,adj,repl)) | Ast_cocci.CONTEXT(pos,Ast_cocci.NOTHING) -> mck | Ast_cocci.CONTEXT(pos,Ast_cocci.BEFORE(bef,c)) -> (match extract_sgrep_marker bef with (NoMark,_) -> mck | (BefMark(marker),[]) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" marker file line col; Ast_cocci.CONTEXT(pos,Ast_cocci.NOTHING) | (BefMark(marker),bef) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" marker file line col; Ast_cocci.CONTEXT(pos,Ast_cocci.BEFORE(bef,c)) | _ -> failwith "after not possible") | Ast_cocci.CONTEXT(pos,Ast_cocci.AFTER(aft,c)) -> (match extract_sgrep_marker aft with (NoMark,_) -> mck | (AftMark(marker),[]) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.NOTHING) | (AftMark(marker),aft) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.AFTER(aft,c)) | _ -> failwith "before not possible") | Ast_cocci.CONTEXT(pos,Ast_cocci.BEFOREAFTER(bef,aft,c)) -> (match extract_sgrep_marker bef with (NoMark,_) -> (match extract_sgrep_marker aft with (NoMark,_) -> mck | (AftMark(marker),[]) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.BEFORE(bef,c)) | (AftMark(marker),aft) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.BEFOREAFTER(bef,aft,c)) | _ -> failwith "before not possible") | (BefMark(marker),[]) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" marker file line col; (match extract_sgrep_marker aft with (NoMark,_) -> Ast_cocci.CONTEXT(pos,Ast_cocci.AFTER(aft,c)) | (AftMark(marker),[]) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.NOTHING) | (AftMark(marker),aft) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.AFTER(aft,c)) | _ -> failwith "before not possible") | (BefMark(marker),bef) -> Printf.printf "Match on line %s starting at %s: line %d offset %d\n" marker file line col; (match extract_sgrep_marker aft with (NoMark,_) -> Ast_cocci.CONTEXT(pos,Ast_cocci.BEFOREAFTER(bef,aft,c)) | (AftMark(marker),[]) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.BEFORE(bef,c)) | (AftMark(marker),aft) -> Printf.printf "Match on line %s ending at %s: line %d offset %d\n" marker file line (col + String.length str); Ast_cocci.CONTEXT(pos,Ast_cocci.BEFOREAFTER(bef,aft,c)) | _ -> failwith "before not possible") | _ -> failwith "after not possible") | _ -> failwith "unexpected plus code" coccinelle-1.0.0-rc19/engine/flag_matcher.ml0000644000175000017500000000322512247442615017600 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_matcher.ml" let debug_engine = ref false let verbose_matcher = ref true (* false = simpler formulas, only for debugging *) let useEU = ref true let disallow_nested_exps = ref false (* if this flag is not set, then break and continue are also error exits *) let only_return_is_error_exit = ref false (* a hack to allow adding code in some more sgrep-like uses *) let allow_inconsistent_paths = ref false (* see the use of this variable in asttoctl2.ml *) let no_safe_expressions = ref false let show_misc = ref true let show_transinfo = ref false coccinelle-1.0.0-rc19/engine/check_exhaustive_pattern.ml0000644000175000017500000001536112247442615022247 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./check_exhaustive_pattern.ml" (* Just to warn me when there is some news in the types in * ast_cocci.ml or even ast_c.ml, so that I can then adjust my code in * pattern.ml or transformation.ml. * * For the moment I do it only for myself (pad), that is I check only * for news in ast_cocci.ml, because I already know when I add stuff in * my code in ast_c.ml or control_flow_c.ml. *) module A = Ast_cocci module B = Ast_c module F = Control_flow_c (* dependencies_to_adjust: pattern.ml, transformaton.ml *) let dumb_astcocci_rule_elem = function | A.MetaRuleElem _ -> () | A.MetaStmt (ida,_,_,_) -> () | A.MetaStmtList _ -> () | A.Exp expr -> () | A.TopExp expr -> () | A.Ty ty -> () | A.TopInit init -> () | A.FunHeader (bef,allminus, fninfo, ida, _, paramsa, _) -> () | A.Decl (bef,allminus,decla) -> () | A.SeqStart _ -> () | A.SeqEnd _ -> () | A.ExprStatement (ea, _) -> () | A.IfHeader (_,_, ea, _) -> () | A.Else _ -> () | A.WhileHeader (_, _, ea, _) -> () | A.DoHeader _ -> () | A.WhileTail (_,_,ea,_,_) -> () | A.ForHeader (_, _, _, ea2opt, _, ea3opt, _) -> () | A.IteratorHeader (ia1, ia2, ea, ia3) -> () | A.SwitchHeader _ -> () | A.Break _ -> () | A.Continue _ -> () | A.Label _ -> () | A.Goto(_,_,_) -> () | A.Return _ -> () | A.ReturnExpr (_, ea, _) -> () | A.DefineHeader _ -> () | A.Undef _ -> () | A.Pragma _ -> () | A.Include _ -> () | A.Default _ -> () | A.Case _ -> () | A.DisjRuleElem _ -> failwith "not possible - compiled away in asttoctl" let dumb_astcocci_decl = function | A.UnInit (stg, typa, sa, _) -> () | A.Init (stg, typa, sa, _, expa, _) -> () | A.TyDecl (typa, _) -> () | A.MacroDecl(fn, _, eas, _, _) -> () | A.MacroDeclInit(fn, _, eas, _, _, _, _) -> () | A.Ddots(dots,whencode) -> () | A.MetaDecl _ -> () | A.MetaField _ -> () | A.MetaFieldList _ -> () | A.AsDecl _ -> () | A.Typedef(d,ty1,ty2,pv) -> () | A.DisjDecl xs -> () | A.OptDecl _ | A.UniqueDecl _ -> () let dumb_astcocci_initialiser = function (* seems same as the above *) A.Init(stg,ty,id,eq,ini,sem) -> () | A.UnInit(stg,ty,id,sem) -> () | A.MacroDecl(fn, _, eas, _, _) -> () | A.MacroDeclInit(fn, _, eas, _, _, _, _) -> () | A.TyDecl(ty,sem) -> () | A.Typedef(d,ty1,ty2,pv) -> () | A.DisjDecl(decls) -> () | A.Ddots(dots,whencode) -> () | A.MetaDecl(name,_,_) -> () | A.MetaField(name,_,_) -> () | A.MetaFieldList(name,_,_,_) -> () | A.AsDecl(_,_) -> () | A.OptDecl(decl) -> () | A.UniqueDecl(decl) -> () let dumb_astcocci_expr = function | A.MetaExpr (ida,_,_, opttypa, _, _) -> () | A.AsExpr (_,_) -> () | A.Edots (_,_) -> () | A.MetaErr _ -> () | A.Ident ida -> () | A.Constant (A.String sa,_,_,_) -> () | A.Constant (A.Char sa,_,_,_) -> () | A.Constant (A.Int sa,_,_,_) -> () | A.Constant (A.Float sa,_,_,_) -> () | A.Constant (A.DecimalConst _,_,_,_) -> () | A.StringConstant (lq,frags,rq) -> () | A.FunCall (ea1, _, eas, _) -> () | A.Assignment (ea1, opa, ea2, _) -> () | A.Sequence (ea1, opa, ea2) -> () | A.CondExpr (ea1,_,ea2opt,_,ea3) -> () | A.Postfix (ea, opa) -> () | A.Infix (ea, opa) -> () | A.Unary (ea, opa) -> () | A.Binary (ea1, opa, ea2) -> () | A.Nested (ea1, opa, ea2) -> () | A.ArrayAccess (ea1, _, ea2, _) -> () | A.RecordAccess (ea, _, ida) -> () | A.RecordPtAccess (ea, _, ida) -> () | A.Cast (_, typa, _, ea) -> () | A.SizeOfExpr (_, ea) -> () | A.SizeOfType (_, _, typa, _) -> () | A.TypeExp (typa) -> () | A.Constructor (_, typa, _, ia) -> () | A.Paren (_, ea, _) -> () | A.NestExpr _ -> () | A.MetaExprList _ -> () | A.EComma _ -> () | A.Ecircles _ -> () | A.Estars _ -> () | A.DisjExpr eas -> () | A.UniqueExp _ -> () | A.OptExp _ -> () let dumb_astcocci_fulltype = function A.Type(_,cv,ty) -> () | A.AsType(_,_) -> () | A.DisjType(types) -> () | A.OptType(ty) -> () | A.UniqueType(ty) -> () let dumb_astcocci_type = function | A.MetaType(ida,_,_) -> () | A.BaseType (basea,strings) -> () | A.SignedT (signa,tya) -> () | A.Pointer (typa, _) -> () | A.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> () | A.FunctionType _ -> () | A.Array (typa, _, eaopt, _) -> () | A.Decimal(_, _, _, _, _, _) -> () | A.EnumName(en, ena) -> () | A.EnumDef(ty, lb, ids, rb) -> () | A.StructUnionName(sa, sua) -> () | A.StructUnionDef(ty, lb, decls, rb) -> () | A.TypeName sa -> () (* ------------------------------------------------------------------------- *) (* for C *) (* | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_) | Sequence (_,_) | Assignment (_,_,_) | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_) | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | StatementExpr (_) | Constructor | ParenExpr (_) | MacroCall (_) | MacroCall2 (_) ),_ -> | ( Labeled (Label (_,_)) | Labeled (Case (_,_)) | Labeled (CaseRange (_,_,_)) | Labeled (Default _) | Compound _ | ExprStatement _ | Selection (If (_, _, _)) | Selection (Switch (_, _)) | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) | Iteration (For ((_,_), (_,_), (_, _), _)) | Jump (Goto _) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) | Decl _ | Asm | Selection (IfCpp (_,_)) ), _ -> *) (* for control flow nodes | ( F.ExprStatement (_, _) | F.IfHeader (_, _) | F.SwitchHeader (_, _) | F.WhileHeader (_, _) | (* F.DoHeader (_, _) | *) F.DoWhileTail (_, _) | F.ForHeader (_, _) | F.Return (_, _) | F.ReturnExpr (_, _) (* no counter part in cocci *) | F.Label (_, _) | F.Case (_,_) | (* F.CaseRange (_, _) | *) F.Default (_, _) | F.Goto (_, _) | F.Continue (_, _) | F.Break (_, _) ) -> raise Impossible *) coccinelle-1.0.0-rc19/engine/pretty_print_engine.ml0000644000175000017500000001332012247442615021251 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_engine.ml" open Common.Infix open Lib_engine let pp = Common.pp let pp_meta (_,x) = pp x let rec pp_binding_kind = function | Ast_c.MetaIdVal (s,_) -> pp ("id " ^ s) | Ast_c.MetaFuncVal s -> pp ("func " ^ s) | Ast_c.MetaLocalFuncVal s -> pp ("localfunc " ^ s) | Ast_c.MetaExprVal (expr,_) -> Pretty_print_c.pp_expression_simple expr | Ast_c.MetaExprListVal expr_list -> pp "<>" | Ast_c.MetaInitVal ini -> Pretty_print_c.pp_init_simple ini | Ast_c.MetaInitListVal ini -> pp "<>" | Ast_c.MetaTypeVal typ -> Pretty_print_c.pp_type_simple typ | Ast_c.MetaDeclVal decl -> Pretty_print_c.pp_decl_simple decl | Ast_c.MetaFieldVal decl -> Pretty_print_c.pp_field_simple decl | Ast_c.MetaFieldListVal decls -> List.iter Pretty_print_c.pp_field_simple decls | Ast_c.MetaStmtVal statement -> Pretty_print_c.pp_statement_simple statement | Ast_c.MetaFmtVal fmt -> Pretty_print_c.pp_string_format_simple fmt | Ast_c.MetaFragListVal frags -> frags +> (List.iter Pretty_print_c.pp_string_fragment_simple) | Ast_c.MetaParamVal params -> pp "<>" | Ast_c.MetaParamListVal params -> pp "<>" | Ast_c.MetaListlenVal n -> pp (string_of_int n) | Ast_c.MetaPosVal (pos1, pos2) -> let print_pos = function Ast_cocci.Real x -> string_of_int x | Ast_cocci.Virt(x,off) -> Printf.sprintf "%d+%d" x off in pp (Common.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2)) | Ast_c.MetaPosValList l -> pp (Common.sprintf ("poss[%s]") (String.concat ", " (List.map (function (fl,ce,(minl,minc),(maxl,maxc)) -> Printf.sprintf "(%s,%s,(%d,%d),(%d,%d))" fl ce minl minc maxl maxc) l))) and pp_binding subst = begin pp "["; Common.print_between (fun () -> pp ";"; Format.print_cut() ) (fun ((r,s), kind) -> pp r; pp "."; pp s; pp " --> "; pp_binding_kind kind) subst; pp "]"; end let pp_binding_kind2 = function | ParenVal s -> pp "pv("; pp_meta s; pp ")" | NormalMetaVal x -> pp_binding_kind x | LabelVal (Absolute xs) -> begin pp "labelval"; pp "("; Common.print_between (fun () -> pp ",") Format.print_int xs; pp ")"; end | LabelVal (Prefix xs) -> begin pp "prefixlabelval"; pp "("; Common.print_between (fun () -> pp ",") Format.print_int xs; pp ")"; end | GoodVal -> pp "goodval" | BadVal -> pp "badval" let rec pp_predicate = function | InLoop -> pp "InLoop" | TrueBranch -> pp "TrueBranch" | FalseBranch -> pp "FalseBranch" | After -> pp "After" | FallThrough -> pp "FallThrough" | LoopFallThrough -> pp "LoopFallThrough" | Return -> pp "Return" | UnsafeBrace -> pp "UnsafeBrace" | FunHeader -> pp "FunHeader" | Top -> pp "Top" | ErrorExit -> pp "ErrorExit" | Exit -> pp "Exit" | Goto -> pp "Goto" | Paren s -> pp "Paren("; pp_meta s; pp ")" | Match (re) -> Pretty_print_cocci.print_rule_elem re | Label s -> pp "Label("; pp_meta s; pp ")" | BCLabel s -> pp "BreakContinueLabel("; pp_meta s; pp ")" | PrefixLabel s -> pp "PrefixLabel("; pp_meta s; pp ")" | BindGood s -> pp "BindGood("; pp_meta s; pp ")" | BindBad s -> pp "BindBad("; pp_meta s; pp ")" | FakeBrace -> pp "FakeBrace" and pp_binding2 subst = begin pp "["; Common.print_between (fun () -> pp ";";Format.print_cut(); ) (fun (s, kind) -> pp s; pp " --> "; pp_binding_kind2 kind) subst; pp "]"; end and pp_binding2_ctlsubst subst = begin pp "["; Common.print_between (fun () -> pp ";"; Format.print_cut(); ) (function Ast_ctl.Subst (s, kind) -> pp_meta s; pp " --> "; pp_binding_kind2 kind; | Ast_ctl.NegSubst (s, kind) -> pp_meta s; pp " -/-> "; pp_binding_kind2 kind; ) subst; pp "]"; end let predicate_to_string pred = Common.format_to_string (function _ -> pp_predicate pred) let pp_pred_smodif = fun (pred, smodif) -> begin pp_predicate pred; (* (match smodif with | Ast_ctl.Modif x | Ast_ctl.UnModif x -> pp " with " | Ast_ctl.Control -> () ) *) end let pp_ctlcocci show_plus inline_let_def ctl = begin if show_plus then begin Pretty_print_cocci.print_plus_flag := true; Pretty_print_cocci.print_minus_flag := true; end else begin Pretty_print_cocci.print_plus_flag := false; Pretty_print_cocci.print_minus_flag := false; end; Common.pp_do_in_box (fun () -> Pretty_print_ctl.pp_ctl (pp_pred_smodif,(fun s -> pp_meta s)) inline_let_def ctl; ); end coccinelle-1.0.0-rc19/engine/asttoctl2.ml0000644000175000017500000027752412247442614017121 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttoctl2.ml" (* for MINUS and CONTEXT, pos is always None in this file *) (*search for require*) (* true = don't see all matched nodes, only modified ones *) let onlyModif = ref true(*false*) type ex = Exists | Forall let exists = ref Forall module Ast = Ast_cocci module V = Visitor_ast module CTL = Ast_ctl let warning s = Printf.fprintf stderr "warning: %s\n" s type cocci_predicate = Lib_engine.predicate * Ast.meta_name Ast_ctl.modif type formula = Lib_engine.ctlcocci type top_formula = NONDECL of Lib_engine.ctlcocci | CODE of Lib_engine.ctlcocci let union = Common.union_set let intersect l1 l2 = List.filter (function x -> List.mem x l2) l1 let subset l1 l2 = List.for_all (function x -> List.mem x l2) l1 let foldl1 f xs = List.fold_left f (List.hd xs) (List.tl xs) let foldr1 f xs = let xs = List.rev xs in List.fold_left f (List.hd xs) (List.tl xs) let used_after = ref ([] : Ast.meta_name list) let guard_to_strict guard = if guard then CTL.NONSTRICT else CTL.STRICT let saved = ref ([] : Ast.meta_name list) let string2var x = ("",x) (* --------------------------------------------------------------------- *) (* predicates matching various nodes in the graph *) let ctl_and s x y = match (x,y) with (CTL.False,_) | (_,CTL.False) -> CTL.False | (CTL.True,a) | (a,CTL.True) -> a | _ -> CTL.And(s,x,y) let ctl_or x y = match (x,y) with (CTL.True,_) | (_,CTL.True) -> CTL.True | (CTL.False,a) | (a,CTL.False) -> a | _ -> CTL.Or(x,y) let ctl_or_fl x y = match (x,y) with (CTL.True,_) | (_,CTL.True) -> CTL.True | (CTL.False,a) | (a,CTL.False) -> a | _ -> CTL.Or(y,x) let ctl_seqor x y = match (x,y) with (* drop x or true case because x might have side effects *) (CTL.True,_) (* | (_,CTL.True) *) -> CTL.True | (CTL.False,a) | (a,CTL.False) -> a | _ -> CTL.SeqOr(x,y) let ctl_not = function CTL.True -> CTL.False | CTL.False -> CTL.True | x -> CTL.Not(x) let ctl_ax s = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> match !exists with Exists -> CTL.EX(CTL.FORWARD,x) | Forall -> CTL.AX(CTL.FORWARD,s,x) let ctl_ax_absolute s = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.AX(CTL.FORWARD,s,x) let ctl_ex = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.EX(CTL.FORWARD,x) (* This stays being AX even for sgrep_mode, because it is used to identify the structure of the term, not matching the pattern. *) let ctl_back_ag = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.AG(CTL.BACKWARD,CTL.NONSTRICT,x) let ctl_back_ax = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.AX(CTL.BACKWARD,CTL.NONSTRICT,x) let ctl_back_ex = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.EX(CTL.BACKWARD,x) let ctl_ef = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.EF(CTL.FORWARD,x) let ctl_ag s = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.AG(CTL.FORWARD,s,x) let ctl_au s x y = match (x,!exists) with (CTL.True,Exists) -> CTL.EF(CTL.FORWARD,y) | (CTL.True,Forall) -> CTL.AF(CTL.FORWARD,s,y) | (_,Exists) -> CTL.EU(CTL.FORWARD,x,y) | (_,Forall) -> CTL.AU(CTL.FORWARD,s,x,y) let ctl_anti_au s x y = (* only for ..., where the quantifier is changed *) CTL.XX (match (x,!exists) with (CTL.True,Exists) -> CTL.AF(CTL.FORWARD,s,y) | (CTL.True,Forall) -> CTL.EF(CTL.FORWARD,y) | (_,Exists) -> CTL.AU(CTL.FORWARD,s,x,y) | (_,Forall) -> CTL.EU(CTL.FORWARD,x,y)) let ctl_uncheck = function CTL.True -> CTL.True | CTL.False -> CTL.False | x -> CTL.Uncheck x let label_pred_maker = function None -> CTL.True | Some (label_var,used) -> used := true; CTL.Pred(Lib_engine.PrefixLabel(label_var),CTL.Control) let bclabel_pred_maker = function None -> CTL.True | Some (label_var,used) -> used := true; CTL.Pred(Lib_engine.BCLabel(label_var),CTL.Control) (* label used to be used here, but it is not used; label is only needed after and within dots *) let predmaker guard pred label = CTL.Pred pred let aftpred = predmaker false (Lib_engine.After, CTL.Control) let retpred = predmaker false (Lib_engine.Return, CTL.Control) let funpred = predmaker false (Lib_engine.FunHeader, CTL.Control) let unsbrpred = predmaker false (Lib_engine.UnsafeBrace, CTL.Control) let toppred = predmaker false (Lib_engine.Top, CTL.Control) let exitpred = predmaker false (Lib_engine.ErrorExit, CTL.Control) let endpred = predmaker false (Lib_engine.Exit, CTL.Control) let gotopred = predmaker false (Lib_engine.Goto, CTL.Control) let inlooppred = predmaker false (Lib_engine.InLoop, CTL.Control) let truepred = predmaker false (Lib_engine.TrueBranch, CTL.Control) let falsepred = predmaker false (Lib_engine.FalseBranch, CTL.Control) let fallpred = predmaker false (Lib_engine.FallThrough, CTL.Control) let loopfallpred = predmaker false (Lib_engine.LoopFallThrough, CTL.Control) (*let aftret label_var = ctl_or (aftpred label_var) (ctl_or (loopfallpred label_var) (exitpred label_var))*) let letctr = ref 0 let get_let_ctr _ = let cur = !letctr in letctr := cur + 1; Printf.sprintf "r%d" cur (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Eliminate OptStm *) (* for optional thing with nothing after, should check that the optional thing never occurs. otherwise the matching stops before it occurs *) let elim_opt = let mcode x = x in let donothing r k e = k e in let fvlist l = List.fold_left Common.union_set [] (List.map Ast.get_fvs l) in let mfvlist l = List.fold_left Common.union_set [] (List.map Ast.get_mfvs l) in let freshlist l = List.fold_left Common.union_set [] (List.map Ast.get_fresh l) in let inheritedlist l = List.fold_left Common.union_set [] (List.map Ast.get_inherited l) in let savedlist l = List.fold_left Common.union_set [] (List.map Ast.get_saved l) in let varlists l = (fvlist l, mfvlist l, freshlist l, inheritedlist l, savedlist l) in let rec dots_list unwrapped wrapped = match (unwrapped,wrapped) with ([],_) -> [] | (Ast.Dots(_,_,_,_)::Ast.OptStm(stm)::(Ast.Dots(_,_,_,_) as u)::urest, d0::s::d1::rest) | (Ast.Nest(_,_,_,_,_,_,_)::Ast.OptStm(stm)::(Ast.Dots(_,_,_,_) as u) ::urest, d0::s::d1::rest) -> (* why no case for nest as u? *) let l = Ast.get_line stm in let new_rest1 = stm :: (dots_list (u::urest) (d1::rest)) in let new_rest2 = dots_list urest rest in let (fv_rest1,mfv_rest1,fresh_rest1,inherited_rest1,s1) = varlists new_rest1 in let (fv_rest2,mfv_rest2,fresh_rest2,inherited_rest2,s2) = varlists new_rest2 in [d0; {(Ast.make_term (Ast.Disj [{(Ast.make_term(Ast.DOTS(new_rest1))) with Ast.node_line = l; Ast.free_vars = fv_rest1; Ast.minus_free_vars = mfv_rest1; Ast.fresh_vars = fresh_rest1; Ast.inherited = inherited_rest1; Ast.saved_witness = s1}; {(Ast.make_term(Ast.DOTS(new_rest2))) with Ast.node_line = l; Ast.free_vars = fv_rest2; Ast.minus_free_vars = mfv_rest2; Ast.fresh_vars = fresh_rest2; Ast.inherited = inherited_rest2; Ast.saved_witness = s2}])) with Ast.node_line = l; Ast.free_vars = fv_rest1; Ast.minus_free_vars = mfv_rest1; Ast.fresh_vars = fresh_rest1; Ast.inherited = inherited_rest1; Ast.saved_witness = s1}] | (Ast.OptStm(stm)::urest,_::rest) -> let l = Ast.get_line stm in let new_rest1 = dots_list urest rest in let new_rest2 = stm::new_rest1 in let (fv_rest1,mfv_rest1,fresh_rest1,inherited_rest1,s1) = varlists new_rest1 in let (fv_rest2,mfv_rest2,fresh_rest2,inherited_rest2,s2) = varlists new_rest2 in [{(Ast.make_term (Ast.Disj [{(Ast.make_term(Ast.DOTS(new_rest2))) with Ast.node_line = l; Ast.free_vars = fv_rest2; Ast.minus_free_vars = mfv_rest2; Ast.fresh_vars = fresh_rest2; Ast.inherited = inherited_rest2; Ast.saved_witness = s2}; {(Ast.make_term(Ast.DOTS(new_rest1))) with Ast.node_line = l; Ast.free_vars = fv_rest1; Ast.minus_free_vars = mfv_rest1; Ast.fresh_vars = fresh_rest1; Ast.inherited = inherited_rest1; Ast.saved_witness = s1}])) with Ast.node_line = l; Ast.free_vars = fv_rest2; Ast.minus_free_vars = mfv_rest2; Ast.fresh_vars = fresh_rest2; Ast.inherited = inherited_rest2; Ast.saved_witness = s2}] | ([Ast.Dots(_,_,_,_);Ast.OptStm(stm)],[d1;_]) -> let l = Ast.get_line stm in let fv_stm = Ast.get_fvs stm in let mfv_stm = Ast.get_mfvs stm in let fresh_stm = Ast.get_fresh stm in let inh_stm = Ast.get_inherited stm in let saved_stm = Ast.get_saved stm in let fv_d1 = Ast.get_fvs d1 in let mfv_d1 = Ast.get_mfvs d1 in let fresh_d1 = Ast.get_fresh d1 in let inh_d1 = Ast.get_inherited d1 in let saved_d1 = Ast.get_saved d1 in let fv_both = Common.union_set fv_stm fv_d1 in let mfv_both = Common.union_set mfv_stm mfv_d1 in let fresh_both = Common.union_set fresh_stm fresh_d1 in let inh_both = Common.union_set inh_stm inh_d1 in let saved_both = Common.union_set saved_stm saved_d1 in [d1; {(Ast.make_term (Ast.Disj [{(Ast.make_term(Ast.DOTS([stm]))) with Ast.node_line = l; Ast.free_vars = fv_stm; Ast.minus_free_vars = mfv_stm; Ast.fresh_vars = fresh_stm; Ast.inherited = inh_stm; Ast.saved_witness = saved_stm}; {(Ast.make_term(Ast.DOTS([d1]))) with Ast.node_line = l; Ast.free_vars = fv_d1; Ast.minus_free_vars = mfv_d1; Ast.fresh_vars = fresh_d1; Ast.inherited = inh_d1; Ast.saved_witness = saved_d1}])) with Ast.node_line = l; Ast.free_vars = fv_both; Ast.minus_free_vars = mfv_both; Ast.fresh_vars = fresh_both; Ast.inherited = inh_both; Ast.saved_witness = saved_both}] | ([Ast.Nest(_,_,_,_,_,_,_);Ast.OptStm(stm)],[d1;_]) -> let l = Ast.get_line stm in let rw = Ast.rewrap stm in let rwd = Ast.rewrap stm in let dots = Ast.Dots(Ast.make_mcode "...",[],[],[]) in [d1;rw(Ast.Disj [rwd(Ast.DOTS([stm])); {(Ast.make_term(Ast.DOTS([rw dots]))) with Ast.node_line = l}])] | (_::urest,stm::rest) -> stm :: (dots_list urest rest) | _ -> failwith "not possible" in let stmtdotsfn r k d = let d = k d in Ast.rewrap d (match Ast.unwrap d with Ast.DOTS(l) -> Ast.DOTS(dots_list (List.map Ast.unwrap l) l) | Ast.CIRCLES(l) -> failwith "elimopt: not supported" | Ast.STARS(l) -> failwith "elimopt: not supported") in V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing stmtdotsfn donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* --------------------------------------------------------------------- *) (* after management *) (* We need Guard for the following case: <... a <... b ...> ...> foo(); Here the inner <... b ...> should not go past foo. But foo is not the "after" of the body of the outer nest, because we don't want to search for it in the case where the body of the outer nest ends in something other than dots or a nest. *) (* what is the difference between tail and end??? *) type after = After of formula | Guard of formula | Tail | End | VeryEnd type top = Top | NotTop let a2n = function After x -> Guard x | a -> a let print_ctl x = let pp_pred (x,_) = Pretty_print_engine.pp_predicate x in let pp_meta (_,x) = Common.pp x in Pretty_print_ctl.pp_ctl (pp_pred,pp_meta) false x; Format.print_newline() let print_after = function After ctl -> Printf.printf "After:\n"; print_ctl ctl | Guard ctl -> Printf.printf "Guard:\n"; print_ctl ctl | Tail -> Printf.printf "Tail\n" | VeryEnd -> Printf.printf "Very End\n" | End -> Printf.printf "End\n" (* --------------------------------------------------------------------- *) (* Top-level code *) let fresh_var _ = string2var "_v" let fresh_pos _ = string2var "_pos" (* must be a constant *) let fresh_metavar _ = "_S" (* fvinfo is going to end up being from the whole associated statement. it would be better if it were just the free variables in d, but free_vars.ml doesn't keep track of free variables on + code *) let make_meta_rule_elem d fvinfo = let nm = fresh_metavar() in Ast.make_meta_rule_elem nm d fvinfo let get_unquantified quantified vars = List.filter (function x -> not (List.mem x quantified)) vars let make_seq guard l = let s = guard_to_strict guard in foldr1 (function rest -> function cur -> ctl_and s cur (ctl_ax s rest)) l let make_seq_after2 guard first rest = let s = guard_to_strict guard in match rest with After rest -> ctl_and s first (ctl_ax s (ctl_ax s rest)) | _ -> first let make_seq_after guard first rest = match rest with After rest -> make_seq guard [first;rest] | _ -> first let opt_and guard first rest = let s = guard_to_strict guard in match first with None -> rest | Some first -> ctl_and s first rest let and_after guard first rest = let s = guard_to_strict guard in match rest with After rest -> ctl_and s first rest | _ -> first let contains_modif = let bind x y = x or y in let option_default = false in let mcode r (_,_,kind,metapos) = match kind with Ast.MINUS(_,_,_,_) -> true | Ast.PLUS _ -> failwith "not possible" | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let init r k i = let res = k i in match Ast.unwrap i with Ast.StrInitList(allminus,_,_,_,_) -> allminus or res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing init do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem let contains_pos = let bind x y = x or y in let option_default = false in let mcode r (_,_,kind,metapos) = not (metapos = []) in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem (* code is not a DisjRuleElem *) let make_match label guard code = let v = fresh_var() in let matcher = Lib_engine.Match(code) in if contains_modif code && not guard then CTL.Exists(true,v,predmaker guard (matcher,CTL.Modif v) label) else let iso_info = !Flag.track_iso_usage && not (Ast.get_isos code = []) in (match (iso_info,!onlyModif,guard, intersect !used_after (Ast.get_fvs code)) with (false,true,_,[]) | (_,_,true,_) -> predmaker guard (matcher,CTL.Control) label | _ -> CTL.Exists(true,v,predmaker guard (matcher,CTL.UnModif v) label)) let make_raw_match label guard code = match intersect !used_after (Ast.get_fvs code) with [] -> predmaker guard (Lib_engine.Match(code),CTL.Control) label | _ -> let v = fresh_var() in CTL.Exists(true,v,predmaker guard (Lib_engine.Match(code),CTL.UnModif v) label) let rec seq_fvs quantified = function [] -> [] | fv1::fvs -> let t1fvs = get_unquantified quantified fv1 in let termfvs = List.fold_left Common.union_set [] (List.map (get_unquantified quantified) fvs) in let bothfvs = Common.inter_set t1fvs termfvs in let t1onlyfvs = Common.minus_set t1fvs bothfvs in let new_quantified = Common.union_set bothfvs quantified in (t1onlyfvs,bothfvs)::(seq_fvs new_quantified fvs) let quantify guard = List.fold_right (function cur -> function code -> CTL.Exists (not guard && List.mem cur !saved,cur,code)) let non_saved_quantify = List.fold_right (function cur -> function code -> CTL.Exists (false,cur,code)) let intersectll lst nested_list = List.filter (function x -> List.exists (List.mem x) nested_list) lst (* --------------------------------------------------------------------- *) (* Count depth of braces. The translation of a closed brace appears deeply nested within the translation of the sequence term, so the name of the paren var has to take into account the names of the nested braces. On the other hand the close brace does not escape, so we don't have to take into account other paren variable names. *) (* called repetitively, which is inefficient, but less trouble than adding a new field to Seq and FunDecl *) let count_nested_braces s = let bind x y = max x y in let option_default = 0 in let stmt_count r k s = match Ast.unwrap s with Ast.Seq(_,_,_) | Ast.FunDecl(_,_,_,_) -> (k s) + 1 | _ -> k s in let donothing r k e = k e in let mcode r x = 0 in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing stmt_count donothing donothing donothing in let res = string_of_int (recursor.V.combiner_statement s) in string2var ("p"^res) let labelctr = ref 0 let get_label_ctr _ = let cur = !labelctr in labelctr := cur + 1; string2var (Printf.sprintf "l%d" cur) (* --------------------------------------------------------------------- *) (* annotate dots with before and after neighbors *) let print_bef_aft = function Ast.WParen (re,n) -> Printf.printf "bef/aft\n"; Pretty_print_cocci.rule_elem "" re; Format.print_newline() | Ast.Other s -> Printf.printf "bef/aft\n"; Pretty_print_cocci.statement "" s; Format.print_newline() | Ast.Other_dots d -> Printf.printf "bef/aft\n"; Pretty_print_cocci.statement_dots d; Format.print_newline() (* [] can only occur if we are in a disj, where it comes from a ? In that case, we want to use a, which accumulates all of the previous patterns in their entirety. *) let rec get_before_elem sl a = match Ast.unwrap sl with Ast.DOTS(x) -> let rec loop sl a = match sl with [] -> ([],Common.Right a) | [e] -> let (e,ea) = get_before_e e a in ([e],Common.Left ea) | e::sl -> let (e,ea) = get_before_e e a in let (sl,sla) = loop sl ea in (e::sl,sla) in let (l,a) = loop x a in (Ast.rewrap sl (Ast.DOTS(l)),a) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" and get_before sl a = match get_before_elem sl a with (term,Common.Left x) -> (term,x) | (term,Common.Right x) -> (term,x) and get_before_whencode wc = List.map (function Ast.WhenNot w -> let (w,_) = get_before w [] in Ast.WhenNot w | Ast.WhenAlways w -> let (w,_) = get_before_e w [] in Ast.WhenAlways w | Ast.WhenModifier(x) -> Ast.WhenModifier(x) | Ast.WhenNotTrue w -> Ast.WhenNotTrue w | Ast.WhenNotFalse w -> Ast.WhenNotFalse w) wc and get_before_e s a = match Ast.unwrap s with Ast.Dots(d,w,_,aft) -> (Ast.rewrap s (Ast.Dots(d,get_before_whencode w,a,aft)),a) | Ast.Nest(starter,stmt_dots,ender,w,multi,_,aft) -> let w = get_before_whencode w in let (sd,_) = get_before stmt_dots a in (*let a = got rid of this, don't want to let nests overshoot List.filter (function Ast.Other a -> let unifies = Unify_ast.unify_statement_dots (Ast.rewrap s (Ast.DOTS([a]))) stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | Ast.Other_dots a -> let unifies = Unify_ast.unify_statement_dots a stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | _ -> true) a in*) (Ast.rewrap s (Ast.Nest(starter,sd,ender,w,multi,a,aft)), [Ast.Other_dots stmt_dots]) | Ast.Disj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_before e a) stmt_dots_list) in (Ast.rewrap s (Ast.Disj(dsl)),List.fold_left Common.union_set [] dsla) | Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.MetaStmt(_,_,_,_) -> (s,[]) | _ -> (s,[Ast.Other s])) | Ast.Seq(lbrace,body,rbrace) -> let index = count_nested_braces s in let (bd,_) = get_before body [Ast.WParen(lbrace,index)] in (Ast.rewrap s (Ast.Seq(lbrace,bd,rbrace)),[Ast.WParen(rbrace,index)]) | Ast.Define(header,body) -> let (body,_) = get_before body [] in (Ast.rewrap s (Ast.Define(header,body)), [Ast.Other s]) | Ast.AsStmt(stmt,asstmt) -> let (stmt,_) = get_before_e stmt [] in let (asstmt,_) = get_before_e asstmt [] in (Ast.rewrap s (Ast.AsStmt(stmt,asstmt)),[Ast.Other s]) | Ast.IfThen(ifheader,branch,aft) -> let (br,_) = get_before_e branch [] in (Ast.rewrap s (Ast.IfThen(ifheader,br,aft)), [Ast.Other s]) | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> let (br1,_) = get_before_e branch1 [] in let (br2,_) = get_before_e branch2 [] in (Ast.rewrap s (Ast.IfThenElse(ifheader,br1,els,br2,aft)),[Ast.Other s]) | Ast.While(header,body,aft) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.While(header,bd,aft)),[Ast.Other s]) | Ast.For(header,body,aft) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.For(header,bd,aft)),[Ast.Other s]) | Ast.Do(header,body,tail) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.Do(header,bd,tail)),[Ast.Other s]) | Ast.Iterator(header,body,aft) -> let (bd,_) = get_before_e body [] in (Ast.rewrap s (Ast.Iterator(header,bd,aft)),[Ast.Other s]) | Ast.Switch(header,lb,decls,cases,rb) -> let index = count_nested_braces s in let (de,dea) = get_before decls [Ast.WParen(lb,index)] in let cases = List.map (function case_line -> match Ast.unwrap case_line with Ast.CaseLine(header,body) -> let (body,_) = get_before body [] in Ast.rewrap case_line (Ast.CaseLine(header,body)) | Ast.OptCase(case_line) -> failwith "not supported") cases in (Ast.rewrap s (Ast.Switch(header,lb,de,cases,rb)), [Ast.WParen(rb,index)]) | Ast.FunDecl(header,lbrace,body,rbrace) -> let (bd,_) = get_before body [] in (Ast.rewrap s (Ast.FunDecl(header,lbrace,bd,rbrace)),[]) | _ -> Pretty_print_cocci.statement "" s; Format.print_newline(); failwith "get_before_e: not supported" let rec get_after sl a = match Ast.unwrap sl with Ast.DOTS(x) -> let rec loop sl = match sl with [] -> ([],a) | e::sl -> let (sl,sla) = loop sl in let (e,ea) = get_after_e e sla in (e::sl,ea) in let (l,a) = loop x in (Ast.rewrap sl (Ast.DOTS(l)),a) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" and get_after_whencode a wc = List.map (function Ast.WhenNot w -> let (w,_) = get_after w a (*?*) in Ast.WhenNot w | Ast.WhenAlways w -> let (w,_) = get_after_e w a in Ast.WhenAlways w | Ast.WhenModifier(x) -> Ast.WhenModifier(x) | Ast.WhenNotTrue w -> Ast.WhenNotTrue w | Ast.WhenNotFalse w -> Ast.WhenNotFalse w) wc and get_after_e s a = match Ast.unwrap s with Ast.Dots(d,w,bef,_) -> (Ast.rewrap s (Ast.Dots(d,get_after_whencode a w,bef,a)),a) | Ast.Nest(starter,stmt_dots,ender,w,multi,bef,_) -> let w = get_after_whencode a w in let (sd,_) = get_after stmt_dots a in (*let a = got rid of this. don't want to let nests overshoot List.filter (function Ast.Other a -> let unifies = Unify_ast.unify_statement_dots (Ast.rewrap s (Ast.DOTS([a]))) stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | Ast.Other_dots a -> let unifies = Unify_ast.unify_statement_dots a stmt_dots in (match unifies with Unify_ast.MAYBE -> false | _ -> true) | _ -> true) a in*) (Ast.rewrap s (Ast.Nest(starter,sd,ender,w,multi,bef,a)), [Ast.Other_dots stmt_dots]) | Ast.Disj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_after e a) stmt_dots_list) in (Ast.rewrap s (Ast.Disj(dsl)),List.fold_left Common.union_set [] dsla) | Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.MetaStmt(nm,keep,Ast.SequencibleAfterDots _,i) -> (* check "after" information for metavar optimization *) (* if the error is not desired, could just return [], then the optimization (check for EF) won't take place *) List.iter (function Ast.Other x -> (match Ast.unwrap x with Ast.Dots(_,_,_,_) | Ast.Nest(_,_,_,_,_,_,_) -> failwith "dots/nest not allowed before and after stmt metavar" | _ -> ()) | Ast.Other_dots x -> (match Ast.undots x with x::_ -> (match Ast.unwrap x with Ast.Dots(_,_,_,_) | Ast.Nest(_,_,_,_,_,_,_) -> failwith ("dots/nest not allowed before and after stmt "^ "metavar") | _ -> ()) | _ -> ()) | _ -> ()) a; (Ast.rewrap s (Ast.Atomic (Ast.rewrap s (Ast.MetaStmt(nm,keep,Ast.SequencibleAfterDots a,i)))),[]) | Ast.MetaStmt(_,_,_,_) -> (s,[]) | _ -> (s,[Ast.Other s])) | Ast.Seq(lbrace,body,rbrace) -> let index = count_nested_braces s in let (bd,_) = get_after body [Ast.WParen(rbrace,index)] in (Ast.rewrap s (Ast.Seq(lbrace,bd,rbrace)), [Ast.WParen(lbrace,index)]) | Ast.Define(header,body) -> let (body,_) = get_after body a in (Ast.rewrap s (Ast.Define(header,body)), [Ast.Other s]) | Ast.AsStmt(stmt,asstmt) -> let (stmt,_) = get_after_e stmt [] in let (asstmt,_) = get_after_e asstmt [] in (Ast.rewrap s (Ast.AsStmt(stmt,asstmt)),[Ast.Other s]) | Ast.IfThen(ifheader,branch,aft) -> let (br,_) = get_after_e branch a in (Ast.rewrap s (Ast.IfThen(ifheader,br,aft)),[Ast.Other s]) | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> let (br1,_) = get_after_e branch1 a in let (br2,_) = get_after_e branch2 a in (Ast.rewrap s (Ast.IfThenElse(ifheader,br1,els,br2,aft)),[Ast.Other s]) | Ast.While(header,body,aft) -> let (bd,_) = get_after_e body ((Ast.Other s) :: a) in (Ast.rewrap s (Ast.While(header,bd,aft)),[Ast.Other s]) | Ast.For(header,body,aft) -> let (bd,_) = get_after_e body ((Ast.Other s) :: a) in (Ast.rewrap s (Ast.For(header,bd,aft)),[Ast.Other s]) | Ast.Do(header,body,tail) -> let (bd,_) = get_after_e body ((Ast.Other s) :: a) in (Ast.rewrap s (Ast.Do(header,bd,tail)),[Ast.Other s]) | Ast.Iterator(header,body,aft) -> let (bd,_) = get_after_e body ((Ast.Other s) :: a) in (Ast.rewrap s (Ast.Iterator(header,bd,aft)),[Ast.Other s]) | Ast.Switch(header,lb,decls,cases,rb) -> let index = count_nested_braces s in let cases = List.map (function case_line -> match Ast.unwrap case_line with Ast.CaseLine(header,body) -> let (body,_) = get_after body [Ast.WParen(rb,index)] in Ast.rewrap case_line (Ast.CaseLine(header,body)) | Ast.OptCase(case_line) -> failwith "not supported") cases in let (de,_) = get_after decls [] in (Ast.rewrap s (Ast.Switch(header,lb,de,cases,rb)),[Ast.WParen(lb,index)]) | Ast.FunDecl(header,lbrace,body,rbrace) -> let (bd,_) = get_after body [] in (Ast.rewrap s (Ast.FunDecl(header,lbrace,bd,rbrace)),[]) | _ -> failwith "get_after_e: not supported" let preprocess_dots sl = let (sl,_) = get_before sl [] in let (sl,_) = get_after sl [] in sl let preprocess_dots_e sl = let (sl,_) = get_before_e sl [] in let (sl,_) = get_after_e sl [] in sl (* --------------------------------------------------------------------- *) (* various return_related things *) let rec ends_in_return stmt_list = match Ast.unwrap stmt_list with Ast.DOTS(x) -> (match List.rev x with x::_ -> (match Ast.unwrap x with Ast.Atomic(x) -> let rec loop x = match Ast.unwrap x with Ast.Return(_,_) | Ast.ReturnExpr(_,_,_) -> true | Ast.DisjRuleElem((_::_) as l) -> List.for_all loop l | _ -> false in loop x | Ast.Disj(disjs) -> List.for_all ends_in_return disjs | _ -> false) | _ -> false) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" (* --------------------------------------------------------------------- *) (* expressions *) let exptymatch l make_match make_guard_match = let pos = fresh_pos() in let matches_guard_matches = List.map (function x -> let pos = Ast.make_mcode pos in (make_match (Ast.set_pos x (Some pos)), make_guard_match (Ast.set_pos x (Some pos)))) l in let (matches,guard_matches) = List.split matches_guard_matches in let rec suffixes = function [] -> [] | x::xs -> xs::(suffixes xs) in let prefixes = (* normally, we check that an expression does not match something earlier in the disjunction (calculated as prefixes). But for large disjunctions, this can result in a very big CTL formula. So we give the user the option to say he doesn't want this feature, if that is the case. *) if !Flag_matcher.no_safe_expressions then List.map (function _ -> []) matches else List.rev (suffixes (List.rev guard_matches)) in let info = (* not null *) List.map2 (function matcher -> function negates -> CTL.Exists (false,pos, ctl_and CTL.NONSTRICT matcher (ctl_not (ctl_uncheck (List.fold_left ctl_or_fl CTL.False negates))))) matches prefixes in CTL.InnerAnd(List.fold_left ctl_or_fl CTL.False (List.rev info)) (* code might be a DisjRuleElem, in which case we break it apart code might contain an Exp or Ty this one pushes the quantifier inwards *) let do_re_matches label guard res quantified minus_quantified = let make_guard_match x = let stmt_fvs = Ast.get_mfvs x in let fvs = get_unquantified minus_quantified stmt_fvs in non_saved_quantify fvs (make_match None true x) in let make_match x = let stmt_fvs = Ast.get_fvs x in let fvs = get_unquantified quantified stmt_fvs in quantify guard fvs (make_match None guard x) in (* label used to be used here, but it is not use; label is only needed after and within dots ctl_and CTL.NONSTRICT (label_pred_maker label) *) (match List.map Ast.unwrap res with [] -> failwith "unexpected empty disj" | Ast.Exp(e)::rest -> exptymatch res make_match make_guard_match | Ast.Ty(t)::rest -> exptymatch res make_match make_guard_match | all -> if List.exists (function Ast.Exp(_) | Ast.Ty(_) -> true | _ -> false) all then failwith "unexpected exp or ty"; List.fold_left ctl_seqor CTL.False (List.map make_match res)) (* code might be a DisjRuleElem, in which case we break it apart code doesn't contain an Exp or Ty this one is for use when it is not practical to push the quantifier inwards *) let header_match label guard code : ('a, Ast.meta_name, 'b) CTL.generic_ctl = match Ast.unwrap code with Ast.DisjRuleElem(res) -> let make_match = make_match None guard in let orop = if guard then ctl_or else ctl_seqor in (* label used to be used here, but it is not use; label is only needed after and within dots ctl_and CTL.NONSTRICT (label_pred_maker label) *) (List.fold_left orop CTL.False (List.map make_match res)) | _ -> make_match label guard code (* --------------------------------------------------------------------- *) (* control structures *) let end_control_structure fvs header body after_pred after_checks no_after_checks (afvs,afresh,ainh,aft) after label guard = (* aft indicates what is added after the whole if, which has to be added to the endif node *) let (aft_needed,after_branch) = match aft with Ast.CONTEXT(_,Ast.NOTHING) -> (false,make_seq_after2 guard after_pred after) | _ -> let match_endif = make_match label guard (make_meta_rule_elem aft (afvs,afresh,ainh)) in (true, make_seq_after guard after_pred (After(make_seq_after guard match_endif after))) in let body = body after_branch in let s = guard_to_strict guard in (* the code *) quantify guard fvs (ctl_and s header (opt_and guard (match (after,aft_needed) with (After _,_) (* pattern doesn't end here *) | (_,true) (* + code added after *) -> after_checks | _ -> no_after_checks) (ctl_ax_absolute s body))) let ifthen ifheader branch ((afvs,_,_,_) as aft) after quantified minus_quantified label llabel slabel recurse make_match guard = (* "if (test) thn" becomes: if(test) & AX((TrueBranch & AX thn) v FallThrough v After) "if (test) thn; after" becomes: if(test) & AX((TrueBranch & AX thn) v FallThrough v (After & AXAX after)) & EX After *) (* free variables *) let (efvs,bfvs) = match seq_fvs quantified [Ast.get_fvs ifheader;Ast.get_fvs branch;afvs] with [(efvs,b1fvs);(_,b2fvs);_] -> (efvs,Common.union_set b1fvs b2fvs) | _ -> failwith "not possible" in let new_quantified = Common.union_set bfvs quantified in let (mefvs,mbfvs) = match seq_fvs minus_quantified [Ast.get_mfvs ifheader;Ast.get_mfvs branch;[]] with [(efvs,b1fvs);(_,b2fvs);_] -> (efvs,Common.union_set b1fvs b2fvs) | _ -> failwith "not possible" in let new_mquantified = Common.union_set mbfvs minus_quantified in (* if header *) let if_header = quantify guard efvs (make_match ifheader) in (* then branch and after *) let lv = get_label_ctr() in let used = ref false in let true_branch = (* no point to put a label on truepred etc; it is local to this construct so it must have the same label *) make_seq guard [truepred None; recurse branch NotTop Tail new_quantified new_mquantified (Some (lv,used)) llabel slabel guard] in let after_pred = aftpred None in let or_cases after_branch = ctl_or true_branch (ctl_or (fallpred None) after_branch) in let (if_header,wrapper) = if !used then let label_pred = CTL.Pred (Lib_engine.Label(lv),CTL.Control) in (ctl_and CTL.NONSTRICT(*???*) if_header label_pred, (function body -> quantify true [lv] body)) else (if_header,function x -> x) in wrapper (end_control_structure bfvs if_header or_cases after_pred (Some(ctl_ex after_pred)) None aft after label guard) let ifthenelse ifheader branch1 els branch2 ((afvs,_,_,_) as aft) after quantified minus_quantified label llabel slabel recurse make_match guard = (* "if (test) thn else els" becomes: if(test) & AX((TrueBranch & AX thn) v (FalseBranch & AX (else & AX els)) v After) & EX FalseBranch "if (test) thn else els; after" becomes: if(test) & AX((TrueBranch & AX thn) v (FalseBranch & AX (else & AX els)) v (After & AXAX after)) & EX FalseBranch & EX After *) (* free variables *) let (e1fvs,b1fvs,s1fvs) = match seq_fvs quantified [Ast.get_fvs ifheader;Ast.get_fvs branch1;afvs] with [(e1fvs,b1fvs);(s1fvs,b1afvs);_] -> (e1fvs,Common.union_set b1fvs b1afvs,s1fvs) | _ -> failwith "not possible" in let (e2fvs,b2fvs,s2fvs) = (* fvs on else? *) (* just combine with the else branch. no point to have separate quantifier, since there is only one possible control-flow path *) let else_fvs = Common.union_set (Ast.get_fvs els) (Ast.get_fvs branch2) in match seq_fvs quantified [Ast.get_fvs ifheader;else_fvs;afvs] with [(e2fvs,b2fvs);(s2fvs,b2afvs);_] -> (e2fvs,Common.union_set b2fvs b2afvs,s2fvs) | _ -> failwith "not possible" in let bothfvs = union (union b1fvs b2fvs) (intersect s1fvs s2fvs) in let exponlyfvs = intersect e1fvs e2fvs in let new_quantified = union bothfvs quantified in (* minus free variables *) let (me1fvs,mb1fvs,ms1fvs) = match seq_fvs minus_quantified [Ast.get_mfvs ifheader;Ast.get_mfvs branch1;[]] with [(e1fvs,b1fvs);(s1fvs,b1afvs);_] -> (e1fvs,Common.union_set b1fvs b1afvs,s1fvs) | _ -> failwith "not possible" in let (me2fvs,mb2fvs,ms2fvs) = (* fvs on else? *) (* just combine with the else branch. no point to have separate quantifier, since there is only one possible control-flow path *) let else_mfvs = Common.union_set (Ast.get_mfvs els) (Ast.get_mfvs branch2) in match seq_fvs minus_quantified [Ast.get_mfvs ifheader;else_mfvs;[]] with [(e2fvs,b2fvs);(s2fvs,b2afvs);_] -> (e2fvs,Common.union_set b2fvs b2afvs,s2fvs) | _ -> failwith "not possible" in let mbothfvs = union (union mb1fvs mb2fvs) (intersect ms1fvs ms2fvs) in let new_mquantified = union mbothfvs minus_quantified in (* if header *) let if_header = quantify guard exponlyfvs (make_match ifheader) in (* then and else branches *) let lv = get_label_ctr() in let used = ref false in let true_branch = make_seq guard [truepred None; recurse branch1 NotTop Tail new_quantified new_mquantified (Some (lv,used)) llabel slabel guard] in let false_branch = make_seq guard [falsepred None; quantify guard (Common.minus_set (Ast.get_fvs els) new_quantified) (header_match None guard els); recurse branch2 NotTop Tail new_quantified new_mquantified (Some (lv,used)) llabel slabel guard] in let after_pred = aftpred None in let or_cases after_branch = ctl_or true_branch (ctl_or false_branch after_branch) in let s = guard_to_strict guard in let (if_header,wrapper) = if !used then let label_pred = CTL.Pred (Lib_engine.Label(lv),CTL.Control) in (ctl_and CTL.NONSTRICT(*???*) if_header label_pred, (function body -> quantify true [lv] body)) else (if_header,function x -> x) in wrapper (end_control_structure bothfvs if_header or_cases after_pred (Some(ctl_and s (ctl_ex (falsepred None)) (ctl_ex after_pred))) (Some(ctl_ex (falsepred None))) aft after label guard) let forwhile header body ((afvs,_,_,_) as aft) after quantified minus_quantified label recurse make_match guard = let process _ = (* the translation in this case is similar to that of an if with no else *) (* free variables *) let (efvs,bfvs) = match seq_fvs quantified [Ast.get_fvs header;Ast.get_fvs body;afvs] with [(efvs,b1fvs);(_,b2fvs);_] -> (efvs,Common.union_set b1fvs b2fvs) | _ -> failwith "not possible" in let new_quantified = Common.union_set bfvs quantified in (* minus free variables *) let (mefvs,mbfvs) = match seq_fvs minus_quantified [Ast.get_mfvs header;Ast.get_mfvs body;[]] with [(efvs,b1fvs);(_,b2fvs);_] -> (efvs,Common.union_set b1fvs b2fvs) | _ -> failwith "not possible" in let new_mquantified = Common.union_set mbfvs minus_quantified in (* loop header *) let header = quantify guard efvs (make_match header) in let lv = get_label_ctr() in let used = ref false in let body = make_seq guard [inlooppred None; recurse body NotTop Tail new_quantified new_mquantified (Some (lv,used)) (Some (lv,used)) None guard] in let after_pred = loopfallpred None in let or_cases after_branch = ctl_or body after_branch in let (header,wrapper) = if !used then let label_pred = CTL.Pred (Lib_engine.Label(lv),CTL.Control) in (ctl_and CTL.NONSTRICT(*???*) header label_pred, (function body -> quantify true [lv] body)) else (header,function x -> x) in wrapper (end_control_structure bfvs header or_cases after_pred (Some(ctl_ex after_pred)) None aft after label guard) in match (Ast.unwrap body,aft) with (Ast.Atomic(re),(_,_,_,Ast.CONTEXT(_,Ast.NOTHING))) -> (match Ast.unwrap re with Ast.MetaStmt((_,_,Ast.CONTEXT(_,Ast.NOTHING),_), Type_cocci.Unitary,_,false) when after = Tail or after = End or after = VeryEnd -> let (efvs) = match seq_fvs quantified [Ast.get_fvs header] with [(efvs,_)] -> efvs | _ -> failwith "not possible" in quantify guard efvs (make_match header) | _ -> process()) | _ -> process() (* --------------------------------------------------------------------- *) (* statement metavariables *) (* issue: an S metavariable that is not an if branch/loop body should not match an if branch/loop body, so check that the labels of the nodes before the first node matched by the S are different from the label of the first node matched by the S *) let sequencibility body label_pred process_bef_aft = function Ast.Sequencible | Ast.SequencibleAfterDots [] -> body (function x -> (ctl_and CTL.NONSTRICT (ctl_not (ctl_back_ax label_pred)) x)) | Ast.SequencibleAfterDots l -> (* S appears after some dots. l is the code that comes after the S. want to search for that first, because S can match anything, while the stuff after is probably more restricted *) let afts = List.map process_bef_aft l in let ors = foldl1 ctl_or afts in ctl_and CTL.NONSTRICT (ctl_ef (ctl_and CTL.NONSTRICT ors (ctl_back_ax label_pred))) (body (function x -> ctl_and CTL.NONSTRICT (ctl_not (ctl_back_ax label_pred)) x)) | Ast.NotSequencible -> body (function x -> x) let svar_context_with_add_after stmt s label quantified d ast seqible after process_bef_aft guard fvinfo = let label_var = (*fresh_label_var*) string2var "_lab" in let label_pred = CTL.Pred (Lib_engine.Label(label_var),CTL.Control) in (*let prelabel_pred = CTL.Pred (Lib_engine.PrefixLabel(label_var),CTL.Control) in*) let matcher d = make_match None guard (make_meta_rule_elem d fvinfo) in let full_metamatch = matcher d in let first_metamatch = matcher (match d with Ast.CONTEXT(pos,Ast.BEFOREAFTER(bef,_,c)) -> Ast.CONTEXT(pos,Ast.BEFORE(bef,c)) | Ast.CONTEXT(pos,_) -> Ast.CONTEXT(pos,Ast.NOTHING) | Ast.MINUS(_,_,_,_) | Ast.PLUS _ -> failwith "not possible") in (* let middle_metamatch = matcher (match d with Ast.CONTEXT(pos,_) -> Ast.CONTEXT(pos,Ast.NOTHING) | Ast.MINUS(_,_,_,_) | Ast.PLUS _ -> failwith "not possible") in *) let last_metamatch = matcher (match d with Ast.CONTEXT(pos,Ast.BEFOREAFTER(_,aft,c)) -> Ast.CONTEXT(pos,Ast.AFTER(aft,c)) | Ast.CONTEXT(_,_) -> d | Ast.MINUS(_,_,_,_) | Ast.PLUS _ -> failwith "not possible") in (* let rest_nodes = ctl_and CTL.NONSTRICT middle_metamatch prelabel_pred in *) let to_end = ctl_or (aftpred None) (loopfallpred None) in let left_or = (* the whole statement is one node *) make_seq_after guard (ctl_and CTL.NONSTRICT (ctl_not (ctl_ex to_end)) full_metamatch) after in let right_or = (* the statement covers multiple nodes *) ctl_and CTL.NONSTRICT (ctl_ex (make_seq guard [to_end; make_seq_after guard last_metamatch after])) first_metamatch in (* let left_or = make_seq guard [full_metamatch; and_after guard (ctl_not prelabel_pred) after] in let right_or = make_seq guard [first_metamatch; ctl_au CTL.NONSTRICT rest_nodes (make_seq guard [ctl_and CTL.NONSTRICT last_metamatch label_pred; and_after guard (ctl_not prelabel_pred) after])] in *) let body f = ctl_and CTL.NONSTRICT label_pred (f (ctl_and CTL.NONSTRICT (make_raw_match label false ast) (ctl_or left_or right_or))) in let stmt_fvs = Ast.get_fvs stmt in let fvs = get_unquantified quantified stmt_fvs in quantify guard (label_var::fvs) (sequencibility body label_pred process_bef_aft seqible) let svar_minus_or_no_add_after stmt s label quantified d ast seqible after process_bef_aft guard fvinfo = let label_var = (*fresh_label_var*) string2var "_lab" in let label_pred = CTL.Pred (Lib_engine.Label(label_var),CTL.Control) in let prelabel_pred = CTL.Pred (Lib_engine.PrefixLabel(label_var),CTL.Control) in let matcher d = make_match None guard (make_meta_rule_elem d fvinfo) in let ender = match (d,after) with (Ast.PLUS _, _) -> failwith "not possible" | (Ast.CONTEXT(pos,Ast.NOTHING),(Tail|End|VeryEnd)) -> (* just match the root. don't care about label; always ok *) make_raw_match None false ast | (Ast.CONTEXT(pos,Ast.BEFORE(_,_)),(Tail|End|VeryEnd)) -> ctl_and CTL.NONSTRICT (make_raw_match None false ast) (* statement *) (matcher d) (* transformation *) | (Ast.CONTEXT(pos,(Ast.NOTHING|Ast.BEFORE(_,_))), ((After a | Guard a) as after)) -> (* This case and the MINUS one could probably be merged, if HackForStmt were to notice when its arguments are trivial *) (* not really sure what this is doing, esp is_compound... *) let first_metamatch = matcher d in (* try to follow after link *) let to_end = ctl_or (aftpred None) (loopfallpred None) in let is_compound = ctl_ex (make_seq guard [to_end; make_seq_after guard CTL.True after]) in let not_compound = make_seq_after guard (ctl_not (ctl_ex to_end)) after in ctl_and CTL.NONSTRICT (make_raw_match label false ast) (ctl_and CTL.NONSTRICT first_metamatch (ctl_or is_compound not_compound)) | (Ast.CONTEXT(pos,(Ast.AFTER _|Ast.BEFOREAFTER _)),_) -> failwith "not possible" | (Ast.MINUS(pos,inst,adj,l),after) -> let (first_metamatch,last_metamatch,rest_metamatch) = match l with Ast.NOREPLACEMENT -> (matcher(Ast.CONTEXT(pos,Ast.NOTHING)),CTL.True,matcher d) | _ -> (matcher d, matcher(Ast.MINUS(pos,inst,adj,Ast.NOREPLACEMENT)), ctl_and CTL.NONSTRICT (ctl_not (make_raw_match label false ast)) (matcher(Ast.MINUS(pos,inst,adj,Ast.NOREPLACEMENT)))) in (* try to follow after link *) let to_end = ctl_or (aftpred None) (loopfallpred None) in let is_compound = ctl_ex (make_seq guard [to_end; make_seq_after guard last_metamatch after]) in let not_compound = make_seq_after guard (ctl_not (ctl_ex to_end)) after in ctl_and CTL.NONSTRICT (ctl_and CTL.NONSTRICT (make_raw_match label false ast) (ctl_and CTL.NONSTRICT first_metamatch (ctl_or is_compound not_compound))) (* don't have to put anything before the beginning, so don't have to distinguish the first node. so don't have to bother about paths, just use the label. label ensures that found nodes match up with what they should because it is in the lhs of the andany. *) (CTL.HackForStmt(CTL.FORWARD,CTL.NONSTRICT, ctl_and CTL.NONSTRICT label_pred (make_raw_match label false ast), ctl_and CTL.NONSTRICT prelabel_pred rest_metamatch)) in let body f = ctl_and CTL.NONSTRICT label_pred (f ender) in let stmt_fvs = Ast.get_fvs stmt in let fvs = get_unquantified quantified stmt_fvs in quantify guard (label_var::fvs) (sequencibility body label_pred process_bef_aft seqible) (* --------------------------------------------------------------------- *) (* dots and nests *) let dots_au is_strict toend label s wrapcode n x seq_after y quantifier = let matchgoto = gotopred None in let matchbreak = make_match None false (wrapcode (Ast.Break(Ast.make_mcode "break",Ast.make_mcode ";"))) in let matchcontinue = make_match None false (wrapcode (Ast.Continue(Ast.make_mcode "continue",Ast.make_mcode ";"))) in let op = if quantifier = !exists then ctl_au else ctl_anti_au in let stop_early = if quantifier = Exists then Common.Left(CTL.False) else if toend then Common.Left(CTL.Or(aftpred label,exitpred label)) else if is_strict then Common.Left(aftpred label) else Common.Right (function vx -> function v -> (* vx is the contents of the nest, if any. we can only stop early if we find neither the ending code nor the nest contents in the if branch. not sure if this is a good idea. *) let lv = get_label_ctr() in let labelpred = CTL.Pred(Lib_engine.Label lv,CTL.Control) in let preflabelpred = label_pred_maker (Some (lv,ref true)) in (*let is_paren = (* Rather a special case. But if the code afterwards is just a } then there is no point checking after a goto that it does not appear. *) (* this optimization doesn't work. probably depends on whether the destination of the break/goto is local or more global than the dots *) match seq_after with CTL.And(_,e1,e2) -> let is_paren = function CTL.Pred(Lib_engine.Paren _,_) -> true | _ -> false in is_paren e1 or is_paren e2 | _ -> false in *) ctl_or (aftpred label) (quantify false [lv] (ctl_and CTL.NONSTRICT (ctl_and CTL.NONSTRICT (truepred label) labelpred) (op CTL.NONSTRICT (ctl_and CTL.NONSTRICT (ctl_not v) (ctl_and CTL.NONSTRICT vx preflabelpred)) (ctl_and CTL.NONSTRICT preflabelpred (if !Flag_matcher.only_return_is_error_exit then (ctl_and CTL.NONSTRICT (retpred None) (ctl_not seq_after)) else (ctl_or (ctl_and CTL.NONSTRICT (ctl_or (retpred None) matchcontinue) (ctl_not seq_after)) (ctl_and CTL.NONSTRICT (ctl_or matchgoto matchbreak) ((*if is_paren (* an optim that failed see defn is_paren and tests/makes_a_loop *) then CTL.True else*) (ctl_ag s (ctl_not seq_after))))))))))) in let v = get_let_ctr() in op s x (match stop_early with Common.Left x1 -> ctl_or y x1 | Common.Right stop_early -> CTL.Let(v,y, ctl_or (CTL.Ref v) (ctl_and CTL.NONSTRICT (label_pred_maker label) (stop_early n (CTL.Ref v))))) let rec dots_and_nests plus nest whencodes bef aft dotcode after label process_bef_aft statement_list statement guard quantified wrapcode = let ctl_and_ns = ctl_and CTL.NONSTRICT in (* process bef_aft *) let shortest l = List.fold_left ctl_or_fl CTL.False (List.map process_bef_aft l) in let bef_aft = (* to be negated *) try let _ = List.find (function Ast.WhenModifier(Ast.WhenAny) -> true | _ -> false) whencodes in CTL.False with Not_found -> shortest (Common.union_set bef aft) in let is_strict = List.exists (function Ast.WhenModifier(Ast.WhenStrict) -> true | _ -> false) whencodes in let check_quantifier quant other = if List.exists (function Ast.WhenModifier(x) -> x = quant | _ -> false) whencodes then if List.exists (function Ast.WhenModifier(x) -> x = other | _ -> false) whencodes then failwith "inconsistent annotation on dots" else true else false in let quantifier = if check_quantifier Ast.WhenExists Ast.WhenForall then Exists else if check_quantifier Ast.WhenForall Ast.WhenExists then Forall else !exists in (* the following is used when we find a goto, etc and consider accepting without finding the rest of the pattern *) let aft = shortest aft in (* process whencode *) let labelled = label_pred_maker label in let whencodes arg = let (poswhen,negwhen) = List.fold_left (function (poswhen,negwhen) -> function Ast.WhenNot whencodes -> (poswhen,ctl_or (statement_list whencodes) negwhen) | Ast.WhenAlways stm -> (ctl_and CTL.NONSTRICT (statement stm) poswhen,negwhen) | Ast.WhenModifier(_) -> (poswhen,negwhen) | Ast.WhenNotTrue(e) -> (poswhen, ctl_or (whencond_true e label guard quantified) negwhen) | Ast.WhenNotFalse(e) -> (poswhen, ctl_or (whencond_false e label guard quantified) negwhen)) (CTL.True,CTL.False(*bef_aft*)) (List.rev whencodes) in (*bef_aft modifies arg so that inside of a nest can't cause the next to overshoot its boundaries, eg a() <...f()...> b() where f is a metavariable and the whole thing matches code in a loop; don't want f to match eg b(), allowing to go around the loop again*) let poswhen = ctl_and_ns arg poswhen in let negwhen = (* if !exists then*) (* add in After, because it's not part of the program *) ctl_or (aftpred label) negwhen (*else negwhen*) in ctl_and_ns poswhen (ctl_not negwhen) in (* process dot code, if any *) let dotcode = match (dotcode,guard) with (None,_) | (_,true) -> CTL.True | (Some dotcode,_) -> dotcode in (* process nest code, if any *) (* whencode goes in the negated part of the nest; if no nest, just goes on the "true" in between code *) let plus_var = if plus then get_label_ctr() else string2var "" in let plus_var2 = if plus then get_label_ctr() else string2var "" in let (ornest,just_nest) = (* just_nest is used when considering whether to stop early, to continue to collect nest information in the if branch *) match (nest,guard && not plus) with (None,_) | (_,true) -> (whencodes CTL.True,CTL.True) | (Some nest,false) -> let v = get_let_ctr() in let is_plus x = if plus then (* the idea is that BindGood is sort of a witness; a witness to having found the subterm in at least one place. If there is not a witness, then there is a risk that it will get thrown away, if it is merged with a node that has an empty environment. See tests/nestplus. But this all seems rather suspicious *) CTL.And(CTL.NONSTRICT,x, CTL.Exists(true,plus_var2, CTL.Pred(Lib_engine.BindGood(plus_var), CTL.Modif plus_var2))) else x in let body = CTL.Let(v,nest, CTL.Or(is_plus (CTL.Ref v), whencodes (CTL.Not(ctl_uncheck (CTL.Ref v))))) in (body,body) in let plus_modifier x = if plus then CTL.Exists (false,plus_var, (CTL.And (CTL.NONSTRICT,x, CTL.Not(CTL.Pred(Lib_engine.BindBad(plus_var),CTL.Control))))) else x in let ender = match after with (* label within dots is taken care of elsewhere. the next two lines put the label on the code following dots *) After f -> ctl_and (guard_to_strict guard) f labelled | Guard f -> (* actually, label should be None based on the only use of Guard... *) assert (label = None); ctl_and CTL.NONSTRICT (ctl_uncheck f) labelled | VeryEnd -> let exit = endpred label in let errorexit = exitpred label in ctl_or exit errorexit (* not at all sure what the next two mean... *) | End -> CTL.True | Tail -> (match label with Some (lv,used) -> used := true; ctl_or (CTL.Pred(Lib_engine.Label lv,CTL.Control)) (ctl_back_ex (ctl_or (retpred label) (gotopred label))) | None -> endpred label) (* was the following, but not clear why sgrep should allow incomplete patterns let exit = endpred label in let errorexit = exitpred label in if !exists then ctl_or exit errorexit (* end anywhere *) else exit (* end at the real end of the function *) *) in plus_modifier (dots_au is_strict ((after = Tail) or (after = VeryEnd)) label (guard_to_strict guard) wrapcode just_nest (ctl_and_ns dotcode (ctl_and_ns (ctl_and_ns (ctl_not bef_aft) ornest) labelled)) aft ender quantifier) and get_whencond_exps e = match Ast.unwrap e with Ast.Exp e -> [e] | Ast.DisjRuleElem(res) -> List.fold_left Common.union_set [] (List.map get_whencond_exps res) | _ -> failwith "not possible" and make_whencond_headers e e1 label guard quantified = let fvs = Ast.get_fvs e in let header_pred h = quantify guard (get_unquantified quantified fvs) (make_match label guard h) in let if_header e1 = header_pred (Ast.rewrap e (Ast.IfHeader (Ast.make_mcode "if", Ast.make_mcode "(",e1,Ast.make_mcode ")"))) in let while_header e1 = header_pred (Ast.rewrap e (Ast.WhileHeader (Ast.make_mcode "while", Ast.make_mcode "(",e1,Ast.make_mcode ")"))) in let for_header e1 = header_pred (Ast.rewrap e (Ast.ForHeader (Ast.make_mcode "for",Ast.make_mcode "(", Ast.ForExp(None,Ast.make_mcode ";"), Some e1,Ast.make_mcode ";",None,Ast.make_mcode ")"))) in let if_headers = List.fold_left ctl_or CTL.False (List.map if_header e1) in let while_headers = List.fold_left ctl_or CTL.False (List.map while_header e1) in let for_headers = List.fold_left ctl_or CTL.False (List.map for_header e1) in (if_headers, while_headers, for_headers) and whencond_true e label guard quantified = let e1 = get_whencond_exps e in let (if_headers, while_headers, for_headers) = make_whencond_headers e e1 label guard quantified in ctl_or (ctl_and CTL.NONSTRICT (truepred label) (ctl_back_ex if_headers)) (ctl_and CTL.NONSTRICT (inlooppred label) (ctl_back_ex (ctl_or while_headers for_headers))) and whencond_false e label guard quantified = let e1 = get_whencond_exps e in let (if_headers, while_headers, for_headers) = make_whencond_headers e e1 label guard quantified in (* if with else *) ctl_or (ctl_and CTL.NONSTRICT (falsepred label) (ctl_back_ex if_headers)) (* if without else *) (ctl_or (ctl_and CTL.NONSTRICT (fallpred label) (ctl_back_ex if_headers)) (* failure of loop test *) (ctl_and CTL.NONSTRICT (loopfallpred label) (ctl_or (ctl_back_ex while_headers) (ctl_back_ex for_headers)))) (* --------------------------------------------------------------------- *) (* the main translation loop *) let rec statement_list stmt_list top after quantified minus_quantified label llabel slabel dots_before guard = let isdots x = (* include Disj to be on the safe side *) match Ast.unwrap x with Ast.Dots _ | Ast.Nest _ | Ast.Disj _ -> true | _ -> false in let compute_label l e db = if db or isdots e then l else None in match Ast.unwrap stmt_list with Ast.DOTS(x) -> let rec loop top quantified minus_quantified dots_before label llabel slabel = function ([],_,_) -> (match after with After f -> f | _ -> CTL.True) | ([e],_,_) -> statement e top after quantified minus_quantified (compute_label label e dots_before) llabel slabel guard | (e::sl,fv::fvs,mfv::mfvs) -> let shared = intersectll fv fvs in let unqshared = get_unquantified quantified shared in let new_quantified = Common.union_set unqshared quantified in let minus_shared = intersectll mfv mfvs in let munqshared = get_unquantified minus_quantified minus_shared in let new_mquantified = Common.union_set munqshared minus_quantified in quantify guard unqshared (statement e top (After (let (label1,llabel1,slabel1) = match Ast.unwrap e with Ast.Atomic(re) -> (match Ast.unwrap re with Ast.Goto _ -> (None,None,None) | _ -> (label,llabel,slabel)) | _ -> (label,llabel,slabel) in loop NotTop new_quantified new_mquantified (isdots e) label1 llabel1 slabel1 (sl,fvs,mfvs))) new_quantified new_mquantified (compute_label label e dots_before) llabel slabel guard) | _ -> failwith "not possible" in loop top quantified minus_quantified dots_before label llabel slabel (x,List.map Ast.get_fvs x,List.map Ast.get_mfvs x) | Ast.CIRCLES(x) -> failwith "not supported" | Ast.STARS(x) -> failwith "not supported" (* llabel is the label of the enclosing loop and slabel is the label of the enclosing switch *) and statement stmt top after quantified minus_quantified label llabel slabel guard = let ctl_au = ctl_au CTL.NONSTRICT in let ctl_ax = ctl_ax CTL.NONSTRICT in let ctl_and = ctl_and CTL.NONSTRICT in let make_seq = make_seq guard in let make_seq_after = make_seq_after guard in let real_make_match = make_match in let make_match = header_match label guard in let dots_done = ref false in (* hack for dots cases we can easily handle *) let term = match Ast.unwrap stmt with Ast.Atomic(ast) -> (match Ast.unwrap ast with (* the following optimization is not a good idea, because when S is alone, we would like it not to match a declaration. this makes more matching for things like when (...) S, but perhaps that matching is not so costly anyway *) (*Ast.MetaStmt(_,Type_cocci.Unitary,_,false) when guard -> CTL.True*) | Ast.MetaStmt((s,_,(Ast.CONTEXT(_,Ast.BEFOREAFTER(_,_,_)) as d),_), keep,seqible,_) | Ast.MetaStmt((s,_,(Ast.CONTEXT(_,Ast.AFTER(_,_)) as d),_), keep,seqible,_)-> svar_context_with_add_after stmt s label quantified d ast seqible after (process_bef_aft quantified minus_quantified label llabel slabel true) guard (Ast.get_fvs stmt, Ast.get_fresh stmt, Ast.get_inherited stmt) | Ast.MetaStmt((s,_,d,_),keep,seqible,_) -> svar_minus_or_no_add_after stmt s label quantified d ast seqible after (process_bef_aft quantified minus_quantified label llabel slabel true) guard (Ast.get_fvs stmt, Ast.get_fresh stmt, Ast.get_inherited stmt) | _ -> let term = match Ast.unwrap ast with Ast.DisjRuleElem(res) -> do_re_matches label guard res quantified minus_quantified | Ast.Exp(_) | Ast.Ty(_) -> let stmt_fvs = Ast.get_fvs stmt in let fvs = get_unquantified quantified stmt_fvs in CTL.InnerAnd(quantify guard fvs (make_match ast)) | _ -> let stmt_fvs = Ast.get_fvs stmt in let fvs = get_unquantified quantified stmt_fvs in quantify guard fvs (make_match ast) in match Ast.unwrap ast with Ast.Break(brk,semi) -> (match (llabel,slabel) with (_,Some(lv,used)) -> (* use switch label if there is one *) ctl_and term (bclabel_pred_maker slabel) | _ -> ctl_and term (bclabel_pred_maker llabel)) | Ast.Continue(brk,semi) -> ctl_and term (bclabel_pred_maker llabel) | Ast.Return((_,info,retmc,pos),(_,_,semmc,_)) -> (* discard pattern that comes after return *) let normal_res = make_seq_after term after in (* the following code tries to propagate the modifications on return; to a close brace, in the case where the final return is absent *) let new_mc = match (retmc,semmc) with (Ast.MINUS(_,inst1,adj1,l1),Ast.MINUS(_,_,_,l2)) when !Flag.sgrep_mode2 -> (* in sgrep mode, we can propagate the - *) let new_info = match (l1,l2) with (Ast.NOREPLACEMENT,Ast.NOREPLACEMENT) -> Ast.NOREPLACEMENT | _ -> failwith "no replacements allowed in sgrep mode" in Some (Ast.MINUS(Ast.NoPos,inst1,adj1,new_info)) | (Ast.MINUS(_,_,_,l1),Ast.MINUS(_,_,_,l2)) -> let change = match (l1,l2) with (Ast.NOREPLACEMENT,Ast.NOREPLACEMENT) -> Ast.NOTHING | (Ast.NOREPLACEMENT,Ast.REPLACEMENT(l,ct)) | (Ast.REPLACEMENT(l,ct),Ast.NOREPLACEMENT) -> Ast.BEFORE(l,ct) | (Ast.REPLACEMENT(l1,ct1),Ast.REPLACEMENT(l2,ct2)) -> Ast.BEFORE(l1@l2,Ast.lub_count ct1 ct2) in Some (Ast.CONTEXT(Ast.NoPos,change)) | (Ast.CONTEXT(_,Ast.BEFORE(l1,c1)), Ast.CONTEXT(_,Ast.AFTER(l2,c2))) -> Some (Ast.CONTEXT(Ast.NoPos, Ast.BEFORE(l1@l2,Ast.lub_count c1 c2))) | (Ast.CONTEXT(_,Ast.BEFORE(_)),Ast.CONTEXT(_,Ast.NOTHING)) | (Ast.CONTEXT(_,Ast.NOTHING),Ast.CONTEXT(_,Ast.NOTHING)) -> Some retmc | (Ast.CONTEXT(_,Ast.NOTHING), Ast.CONTEXT(_,Ast.AFTER(l,c))) -> Some (Ast.CONTEXT(Ast.NoPos,Ast.BEFORE(l,c))) | _ -> None in let ret = Ast.make_mcode "return" in let edots = Ast.rewrap ast (Ast.Edots(Ast.make_mcode "...",None)) in let semi = Ast.make_mcode ";" in let simple_return = make_match(Ast.rewrap ast (Ast.Return(ret,semi))) in let return_expr = make_match(Ast.rewrap ast (Ast.ReturnExpr(ret,edots,semi))) in (match new_mc with Some new_mc -> let exit = endpred None in let mod_rbrace = Ast.rewrap ast (Ast.SeqEnd (("}",info,new_mc,pos))) in let stripped_rbrace = Ast.rewrap ast (Ast.SeqEnd(Ast.make_mcode "}")) in ctl_or normal_res (ctl_and (make_match mod_rbrace) (ctl_and (ctl_au (make_match stripped_rbrace) (* error exit not possible; it is in the middle of code, so a return is needed *) exit) (* worry about performance, but seems correct, not ax *) (ctl_back_ag (ctl_not (ctl_uncheck (ctl_or simple_return return_expr)))))) | _ -> (* some change in the middle of the return, so have to find an actual return *) normal_res) | _ -> (* should try to deal with the dots_bef_aft problem elsewhere, but don't have the courage... *) let term = if guard then term else do_between_dots stmt term End quantified minus_quantified label llabel slabel guard in dots_done := true; make_seq_after term after) | Ast.Seq(lbrace,body,rbrace) -> let (lbfvs,b1fvs,b2fvs,rbfvs) = match seq_fvs quantified [Ast.get_fvs lbrace;Ast.get_fvs body;Ast.get_fvs rbrace] with [(lbfvs,b1fvs);(_,b2fvs);(rbfvs,_)] -> (lbfvs,b1fvs,b2fvs,rbfvs) | _ -> failwith "not possible" in let (mlbfvs,mb1fvs,mb2fvs,mrbfvs) = match seq_fvs minus_quantified [Ast.get_mfvs lbrace;Ast.get_mfvs body;Ast.get_mfvs rbrace] with [(lbfvs,b1fvs);(_,b2fvs);(rbfvs,_)] -> (lbfvs,b1fvs,b2fvs,rbfvs) | _ -> failwith "not possible" in let pv = count_nested_braces stmt in let lv = get_label_ctr() in let paren_pred = CTL.Pred(Lib_engine.Paren pv,CTL.Control) in let label_pred = CTL.Pred(Lib_engine.Label lv,CTL.Control) in let start_brace = ctl_and (quantify guard lbfvs (make_match lbrace)) (ctl_and paren_pred label_pred) in let empty_rbrace = match Ast.unwrap rbrace with Ast.SeqEnd((data,info,_,pos)) -> Ast.rewrap rbrace(Ast.SeqEnd(Ast.make_mcode data)) | _ -> failwith "unexpected close brace" in let end_brace = (* label is not needed; paren_pred is enough *) quantify guard rbfvs (ctl_au (make_match empty_rbrace) (ctl_and (real_make_match None guard rbrace) paren_pred)) in let new_quantified2 = Common.union_set b1fvs (Common.union_set b2fvs quantified) in let new_mquantified2 = Common.union_set mb1fvs (Common.union_set mb2fvs minus_quantified) in let pattern_as_given = let new_quantified2 = Common.union_set [pv] new_quantified2 in quantify true [pv;lv] (quantify guard b1fvs (make_seq [start_brace; (ctl_or (if !exists = Exists then CTL.False else (aftpred label)) (quantify guard b2fvs (statement_list body NotTop (After (make_seq_after end_brace after)) new_quantified2 new_mquantified2 (Some (lv,ref true)) llabel slabel false guard)))])) in let empty_body = match Ast.undots body with [body] -> (match Ast.unwrap body with Ast.Dots ((_,i,Ast.CONTEXT(_,Ast.NOTHING),_),[],_,_) -> (match Ast.unwrap rbrace with Ast.SeqEnd((_,_,Ast.CONTEXT(_,Ast.NOTHING),_)) when not (contains_pos rbrace) -> true | _ -> false) | _ -> false) | _ -> false in if empty_body && List.mem after [Tail;End;VeryEnd] (* for just a match of an if branch of the form { ... }, just match the first brace *) then quantify guard lbfvs (make_match lbrace) else if ends_in_return body then (* matching error handling code *) (* Cases: 1. The pattern as given 2. A goto, and then some close braces, and then the pattern as given, but without the braces (only possible if there are no decls, and open and close braces are unmodified) 3. Part of the pattern as given, then a goto, and then the rest of the pattern. For this case, we just check that all paths have a goto within the current braces. checking for a goto at every point in the pattern seems expensive and not worthwhile. *) let pattern2 = let body = preprocess_dots body in (* redo, to drop braces *) make_seq [gotopred label; ctl_au (make_match empty_rbrace) (ctl_ax (* skip the destination label *) (quantify guard b2fvs (statement_list body NotTop End new_quantified2 new_mquantified2 None llabel slabel true guard)))] in let pattern3 = let new_quantified2 = Common.union_set [pv] new_quantified2 in quantify true [pv;lv] (quantify guard b1fvs (make_seq [start_brace; ctl_and (CTL.AU (* want AF even for sgrep *) (CTL.FORWARD,CTL.STRICT, CTL.Pred(Lib_engine.PrefixLabel(lv),CTL.Control), ctl_or (aftpred None) (* jll new! *) (ctl_and (* brace must be eventually after goto *) (gotopred (Some (lv,ref true))) (* want AF even for sgrep *) (CTL.AF(CTL.FORWARD,CTL.STRICT,end_brace))))) (quantify guard b2fvs (statement_list body NotTop Tail new_quantified2 new_mquantified2 None(*no label because past the goto*) llabel slabel false guard))])) in ctl_or pattern_as_given (ctl_or pattern2 pattern3) else pattern_as_given | Ast.IfThen(ifheader,branch,aft) -> ifthen ifheader branch aft after quantified minus_quantified label llabel slabel statement make_match guard | Ast.IfThenElse(ifheader,branch1,els,branch2,aft) -> ifthenelse ifheader branch1 els branch2 aft after quantified minus_quantified label llabel slabel statement make_match guard | Ast.While(header,body,aft) | Ast.For(header,body,aft) | Ast.Iterator(header,body,aft) -> forwhile header body aft after quantified minus_quantified label statement make_match guard | Ast.Disj(stmt_dots_list) -> (* list shouldn't be empty *) (*ctl_and seems pointless, disjuncts see label too (label_pred_maker label)*) let subformulas = List.map (function sl -> statement_list sl top after quantified minus_quantified label llabel slabel true guard) stmt_dots_list in let safe_subformulas = match top with Top -> List.map2 protect_top_level stmt_dots_list subformulas | NotTop -> subformulas in List.fold_left ctl_seqor CTL.False safe_subformulas | Ast.Nest(starter,stmt_dots,ender,whencode,multi,bef,aft) -> (* label in recursive call is None because label check is already wrapped around the corresponding code. not good enough, want to stay in a specific region, dots and nests will keep going *) let bfvs = match seq_fvs quantified [Ast.get_wcfvs whencode;Ast.get_fvs stmt_dots] with [(wcfvs,bothfvs);(bdfvs,_)] -> bothfvs | _ -> failwith "not possible" in (* no minus version because when code doesn't contain any minus code *) let new_quantified = Common.union_set bfvs quantified in let (dot_code,stmt_dots) = match Ast.get_mcodekind starter with (*ender must have the same mcode*) Ast.MINUS(_,_,_,_) as d -> (* no need for the fresh metavar, but ... is a bit weird as a variable name *) (* drops minuses on pattern, because d will have the minus effect*) (Some(make_match (make_meta_rule_elem d ([],[],[]))), drop_minuses stmt_dots) | _ -> (None,stmt_dots) in quantify guard bfvs (let dots_pattern = statement_list stmt_dots top (a2n after) new_quantified minus_quantified label(*None*) llabel slabel true guard in dots_and_nests multi (Some dots_pattern) whencode bef aft dot_code after label (process_bef_aft new_quantified minus_quantified label(*None*) llabel slabel true) (function x -> (* for when code *) statement_list x NotTop Tail new_quantified minus_quantified label(*None*) llabel slabel true true) (function x -> (* for when code *) statement x NotTop Tail new_quantified minus_quantified label(*None*) llabel slabel true) guard quantified (function x -> Ast.set_fvs [] (Ast.rewrap stmt x))) | Ast.Dots((_,i,d,_),whencodes,bef,aft) -> let dot_code = match d with Ast.MINUS(_,_,_,_) -> (* no need for the fresh metavar, but ... is a bit weird as a variable name *) Some(make_match (make_meta_rule_elem d ([],[],[]))) | _ -> None in dots_and_nests false None whencodes bef aft dot_code after label (process_bef_aft quantified minus_quantified None llabel slabel true) (function x -> statement_list x NotTop Tail quantified minus_quantified None llabel slabel true true) (function x -> statement x NotTop Tail quantified minus_quantified None llabel slabel true) guard quantified (function x -> Ast.set_fvs [] (Ast.rewrap stmt x)) | Ast.Switch(header,lb,decls,cases,rb) -> let rec intersect_all = function [] -> [] | [x] -> x | x::xs -> intersect x (intersect_all xs) in let rec intersect_all2 = function (* pairwise *) [] -> [] | x::xs -> let front = List.filter (function elem -> List.exists (List.mem elem) xs) x in Common.union_set front (intersect_all2 xs) in let rec union_all l = List.fold_left union [] l in (* start normal variables *) let header_fvs = Ast.get_fvs header in let lb_fvs = Ast.get_fvs lb in let decl_fvs = union_all (List.map Ast.get_fvs (Ast.undots decls)) in let case_fvs = List.map Ast.get_fvs cases in let rb_fvs = Ast.get_fvs rb in let (all_efvs,all_b1fvs,all_lbfvs,all_b2fvs, all_casefvs,all_b3fvs,all_rbfvs) = List.fold_left (function (all_efvs,all_b1fvs,all_lbfvs,all_b2fvs, all_casefvs,all_b3fvs,all_rbfvs) -> function case_fvs -> match seq_fvs quantified [header_fvs;lb_fvs;case_fvs;rb_fvs] with [(efvs,b1fvs);(lbfvs,b2fvs);(casefvs,b3fvs);(rbfvs,_)] -> (efvs::all_efvs,b1fvs::all_b1fvs,lbfvs::all_lbfvs, b2fvs::all_b2fvs,casefvs::all_casefvs,b3fvs::all_b3fvs, rbfvs::all_rbfvs) | _ -> failwith "not possible") ([],[],[],[],[],[],[]) (decl_fvs :: case_fvs) in let (all_efvs,all_b1fvs,all_lbfvs,all_b2fvs, all_casefvs,all_b3fvs,all_rbfvs) = (List.rev all_efvs,List.rev all_b1fvs,List.rev all_lbfvs, List.rev all_b2fvs,List.rev all_casefvs,List.rev all_b3fvs, List.rev all_rbfvs) in let exponlyfvs = intersect_all all_efvs in let lbonlyfvs = intersect_all all_lbfvs in (* don't do anything with right brace. Hope there is no + code on it *) (* let rbonlyfvs = intersect_all all_rbfvs in*) let b1fvs = union_all all_b1fvs in let new1_quantified = union b1fvs quantified in let b2fvs = union (union_all all_b2fvs) (intersect_all2 all_casefvs) in let new2_quantified = union b2fvs new1_quantified in (* let b3fvs = union_all all_b3fvs in*) (* ------------------- start minus free variables *) let header_mfvs = Ast.get_mfvs header in let lb_mfvs = Ast.get_mfvs lb in let decl_mfvs = union_all (List.map Ast.get_mfvs (Ast.undots decls)) in let case_mfvs = List.map Ast.get_mfvs cases in let rb_mfvs = Ast.get_mfvs rb in let (all_mefvs,all_mb1fvs,all_mlbfvs,all_mb2fvs, all_mcasefvs,all_mb3fvs,all_mrbfvs) = List.fold_left (function (all_efvs,all_b1fvs,all_lbfvs,all_b2fvs, all_casefvs,all_b3fvs,all_rbfvs) -> function case_mfvs -> match seq_fvs quantified [header_mfvs;lb_mfvs;case_mfvs;rb_mfvs] with [(efvs,b1fvs);(lbfvs,b2fvs);(casefvs,b3fvs);(rbfvs,_)] -> (efvs::all_efvs,b1fvs::all_b1fvs,lbfvs::all_lbfvs, b2fvs::all_b2fvs,casefvs::all_casefvs,b3fvs::all_b3fvs, rbfvs::all_rbfvs) | _ -> failwith "not possible") ([],[],[],[],[],[],[]) (decl_mfvs::case_mfvs) in let (all_mefvs,all_mb1fvs,all_mlbfvs,all_mb2fvs, all_mcasefvs,all_mb3fvs,all_mrbfvs) = (List.rev all_mefvs,List.rev all_mb1fvs,List.rev all_mlbfvs, List.rev all_mb2fvs,List.rev all_mcasefvs,List.rev all_mb3fvs, List.rev all_mrbfvs) in (* don't do anything with right brace. Hope there is no + code on it *) (* let rbonlyfvs = intersect_all all_rbfvs in*) let mb1fvs = union_all all_mb1fvs in let new1_mquantified = union mb1fvs quantified in let mb2fvs = union (union_all all_mb2fvs) (intersect_all2 all_mcasefvs) in let new2_mquantified = union mb2fvs new1_mquantified in (* let b3fvs = union_all all_b3fvs in*) (* ------------------- end collection of free variables *) let switch_header = quantify guard exponlyfvs (make_match header) in let pv = count_nested_braces stmt in let paren_pred = CTL.Pred(Lib_engine.Paren pv,CTL.Control) in let lb = quantify guard lbonlyfvs (ctl_and (make_match lb) paren_pred) in (* let rb = quantify guard rbonlyfvs (make_match rb) in*) let case_headers = List.map (function case_line -> match Ast.unwrap case_line with Ast.CaseLine(header,body) -> let e1fvs = match seq_fvs new2_quantified [Ast.get_fvs header] with [(e1fvs,_)] -> e1fvs | _ -> failwith "not possible" in quantify guard e1fvs (real_make_match label true header) | Ast.OptCase(case_line) -> failwith "not supported") cases in let lv = get_label_ctr() in let used = ref false in let (decls_exists_code,decls_all_code) = (*don't really understand this*) if (Ast.undots decls) = [] then (CTL.True,CTL.False) else let res = statement_list decls NotTop Tail new2_quantified new2_mquantified (Some (lv,used)) llabel None false(*?*) guard in (res,res) in let no_header = ctl_not (List.fold_left ctl_or_fl CTL.False (List.map ctl_uncheck (decls_all_code::case_headers))) in let case_code = List.map (function case_line -> match Ast.unwrap case_line with Ast.CaseLine(header,body) -> let (e1fvs,b1fvs,s1fvs) = let fvs = [Ast.get_fvs header;Ast.get_fvs body] in match seq_fvs new2_quantified fvs with [(e1fvs,b1fvs);(s1fvs,_)] -> (e1fvs,b1fvs,s1fvs) | _ -> failwith "not possible" in let (me1fvs,mb1fvs,ms1fvs) = let fvs = [Ast.get_mfvs header;Ast.get_mfvs body] in match seq_fvs new2_mquantified fvs with [(e1fvs,b1fvs);(s1fvs,_)] -> (e1fvs,b1fvs,s1fvs) | _ -> failwith "not possible" in let case_header = quantify guard e1fvs (make_match header) in let new3_quantified = union b1fvs new2_quantified in let new3_mquantified = union mb1fvs new2_mquantified in let body = statement_list body NotTop Tail new3_quantified new3_mquantified (Some (lv,used)) llabel (Some (lv,used)) false(*?*) guard in quantify guard b1fvs (make_seq [case_header; body]) | Ast.OptCase(case_line) -> failwith "not supported") cases in let default_required = if List.exists (function case -> match Ast.unwrap case with Ast.CaseLine(header,_) -> (match Ast.unwrap header with Ast.Default(_,_) -> true | _ -> false) | _ -> false) cases then function x -> x else function x -> ctl_or (fallpred label) x in let after_pred = aftpred label in let body after_branch = ctl_or (default_required (quantify guard b2fvs (make_seq [ctl_and lb (List.fold_left ctl_and CTL.True (List.map ctl_ex (decls_exists_code :: case_headers))); List.fold_left ctl_or_fl no_header (decls_all_code :: case_code)]))) after_branch in let aft = (rb_fvs,Ast.get_fresh rb,Ast.get_inherited rb, match Ast.unwrap rb with Ast.SeqEnd(rb) -> Ast.get_mcodekind rb | _ -> failwith "not possible") in let (switch_header,wrapper) = if !used then let label_pred = CTL.Pred (Lib_engine.Label(lv),CTL.Control) in (ctl_and switch_header label_pred, (function body -> quantify true [lv] body)) else (switch_header,function x -> x) in wrapper (end_control_structure b1fvs switch_header body after_pred (Some(ctl_ex after_pred)) None aft after label guard) | Ast.FunDecl(header,lbrace,body,rbrace) -> let (hfvs,b1fvs,lbfvs,b2fvs,b3fvs,rbfvs) = match seq_fvs quantified [Ast.get_fvs header;Ast.get_fvs lbrace; Ast.get_fvs body;Ast.get_fvs rbrace] with [(hfvs,b1fvs);(lbfvs,b2fvs);(_,b3fvs);(rbfvs,_)] -> (hfvs,b1fvs,lbfvs,b2fvs,b3fvs,rbfvs) | _ -> failwith "not possible" in let (mhfvs,mb1fvs,mlbfvs,mb2fvs,mb3fvs,mrbfvs) = match seq_fvs quantified [Ast.get_mfvs header;Ast.get_mfvs lbrace; Ast.get_mfvs body;Ast.get_mfvs rbrace] with [(hfvs,b1fvs);(lbfvs,b2fvs);(_,b3fvs);(rbfvs,_)] -> (hfvs,b1fvs,lbfvs,b2fvs,b3fvs,rbfvs) | _ -> failwith "not possible" in let function_header = quantify guard hfvs (make_match header) in let start_brace = quantify guard lbfvs (make_match lbrace) in let stripped_rbrace = match Ast.unwrap rbrace with Ast.SeqEnd((data,info,_,_)) -> Ast.rewrap rbrace(Ast.SeqEnd (Ast.make_mcode data)) | _ -> failwith "unexpected close brace" in let end_brace = let exit = CTL.Pred (Lib_engine.Exit,CTL.Control) in let errorexit = CTL.Pred (Lib_engine.ErrorExit,CTL.Control) in let fake_brace = CTL.Pred (Lib_engine.FakeBrace,CTL.Control) in ctl_and (quantify guard rbfvs (make_match rbrace)) (ctl_and (* the following finds the beginning of the fake braces, if there are any, not completely sure how this works. sse the examples sw and return *) (ctl_back_ex (ctl_not fake_brace)) (ctl_au (make_match stripped_rbrace) (ctl_or exit errorexit))) in let new_quantified3 = Common.union_set b1fvs (Common.union_set b2fvs (Common.union_set b3fvs quantified)) in let new_mquantified3 = Common.union_set mb1fvs (Common.union_set mb2fvs (Common.union_set mb3fvs minus_quantified)) in let not_minus = function Ast.MINUS(_,_,_,_) -> false | _ -> true in let optim1 = match (Ast.undots body, contains_modif rbrace or contains_pos rbrace) with ([body],false) -> (match Ast.unwrap body with Ast.Nest(starter,stmt_dots,ender,[],false,_,_) (* perhaps could optimize for minus case too... TODO *) when not_minus (Ast.get_mcodekind starter) -> (* special case for function header + body - header is unambiguous and unique, so we can just look for the nested body anywhere else in the CFG *) Some (CTL.AndAny (CTL.FORWARD,guard_to_strict guard,start_brace, statement_list stmt_dots NotTop (* discards match on right brace, but don't need it *) (Guard (make_seq_after end_brace after)) new_quantified3 new_mquantified3 None llabel slabel true guard)) | Ast.Dots((_,i,d,_),whencode,_,_) when (List.for_all (* flow sensitive, so not optimizable *) (function Ast.WhenNotTrue(_) | Ast.WhenNotFalse(_) -> false | _ -> true) whencode) -> (* try to be more efficient for the case where the body is just ... Perhaps this is too much of a special case, but useful for dropping a parameter and checking that it is never used. *) (match d with Ast.MINUS(_,_,_,_) -> None | _ -> let pv = (* no nested braces, because only dots *) string2var ("p1") in let paren_pred = CTL.Pred(Lib_engine.Paren pv,CTL.Control) in Some ( make_seq [ctl_and start_brace paren_pred; match whencode with [] -> CTL.True | _ -> let leftarg = ctl_and (ctl_not (List.fold_left (function prev -> function Ast.WhenAlways(s) -> prev | Ast.WhenNot(sl) -> let x = statement_list sl NotTop Tail new_quantified3 new_mquantified3 label llabel slabel true true in ctl_or prev x | Ast.WhenNotTrue(_) | Ast.WhenNotFalse(_) -> failwith "unexpected" | Ast.WhenModifier (Ast.WhenAny) -> CTL.False | Ast.WhenModifier(_) -> prev) CTL.False whencode)) (List.fold_left (function prev -> function Ast.WhenAlways(s) -> let x = statement s NotTop Tail new_quantified3 new_mquantified3 label llabel slabel true in ctl_and prev x | Ast.WhenNot(sl) -> prev | Ast.WhenNotTrue(_) | Ast.WhenNotFalse(_) -> failwith "unexpected" | Ast.WhenModifier(Ast.WhenAny) -> CTL.True | Ast.WhenModifier(_) -> prev) CTL.True whencode) in ctl_au leftarg (ctl_and (make_match stripped_rbrace) paren_pred)])) | _ -> None) | _ -> None in let optim2 = (* function body is all minus, no whencode *) match Ast.undots body with [body] -> (match Ast.unwrap body with Ast.Dots ((_,i,(Ast.MINUS(_,_,_,Ast.NOREPLACEMENT) as d),_),[],_,_) -> (match (Ast.unwrap lbrace,Ast.unwrap rbrace) with (Ast.SeqStart((_,_,Ast.MINUS(_,_,_,Ast.NOREPLACEMENT),_)), Ast.SeqEnd((_,_,Ast.MINUS(_,_,_,Ast.NOREPLACEMENT),_))) when not (contains_pos rbrace) -> Some (* andany drops everything to the end, including close braces - not just function body, could check label to keep braces *) (ctl_and start_brace (ctl_ax (CTL.AndAny (CTL.FORWARD,guard_to_strict guard,CTL.True, make_match (make_meta_rule_elem d ([],[],[])))))) | _ -> None) | _ -> None) | _ -> None in let body_code = match (optim1,optim2) with (Some o1,_) -> o1 | (_,Some o2) -> o2 | _ -> make_seq [start_brace; quantify guard b3fvs (statement_list body NotTop (After (make_seq_after end_brace after)) new_quantified3 new_mquantified3 None llabel slabel false guard)] in quantify guard b1fvs (make_seq [function_header; quantify guard b2fvs body_code]) | Ast.Define(header,body) -> let (hfvs,bfvs,bodyfvs) = match seq_fvs quantified [Ast.get_fvs header;Ast.get_fvs body] with [(hfvs,b1fvs);(bodyfvs,_)] -> (hfvs,b1fvs,bodyfvs) | _ -> failwith "not possible" in let (mhfvs,mbfvs,mbodyfvs) = match seq_fvs minus_quantified [Ast.get_mfvs header;Ast.get_mfvs body] with [(hfvs,b1fvs);(bodyfvs,_)] -> (hfvs,b1fvs,bodyfvs) | _ -> failwith "not possible" in let define_header = quantify guard hfvs (make_match header) in let body_code = statement_list body NotTop after (Common.union_set bfvs quantified) (Common.union_set mbfvs minus_quantified) None llabel slabel true guard in quantify guard bfvs (make_seq [define_header; body_code]) | Ast.AsStmt(stmt,asstmt) -> ctl_and (statement stmt top after quantified minus_quantified label llabel slabel guard) (statement asstmt top after quantified minus_quantified label llabel slabel guard) | Ast.OptStm(stm) -> failwith "OptStm should have been compiled away\n" | Ast.UniqueStm(stm) -> failwith "arities not yet supported" | _ -> failwith "not supported" in if guard or !dots_done then term else do_between_dots stmt term after quantified minus_quantified label llabel slabel guard (* term is the translation of stmt *) and do_between_dots stmt term after quantified minus_quantified label llabel slabel guard = match Ast.get_dots_bef_aft stmt with Ast.AddingBetweenDots (brace_term,n) | Ast.DroppingBetweenDots (brace_term,n) -> let match_brace = statement brace_term NotTop after quantified minus_quantified label llabel slabel guard in let v = Printf.sprintf "_r_%d" n in let case1 = ctl_and CTL.NONSTRICT (CTL.Ref v) match_brace in let case2 = ctl_and CTL.NONSTRICT (ctl_not (CTL.Ref v)) term in CTL.Let (v,ctl_or (ctl_back_ex (ctl_or (truepred label) (inlooppred label))) (ctl_back_ex (ctl_back_ex (falsepred label))), ctl_or case1 case2) | Ast.NoDots -> term (* un_process_bef_aft is because we don't want to do transformation in this code, and thus don't case about braces before or after it *) and process_bef_aft quantified minus_quantified label llabel slabel guard = function Ast.WParen (re,n) -> let paren_pred = CTL.Pred (Lib_engine.Paren n,CTL.Control) in let s = guard_to_strict guard in quantify true (get_unquantified quantified [n]) (ctl_and s (make_raw_match None guard re) paren_pred) | Ast.Other s -> statement s NotTop Tail quantified minus_quantified label llabel slabel guard | Ast.Other_dots d -> statement_list d NotTop Tail quantified minus_quantified label llabel slabel true guard and protect_top_level stmt_dots formula = let starts_with_dots = match Ast.undots stmt_dots with d::ds -> (match Ast.unwrap d with Ast.Dots(_,_,_,_) | Ast.Circles(_,_,_,_) | Ast.Stars(_,_,_,_) -> true | _ -> false) | _ -> false in let starts_with_non_context_brace = (* None = No danger Some false = OK except on function braces Some true = Never OK *) match Ast.undots stmt_dots with d::ds -> (match Ast.unwrap d with Ast.Seq(before,body,after) -> let beforemc = match Ast.unwrap before with Ast.SeqStart(obr) -> Ast.get_mcodekind obr | _ -> failwith "bad seq" in let aftermc = match Ast.unwrap after with Ast.SeqEnd(cbr) -> Ast.get_mcodekind cbr | _ -> failwith "bad seq"in (match (beforemc,aftermc) with (* safe cases *) (Ast.CONTEXT(_,(Ast.NOTHING|Ast.AFTER _)), Ast.CONTEXT(_,(Ast.NOTHING|Ast.BEFORE _))) -> None | (Ast.MINUS(_,_,_,Ast.NOREPLACEMENT), Ast.MINUS(_,_,_,Ast.NOREPLACEMENT)) when List.length (Ast.undots body) = 1 -> Some false (*ok on if*) (* unsafe, can't be allowed to match fn top *) | _ -> Some true) | _ -> None) | _ -> None in if starts_with_dots then (* EX because there is a loop on enter/top *) ctl_and CTL.NONSTRICT (toppred None) (ctl_ex formula) else match starts_with_non_context_brace with None -> formula | Some false -> ctl_and CTL.NONSTRICT (ctl_not(CTL.EX(CTL.BACKWARD,funpred None))) formula | Some true -> ctl_and CTL.NONSTRICT (ctl_not(CTL.EX(CTL.BACKWARD,unsbrpred None))) formula and drop_minuses stmt_dots = let mcode (x,info,mc,pos) = let newmc = match mc with Ast.MINUS(pos,inst,adj,Ast.NOREPLACEMENT) -> Ast.CONTEXT(pos,Ast.NOTHING) (* drops adjacency, maybe not useful *) | _ -> failwith "only pure minus expected in removed nest" in (x,info,newmc,pos) in let donothing r k e = k e in let v = V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in v.V.rebuilder_statement_dots stmt_dots (* --------------------------------------------------------------------- *) (* cleanup: convert AX to EX for pdots. Concretely: AX(A[...] & E[...]) becomes AX(A[...]) & EX(E[...]) This is what we wanted in the first place, but it wasn't possible to make because the AX and its argument are not created in the same place. Rather clunky... *) (* also cleanup XX, which is a marker for the case where the programmer specifies to change the quantifier on .... Assumed to only occur after one AX or EX, or at top level. *) let rec cleanup c = let c = match c with CTL.XX(c) -> c | _ -> c in match c with CTL.False -> CTL.False | CTL.True -> CTL.True | CTL.Pred(p) -> CTL.Pred(p) | CTL.Not(phi) -> CTL.Not(cleanup phi) | CTL.Exists(keep,v,phi) -> CTL.Exists(keep,v,cleanup phi) | CTL.AndAny(dir,s,phi1,phi2) -> CTL.AndAny(dir,s,cleanup phi1,cleanup phi2) | CTL.HackForStmt(dir,s,phi1,phi2) -> CTL.HackForStmt(dir,s,cleanup phi1,cleanup phi2) | CTL.And(s,phi1,phi2) -> CTL.And(s,cleanup phi1,cleanup phi2) | CTL.Or(phi1,phi2) -> CTL.Or(cleanup phi1,cleanup phi2) | CTL.SeqOr(phi1,phi2) -> CTL.SeqOr(cleanup phi1,cleanup phi2) | CTL.Implies(phi1,phi2) -> CTL.Implies(cleanup phi1,cleanup phi2) | CTL.AF(dir,s,phi1) -> CTL.AF(dir,s,cleanup phi1) | CTL.AX(CTL.FORWARD,s, CTL.Let(v1,e1, CTL.And(CTL.NONSTRICT,CTL.AU(CTL.FORWARD,s2,e2,e3), CTL.EU(CTL.FORWARD,e4,e5)))) -> CTL.Let(v1,e1, CTL.And(CTL.NONSTRICT, CTL.AX(CTL.FORWARD,s,CTL.AU(CTL.FORWARD,s2,e2,e3)), CTL.EX(CTL.FORWARD,CTL.EU(CTL.FORWARD,e4,e5)))) | CTL.AX(dir,s,CTL.XX(phi)) -> CTL.EX(dir,cleanup phi) | CTL.EX(dir,CTL.XX((CTL.AU(_,s,_,_)) as phi)) -> CTL.AX(dir,s,cleanup phi) | CTL.XX(phi) -> failwith "bad XX" | CTL.AX(dir,s,phi1) -> CTL.AX(dir,s,cleanup phi1) | CTL.AG(dir,s,phi1) -> CTL.AG(dir,s,cleanup phi1) | CTL.EF(dir,phi1) -> CTL.EF(dir,cleanup phi1) | CTL.EX(dir,phi1) -> CTL.EX(dir,cleanup phi1) | CTL.EG(dir,phi1) -> CTL.EG(dir,cleanup phi1) | CTL.AW(dir,s,phi1,phi2) -> CTL.AW(dir,s,cleanup phi1,cleanup phi2) | CTL.AU(dir,s,phi1,phi2) -> CTL.AU(dir,s,cleanup phi1,cleanup phi2) | CTL.EU(dir,phi1,phi2) -> CTL.EU(dir,cleanup phi1,cleanup phi2) | CTL.Let (x,phi1,phi2) -> CTL.Let (x,cleanup phi1,cleanup phi2) | CTL.LetR (dir,x,phi1,phi2) -> CTL.LetR (dir,x,cleanup phi1,cleanup phi2) | CTL.Ref(s) -> CTL.Ref(s) | CTL.Uncheck(phi1) -> CTL.Uncheck(cleanup phi1) | CTL.InnerAnd(phi1) -> CTL.InnerAnd(cleanup phi1) (* --------------------------------------------------------------------- *) (* Function declaration *) (* ua = used_after, fua = fresh_used_after, fuas = fresh_used_after_seeds *) let top_level name ((ua,pos),fua) (fuas,t) = let ua = List.filter (function (nm,_) -> nm = name) ua in used_after := ua; saved := Ast.get_saved t; let quantified = Common.minus_set (Common.union_set ua fuas) pos in let (wrap,formula) = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo" | Ast.NONDECL(stmt) -> let unopt = elim_opt.V.rebuilder_statement stmt in let unopt = preprocess_dots_e unopt in let formula = cleanup (statement unopt Top VeryEnd quantified [] None None None false) in ((function x -> NONDECL x), formula) | Ast.CODE(stmt_dots) -> let unopt = elim_opt.V.rebuilder_statement_dots stmt_dots in let unopt = preprocess_dots unopt in let formula = statement_list unopt Top VeryEnd quantified [] None None None false false in let clean_formula = cleanup (protect_top_level stmt_dots formula) in ((function x -> CODE x), clean_formula) | Ast.ERRORWORDS(exps) -> failwith "not supported errorwords" in wrap (quantify false quantified formula) (* --------------------------------------------------------------------- *) (* Entry points *) let asttoctlz (name,(_,_,exists_flag),l) (used_after,fresh_used_after,fresh_used_after_seeds) positions = letctr := 0; labelctr := 0; (match exists_flag with Ast.Exists -> exists := Exists | Ast.Forall -> exists := Forall | Ast.Undetermined -> exists := if !Flag.sgrep_mode2 then Exists else Forall); let (l,used_after) = List.split (List.filter (function (t,_) -> match Ast.unwrap t with Ast.ERRORWORDS(exps) -> false | _ -> true) (List.combine l (List.combine used_after positions))) in let res = List.map2 (top_level name) (List.combine used_after fresh_used_after) (List.combine fresh_used_after_seeds l) in exists := Forall; res let asttoctl r used_after positions = match r with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> [] | Ast.CocciRule (a,b,c,_,Ast_cocci.Normal) -> asttoctlz (a,b,c) used_after positions | Ast.CocciRule (a,b,c,_,Ast_cocci.Generated) -> [CODE CTL.True] let pp_cocci_predicate (pred,modif) = Pretty_print_engine.pp_predicate pred let cocci_predicate_to_string (pred,modif) = Pretty_print_engine.predicate_to_string pred coccinelle-1.0.0-rc19/engine/check_reachability.mli0000644000175000017500000000314212247442615021130 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./check_reachability.mli" type witness = (Ograph_extended.nodei, unit, (Ograph_extended.nodei, unit, unit) Ast_ctl.generic_ctl list) Ast_ctl.generic_witnesstree type ('a,'b,'c,'d,'e) triples = (Ograph_extended.nodei * 'a * (Ograph_extended.nodei, ('b, ('c,'d) Wrapper_ctl.wrapped_binding) Ast_ctl.generic_subst list, 'e) Ast_ctl.generic_witnesstree list) list val check_reachability : string (*rulename*) -> ('a,'b,'c,'d,'e) triples -> Control_flow_c.cflow -> unit coccinelle-1.0.0-rc19/engine/asttomember.mli0000644000175000017500000000240612247442615017657 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttomember.mli" val asttomember : Ast_cocci.rule -> Ast_cocci.meta_name list list -> (Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif) list list list coccinelle-1.0.0-rc19/engine/lib_matcher_c.ml0000644000175000017500000000216612247442615017742 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lib_matcher_c.ml" coccinelle-1.0.0-rc19/engine/engine.mllib0000644000175000017500000000041312247437436017121 0ustar eugeneugenAsttoctl2 Asttomember C_vs_c Check_exhaustive_pattern Check_reachability Cocci_vs_c Ctlcocci_integration Ctltotex Externalanalysis Flag_engine Flag_matcher Isomorphisms_c_c Lib_engine Lib_matcher_c Pattern_c Postprocess_transinfo Pretty_print_engine Transformation_c coccinelle-1.0.0-rc19/engine/main.ml0000644000175000017500000000336012247442615016110 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./main.ml" (* ----------------------------------------------------------------------- *) (* Entry point *) let in_file = ref "" let out_file = ref "" let anonymous s = if !in_file = "" then in_file := s else out_file := s let speclist = [] let usage = Printf.sprintf "Usage: %s [options] \nOptions are:" (Filename.basename Sys.argv.(0)) let main _ = Arg.parse speclist anonymous usage; if !in_file = "" then failwith "in_filename required"; let (ast_lists,ua) = Parse_cocci.process !in_file None false in Ctltotex.totex !out_file ast_lists (List.map2 Asttoctl.asttoctl ast_lists ua) let _ = main () coccinelle-1.0.0-rc19/engine/externalanalysis.ml0000644000175000017500000002304712247442615020556 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./externalanalysis.ml" (* Support code for the integration of results * from external analysis tools. * * the file should contain a result per line, where each line * is of the form: * filename;begin_row;begin_column;end_row;end_column;data * where data can be: * E;n;int_1;...;int_n (an integer set) * I;bnd;bnd (integer bounds, either integer or empty) * other * * Note: for the moment the analysis results are assumed to be * integer ranges or sets. Other types of analysis results will * be regarded as a plain string. * * Todo: implement a proper querying facility that keeps different * types of analysis apart. *) (* provides a search structure for providing a map from posl to * some value, and search operations that find the nearest posl. * This is mainly a hack for backwards compatibility with older * ocaml versions that provide only limited functionality on * Maps. *) module PoslMap = struct module PComp = struct type t = Ast_c.posl let compare = Ast_c.compare_posl end module PMap = Map.Make (PComp) module PSet = Set.Make (PComp) type 'a t = (PSet.t * 'a PMap.t) let empty = (PSet.empty, PMap.empty) let mem x (s, _) = PSet.mem x s let find k (_, m) = PMap.find k m let add k v (s, m) = (PSet.add k s, PMap.add k v m) (* throws Not_found if such a key does not exist *) let nearest_key find_smaller k s = match PSet.split k s with (_, true, _) -> k | (smaller, false, greater) -> match find_smaller with true -> PSet.max_elt smaller | false -> PSet.min_elt greater (* throws Not_found if such an entry does not exist *) let find_nearest find_smaller (s, m) k = PMap.find (nearest_key find_smaller k s) m end module StringMap = Map.Make (String) module Int64Set = Set.Make (Int64) (* bound: either concrete or unbounded *) type bound = int64 option (* The type of analysis results, which for the moment focuses on integers. * The lower bound should be smaller or equal to the upper bound (not enforced) *) type result = IntSet of Int64Set.t | IntBounds of bound * bound | Other of string (* for printing *) let show_bound b = match b with None -> "*" | Some i -> Printf.sprintf "%Ld" i let show_result result = let out = Buffer.create 120 in begin match result with IntSet s -> Buffer.add_string out "{"; Int64Set.iter (fun i -> Buffer.add_string out (Printf.sprintf "%Ld;" i)) s; Buffer.add_string out "}" | IntBounds (l, u) -> Buffer.add_string out (show_bound l); Buffer.add_string out "-"; Buffer.add_string out (show_bound u) | Other s -> Buffer.add_string out s end; Buffer.contents out (* search structure for results *) type result_map = (((result list) PoslMap.t) PoslMap.t) StringMap.t let empty_map : result_map = StringMap.empty (* this module is organized that it contains the analysis results as a singleton. *) let current_map = ref empty_map (* regular expressions for extracting results from the .csv file *) let loc_regexp = Str.regexp "\\([^;]*\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\(.+\\)" let intset_regexp = Str.regexp "E;\\([0-9]+\\)\\(\\(;[0-9]+\\)*\\)" let intbounds_regexp = Str.regexp "I;\\([0-9]*\\);\\([0-9]*\\)" let split_regexp = Str.regexp "[;]" (* Loading of results from a .cvs-like format. * Skips over unparsable entries without reporting an error. *) let load_external_results filename = let chan = open_in filename in try while true do let line = input_line chan in match Str.string_match loc_regexp line 0 with false -> () | true -> let s_file = Str.matched_group 1 line in let s_lbegin = Str.matched_group 2 line in let s_cbegin = Str.matched_group 3 line in let s_lend = Str.matched_group 4 line in let s_cend = Str.matched_group 5 line in let s_data = Str.matched_group 6 line in let mk_posl s_row s_col = (int_of_string s_row, int_of_string s_col) in let posl_begin = mk_posl s_lbegin s_cbegin in let posl_end = mk_posl s_lend s_cend in (* map the line to a value *) let value = match Str.string_match intset_regexp s_data 0 with true -> let n_fields = int_of_string (Str.matched_group 1 s_data) in let s_fields = Str.matched_group 2 s_data in let strs = Str.bounded_split split_regexp s_fields n_fields in let ints = List.map Int64.of_string strs in let set = List.fold_right Int64Set.add ints Int64Set.empty in IntSet set | false -> match Str.string_match intbounds_regexp s_data 0 with true -> let mk_bound s = match String.length s == 0 with true -> None | false -> Some (Int64.of_string s) in IntBounds (mk_bound (Str.matched_group 1 s_data), mk_bound (Str.matched_group 2 s_data)) | false -> Other s_data in (* add the new value to the current map *) let ensure_str m k f = let v = match StringMap.mem k m with true -> f (StringMap.find k m) | false -> f PoslMap.empty in StringMap.add k v m in let ensure_posl k e f m = let v = match PoslMap.mem k m with true -> f (PoslMap.find k m) | false -> f e in PoslMap.add k v m in current_map := ensure_str !current_map s_file (ensure_posl posl_begin PoslMap.empty (ensure_posl posl_end [] (fun xs -> value :: xs ))) done with End_of_file -> (); close_in chan (* finds all nearest results in the map that enclose the given position *) let find_results filename p_begin p_end = try let m_begin = StringMap.find filename !current_map in let m_end = PoslMap.find_nearest true m_begin p_begin in let results = PoslMap.find_nearest false m_end p_end in results with Not_found -> [] (* * some convenience functions on analysis results. *) let within_bounds c l u = match (l, u) with (None, None) -> true | (None, Some k) -> c <= k | (Some k, None) -> k <= c | (Some k, Some n) -> k <= c && c <= n let contains_bounds m n l u = begin match (l, m) with (None, None) -> true | (Some k, Some i) -> k <= i | _ -> false end && begin match (u, n) with (None, None) -> true | (Some q, Some j) -> j <= q | _ -> false end (* given two result values, computes their intersection. An empty intersection is indicated with a None result value. *) let intersect_results r1 r2 = let sets s1 s2 = match Int64Set.inter s1 s2 with s when Int64Set.is_empty s -> None | s -> Some (IntSet s) in let bounds_set r l u s = if Int64Set.for_all (fun c -> within_bounds c l u) s then Some r else None in let bounds r m n l u = if contains_bounds m n l u then Some r else None in match r1 with IntSet s1 -> begin match r2 with IntSet s2 -> sets s1 s2 | IntBounds (l, u) -> bounds_set r2 l u s1 | Other _ -> None end | IntBounds (l, u) -> begin match r2 with IntSet s2 -> bounds_set r1 l u s2 | IntBounds (m, n) -> bounds r1 l u m n | Other _ -> None end | Other _ -> None (* a predicate over the analysis results *) let satisfy f filename p_begin p_end = try f (find_results filename p_begin p_end) with Not_found -> false (* satisfy, but with the intersection of all analysis results. *) let satisfy1 f = let inter mbR r = match mbR with None -> None | Some s -> intersect_results r s in satisfy begin fun ls -> match ls with [] -> false | (x :: xs) -> match List.fold_left inter (Some x) xs with None -> false | Some r -> f r end let has_any_result = satisfy (fun rs -> List.length rs > 0) let for_all p = satisfy (List.for_all p) let for_all1 p = satisfy (fun rs -> List.length rs > 0 && List.for_all p rs) let exists p = satisfy (List.exists p) let single_int c r = match r with | IntSet s when Int64Set.is_empty s -> true (* unreachable memory, thus any property holds *) | IntSet s -> Int64Set.equal (Int64Set.singleton c) s | IntBounds (Some l, Some u) -> l == c && u == c | _ -> false let contains_int c r = match r with IntSet s -> Int64Set.mem c s | IntBounds (l, u) -> within_bounds c l u | _ -> false let has_only_nul = for_all1 (single_int Int64.zero) let has_also_nul = exists (contains_int Int64.zero) let has_also_int c = exists (contains_int c) coccinelle-1.0.0-rc19/engine/tests/0000755000175000017500000000000012247437436015777 5ustar eugeneugencoccinelle-1.0.0-rc19/engine/tests/test10000644000175000017500000000411012247437436016756 0ustar eugeneugen@@ @@ f(); ... ? g(); ... h(); @@ expression E,X,Y,Z; local function foo; @@ foo(...) { ( - f(3,E); + f(3,3,E); | - f(E,4); + f(E,4,4); | - E; + g(E); ) ( - f(3,X); + f(3,3,X); | - f(Y,4); + f(Y,4,4); | - Z; + g(Z); ) ( - f(3); + f(3,3); | - f(4); + f(4,4); ) } @@ identifier buffer; identifier hostptr; @@ p( + int hostptr, char buffer) { - int hostptr; } @@ expression X,Y; @@ f(X); - ... WHEN != h(X) g(Y); @@ expression X,Y; @@ f(X); - ... g(Y); @@ expression X,Y; @@ f(X); g(Y); h(X); f(Y); g(X); h(Y); @@ expression X; @@ f(X); ... g(X); h(X); @@ expression X; @@ if (X) { ... } else { ... } f(X); @@ expression X; @@ if (X) { ... } f(X); @@ expression X; @@ while (X) { ... } f(X); @@ expression X; @@ while (X) { ... } @@ expression X,Y; @@ { ... WHEN != g(Y) f(X); ... WHEN != h(Y) } @@ expression X,Y; @@ f(X); ... - g(Y); + h(X,Y); @@ expression X,Y,Z; @@ - f(X); + f(Z); - ... g(Y); h(Z); @@ expression X,Y,Z; @@ - f(X); + f(Z); ... g(Y); h(Z); @@ expression X,Y,Z; @@ f(X); ... g(Y); h(Z); @@ expression X,Y,Z; @@ f(X); ... WHEN != h(Z) g(Y); h(Z); @@ expression X,Y,Z,Q; @@ f(X); ... WHEN != h(Q) g(Y); h(Z); @@ expression X,Z; @@ if (X) { ... } else { g(X); } h(Z); @@ expression X,Y; @@ <... ( h(X) | g(Y) ) ...> @@ expression X,Y; @@ <... ( h(X) | g(Y) ) ...> r(X); @@ expression X,Y; @@ ( h(X) | g(Y) ) @@ expression X,Y; @@ m(Y); ? h(X); g(Y); @@ struct Scsi_Host_Template sht; !local function proc_info_func; @@ sht.proc_info = proc_info_func; @@ identifier buffer, start, offset, length, inout, hostptr, hostno; @@ proc_info_func( char *buffer, char **start, off_t offset, int length, int hostno, int inout) { ... struct Scsi_Host *hostptr; ... hostptr = scsi_host_hn_get(hostno); ... ? if (hostptr == NULL) { ... } ... ? scsi_host_put(hostptr); ... } @@ expression E; @@ proc_info_func(...) { <... ( E->host_no == hostno | hostno ) ...> } coccinelle-1.0.0-rc19/engine/tests/Makefile0000644000175000017500000000025612247437436017442 0ustar eugeneugenall: test1.tex all: test2.tex test1.tex: test1 ../engine ../engine test1 test1.tex latex test1.tex test2.tex: test2 ../engine ../engine test2 test2.tex latex test2.tex coccinelle-1.0.0-rc19/engine/tests/test1.tex0000644000175000017500000004777212247437436017602 0ustar eugeneugen\documentclass{article} \usepackage{fullpage} \newcommand{\U}{\,\mbox{\sf{U}}\,} \newcommand{\A}{\mbox{\sf{A}}} \newcommand{\E}{\mbox{\sf{E}}} \newcommand{\AX}{\mbox{\sf{AX}}} \newcommand{\EX}{\mbox{\sf{EX}}} \newcommand{\AF}{\mbox{\sf{AF}}} \newcommand{\EF}{\mbox{\sf{EF}}} \newcommand{\AG}{\mbox{\sf{AG}}} \newcommand{\EG}{\mbox{\sf{EG}}} \newcommand{\mita}[1]{\mbox{\it{{#1}}}} \newcommand{\mtt}[1]{\mbox{\tt{{#1}}}} \newcommand{\msf}[1]{\mbox{\sf{{#1}}}} \newcommand{\mrm}[1]{\mbox{\rm{{#1}}}} \newcommand{\mth}[1]{\({#1}\)} \newcommand{\ttlb}{\mbox{\tt \char'173}} \newcommand{\ttrb}{\mbox{\tt \char'175}} \begin{document} \begin{quote}\begin{verbatim} @@ @@ f(); ... ?g(); ... h(); \end{verbatim}\end{quote} \[\begin{array}{l} \mita{\sf{let}} \, \mita{l9} = \mita{f();} \, \mita{\sf{in}} \, \mita{l9} \wedge (\AX(\mita{\sf{let}} \, \mita{l0} = \mita{g();} \, \mita{\sf{in}} \, \A[\neg (\mita{l0} \vee \mita{l9}) \U (\mita{\sf{let}} \, \mita{l7} = \msf{After}\\\mbox{} \vee \msf{ErrorExit} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l10} = (\mita{\sf{let}} \, \mita{l5} = \mita{h();} \, \mita{\sf{in}} \, \A[\neg (\mita{l5} \vee \mita{l0}) \U (\mita{l5} \vee \mita{l7})] ) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l3} = \mita{l0}\\\mbox{} \wedge (\AX\mita{l10}) \, \mita{\sf{in}} \, \mita{l3} \vee ((\neg \mita{l3}) \wedge \mita{l10}) ) ) \vee \mita{l7} )] )) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ foo(...) { ( -f-(-3-, -E-)-; >>> f(3, 3, E); | -f-(-E-, -4-)-; >>> f(E, 4, 4); | -E-; >>> g(E); ) ( -f-(-3-, -X-)-; >>> f(3, 3, X); | -f-(-Y-, -4-)-; >>> f(Y, 4, 4); | -Z-; >>> g(Z); ) ( -f-(-3-)-; >>> f(3, 3); | -f-(-4-)-; >>> f(4, 4); ) } \end{verbatim}\end{quote} \[\begin{array}{l} (\exists \mita{foo} . \mita{foo(...) }) \wedge (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l17} = \msf{Paren}(p0) \, \mita{\sf{in}} \, \mita{{\ttlb} } \wedge \mita{l17} \wedge (\AX(\mita{\sf{let}} \, \mita{l32} = \AX(\mita{\sf{let}} \, \mita{l2} = \AX(\mita{\sf{let}} \, \mita{l12} = \AX(\mita{ {\ttrb}}\\\mbox{} \wedge \mita{l17}) \, \mita{\sf{in}} \, ((\exists \mita{v0} . \mita{-f-(-3-)-; \mth{>}\mth{>}\mth{>} f(3, 3);}_{\mita{v0}}) \wedge \mita{l12}) \vee ((\exists \mita{v0} . \mita{-f-(-4-)-; \mth{>}\mth{>}\mth{>} f(4, 4);}_{\mita{v0}})\\\mbox{} \wedge \mita{l12}) ) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l7} = \exists \mita{X} . \exists \mita{v0} . \mita{-f-(-3-, -X-)-; \mth{>}\mth{>}\mth{>} f(3, 3, X);}_{\mita{v0}} \, \mita{\sf{in}} \, (\mita{l7}\\\mbox{} \wedge \mita{l2}) \vee (\mita{\sf{let}} \, \mita{l21} = \neg \mita{l7} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l6} = \exists \mita{Y} . \exists \mita{v0} . \mita{-f-(-Y-, -4-)-; \mth{>}\mth{>}\mth{>} f(Y, 4, 4);}_{\mita{v0}}\\\mbox{} \, \mita{\sf{in}} \, (\mita{l21} \wedge \mita{l6} \wedge \mita{l2}) \vee ((\neg \mita{l6}) \wedge \mita{l21} \wedge (\exists \mita{Z} . \exists \mita{v0} . \mita{-Z-; \mth{>}\mth{>}\mth{>} g(Z);}_{\mita{v0}}) \wedge \mita{l2}) ) ) ) ) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l8} = \exists \mita{E}\\\mbox{} . \exists \mita{v0} . \mita{-f-(-3-, -E-)-; \mth{>}\mth{>}\mth{>} f(3, 3, E);}_{\mita{v0}} \, \mita{\sf{in}} \, (\mita{l8} \wedge \mita{l32}) \vee (\mita{\sf{let}} \, \mita{l19} = \neg \mita{l8}\\\mbox{} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l4} = \exists \mita{E} . \exists \mita{v0} . \mita{-f-(-E-, -4-)-; \mth{>}\mth{>}\mth{>} f(E, 4, 4);}_{\mita{v0}} \, \mita{\sf{in}} \, (\mita{l19} \wedge \mita{l4}\\\mbox{} \wedge \mita{l32}) \vee ((\neg \mita{l4}) \wedge \mita{l19} \wedge (\exists \mita{E} . \exists \mita{v0} . \mita{-E-; \mth{>}\mth{>}\mth{>} g(E);}_{\mita{v0}}) \wedge \mita{l32}) ) ) ) )) ))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ p( <<< int hostptr, char buffer) { -int -hostptr-; } \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{hostptr} . ((\exists \mita{buffer} . \exists \mita{v0} . \mita{p( <<< int hostptr, char buffer) }_{\mita{v0}})\\\mbox{} \wedge (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l0} = \msf{Paren}(p0) \, \mita{\sf{in}} \, \mita{{\ttlb} } \wedge \mita{l0} \wedge (\AX((\exists \mita{v0} . \mita{-int -hostptr-;}_{\mita{v0}})\\\mbox{} \wedge (\AX(\mita{ {\ttrb}} \wedge \mita{l0})))) )))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); -... WHEN != -h-(-X-) g(Y); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l1} = \mita{f(X);} \, \mita{\sf{in}} \, \mita{l1} \wedge (\AX(\mita{\sf{let}} \, \mita{l0} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[((\exists \mita{v0} . \mita{-\_S0}_{\mita{v0}}) \wedge (\neg (\exists \mita{v0}\\\mbox{} . \mita{-h-(-X-)}_{\mita{v0}})) \wedge (\neg (\mita{l0} \vee \mita{l1}))) \U (\mita{l0} \vee \msf{After} \vee \msf{ErrorExit})] )) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); -... g(Y); \end{verbatim}\end{quote} \[\begin{array}{l} \mita{\sf{let}} \, \mita{l1} = \exists \mita{X} . \mita{f(X);} \, \mita{\sf{in}} \, \mita{l1} \wedge (\AX(\mita{\sf{let}} \, \mita{l2} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[((\exists \mita{v0} . \mita{-\_S0}_{\mita{v0}}) \wedge (\neg (\mita{l2}\\\mbox{} \vee \mita{l1}))) \U (\mita{l2} \vee \msf{After} \vee \msf{ErrorExit})] )) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); g(Y); h(X); f(Y); g(X); h(Y); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{f(X);} \wedge (\AX(\exists \mita{Y} . (\mita{g(Y);} \wedge (\AX(\mita{h(X);} \wedge (\AX(\mita{f(Y);} \wedge (\AX(\mita{g(X);} \wedge (\AX(\mita{h(Y);})))))))))))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); ... g(X); h(X); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l0} = \mita{f(X);} \, \mita{\sf{in}} \, \mita{l0} \wedge (\AX(\mita{\sf{let}} \, \mita{l1} = \mita{g(X);} \, \mita{\sf{in}} \, \A[\neg (\mita{l1} \vee \mita{l0}) \U ((\mita{l1} \wedge (\AX(\mita{h(X);})))\\\mbox{} \vee \msf{After} \vee \msf{ErrorExit})] )) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ if (X) { ... } else { ... } f(X); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l0} = \msf{FalseBranch} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l1} = \msf{After} \, \mita{\sf{in}} \, \mita{if (X) } \wedge (\AX(\mita{\sf{let}} \, \mita{l15} = \AX(\exists \mita{p0}\\\mbox{} . (\mita{\sf{let}} \, \mita{l7} = \msf{Paren}(p0) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l14} = \mita{{\ttlb} } \wedge \mita{l7} \, \mita{\sf{in}} \, \mita{l14} \wedge (\AX(\mita{\sf{let}} \, \mita{l13} = \mita{ {\ttrb}} \wedge \mita{l7}\\\mbox{} \, \mita{\sf{in}} \, \A[\neg (\mita{l13} \vee \mita{l14}) \U (\mita{l13} \vee \mita{l1} \vee \msf{ErrorExit})] )) ) )) \, \mita{\sf{in}} \, (\msf{TrueBranch} \wedge \mita{l15}) \vee (\mita{l0}\\\mbox{} \wedge \mita{l15}) \vee (\mita{l1} \wedge (\AX(\mita{f(X);}))) )) \wedge (\EX\mita{l0}) \wedge (\EX\mita{l1}) ) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ if (X) { ... } f(X); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l0} = \msf{After} \, \mita{\sf{in}} \, \mita{if (X) } \wedge (\AX((\msf{TrueBranch} \wedge (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l2} = \msf{Paren}(p0)\\\mbox{} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l4} = \mita{{\ttlb} } \wedge \mita{l2} \, \mita{\sf{in}} \, \mita{l4} \wedge (\AX(\mita{\sf{let}} \, \mita{l3} = \mita{ {\ttrb}} \wedge \mita{l2} \, \mita{\sf{in}} \, \A[\neg (\mita{l3} \vee \mita{l4}) \U (\mita{l3} \vee \mita{l0}\\\mbox{} \vee \msf{ErrorExit})] )) ) )))) \vee \msf{FallThrough} \vee (\mita{l0} \wedge (\AX(\mita{f(X);}))))) \wedge (\EX\mita{l0}) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ while (X) { ... } f(X); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{while (X) } \wedge (\mita{\sf{let}} \, \mita{l0} = \msf{After} \, \mita{\sf{in}} \, (\AX((\msf{TrueBranch} \rightarrow (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l3} = \msf{Paren}(p0)\\\mbox{} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l5} = \mita{{\ttlb} } \wedge \mita{l3} \, \mita{\sf{in}} \, \mita{l5} \wedge (\AX(\mita{\sf{let}} \, \mita{l4} = \mita{ {\ttrb}} \wedge \mita{l3} \, \mita{\sf{in}} \, \A[\neg (\mita{l4} \vee \mita{l5}) \U (\mita{l4} \vee \mita{l0}\\\mbox{} \vee \msf{ErrorExit})] )) ) )))) \wedge (\mita{l0} \rightarrow (\AX(\mita{f(X);}))))) \wedge (\EX\mita{l0}) )) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ while (X) { ... } \end{verbatim}\end{quote} \[\begin{array}{l} (\exists \mita{X} . \mita{while (X) }) \wedge (\AX(\msf{TrueBranch} \rightarrow (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l1} = \msf{Paren}(p0) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l4} = \mita{{\ttlb} }\\\mbox{} \wedge \mita{l1} \, \mita{\sf{in}} \, \mita{l4} \wedge (\AX(\mita{\sf{let}} \, \mita{l3} = \mita{ {\ttrb}} \wedge \mita{l1} \, \mita{\sf{in}} \, \A[\neg (\mita{l3} \vee \mita{l4}) \U (\mita{l3} \vee \msf{After} \vee \msf{ErrorExit})] \\\mbox{} )) ) ))))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ { ... WHEN != g(Y) f(X); ... WHEN != h(Y) } \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{p0} . (\mita{\sf{let}} \, \mita{l6} = \msf{Paren}(p0) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l9} = \mita{{\ttlb} } \wedge \mita{l6} \, \mita{\sf{in}} \, \mita{l9} \wedge (\AX(\exists \mita{Y} . (\mita{\sf{let}} \, \mita{l3} = \exists \mita{X} . \mita{f(X);}\\\mbox{} \, \mita{\sf{in}} \, \A[((\neg \mita{g(Y)}) \wedge (\neg (\mita{l3} \vee \mita{l9}))) \U (\mita{\sf{let}} \, \mita{l5} = \msf{After} \vee \msf{ErrorExit} \, \mita{\sf{in}} \, (\mita{l3} \wedge (\AX(\mita{\sf{let}} \, \mita{l8} = \mita{ {\ttrb}}\\\mbox{} \wedge \mita{l6} \, \mita{\sf{in}} \, \A[((\neg \mita{h(Y)}) \wedge (\neg (\mita{l8} \vee \mita{l3}))) \U (\mita{l8} \vee \mita{l5})] ))) \vee \mita{l5} )] ))) ) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); ... -g-(-Y-)-; >>> h(X, Y); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l0} = \mita{f(X);} \, \mita{\sf{in}} \, \mita{l0} \wedge (\AX\A[\neg ((\exists \mita{Y} . \mita{-g-(-Y-)-; \mth{>}\mth{>}\mth{>} h(X, Y);}) \vee \mita{l0})\\\mbox{} \U ((\exists \mita{Y} . \exists \mita{v0} . \mita{-g-(-Y-)-; \mth{>}\mth{>}\mth{>} h(X, Y);}_{\mita{v0}}) \vee \msf{After} \vee \msf{ErrorExit})] ) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ -f-(-X-)-; >>> f(Z); -... g(Y); h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{Z} . ((\exists \mita{X} . \exists \mita{v0} . \mita{-f-(-X-)-; \mth{>}\mth{>}\mth{>} f(Z);}_{\mita{v0}}) \wedge (\AX(\mita{\sf{let}} \, \mita{l0} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[((\exists \mita{v0}\\\mbox{} . \mita{-\_S0}_{\mita{v0}}) \wedge (\neg (\mita{l0} \vee (\exists \mita{X} . \mita{-f-(-X-)-; \mth{>}\mth{>}\mth{>} f(Z);})))) \U ((\mita{l0} \wedge (\AX(\mita{h(Z);})))\\\mbox{} \vee \msf{After} \vee \msf{ErrorExit})] ))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ -f-(-X-)-; >>> f(Z); ... g(Y); h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{Z} . ((\exists \mita{X} . \exists \mita{v0} . \mita{-f-(-X-)-; \mth{>}\mth{>}\mth{>} f(Z);}_{\mita{v0}}) \wedge (\AX(\mita{\sf{let}} \, \mita{l0} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[\neg (\mita{l0}\\\mbox{} \vee (\exists \mita{X} . \mita{-f-(-X-)-; \mth{>}\mth{>}\mth{>} f(Z);})) \U ((\mita{l0} \wedge (\AX(\mita{h(Z);}))) \vee \msf{After} \vee \msf{ErrorExit})] \\\mbox{} ))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); ... g(Y); h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \mita{\sf{let}} \, \mita{l1} = \exists \mita{X} . \mita{f(X);} \, \mita{\sf{in}} \, \mita{l1} \wedge (\AX(\mita{\sf{let}} \, \mita{l2} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[\neg (\mita{l2} \vee \mita{l1}) \U ((\mita{l2} \wedge (\AX(\exists \mita{Z}\\\mbox{} . \mita{h(Z);}))) \vee \msf{After} \vee \msf{ErrorExit})] )) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); ... WHEN != h(Z) g(Y); h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \mita{\sf{let}} \, \mita{l1} = \exists \mita{X} . \mita{f(X);} \, \mita{\sf{in}} \, \mita{l1} \wedge (\AX(\exists \mita{Z} . (\mita{\sf{let}} \, \mita{l2} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[((\neg \mita{h(Z)}) \wedge (\neg (\mita{l2} \vee \mita{l1})))\\\mbox{} \U ((\mita{l2} \wedge (\AX(\mita{h(Z);}))) \vee \msf{After} \vee \msf{ErrorExit})] ))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ f(X); ... WHEN != h(Q) g(Y); h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \mita{\sf{let}} \, \mita{l1} = \exists \mita{X} . \mita{f(X);} \, \mita{\sf{in}} \, \mita{l1} \wedge (\AX(\mita{\sf{let}} \, \mita{l2} = \exists \mita{Y} . \mita{g(Y);} \, \mita{\sf{in}} \, \A[((\neg (\exists \mita{Q} . \mita{h(Q)})) \wedge (\neg (\mita{l2}\\\mbox{} \vee \mita{l1}))) \U ((\mita{l2} \wedge (\AX(\exists \mita{Z} . \mita{h(Z);}))) \vee \msf{After} \vee \msf{ErrorExit})] )) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ if (X) { ... } else { g(X); } h(Z); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l0} = \msf{FalseBranch} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l1} = \msf{After} \, \mita{\sf{in}} \, \mita{if (X) } \wedge (\AX(\mita{\sf{let}} \, \mita{l2} = \msf{Paren}(p0)\\\mbox{} \, \mita{\sf{in}} \, (\msf{TrueBranch} \wedge (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l6} = \mita{{\ttlb} } \wedge \mita{l2} \, \mita{\sf{in}} \, \mita{l6} \wedge (\AX(\mita{\sf{let}} \, \mita{l5} = \mita{ {\ttrb}} \wedge \mita{l2} \, \mita{\sf{in}} \, \A[\neg (\mita{l5}\\\mbox{} \vee \mita{l6}) \U (\mita{l5} \vee \mita{l1} \vee \msf{ErrorExit})] )) )))) \vee (\mita{l0} \wedge (\AX(\exists \mita{p0} . (\mita{{\ttlb} } \wedge \mita{l2} \wedge (\AX(\mita{g(X);} \wedge (\AX(\mita{ {\ttrb}}\\\mbox{} \wedge \mita{l2})))))))) \vee (\mita{l1} \wedge (\AX(\exists \mita{Z} . \mita{h(Z);}))) )) \wedge (\EX\mita{l0}) \wedge (\EX\mita{l1}) ) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ <... ( h(X) | g(Y) ) ...> \end{verbatim}\end{quote} \[\begin{array}{l} \AG(\mita{\sf{let}} \, \mita{l2} = \exists \mita{Y} . \exists \mita{X} . \mita{ ( h(X) | g(Y) )} \, \mita{\sf{in}} \, \mita{l2} \vee (\neg \mita{l2}) ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ <... ( h(X) | g(Y) ) ...> r(X); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{X} . (\mita{\sf{let}} \, \mita{l1} = \mita{r(X);} \, \mita{\sf{in}} \, \A[((\neg \mita{l1}) \wedge (\mita{\sf{let}} \, \mita{l0} = \exists \mita{Y} . \mita{ ( h(X) | g(Y) )} \, \mita{\sf{in}} \, \mita{l0} \vee (\neg \mita{l0})\\\mbox{} )) \U (\mita{l1} \vee \msf{After} \vee \msf{ErrorExit})] ) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ ( h(X) | g(Y) ) \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{Y} . \exists \mita{X} . \mita{ ( h(X) | g(Y) )} \end{array}\] \begin{quote}\begin{verbatim} @@ @@ m(Y); ?h(X); g(Y); \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{Y} . (\mita{m(Y);} \wedge (\AX(\mita{\sf{let}} \, \mita{l0} = \mita{g(Y);} \, \mita{\sf{in}} \, ((\exists \mita{X} . \mita{h(X);}) \wedge (\AX\mita{l0})) \vee \mita{l0} ))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ sht/*struct Scsi_Host_Template */.proc_info = proc_info_func; \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{proc\_info\_func} . \exists \mita{sht} . \mita{sht/*struct Scsi\_Host\_Template */.proc\_info = proc\_info\_func;} \end{array}\] \begin{quote}\begin{verbatim} @@ @@ proc_info_func(char *buffer, char **start, off_t offset, int length, int hostno, int inout) { ... struct Scsi_Host *hostptr; ... hostptr = scsi_host_hn_get(hostno); ... ?if (hostptr == NULL) ?{ ?... ?} ... ?scsi_host_put(hostptr); ... } \end{verbatim}\end{quote} \[\begin{array}{l} \exists \mita{hostno} . ((\exists \mita{buffer} . \exists \mita{start} . \exists \mita{offset} . \exists \mita{length} . \exists \mita{inout} . \mita{proc\_info\_func(char *buffer, char **start, off\_t offset, int length, int hostno, int inout) })\\\mbox{} \wedge (\AX(\exists \mita{p1} . (\mita{\sf{let}} \, \mita{l33} = \msf{Paren}(p1) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l5} = \mita{{\ttlb} } \wedge \mita{l33} \, \mita{\sf{in}} \, \mita{l5} \wedge (\AX(\mita{\sf{let}} \, \mita{l53} = \mita{struct Scsi\_Host *hostptr;}\\\mbox{} \, \mita{\sf{in}} \, \A[\neg ((\exists \mita{hostptr} . \mita{l53}) \vee \mita{l5}) \U (\mita{\sf{let}} \, \mita{l1} = \msf{After} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l6} = \mita{l1} \vee \msf{ErrorExit}\\\mbox{} \, \mita{\sf{in}} \, (\exists \mita{hostptr} . (\mita{l53} \wedge (\AX(\mita{\sf{let}} \, \mita{l30} = \mita{hostptr = scsi\_host\_hn\_get(hostno);}\\\mbox{} \, \mita{\sf{in}} \, \A[\neg (\mita{l30} \vee \mita{l53}) \U ((\mita{l30} \wedge (\AX(\mita{\sf{let}} \, \mita{l32} = \msf{Paren}(p0) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l50} = \mita{ {\ttrb}} \wedge \mita{l32}\\\mbox{} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l14} = \mita{l50} \vee \mita{l6} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l2} = \msf{FallThrough} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l29} = \mita{l2} \vee \mita{l1} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l51} = \mita{{\ttlb} }\\\mbox{} \wedge \mita{l32} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l0} = \msf{TrueBranch} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l52} = \mita{if (hostptr == NULL) } \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l20} = \mita{l52}\\\mbox{} \wedge (\AX((\mita{l0} \wedge (\AX(\exists \mita{p0} . (\mita{l51} \wedge (\AX\AF\mita{l14}))))) \vee \mita{l29})) \, \mita{\sf{in}} \, \A[\neg (\mita{l20} \vee \mita{l30}) \U ((\mita{\sf{let}} \, \mita{l8} = \mita{scsi\_host\_put(hostptr);}\\\mbox{} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l11} = \A[\neg \mita{l8} \U \mita{l6}] \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l25} = \mita{l8} \wedge (\AX\mita{l11}) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l39} = \neg \mita{l25} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l13} = (\mita{\sf{let}} \, \mita{l48} = (\mita{\sf{let}} \, \mita{l4} = \mita{ {\ttrb}}\\\mbox{} \wedge \mita{l33} \, \mita{\sf{in}} \, \A[\neg (\mita{l4} \vee \mita{l8}) \U (\mita{l4} \vee \mita{l6})] ) \, \mita{\sf{in}} \, (\mita{l8} \wedge (\AX\mita{l48})) \vee (\mita{l39} \wedge \mita{l48}) ) \vee \mita{l6} \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l36} = \neg (\mita{l8}\\\mbox{} \vee \mita{l20}) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l34} = \mita{l0} \wedge (\AX(\exists \mita{p0} . (\mita{l51} \wedge (\AX\A[\neg (\mita{l50} \vee \mita{l51}) \U \mita{l14}] )))) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l16} = \EX\mita{l1}\\\mbox{} \, \mita{\sf{in}} \, (\mita{l52} \wedge (\AX(\mita{l34} \vee \mita{l2} \vee (\mita{l1} \wedge (\AX\A[\mita{l36} \U \mita{l13}] )))) \wedge \mita{l16}) \vee ((\neg (\mita{l52} \wedge (\AX(\mita{l34}\\\mbox{} \vee \mita{l2} \vee (\mita{l1} \wedge (\AX\A[\mita{l36} \U (\mita{l25} \vee (\mita{l39} \wedge \mita{l11}) \vee \mita{l6})] )))) \wedge \mita{l16})) \wedge (\A[\neg (\mita{l8} \vee (\mita{l52} \wedge (\AX(\mita{l34}\\\mbox{} \vee \mita{l29})))) \U \mita{l13}] )) ) ) ) ) ) ) ) ) \vee \mita{l6})] ) ) ) ) ) ) ) ) ))) \vee \mita{l6})] )))) \vee \mita{l6} ) )] )) ) )))) \end{array}\] \begin{quote}\begin{verbatim} @@ @@ proc_info_func(...) { <... ( E->host_no == hostno | hostno ) ...> } \end{verbatim}\end{quote} \[\begin{array}{l} \mita{proc\_info\_func(...) } \wedge (\AX(\exists \mita{p0} . (\mita{\sf{let}} \, \mita{l3} = \msf{Paren}(p0) \, \mita{\sf{in}} \, (\mita{\sf{let}} \, \mita{l6} = \mita{{\ttlb} } \wedge \mita{l3}\\\mbox{} \, \mita{\sf{in}} \, \mita{l6} \wedge (\AX(\mita{\sf{let}} \, \mita{l5} = \mita{ {\ttrb}} \wedge \mita{l3} \, \mita{\sf{in}} \, \A[((\neg (\mita{l5} \vee \mita{l6})) \wedge (\mita{\sf{let}} \, \mita{l2} = \exists \mita{E} . \mita{ ( E-\mth{>}host\_no == hostno | hostno )}\\\mbox{} \, \mita{\sf{in}} \, \mita{l2} \vee (\neg \mita{l2}) )) \U (\mita{l5} \vee \msf{After} \vee \msf{ErrorExit})] )) ) ))) \end{array}\] \end{document} coccinelle-1.0.0-rc19/engine/lib_matcher_c.mli0000644000175000017500000000216712247442615020114 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lib_matcher_c.mli" coccinelle-1.0.0-rc19/engine/c_vs_c.ml0000644000175000017500000002504212247442615016421 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./c_vs_c.ml" open Common open Ast_c (* For the moment I do only eq_type and not eq_expr, etc. The reason * for eq_type is related to the typedef and struct isomorphism. Sometimes * one use the typedef and sometimes the structname. * * TODO: should use the isomorphisms engine of julia. * Maybe I can transform my ast_c in ast_cocci, and use julia's code ? * Maybe I can add some Disj in my ast_c ? *) module type PARAM = sig type tin type 'x tout type 'a matcher = 'a -> 'a -> tin -> 'a tout val (>>=): (tin -> 'a tout) -> ('a -> (tin -> 'b tout)) -> (tin -> 'b tout) val (>&&>) : bool -> (tin -> 'x tout) -> (tin -> 'x tout) val return : 'a -> tin -> 'a tout val fail : tin -> 'a tout end module C_VS_C = functor (X : PARAM) -> struct type 'a matcher = 'a -> 'a -> X.tin -> 'a X.tout let (>>=) = X.(>>=) let (>&&>) = X.(>&&>) let return = X.return let fail = X.fail let (option: 'a matcher -> ('a option matcher)) = fun f t1 t2 -> match (t1,t2) with | (Some t1, Some t2) -> f t1 t2 >>= (fun t -> return (Some t) ) | (None, None) -> return None | _ -> fail let same_s saopt sbopt = match saopt, sbopt with | None, None -> true | Some namea, Some nameb -> let sa = Ast_c.str_of_name namea in let sb = Ast_c.str_of_name nameb in sa =$= sb | _ -> false let rec fullType a b = let ((qua,iiqa), tya) = a in let ((qub,iiqb), tyb) = b in (qua.const =:= qub.const && qua.volatile =:= qub.volatile) >&&> let (qu,iiq) = (qua, iiqa) in typeC tya tyb >>= (fun ty -> return ((qu,iiq), ty) ) and typeC tya tyb = let (a, iia) = tya in let (b, iib) = tyb in let iix = iia in match a, b with | BaseType a, BaseType b -> a =*= b >&&> return (BaseType a, iix) | Pointer a, Pointer b -> fullType a b >>= (fun x -> return (Pointer x, iix)) | StructUnionName (sua, sa), StructUnionName (sub, sb) -> (sua =*= sub && sa =$= sb) >&&> return (StructUnionName (sua, sa), iix) | TypeName (namea, opta), TypeName (nameb, optb) -> let sa = Ast_c.str_of_name namea in let sb = Ast_c.str_of_name nameb in (* assert compatible opta optb ? *) (*option fullType opta optb*) sa =$= sb >&&> let opt = (match opta, optb with | None, None -> None | Some x, _ | _, Some x -> Some x ) in return (TypeName (namea, opt), iix) | Array (ea, a), Array (eb,b) -> let get_option f = function Some x -> Some (f x) | None -> None in let ea = get_option Lib_parsing_c.al_expr ea in let eb = get_option Lib_parsing_c.al_expr eb in ea =*= eb >&&> fullType a b >>= (fun x -> return (Array (ea, x), iix)) | FunctionType (returna, paramsa), FunctionType (returnb, paramsb) -> let (tsa, (ba,iihas3dotsa)) = paramsa in let (tsb, (bb,iihas3dotsb)) = paramsb in let bx = ba in let iihas3dotsx = iihas3dotsa in (ba =:= bb && List.length tsa =|= List.length tsb) >&&> fullType returna returnb >>= (fun returnx -> Common.zip tsa tsb +> List.fold_left (fun acc ((parama,iia),(paramb,iib))-> let iix = iia in acc >>= (fun xs -> let {p_register = (ba,iiba); p_namei = saopt; p_type = ta} = parama in let {p_register = (bb,iibb); p_namei = sbopt; p_type = tb} = paramb in let bx = ba in let iibx = iiba in let sxopt = saopt in (* todo? iso on name or argument ? *) (ba =:= bb && same_s saopt sbopt) >&&> fullType ta tb >>= (fun tx -> let paramx = { p_register = (bx, iibx); p_namei = sxopt; p_type = tx; } in return ((paramx,iix)::xs) ) ) ) (return []) >>= (fun tsx -> let paramsx = (List.rev tsx, (bx, iihas3dotsx)) in return (FunctionType (returnx, paramsx), iix) )) | Enum (saopt, enuma), Enum (sbopt, enumb) -> (saopt =*= sbopt && List.length enuma =|= List.length enumb && Common.zip enuma enumb +> List.for_all (fun (((namesa,eopta), iicommaa), ((namesb,eoptb),iicommab)) -> let sa = str_of_name namesa in let sb = str_of_name namesb in sa =$= sb && (* todo ? eopta and b can have some info so ok to use =*= ? *) eopta =*= eoptb ) ) >&&> return (Enum (saopt, enuma), iix) | EnumName sa, EnumName sb -> sa =$= sb >&&> return (EnumName sa, iix) | ParenType a, ParenType b -> (* iso here ? *) fullType a b >>= (fun x -> return (ParenType x, iix) ) | TypeOfExpr ea, TypeOfExpr eb -> let ea = Lib_parsing_c.al_expr ea in let eb = Lib_parsing_c.al_expr eb in ea =*= eb >&&> return (TypeOfExpr ea, iix) | TypeOfType a, TypeOfType b -> fullType a b >>= (fun x -> return (TypeOfType x, iix)) (* | TypeOfType a, b -> | a, TypeOfType b -> *) | StructUnion (sua, saopt, sta), StructUnion (sub, sbopt, stb) -> (sua =*= sub && saopt =*= sbopt && List.length sta =|= List.length stb) >&&> (function tin -> (* zip is only safe if the above succeeds *) (Common.zip sta stb +> List.fold_left (fun acc ((fielda), (fieldb)) -> acc >>= (fun xs -> match fielda, fieldb with | EmptyField iia, EmptyField iib -> let iix = iia in return ((EmptyField iix)::xs) | DeclarationField (FieldDeclList (fa, iipta)), DeclarationField (FieldDeclList (fb, iiptb)) -> let iipt = iipta in (* TODO ?*) (List.length fa =|= List.length fb) >&&> (function tin -> (* only executable if the length is correct *) (Common.zip fa fb +> List.fold_left (fun acc2 ((fielda,iia),(fieldb,iib))-> let iix = iia in acc2 >>= (fun xs -> match fielda, fieldb with | Simple (nameaopt, ta), Simple (namebopt, tb) -> same_s nameaopt namebopt >&&> fullType ta tb >>= (fun tx -> return (((Simple (nameaopt, tx)), iix)::xs) ) | BitField (nameopta, ta, infoa, ea), BitField (nameoptb, tb, infob, eb) -> let infox = infoa in (same_s nameopta nameoptb && ea =*= eb) >&&> fullType ta tb >>= (fun tx -> return (((BitField (nameopta,tx,infox,ea)), iix)::xs) ) | _,_ -> fail ) ) (return [])) tin) >>= (fun fx -> return (((DeclarationField (FieldDeclList (List.rev fx,iipt))))::xs) ) | _ -> fail ) ) (return []) >>= (fun stx -> return (StructUnion (sua, saopt, List.rev stx), iix) )) tin) (* choose the lub. * subtil: in the return must put iia, not iix, and in following case * must put iib and not iix, because we want the token corresponding * to the typedef. *) | TypeName (name, Some a), _ -> fullType a (Ast_c.nQ, tyb) >>= (fun x -> return (TypeName (name, Some x), iia) ) | _, TypeName (name, Some b) -> fullType b (Ast_c.nQ, tya) >>= (fun x -> return (TypeName (name, Some x), iib) (* subtil: *) ) | _, _ -> fail end module XEQ = struct type tin = unit type 'a tout = 'a option type 'a matcher = 'a -> 'a -> tin -> 'a tout let return x = fun tin -> Some x let fail = fun tin -> None let (>>=) m f = fun tin -> match m tin with | None -> None | Some x -> f x tin let (>&&>) b m = fun tin -> if b then m tin else fail tin end module EQ = C_VS_C (XEQ) let eq_type2 a b = EQ.fullType a b () <> None let merge_type2 a b = Common.some (EQ.fullType a b ()) let eq_type a b = Common.profile_code "C_vs_c" (fun () -> eq_type2 a b) let merge_type a b = Common.profile_code "C_vs_c" (fun () -> merge_type2 a b) (* ------------------------------------------------------------------------- *) (* This seemed like a reasonable place to put this, given the file name, but not sure that it is the case... This has to be compatible with the function equal_inh_metavarval. It is indeed not so clear why that is defined in cocci_vs_c.ml, and not here, since it is comparing C code to C code. *) let subexpression_of_expression small_exp big_exp = let res = ref false in (* because no appropriate functional visitor... *) let expr (k,bigf) big_exp = (* comparison used in Cocci_vs_c.equal_inh_metavarval *) (* have to strip each subexp, because stripping puts some offsets in the term rather than setting everything to 0. No idea why... *) if small_exp =*= Lib_parsing_c.al_inh_expr big_exp then res := true else k big_exp in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kexpr = expr } in Visitor_c.vk_expr bigf big_exp; (*Printf.printf "comparison gives %b\n" !res; Pretty_print_c.pp_expression_simple small_exp; Format.print_newline(); Pretty_print_c.pp_expression_simple big_exp; Format.print_newline(); Printf.printf "--------------------------------\n";*) !res coccinelle-1.0.0-rc19/engine/Makefile0000644000175000017500000001016212247442615016270 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ############################################################################## # Variables ############################################################################## #TARGET=matcher ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=cocciengine CTLTARGET=engine SRC= externalanalysis.ml \ flag_matcher.ml lib_engine.ml pretty_print_engine.ml \ check_exhaustive_pattern.ml \ check_reachability.ml \ c_vs_c.ml isomorphisms_c_c.ml \ cocci_vs_c.ml pattern_c.ml transformation_c.ml \ asttomember.ml asttoctl2.ml ctltotex.ml \ postprocess_transinfo.ml ctlcocci_integration.ml INCLUDES = -I ../commons -I ../commons/ocamlextra -I ../globals \ -I ../ctl -I ../parsing_cocci -I ../parsing_c LIBS=../commons/commons.cma ../globals/globals.cma \ ../ctl/ctl.cma ../parsing_c/parsing_c.cma ../parsing_cocci/cocci_parser.cma SYSLIBS= str.cma unix.cma # just to test asttoctl # CTLSOURCES = lib_engine.ml pretty_print_engine.ml asttoctl.ml ctltotex.ml \ # main.ml ############################################################################## # Generic variables ############################################################################## #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLCFLAGS ?= -g OPTFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDESDEP) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ############################################################################## # Top rules ############################################################################## ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).cma: $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) $(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa) $(OCAMLOPT_CMD) -a -o $(TARGET).cmxa $(OPTOBJS) $(TARGET).top: $(OBJS) $(LIBS) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) clean:: rm -f $(TARGET).top else all: cd .. && $(OCAMLBUILD) engine/engine.cma all.opt: cd .. && $(OCAMLBUILD) engine/engine.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif ############################################################################## # Pad's rules ############################################################################## ############################################################################## # Generic rules ############################################################################## .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< .ml.mldepend: $(OCAMLC_CMD) -i $< clean:: rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# rm -f .depend distclean: clean .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/engine/postprocess_transinfo.ml0000644000175000017500000001427312247442615021640 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./postprocess_transinfo.ml" (* two goals: first drop from the environments things that are not used, and second prompt for the names of fresh variables that are used *) (* have to add in the whole inherited env because inherited variables are not returned by get_fvs. It would be better if that were the case, but since at the moment I think we can only inherit one value per variable, perhaps it doesn't matter - these bindings will always be the same no matter how we reached a particular match *) module Ast = Ast_cocci let extra_counter = ref 0 let get_extra _ = let ctr = !extra_counter in extra_counter := !extra_counter + 1; "__extra_counter__"^(string_of_int ctr) let get_seeded seed = let ctr = !extra_counter in extra_counter := !extra_counter + 1; seed^(string_of_int ctr) let read_fresh_id _ = try let s = read_line () in match Parse_c.tokens_of_string s with [Parser_c.TIdent _; Parser_c.EOF _] -> s | [Parser_c.EOF _] -> get_extra() | _ -> failwith ("wrong fresh id: " ^ s) with End_of_file -> get_extra() let get_vars = function Lib_engine.Match(re) -> (Ast.get_fvs re, Ast.get_fresh re) | _ -> ([],[]) let string2val str = Lib_engine.NormalMetaVal(Ast_c.MetaIdVal(str,[])) (* ----------------------------------------------------------------------- *) (* Get values for fresh variables *) let process_tree inherited_env l = let (all_fresh,local_freshs,new_triples) = List.fold_left (function (all_fresh,local_freshs,new_triples) -> function (node,env,pred) -> let (other,fresh) = get_vars pred in let env = List.filter (function (x,_) -> List.mem x other) env in (Common.union_set fresh all_fresh, fresh::local_freshs, (node,env@inherited_env,pred)::new_triples)) ([],[],[]) l in let local_freshs = List.rev local_freshs in let new_triples = List.rev new_triples in let fresh_env = List.map (function ((r,n) as fresh,Ast.NoVal) -> Printf.printf "%s: name for %s: " r n; (* not debugging code!!! *) flush stdout; (fresh,let v = string2val(read_fresh_id()) in function _ -> v) | ((r,n) as fresh,Ast.StringSeed seed) -> (fresh,let v = string2val(get_seeded seed) in function _ -> v) | ((r,n) as fresh,Ast.ListSeed seed) -> (fresh, function env -> let strings = List.map (function Ast.SeedString s -> s | Ast.SeedId id -> try (match List.assoc id env with Lib_engine.NormalMetaVal(Ast_c.MetaIdVal(str,_)) -> str | _ -> failwith "bad id value") with Not_found -> failwith ("fresh: no binding for meta "^(Dumper.dump id))) seed in string2val(String.concat "" strings))) all_fresh in let (_,res) = List.split (List.fold_left (function freshs_node_env_preds -> function (fresh,fn) -> List.map (function (freshs,((node,env,pred) as cur)) -> try let _ = List.assoc fresh freshs in (freshs,(node,(fresh,fn env)::env,pred)) with Not_found -> (freshs,cur)) freshs_node_env_preds) (List.combine local_freshs new_triples) fresh_env) in (List.rev res, fresh_env) (* ----------------------------------------------------------------------- *) (* Create the environment to be used afterwards *) (* anything that a used after fresh variable refers to has to have a unique value, by virtue of the placement of the quantifier. thus we augment inherited env with the first element of l, if any *) let collect_used_after used_after envs l inherited_env = List.map2 (function env -> function l -> let inherited_env = match l with [] -> inherited_env | (_,fse,_)::_ -> (* l represents the result from a single tree. fse is a complete environment in that tree. for a fresh seed, the environments for all leaves contain the same information *) fse@inherited_env in List.map (function (v,vl) -> (v,vl inherited_env)) (List.filter (function (v,vl) -> List.mem v used_after) env)) envs l (* ----------------------------------------------------------------------- *) (* distinguish between distinct witness trees, each gets an index n *) (* index should be global, so that it can extend over environments *) let index = ref (-1) let fold_left_with_index f acc = let rec fold_lwi_aux acc = function | [] -> acc | x::xs -> let n = !index in index := !index + 1; fold_lwi_aux (f acc x n) xs in fold_lwi_aux acc let numberify trees = let trees = fold_left_with_index (function acc -> function xs -> function n -> (List.map (function x -> (n,x)) xs) @ acc) [] trees in List.fold_left (function res -> function (n,x) -> let (same,diff) = List.partition (function (ns,xs) -> x = xs) res in match same with [(ns,xs)] -> (n::ns,xs)::diff | _ -> ([n],x)::res) [] trees (* ----------------------------------------------------------------------- *) (* entry point *) let process used_after inherited_env l = let (trees, fresh_envs) = List.split (List.map (process_tree inherited_env) l) in let trees = numberify trees in (trees, collect_used_after used_after fresh_envs l inherited_env) coccinelle-1.0.0-rc19/engine/asttomember.ml0000644000175000017500000002675512247442615017523 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttomember.ml" (* on the first pass, onlyModif is true, so we don't see all matched nodes, only modified ones *) module Ast = Ast_cocci module V = Visitor_ast module CTL = Ast_ctl let mcode r (_,_,kind,_) = match kind with Ast.MINUS(_,_,_,_) -> true | Ast.PLUS _ -> failwith "not possible" | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) let no_mcode _ _ = false let contains_modif used_after x = if List.exists (function x -> List.mem x used_after) (Ast.get_fvs x) then true else let bind x y = x or y in let option_default = false in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem x (* contains an inherited metavariable or contains a constant *) let contains_constant x = match Ast.get_inherited x with [] -> let bind x y = x or y in let option_default = false in let do_nothing r k e = k e in let mcode _ _ = false in let ident r k i = match Ast.unwrap i with Ast.Id(name) -> true | _ -> k i in let expr r k e = match Ast.unwrap e with Ast.Constant(const) -> true | _ -> k e in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing ident expr do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem x | _ -> true (* --------------------------------------------------------------------- *) let print_info = function [] -> Printf.printf "no information\n" | l -> List.iter (function disj -> Printf.printf "one set of required things %d:\n" (List.length disj); List.iter (function (_,thing) -> Printf.printf "%s\n" (Pretty_print_cocci.rule_elem_to_string thing)) disj;) l (* --------------------------------------------------------------------- *) (* drop all distinguishing information from a term except inherited variables, which are used to improve efficiency of matching process *) let strip x = let do_nothing r k e = let inh = Ast.get_inherited e in Ast.make_inherited_term (Ast.unwrap (k e)) inh in let do_absolutely_nothing r k e = k e in let mcode m = Ast.make_mcode(Ast.unwrap_mcode m) in let decl r k d = let res = do_nothing r k d in if Ast.get_safe_decl d then {res with Ast.safe_for_multi_decls = true} else res in let rule_elem r k re = let res = do_nothing r k re in let no_mcode = Ast.CONTEXT(Ast.NoPos,Ast.NOTHING) in match Ast.unwrap res with Ast.FunHeader(bef,b,fninfo,name,lp,params,rp) -> Ast.rewrap res (Ast.FunHeader(no_mcode,b,fninfo,name,lp,params,rp)) | Ast.Decl(bef,b,decl) -> Ast.rewrap res (Ast.Decl(no_mcode,b,decl)) | _ -> res in let recursor = V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing decl rule_elem do_nothing do_nothing do_nothing do_absolutely_nothing in recursor.V.rebuilder_rule_elem x (* --------------------------------------------------------------------- *) let disj l1 l2 = l1 l2 let rec conj xs ys = match (xs,ys) with ([],_) -> ys | (_,[]) -> xs | _ -> List.fold_left (function prev -> function x -> List.fold_left (function prev -> function cur -> let cur_res = (List.sort compare (Common.union_set x cur)) in cur_res :: (List.filter (function x -> not (Common.include_set cur_res x)) prev)) prev ys) [] xs let conj_wrapped x l = conj [List.map (function x -> (1,strip x)) x] l (* --------------------------------------------------------------------- *) (* the main translation loop *) let rec rule_elem re = match Ast.unwrap re with Ast.DisjRuleElem(res) -> (* why was the following done? ors have to be kept together for efficiency, so they are considered at once and not individually anded with everything else *) let re = let all_inhs = List.map Ast.get_inherited res in let inhs = List.fold_left (function prev -> function inh -> Common.inter_set inh prev) (List.hd all_inhs) (List.tl all_inhs) in Ast.make_inherited_term (Ast.unwrap re) inhs in [[(List.length res,strip re)]] | _ -> [[(1,strip re)]] let conj_one testfn x l = if testfn x then conj (rule_elem x) l else l let rec statement_list testfn mcode tail stmt_list : 'a list list = match Ast.unwrap stmt_list with Ast.DOTS(x) | Ast.CIRCLES(x) | Ast.STARS(x) -> (match List.rev x with [] -> [] | last::rest -> List.fold_right (function cur -> function rest -> conj (statement testfn mcode false cur) rest) rest (statement testfn mcode tail last)) and statement testfn mcode tail stmt : 'a list list = match Ast.unwrap stmt with Ast.Atomic(ast) -> (match Ast.unwrap ast with (* modifications on return are managed in some other way *) Ast.Return(_,_) | Ast.ReturnExpr(_,_,_) when tail -> [] | _ -> if testfn ast then rule_elem ast else []) | Ast.Seq(lbrace,body,rbrace) -> let body_info = statement_list testfn mcode tail body in if testfn lbrace or testfn rbrace then conj_wrapped [lbrace;rbrace] body_info else body_info | Ast.IfThen(header,branch,(_,_,_,aft)) | Ast.While(header,branch,(_,_,_,aft)) | Ast.For(header,branch,(_,_,_,aft)) | Ast.Iterator(header,branch,(_,_,_,aft)) -> if testfn header or mcode () ((),(),aft,[]) then conj (rule_elem header) (statement testfn mcode tail branch) else statement testfn mcode tail branch | Ast.Switch(header,lb,decls,cases,rb) -> let body_info = conj (statement_list testfn mcode false decls) (case_lines testfn mcode tail cases) in if testfn header or testfn lb or testfn rb then conj (rule_elem header) body_info else body_info | Ast.IfThenElse(ifheader,branch1,els,branch2,(_,_,_,aft)) -> let branches = conj (statement testfn mcode tail branch1) (statement testfn mcode tail branch2) in if testfn ifheader or mcode () ((),(),aft,[]) then conj (rule_elem ifheader) branches else branches | Ast.Disj(stmt_dots_list) -> let processed = List.map (statement_list testfn mcode tail) stmt_dots_list in (* if one branch gives no information, then we have to take anything *) if List.exists (function [] -> true | _ -> false) processed then [] else Common.union_all processed | Ast.Nest(starter,stmt_dots,ender,whencode,true,_,_) -> statement_list testfn mcode false stmt_dots | Ast.Nest(starter,stmt_dots,ender,whencode,false,_,_) -> [] | Ast.Dots(_,whencodes,_,_) -> [] | Ast.FunDecl(header,lbrace,body,rbrace) -> let body_info = statement_list testfn mcode true body in if testfn header or testfn lbrace or testfn rbrace then conj (rule_elem header) body_info else body_info | Ast.Define(header,body) -> conj_one testfn header (statement_list testfn mcode tail body) | Ast.AsStmt(stm,asstm) -> conj (statement testfn mcode tail stm) (statement testfn mcode tail asstm) | Ast.OptStm(stm) -> [] | Ast.UniqueStm(stm) -> statement testfn mcode tail stm | _ -> failwith "not supported" and case_lines testfn mcode tail cases = match cases with [] -> [] | last::rest -> List.fold_right (function cur -> function rest -> conj (case_line testfn mcode false cur) rest) rest (case_line testfn mcode tail last) and case_line testfn mcode tail case = match Ast.unwrap case with Ast.CaseLine(header,code) -> conj_one testfn header (statement_list testfn mcode tail code) | Ast.OptCase(case) -> [] (* --------------------------------------------------------------------- *) (* Function declaration *) let top_level testfn mcode t : 'a list list = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo" | Ast.NONDECL(stmt) -> statement testfn mcode false stmt | Ast.CODE(stmt_dots) -> statement_list testfn mcode false stmt_dots | Ast.ERRORWORDS(exps) -> failwith "not supported errorwords" (* --------------------------------------------------------------------- *) (* Entry points *) let debug = false (* if we end up with nothing, we assume that this rule is only here because someone depends on it, and thus we try again with testfn as contains_modif. Alternatively, we could check that this rule is mentioned in some dependency, but that would be a little more work, and doesn't seem worthwhile. *) (* lists are sorted such that smaller DisjRuleElem are first, because they are cheaper to test *) let asttomemberz (_,_,l) used_after = let process_one (l : (int * Ast_cocci.rule_elem) list list) = if debug then print_info l; List.map (function info -> let info = List.sort (function (n1,_) -> function (n2,_) -> compare n1 n2) info in List.map (function (_,x) -> (Lib_engine.Match(x),CTL.Control)) info) l in List.map2 (function min -> function (max,big_max) -> match min with [] -> (match max() with [] -> process_one (big_max()) | max -> process_one max) | _ -> process_one min) (List.map (top_level contains_constant no_mcode) l) (List.combine (List.map2 (function x -> function ua -> function _ -> top_level (contains_modif ua) mcode x) l used_after) (List.map (function x -> function _ -> top_level (function _ -> true) no_mcode x) l)) let asttomember r used_after = match r with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> [] | Ast.CocciRule (a,b,c,_,_) -> asttomemberz (a,b,c) used_after coccinelle-1.0.0-rc19/version.ml.in0000644000175000017500000000011512247437436016011 0ustar eugeneugenlet version_date = "@CONFVERSION@" let configure_flags = "@CONFIGURE_FLAGS@" coccinelle-1.0.0-rc19/Makefile.dev0000644000175000017500000000664512247437436015620 0ustar eugeneugen ############################################################################## # Pad specific rules ############################################################################## #TOP=/home/pad/mobile/project-coccinelle WEBBASE=~/website WEBSITE=$(WEBBASE)/distrib website: cp $(TMP)/$(PACKAGE).tgz $(WEBSITE) cp $(TMP)/$(PACKAGE)-bin-x86.tgz $(WEBSITE) # cp $(TMP)/$(PACKAGE)-bin-x86-static.tgz $(WEBSITE) cp $(TMP)/$(PACKAGE)-bin-x86-python.tgz $(WEBSITE) cp $(TMP)/$(PACKAGE)-bin-bytecode-$(OCAMLVERSION).tgz $(WEBSITE) cp $(TMP)/$(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz $(WEBSITE) cd $(WEBSITE); svn add $(PACKAGE).tgz \ $(PACKAGE)-bin-x86.tgz \ $(PACKAGE)-bin-x86-python.tgz \ $(PACKAGE)-bin-bytecode-$(OCAMLVERSION).tgz \ $(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz # $(PACKAGE)-bin-x86-static.tgz @echo "\nYou need to manually update those files:\n" @echo "\t$(WEBBASE)/download.php" @echo "\t$(WEBSITE)/change.html\n" @echo "Then commit the changes.\n" # rm -f $(WEBSITE)/LATEST* $(WEBSITE)/coccinelle-latest.tgz # cp changes.txt $(WEBSITE)/changes-$(VERSION).txt # cd $(WEBSITE); touch LATEST_IS_$(VERSION); ln -s $(PACKAGE).tgz coccinelle-latest.tgz # cp readme.txt $(WEBSITE) #TXT=$(wildcard *.txt) syncwiki: # unison ~/public_html/wiki/wiki-LFS/data/pages/ docs/wiki/ # set -e; for i in $(TXT); do unison $$i docs/wiki/$$i; done darcsweb: # @echo pull from ~/public_html/darcs/c-coccinelle and c-commons and lib-xxx DARCSFORESTS=commons ocamlsexp \ parsing_c parsing_cocci engine update_darcs: darcs pull set -e; for i in $(DARCSFORESTS); do cd $$i; darcs pull; cd ..; done #darcs diff -u diff_darcs: set -e; for i in $(DARCSFORESTS); do cd $$i; darcs diff -u; cd ..; done ############################################################################## # Git Developer rules ############################################################################## gitupdate: echo "you should pull from the git repository" # git cvsimport -d :ext:topps:/var/cvs/cocci coccinelle #UBUNTU=karmic lucid maverick natty UBUNTU=lucid maverick natty oneiric UBUNTURELEASE=$(UBUNTU:%=ubuntu-%) .PHONY:: ubuntu $(UBUNTURELEASE) ubuntu: for r in $(UBUNTURELEASE); do $(MAKE) $$r ; done @echo "\nYou can now build the Ubuntu source package with\n" @echo "\tmake packsrc\n" #$(UBUNTURELEASE): # debchange -c debian/changelog.karmic -D karmic -v $(VERSION)~$(@:ubuntu-%=%)~npalix1 "New release $(VERSION)" IDX?=1 ubuntu-karmic: debchange -c debian/changelog.karmic -D karmic -v $(VERSION)~910npalix$(IDX) "New release $(VERSION)" ubuntu-lucid: debchange -c debian/changelog.lucid -D lucid -v $(VERSION)~1004npalix$(IDX) "New release $(VERSION)" ubuntu-maverick: debchange -c debian/changelog.maverick -D maverick -v $(VERSION)~1010npalix$(IDX) "New release $(VERSION)" ubuntu-natty: debchange -c debian/changelog.natty -D natty -v $(VERSION)~1104npalix$(IDX) "New release $(VERSION)" ubuntu-oneiric: debchange -c debian/changelog.oneiric -D oneiric -v $(VERSION)~1110npalix$(IDX) "New release $(VERSION)" ubuntu-p: if [ ! -f debian/changelog.$(@:ubuntu-%=%) ] ; then \ debchange --create -c debian/changelog.$(@:ubuntu-%=%) -D UNRELEASED \ -v $(VERSION)~npalix$(IDX) "New release $(VERSION)" --package $(PRJNAME) ; \ else \ debchange -c debian/changelog.$(@:ubuntu-%=%) -D UNRELEASED -v $(VERSION)~npalix$(IDX) "New release $(VERSION)" ; \ fi coccinelle-1.0.0-rc19/standard.iso0000644000175000017500000003547312247437436015720 0ustar eugeneugen// **************************************************************************** // Prelude // **************************************************************************** // Note: some isomorphisms are handled in the engine directly because they // require special support. They can not be easily described with a // XX <=> YY. But some of them have names, so they can be disabled, as for // any other isomorphism rule. That also means that those names can not // be used for regular isomorphism rule. Those reserved rule names are: // - optional_storage // - optional_qualifier // - value_format // See parse_cocci.ml, pattern.ml, transformation.ml. // Note: the order of the rules has some importance. As we don't do a fixpoint, // changing the order may impact the result. For instance, if we have // // iso1 = x+y <=> y+x // iso2 = i++ <=> i=i+1; // // and if // in SP we have i++; // in C we have i=1+i; // // Does the SP matches the C ? // - Yes if iso2 precedes iso1 in this file, // - No otherwise. // **************************************************************************** // Standard C isomorphisms // **************************************************************************** // --------------------------------------------------------------------------- // Spacing (include comments) isomorphisms // --------------------------------------------------------------------------- // They are handled at lex time. // --------------------------------------------------------------------------- // Dataflow isomorphisms (copy propagation, assignments) // --------------------------------------------------------------------------- // They are handled in engine (TODO). // --------------------------------------------------------------------------- // Iso-by-absence (optional qualifier, storage, sign, cast) isomorphisms // --------------------------------------------------------------------------- // Some of them are handled in cocci_vs_c. Some of them handled here. // We would like that // chip = (ak4117_t *)snd_magic_kcalloc(ak4117_t, 0, GFP_KERNEL); // also matches // X = snd_magic_kcalloc(T, 0, C) // // For the moment because the iso is (T) E => E and not <=>, it forces // us to rewrite the SP as X = (T) snd_magic_kcalloc(T, 0, C) Expression @ drop_cast @ expression E; pure type T; @@ // in the following, the space at the beginning of the line is very important! (T)E => E Type @ add_signed @ @@ int => signed int Type @ add_int1 @ @@ unsigned => unsigned int Type @ add_int2 @ @@ signed => signed int // --------------------------------------------------------------------------- // Field isomorphisms // --------------------------------------------------------------------------- // Dereferences // Those iso were introduced for the 'generic program matching' paper, // with sgrep. The idea is that when we want to detect bugs, // we want to detect something like free(X) ... *X // meaning that you try to access something that have been freed. // But *X is not the only way to deference X, there is also // X->fld, hence those iso. // The following don't see like a good idea, because eg fld could be // instantiated in different ways in different places, meaning that the // two occurrences of "*E" would not refer to the same thing at all. // This could be addressed by making E pure, but then I think it would // have no purpose. // Expression // @@ // expression E; // identifier fld; // @@ // // *E => E->fld // // Expression // @@ // expression E; // identifier fld; // @@ // // *E => (E)->fld // // Expression // @@ // expression E,E1; // @@ // // *E => E[E1] // --------------------------------------------------------------------------- // Typedef isomorphisms // --------------------------------------------------------------------------- // They are handled in engine. // --------------------------------------------------------------------------- // Boolean isomorphisms for int and pointer types // --------------------------------------------------------------------------- // the space at the beginning of the line is very important! Expression @ not_int1 @ int X; @@ !X => X == 0 TestExpression @ not_int2 @ int X; @@ X => X != 0 // the space at the beginning of the line is very important! Expression @ not_ptr1 @ expression *X; @@ !X => X == NULL TestExpression @ not_ptr2 @ expression *X; @@ X => X != NULL // --------------------------------------------------------------------------- // Boolean isomorphisms // --------------------------------------------------------------------------- Expression @commeq@ expression E; constant C; @@ E == C <=> C == E Expression @commneq@ expression E; constant C; @@ E != C <=> C != E Expression @ is_zero @ expression X; @@ X == 0 => !X // X should be a test expression, but X!=0 doesn't have to be one // not nice at all... ToTestExpression sets everything after the first // pattern in the iso rule to be TestExpression ToTestExpression @ isnt_zero @ expression X; @@ X != 0 => X Expression @ is_null @ expression X; @@ X == NULL => !X ToTestExpression @ isnt_null1 @ expression X; @@ X != NULL => X // --------------------------------------------------------------------------- // Bit operations // --------------------------------------------------------------------------- Expression @ bitor_comm @ expression X,Y; @@ X | Y => Y | X Expression @ bitand_comm @ expression X,Y; @@ X & Y => Y & X // only if side effect free in theory, perhaps makes no sense // Expression // @ and_comm @ // expression X,Y; // @@ // X && Y => Y && X // Expression // @ or_comm @ // expression X,Y; // @@ // X || Y => Y || X // --------------------------------------------------------------------------- // Arithmetic isomorphisms // --------------------------------------------------------------------------- //todo: require check side-effect free expression Expression @ plus_comm @ expression X, Y; @@ X + Y => Y + X // needed in kcalloc CE, where have a -kzalloc(c * sizeof(T), E) Expression @ mult_comm @ expression X, Y; @@ X * Y => Y * X Expression @ plus_assoc @ expression X, Y, Z; @@ // note space before ( (X + Y) + Z <=> X + Y + Z Expression @ minus_assoc @ expression X, Y, Z; @@ (X - Y) - Z <=> X - Y - Z Expression @ plus_minus_assoc1 @ expression X, Y, Z; @@ (X + Y) - Z <=> X + Y - Z Expression @ plus_minus_assoc2 @ expression X, Y, Z; @@ (X - Y) + Z <=> X - Y + Z Expression @ times_assoc @ expression X, Y, Z; @@ (X * Y) * Z <=> X * Y * Z Expression @ div_assoc @ expression X, Y, Z; @@ (X / Y) / Z <=> X / Y / Z Expression @ times_div_assoc1 @ expression X, Y, Z; @@ (X * Y) / Z <=> X * Y / Z Expression @ times_div_assoc2 @ expression X, Y, Z; @@ (X / Y) * Z <=> X / Y * Z // --------------------------------------------------------------------------- // Relational isomorphisms // --------------------------------------------------------------------------- Expression @ gtr_lss @ expression X, Y; @@ X < Y <=> Y > X Expression @ gtr_lss_eq @ expression X, Y; @@ X <= Y <=> Y >= X // --------------------------------------------------------------------------- // Increment isomorphisms // --------------------------------------------------------------------------- // equivalences between i++, +=1, etc. // note: there is an addition in this SP. Statement @ inc @ identifier i; @@ i++; <=> ++i; <=> i+=1; <=> i=i+1; // I would like to avoid the following rule, but we cant transform a ++i // in i++ everywhere. We can do it only when the instruction is alone, // such as when there is not stuff around it (not as in x = i++) That's why in // the previous iso, we have explicitely force the i++ do be alone with // the ';'. But unfortunately in the last expression of the for there is // no ';' so the previous rule cannot be applied, hence this special // case. Statement @ for_inc @ expression X, Y; statement S; identifier i; @@ for(X;Y;i++) S <=> for(X;Y;++i) S // **************************************************************************** // gcc specific isomorphisms // **************************************************************************** // likely and unlikely are used to give hints to gcc to improve performance. Expression @ unlikely @ expression E; @@ unlikely(E) <=> likely(E) => E // --------------------------------------------------------------------------- // Parenthesis isomorphisms // --------------------------------------------------------------------------- //Expression //@@ expression E; @@ // E => (E) //// E => ((E)) // todo: isomorphism avec les () around ? cf sizeof 3. // (E) => E with some conditions. Expression @ paren @ expression E; @@ (E) => E // --------------------------------------------------------------------------- // Statement isomorphisms // --------------------------------------------------------------------------- // --------------------------------------------------------------------------- // Value isomorphisms // --------------------------------------------------------------------------- // There is also equal_c_int in cocci_vs_c to dealing with other // integer decimal/hexadecimal isomorphisms. // an argexpression applies only at top level, in the argument of a // function call, or on the right-hand side of an assignment ArgExpression @ zero_multiple_format @ @@ 0 => '\0' // ---------------- // If // ---------------- // **************************************************************************** // if structure isomorphisms // **************************************************************************** // these are after the above so that the introduced negation will distribute // properly over the argument to likely/unlikely Statement @ neg_if @ expression X; statement S1, S2; @@ if (X) S1 else S2 => if (!X) S2 else S1 Statement @ ne_if @ expression E1, E2; statement S1, S2; @@ if (E1 != E2) S1 else S2 => if (E1 == E2) S2 else S1 Statement @ drop_else @ expression E; statement S1; pure statement S2; @@ if (E) S1 else S2 => if (E) S1 Expression @ neg_if_exp @ expression E1, E2, E3; @@ E1 ? E2 : E3 => !E1 ? E3 : E2 // if (X) Y else Z <=> X ? Y : Z sometimes. // ---------------- // Loops // ---------------- // --------------------------------------------------------------------------- // Optional initializers // --------------------------------------------------------------------------- // this is not safe when the declaration is replaced // attempt to indicate that by requiring that Z is context // no optional static/extern for isos Declaration @ decl_init @ type T; context identifier Z; @@ T Z; => T Z = ...; Declaration @ const_decl_init @ type T; identifier Z; constant C; @@ T Z; => T Z = C; Declaration @ extern_decl_init @ type T; context identifier Z; @@ extern T Z; => extern T Z = ...; Declaration @ const_extern_decl_init @ type T; identifier Z; constant C; @@ extern T Z; => extern T Z = C; Declaration @ static_decl_init @ type T; context identifier Z; @@ static T Z; => static T Z = ...; Declaration @ const_static_decl_init @ type T; identifier Z; constant C; @@ static T Z; => static T Z = C; // --------------------------------------------------------------------------- // Branch (or compound) isomorphisms // --------------------------------------------------------------------------- // maybe a cocci patch should require something that looks like what is on // the left above to occur in a if or while // could worry that this has to be a simple statement, but this should work // better as it allows + code on S Statement @ braces1 @ statement S; @@ { ... S } => S Statement @ braces2 @ statement S; @@ { ... S ... } => S Statement @ braces3 @ statement S; @@ { S ... } => S Statement @ braces4 @ statement S; @@ { S } => S Statement @ ret @ @@ return ...; => return; // --------------------------------------------------------------------------- // Declaration isomorphisms // --------------------------------------------------------------------------- // They are handled in engine (TODO) // int i,j,k; <=> int i; int j; int k; // --------------------------------------------------------------------------- // Affectation/initialisation isomorphism // --------------------------------------------------------------------------- // They are handled in engine. // 'X = Y' should also match 'type X = Y'; // --------------------------------------------------------------------------- // Pointer/Array isomorphisms // --------------------------------------------------------------------------- // pointer arithmetic equivalences // a + x <=> a[x] // --------------------------------------------------------------------------- // Pointer/Field isomorphisms // --------------------------------------------------------------------------- Expression @ ptr_to_array @ expression E1, E2; // was pure, not sure why that's needed, not good for rule27 identifier fld; @@ E1->fld => E1[E2].fld TopLevel @ mkinit @ type T; pure context T E; identifier I; identifier fld; expression E1; @@ E.fld = E1; => T I = { .fld = E1, }; // --------------------------------------------------------------------------- // more pointer field iso // --------------------------------------------------------------------------- // pure means that either the whole field reference expression is dropped, // or E is context code and has no attached + code // not really... pure means matches a unitary unplussed metavariable // but this rule doesn't work anyway Expression @ fld_to_ptr @ type T; pure T E; pure T *E1; identifier fld; @@ E.fld => E1->fld // --------------------------------------------------------------------------- // sizeof isomorphisms // --------------------------------------------------------------------------- // The following is made redundant by the paren isomorphism // Expression // @ sizeof_parens @ // expression E; // @@ // sizeof(E) => sizeof E Expression @ sizeof_type_expr @ pure type T; // pure because we drop a metavar T E; @@ sizeof(T) => sizeof(E) // Expression // @ fld_func_call @ // expression list ES; // identifier fld; // expression E; // @@ // E.fld(ES) <=> (*E.fld)(ES) // **************************************************************************** // Linux specific isomorphisms // **************************************************************************** // Examples: many functions are equivalent/related, and one SP modifying // such a function should also modify the equivalent/related one. // --------------------------------------------------------------------------- // in rule18, needed ? // --------------------------------------------------------------------------- // ( // - test_and_set_bit(ev, &bcs->event); // | // - set_bit(ev, &bcs->event); // | // - bcs->event |= 1 << ev; // the only case that is used // **************************************************************************** // Everything that is required to be in last position, for ugly reasons ... // **************************************************************************** coccinelle-1.0.0-rc19/ocaml/0000755000175000017500000000000012247442646014462 5ustar eugeneugencoccinelle-1.0.0-rc19/ocaml/no_prepare_ocamlcocci.ml0000644000175000017500000000121512247437436021322 0ustar eugeneugen exception CompileFailure of string exception LinkFailure of string let prepare coccifile code = let ocamls_rules = List.fold_left (function prev -> function Ast_cocci.ScriptRule (name,"ocaml",deps,mv,script_vars,code) -> code :: prev | Ast_cocci.InitialScriptRule (name,"ocaml",deps,code) -> code :: prev | Ast_cocci.FinalScriptRule (name,"ocaml",deps,code) -> code :: prev | _ -> prev) [] code in if ocamls_rules = [] then None else failwith "OCaml scripting is unsupported. Compile spatch with OCaml version >= 3.11" let load_file mlfile = () let clean_file mlfile = () let test () = () coccinelle-1.0.0-rc19/ocaml/prepare_ocamlcocci.mli0000644000175000017500000000033112247437436020775 0ustar eugeneugen exception CompileFailure of string exception LinkFailure of string val prepare : string -> Ast_cocci.rule list -> string option val load_file : string -> unit val clean_file : string -> unit val test : unit -> unit coccinelle-1.0.0-rc19/ocaml/exposed_modules.ml0000644000175000017500000000160712247437436020220 0ustar eugeneugen(* Modules accessible by the ocaml scripts. *) module Ast_c = Ast_c (* parsing_c/ast_c.ml *) module Parser_c = Parser_c (* parsing_c/parser_c.mly *) module Lexer_c = Lexer_c (* parsing_c/lexer_c.mll *) module Pretty_print_c = Pretty_print_c (* parsing_c/pretty_print_c.ml *) module Lib_parsing_c = Lib_parsing_c (* parsing_c/lib_parsing_c.ml *) module Visitor_c = Visitor_c (* parsing_c/visitor_c.ml *) module Regexp = Regexp (* globals/regexp.ml *) module Config = Config (* globals/config.ml *) module Flag = Flag (* globals/flag.ml *) module Iteration = Iteration (* globals/iteration.ml *) module Common = Common (* commons/common.ml *) module Ast_cocci = Ast_cocci (* parsing_cocci/ast_cocci.ml *) module Ast0_cocci = Ast0_cocci (* parsing_cocci/ast0_cocci.ml *) module Type_cocci = Type_cocci (* parsing_cocci/type_cocci.ml *) coccinelle-1.0.0-rc19/ocaml/ocaml.mllib0000644000175000017500000000007112247437436016575 0ustar eugeneugenCoccilib Ocamlcocci_aux Run_ocamlcocci Prepare_ocamlcoccicoccinelle-1.0.0-rc19/ocaml/html.odocl0000644000175000017500000000007412247437436016452 0ustar eugeneugenCommon Ast_c Visitor_c Lib_parsing_c Iteration Flag Coccilibcoccinelle-1.0.0-rc19/ocaml/coccilib.ml0000644000175000017500000001566312247437436016577 0ustar eugeneugen(** A library of functions for use with Coccinelle OCaml script code. *) (**/**) (** Coccinelle modules accessible from an ocaml script. *) include Exposed_modules (**/**) (** A value of type {b pos} describes a position in a source file. *) type pos = { current_element : string; (** {b current_element} is the name of the function containing the matched position *) file :string ; (** {b file} is the name of the file containing the matched position *) line : int; (** {b line} is the number of the line containing the first character of the matched position *) col : int; (** {b col} is the column containing the first character of the matched position *) line_end : int; (** {b line_end} is the number of the line containing the last character of the matched position *) col_end : int; (** {b col_end} is the column containing the last character of the matched position. *) } (** Types describing the metavariables. *) type param_type = Pos of pos list | Str of string | Type of Ast_c.fullType | Init of Ast_c.initialiser | InitList of Ast_c.initialiser Ast_c.wrap2 list | Int of int | Param of Ast_c.parameterType | ParamList of Ast_c.parameterType Ast_c.wrap2 list | Expr of Ast_c.expression | ExprList of Ast_c.argument Ast_c.wrap2 list | Decl of Ast_c.declaration | Field of Ast_c.field | FieldList of Ast_c.field list | FragList of Ast_c.string_fragment list | Fmt of Ast_c.string_format | Stmt of Ast_c.statement (* Function table management *) (**/**) (** For internal use only. *) let fcts : (string, param_type list -> string ref list -> unit) Hashtbl.t = Hashtbl.create 11 (* Use prime number *) (**/**) (* ---------------------------------------------------------------------- *) (* Match management *) (** See include_match. *) let inc_match = ref true (** If the argument is true, retain the environment with respect to which the ocaml script code is being executed for use in subsequent rules. If the argument is false, discard this environment. By default, the environment is retained. *) let include_match x = inc_match := x (** See exit *) let exited = ref false (** If called, aborts the treatment of the current file. All previous changes take effect. *) let exit () = exited := true let dir () = !Flag.dir (* ---------------------------------------------------------------------- *) (* org mode *) let build_link p msg color = Printf.sprintf "[[view:%s::face=%s::linb=%d::colb=%d::cole=%d][%s]]" p.file color p.line p.col p.col_end msg let print_todo ?color:(color="ovl-face1") ?msg:(msg="") p = let msg = if msg = "" then Printf.sprintf "%s::%d" p.file p.line else msg in Printf.printf "* TODO %s\n" (build_link p msg color) let print_link ?color:(color="ovl-face2") ?msg:(msg="") p = let msg = if msg = "" then Printf.sprintf "%s::%d" p.file p.line else msg in Printf.printf "%s\n" (build_link p msg color) let print_safe_todo ?color:(color="ovl-face1") ?msg:(msg="") p = let msg = String.concat "@(" (Str.split_delim (Str.regexp_string "[") msg) in let msg = String.concat ")" (Str.split_delim (Str.regexp_string "]") msg) in print_todo ~color:color ~msg:msg p let print_safe_link ?color:(color="ovl-face2") ?msg:(msg="") p = let msg = String.concat "@(" (Str.split_delim (Str.regexp_string "[") msg) in let msg = String.concat ")" (Str.split_delim (Str.regexp_string "]") msg) in print_link ~color:color ~msg:msg p (* print_main, print_sec and print_secs *) let print_main ?color:(color="ovl-face1") msg ps = let p = List.hd ps in let oldmsgfmt = if msg == "" then Printf.sprintf "%s::%d" p.file p.line else Printf.sprintf "%s %s::%d" msg p.file p.line in print_todo ~color:color ~msg:oldmsgfmt p let print_sec ?color:(color="ovl-face2") msg ps = print_link ~color:color ~msg:msg (List.hd ps) let print_secs ?color:(color="ovl-face2") msg ps = List.iter (function i -> print_link ~color:color ~msg:msg i) ps (* pos transformations *) (** convert the filename of a pos to its basename *) let basename_pos pos = { pos with file = Filename.basename (pos.file) } (* external analysis results interface (in a separate module to not pollute the namespace) *) (** external analysis integration. Note: do not use after transformations. *) module Ana = struct (** the type of analysis results: currently only integer ranges. *) type result = Externalanalysis.result type bound = Externalanalysis.bound (** convert a bound to a string for showing. *) let show_bound = Externalanalysis.show_bound (** convert a result value to a string for showing. *) let show_result = Externalanalysis.show_result (** loads some analysis results from the given file. *) let load_results = Externalanalysis.load_external_results (** finds the analysis results for a given position. *) let find pos = Externalanalysis.find_results pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** computes the intersection of analysis results, if possible. *) let inter = Externalanalysis.intersect_results (** predicate over a list of analysis results of a given position. *) let satisfy f pos = Externalanalysis.satisfy f pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** predicate over the intersection of analysis results. *) let satisfy1 f pos = Externalanalysis.satisfy1 f pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** true if an analysis result exists for the given position. *) let has_any pos = Externalanalysis.has_any_result pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** predicate over all analysis results of a given position. *) let for_all p pos = Externalanalysis.for_all p pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** predicate over all analysis results (at least one) of a given position. *) let for_all1 p pos = Externalanalysis.for_all1 p pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** true if the predicate is satisfied for at least one result of a given position. *) let exists p pos = Externalanalysis.exists p pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** true if the result contains only a single integer as range *) let single_int = Externalanalysis.single_int (** true if the result range contains the given integer. *) let contains_int = Externalanalysis.contains_int (** analysis result of the position has only the zero value. *) let has_only_nul pos = Externalanalysis.has_only_nul pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** analysis result of the position contains also the zero value. *) let has_also_nul pos = Externalanalysis.has_also_nul pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) (** analysis result of the position contains also the given integer. *) let has_also_int c pos = Externalanalysis.has_also_int c pos.file (pos.line, pos.col) (pos.line_end, pos.col_end) end coccinelle-1.0.0-rc19/ocaml/ocamlcocci_aux.mli0000644000175000017500000000013512247437436020136 0ustar eugeneugenval exprrep : Ast_c.expression -> string val stringrep : Ast_c.metavar_binding_kind ->string coccinelle-1.0.0-rc19/ocaml/yes_prepare_ocamlcocci.ml0000644000175000017500000003672212247437436021521 0ustar eugeneugen(* Note: this module passes paths to other commands, but does not take * quoting into account. Thus, if these paths contain spaces, it's likely * that things go wrong. *) module Ast = Ast_cocci exception CompileFailure of string exception LinkFailure of string let ext = if Config.dynlink_is_native then ".cmxs" else ".cma" let sysdir () = let sysdircmd = !Flag.ocamlfind ^ " printconf stdlib" in match Common.cmd_to_list sysdircmd with [sysdir] -> sysdir | _ -> raise (CompileFailure (sysdircmd ^" has failed")) let check_cmd cmd = let (_,stat) = Common.cmd_to_list_and_status cmd in match stat with Unix.WEXITED 0 -> true | _ -> false (* this function does not work when the executable has an extension like .exe *) let to_opt cmd = let n = String.length cmd in if n > 4 && String.compare (String.sub cmd (n-4) 4) ".opt" == 0 then cmd else cmd ^ ".opt" let check_runtime () = let has_opt = check_cmd (to_opt (!Flag.ocamlc) ^ " -version 2>&1 > /dev/null") in let has_c = check_cmd (!Flag.ocamlc ^ " -version 2>&1 > /dev/null") in if has_opt then begin Flag.ocamlc := to_opt (!Flag.ocamlc); Flag.ocamlopt := to_opt (!Flag.ocamlopt); Flag.ocamldep := to_opt (!Flag.ocamldep); Common.pr2 "Using native version of ocamlc/ocamlopt/ocamldep" end else if has_c then Common.pr2 "Using bytecode version of ocamlc/ocamlopt/ocamldep" else if Config.dynlink_is_native then failwith "No OCaml compiler found! Install either ocamlopt or ocamlopt.opt" else failwith "No OCaml compiler found! Install either ocamlc or ocamlc.opt" let init_ocamlcocci _ = "open Coccilib\n" let print_match ctr nm kind = let endlet = "| _ -> failwith \"bad value\" in\n" in let index = !ctr in ctr := !ctr + 1; Printf.sprintf "let %s = match List.nth args %d with Coccilib.%s x -> x %s" nm index kind endlet let string_rep_binding ctr = function (Some nm,Ast.MetaPosDecl _) -> print_match ctr nm "Pos" | (Some nm,Ast.MetaListlenDecl _) -> print_match ctr nm "Int" | (Some nm,_) (* strings for everything else *) -> print_match ctr nm "Str" | (None,_) -> "" let ast_rep_binding ctr = function (Some nm,Ast.MetaPosDecl _) -> failwith (Printf.sprintf "%s: No AST representation for position variables" nm) | (Some nm,Ast.MetaAnalysisDecl _) -> failwith "Todo" | (Some nm,Ast.MetaMetaDecl _) -> failwith (Printf.sprintf "%s: No AST representation for metavariables declared as \"%s\"" "metavariable" nm) | (Some nm,Ast.MetaIdDecl _) -> print_match ctr nm "Str" | (Some nm,Ast.MetaFreshIdDecl _) -> print_match ctr nm "Str" | (Some nm,Ast.MetaTypeDecl _) -> print_match ctr nm "Type" | (Some nm,Ast.MetaInitDecl _) -> print_match ctr nm "Init" | (Some nm,Ast.MetaInitListDecl _) -> print_match ctr nm "InitList" | (Some nm,Ast.MetaListlenDecl _) -> failwith (Printf.sprintf "%s: No AST representation for listlen variables" nm) | (Some nm,Ast.MetaParamDecl _) -> print_match ctr nm "Param" | (Some nm,Ast.MetaParamListDecl _) -> print_match ctr nm "ParamList" | (Some nm,Ast.MetaConstDecl _) -> print_match ctr nm "Expr" | (Some nm,Ast.MetaErrDecl _) -> failwith ("not supported: "^nm) | (Some nm,Ast.MetaExpDecl _) -> print_match ctr nm "Expr" | (Some nm,Ast.MetaIdExpDecl _) -> print_match ctr nm "Expr" | (Some nm,Ast.MetaLocalIdExpDecl _) -> print_match ctr nm "Expr" | (Some nm,Ast.MetaExpListDecl _) -> print_match ctr nm "ExprList" | (Some nm,Ast.MetaDeclDecl _) -> print_match ctr nm "Decl" | (Some nm,Ast.MetaFieldDecl _) -> print_match ctr nm "Field" | (Some nm,Ast.MetaFieldListDecl _) -> print_match ctr nm "FieldList" | (Some nm,Ast.MetaStmDecl _) -> print_match ctr nm "Stmt" | (Some nm,Ast.MetaStmListDecl _) -> failwith ("not supported: "^nm) | (Some nm,Ast.MetaFmtDecl _) -> print_match ctr nm "Fmt" | (Some nm,Ast.MetaFragListDecl _) -> print_match ctr nm "FragList" | (Some nm,Ast.MetaFuncDecl _) -> print_match ctr nm "Str" | (Some nm,Ast.MetaLocalFuncDecl _) -> print_match ctr nm "Str" | (Some nm,Ast.MetaDeclarerDecl _) -> print_match ctr nm "Str" | (Some nm,Ast.MetaIteratorDecl _) -> print_match ctr nm "Str" | (None,_) -> "" let manage_script_vars script_vars = let rec loop n = function [] -> "" | (_,x)::xs -> (Printf.sprintf "let %s = List.nth script_args %d in\n" x n) ^ (loop (n+1) xs) in loop 0 script_vars (* ---------------------------------------------------------------------- *) (* Iteration management *) let print_iteration_code o = let translator l = String.concat "\n | " (List.map (function x -> Printf.sprintf "%s -> \"%s\"" (String.capitalize x) x) l) in let add_virt_rules_method = match !Iteration.parsed_virtual_rules with [] -> "" | l -> Printf.sprintf " method add_virtual_rule r = let r = match r with %s in virtual_rules <- Common.union_set [r] virtual_rules\n" (translator l) in let add_virt_ids_method = match !Iteration.parsed_virtual_identifiers with [] -> "" | l -> Printf.sprintf " method add_virtual_identifier i v = let i = match i with %s in try let v1 = List.assoc i virtual_identifiers in if not (v = v1) then failwith (\"multiple values specified for \"^i) with Not_found -> virtual_identifiers <- (i,v) :: virtual_identifiers" (translator l) in Printf.fprintf o " class iteration () = object val mutable files = None val mutable files_changed = false val mutable virtual_rules = ([] : string list) val mutable virtual_identifiers = ([] : (string * string) list) method set_files f = files <- Some f %s%s method register () = Iteration.add_pending_instance (files,virtual_rules,virtual_identifiers) end\n\n" add_virt_rules_method add_virt_ids_method (* ---------------------------------------------------------------------- *) let prepare_rule (name, metavars, script_vars, code) = let fname = String.concat "_" (Str.split (Str.regexp " ") name) in (* function header *) let function_header body = Printf.sprintf "let %s args script_args =\n %s" fname body in (* parameter list *) let build_parameter_list body = let ctr = ref 0 in let lets = String.concat "" (List.rev (List.fold_left (function prev -> function ((str_nm,ast_nm),_,mv) -> (* order important; ctr is incremented *) let string_rep = string_rep_binding ctr (str_nm,mv) in let ast_rep = ast_rep_binding ctr (ast_nm,mv) in ast_rep :: string_rep :: prev) [] metavars)) in lets ^ (manage_script_vars script_vars) ^ body in (* add to hash table *) let hash_add body = Printf.sprintf "%s\nlet _ = Hashtbl.add Coccilib.fcts \"%s\" %s\n" body name fname in hash_add (function_header (build_parameter_list code)) let prepare coccifile code = let init_rules = List.fold_left (function prev -> function Ast_cocci.InitialScriptRule (name,"ocaml",deps,code) -> code :: prev | _ -> prev) [] code in let init_rules = List.rev init_rules in let other_rules = List.fold_left (function prev -> function Ast_cocci.ScriptRule (name,"ocaml",deps,mv,script_vars,code) -> (name,mv,script_vars,code) :: prev | Ast_cocci.InitialScriptRule (name,"ocaml",deps,code) -> prev | Ast_cocci.FinalScriptRule (name,"ocaml",deps,code) -> (name,[],[],code) :: prev | _ -> prev) [] code in let other_rules = List.rev other_rules in if init_rules = [] && other_rules = [] then None else begin let basefile = Filename.basename (Filename.chop_extension coccifile) in let basefile = String.concat "_" (Str.split (Str.regexp "-") basefile) in let (file,o) = Filename.open_temp_file basefile ".ml" in (* Global initialization *) Printf.fprintf o "%s\n" (init_ocamlcocci()); (* virtual rules and identifiers *) (if !Iteration.parsed_virtual_rules != [] then Printf.fprintf o "type __virtual_rules__ = %s\n\n" (String.concat " | " (List.map String.capitalize !Iteration.parsed_virtual_rules))); (if !Iteration.parsed_virtual_identifiers != [] then Printf.fprintf o "type __virtual_identifiers__ = %s\n\n" (String.concat " | " (List.map (function x -> Printf.sprintf "%s" x) (List.map String.capitalize !Iteration.parsed_virtual_identifiers)))); print_iteration_code o; (* Semantic patch specific initialization *) Printf.fprintf o "%s" (String.concat "\n\n" init_rules); (* Semantic patch rules and finalizer *) let rule_code = List.map prepare_rule other_rules in Printf.fprintf o "%s" (String.concat "\n\n" rule_code); close_out o; check_runtime (); Some file end (* give a path to the coccilib cmi file *) let find_cmifile name = let path1 = Printf.sprintf "%s/ocaml/%s.cmi" Config.path name in if Sys.file_exists path1 then path1 else let path2 = Printf.sprintf "%s/ocaml/coccilib/%s.cmi" Config.path name in if Sys.file_exists path2 then path2 else raise (CompileFailure ("No coccilib.cmi in " ^ path1 ^ " or " ^ path2)) (* extract upper case identifiers from the cmi file. This will be an * approximation of the modules referenced by the coccilib, which are * thus present in the application and do not need to be loaded by * the dynamic linker. *) module ModuleSet = Set.Make(String) let approx_coccilib_deps cmi = let chan = open_in_bin cmi in let tbl = Hashtbl.create 1024 in let buf = Buffer.create 140 in begin try while true do let c = input_char chan in let has_ident = Buffer.length buf > 0 in if has_ident then begin if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '0' && c <= '9') || c == '_' || c == '\'' then Buffer.add_char buf c else begin if Buffer.length buf >= 3 then begin let key = Buffer.contents buf in if Hashtbl.mem tbl key then () else Hashtbl.add tbl (Buffer.contents buf) () end; Buffer.clear buf end end else begin if c >= 'A' && c <= 'Z' then (* perhaps the begin of a capitalized identifier *) Buffer.add_char buf c else () end done with End_of_file -> () end; close_in chan; tbl let filter_dep existing_deps (accld, accinc) dep = if Hashtbl.mem existing_deps dep then (accld, accinc) (* skip an existing dep *) else match dep with (* Built-in and OCaml defaults are filtered out *) "Arg" | "Arith_status" | "Array" | "ArrayLabels" | "Big_int" | "Bigarray" | "Buffer" | "Callback" | "CamlinternalLazy" | "CamlinternalMod" | "CamlinternalOO" | "Char" | "Complex" | "Condition" | "Digest" | "Dynlink" | "Event" | "Filename" | "Format" | "Gc" | "Genlex" | "GraphicsX11" | "Hashtbl" | "Int32" | "Int64" | "Lazy" | "Lexing" | "List" | "ListLabels" | "Map" | "Marshal" | "MoreLabels" | "Mutex" | "Nativeint" | "Num" | "Obj" | "Oo" | "Parsing" | "Pervasives" | "Printexc" | "Printf" | "Queue" | "Random" | "Scanf" | "Set" | "Sort" | "Stack" | "StdLabels" | "Str" | "Stream" | "String" | "StringLabels" | "Sys" | "ThreadUnix" | "Unix" | "UnixLabels" | "Weak" -> (accld, accinc) | "Dbm" -> ("dbm"::accld, accinc) | "Graphics" -> ("graphics"::accld, accinc) | "Thread" -> ("thread"::accld, accinc) | "Tk" -> ("tk"::accld, accinc) | _ -> let l = Char.lowercase (String.get dep 0)in String.set dep 0 l; (accld, dep::accinc) let get_dir p = let inclcmd = !Flag.ocamlfind ^" query "^p in let dir = List.hd (Common.cmd_to_list inclcmd) in (dir, p) let parse_dep cmifile mlfile depout = let empty_deps = ([], "") in let existing_deps = approx_coccilib_deps cmifile in let re_colon = Str.regexp_string ":" in match Str.split re_colon depout with _::[dep] -> let deplist = Str.split (Str.regexp_string " ") dep in let (libs, orderdep) = List.fold_left (filter_dep existing_deps) ([],[]) deplist in if libs <> [] || orderdep <> [] then begin if check_cmd (!Flag.ocamlfind ^ " printconf 2>&1 > /dev/null") then let packages = List.rev orderdep in let inclflags = List.map get_dir packages in let intlib = List.map get_dir libs in let alllibs = List.rev_append intlib inclflags in let plist = List.fold_left (fun acc (_,p) -> acc ^" "^p) "" alllibs in let flags = String.concat " " (List.map (fun (d,_) -> "-I "^d) inclflags) in if flags <> "" || libs <> [] then begin Common.pr2 ("Extra OCaml packages used in the semantic patch:"^ plist); (alllibs, flags) end else begin Common.pr2 ("Warning: ocamlfind did not find "^ (if (List.length libs + List.length orderdep) = 1 then "this package:" else "one of these packages:")^ plist); empty_deps end else begin Common.pr2 ("Warning: ocamlfind not found but "^mlfile^" uses "^dep); empty_deps end end else empty_deps | _ -> raise (CompileFailure ("Wrong dependencies for "^mlfile^" (Got "^depout^")")) let dep_flag cmifile mlfile = let depcmd = !Flag.ocamldep ^" -modules "^mlfile in match Common.cmd_to_list depcmd with [dep] -> parse_dep cmifile mlfile dep | err -> List.iter (function x -> Common.pr2 (x^"\n")) err; raise (CompileFailure ("Failed ocamldep for "^mlfile)) let compile_bytecode_cmd flags mlfile = let obj = (Filename.chop_extension mlfile) ^ ".cmo" in (obj, Printf.sprintf "%s -c %s %s %s" !Flag.ocamlc obj flags mlfile) let compile_native_cmd flags mlfile = let obj = (Filename.chop_extension mlfile) ^ ".cmxs" in (obj, Printf.sprintf "%s -shared -o %s %s %s" !Flag.ocamlopt obj flags mlfile) let compile mlfile cmd = Common.pr2 cmd; match Sys.command cmd with 0 -> () | _ -> raise (CompileFailure mlfile) let load_obj obj = Dynlink.allow_unsafe_modules true; try Dynlink.loadfile obj with Dynlink.Error e -> Common.pr2 (Dynlink.error_message e); raise (LinkFailure obj) let load_lib (dir, name) = let obj = dir ^ "/" ^name ^ ext in Common.pr2 ("Loading "^ obj ^"..."); load_obj obj let load_libs libs = List.iter load_lib libs let load_file mlfile = let cmifile = find_cmifile "coccilib" in let (ldlibs, inc) = dep_flag cmifile mlfile in (* add ocaml and ocaml/coccilib as search directories for the ocaml scripting *) let flags = Printf.sprintf "-g -I %s %s -I %s" (sysdir ()) inc (Filename.dirname cmifile) in let (obj, cmd) = if Config.dynlink_is_native then compile_native_cmd flags mlfile else compile_bytecode_cmd flags mlfile in compile mlfile cmd; Common.pr2 "Compilation OK!"; load_libs ldlibs; Common.pr2 "Loading ML code of the SP..."; load_obj obj let clean_file mlfile = let basefile = Filename.chop_extension mlfile in let files = if Config.dynlink_is_native then [basefile ^ ".cmxs"; basefile ^ ".cmx"; basefile ^ ".o"; basefile ^ ".annot"] else [basefile ^ ".cmo"; basefile ^ ".annot"] in if not !Flag_parsing_cocci.keep_ml_script then Sys.remove mlfile; Sys.remove (basefile^".cmi"); List.iter (fun f -> try Sys.remove f with _ -> ()) files (* This function is used in testing.ml. Once the ML file is compiled and loaded, newly available functions are reported here. *) let test () = Hashtbl.iter (fun key fct -> Common.pr2 ("Fct registered: \""^key^"\"") ) Coccilib.fcts coccinelle-1.0.0-rc19/ocaml/coccilib/0000755000175000017500000000000012247437436016232 5ustar eugeneugencoccinelle-1.0.0-rc19/ocaml/ocaml.mldylib0000644000175000017500000000007112247437436017132 0ustar eugeneugenCoccilib Ocamlcocci_aux Run_ocamlcocci Prepare_ocamlcoccicoccinelle-1.0.0-rc19/ocaml/prepare_ocamlcocci.ml.in0000644000175000017500000000003412247437436021231 0ustar eugeneugeninclude @OCAMLCOCCI_MODULE@ coccinelle-1.0.0-rc19/ocaml/run_ocamlcocci.ml0000644000175000017500000000463512247437436020005 0ustar eugeneugenopen Common let string_binding vl = function None -> [] | Some _ -> [match vl with Ast_c.MetaPosValList l -> let locs = List.map (function (fname,current_element,(line,col),(line_end,col_end)) -> { Coccilib.current_element = current_element; Coccilib.file = fname; Coccilib.line = line; Coccilib.col = col; Coccilib.line_end = line_end; Coccilib.col_end = col_end }) l in Coccilib.Pos locs | Ast_c.MetaListlenVal n -> Coccilib.Int n | _ -> Coccilib.Str (Ocamlcocci_aux.stringrep vl)] let ast_binding vl = function None -> [] | Some _ -> [match vl with Ast_c.MetaIdVal(id,_) | Ast_c.MetaFuncVal id | Ast_c.MetaLocalFuncVal id -> Coccilib.Str id | Ast_c.MetaExprVal(expr,_) -> Coccilib.Expr expr | Ast_c.MetaExprListVal arglist -> Coccilib.ExprList arglist | Ast_c.MetaParamVal param -> Coccilib.Param param | Ast_c.MetaParamListVal paramlist -> Coccilib.ParamList paramlist | Ast_c.MetaTypeVal ty -> Coccilib.Type ty | Ast_c.MetaInitVal init -> Coccilib.Init init | Ast_c.MetaInitListVal init -> Coccilib.InitList init | Ast_c.MetaDeclVal decl -> Coccilib.Decl decl | Ast_c.MetaFieldVal field -> Coccilib.Field field | Ast_c.MetaFieldListVal field -> Coccilib.FieldList field | Ast_c.MetaStmtVal stm -> Coccilib.Stmt stm | Ast_c.MetaFragListVal frags -> Coccilib.FragList frags | Ast_c.MetaFmtVal fmt -> Coccilib.Fmt fmt | Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _ | Ast_c.MetaListlenVal _ -> failwith "not associated with a declared metavariable"] let run mv ve script_vars name code = (* set up variables *) let find_binding (r,m) = try let elem = List.find (function ((re,rm),_) -> r =*= re && m =$= rm) ve in Some elem with Not_found -> None in let args = List.concat (List.map (function ((str_name,ast_name),(r,m),_) -> match find_binding (r,m) with None -> [] | Some (_,vl) -> (string_binding vl str_name) @ (ast_binding vl ast_name)) mv) in let script_args = List.map (function _ -> ref "") script_vars in (* call the function *) Coccilib.include_match true; Coccilib.exited := false; let fn = try Hashtbl.find Coccilib.fcts name with Not_found -> failwith (Printf.sprintf "%s not found" name) in fn args script_args; List.map (function x -> !x) script_args coccinelle-1.0.0-rc19/ocaml/Makefile0000644000175000017500000000552012247437436016125 0ustar eugeneugen############################################################################## # Variables ############################################################################## ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=cocciocaml SRC=exposed_modules.ml coccilib.ml ocamlcocci_aux.ml $(OCAMLCOCCI_FILE) prepare_ocamlcocci.ml run_ocamlcocci.ml #LIBS=../commons/commons.cma ../parsing_c/parsing_c.cma #INCLUDES= -I ../commons -I ../parsing_c INCLUDES = -I ../commons -I ../commons/ocamlextra -I ../globals \ -I ../parsing_cocci -I ../parsing_c -I ../engine LIBS=../commons/commons.cma ../globals/globals.cma \ ../parsing_c/parsing_c.cma ../parsing_cocci/cocci_parser.cma SYSLIBS= str.cma unix.cma ############################################################################## # Generic variables ############################################################################## #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLCFLAGS ?= -g OPTFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ############################################################################## # Top rules ############################################################################## ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).cma: $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) $(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa) $(OCAMLOPT_CMD) -a -o $(TARGET).cmxa $(OPTOBJS) $(TARGET).top: $(OBJS) $(LIBS) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) clean:: rm -f $(TARGET).top else all: cd .. && $(OCAMLBUILD) ocaml/ocaml.cma all.opt: cd .. && $(OCAMLBUILD) ocaml/ocaml.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif include Makefile.doc ############################################################################## # Pad's rules ############################################################################## ############################################################################## # Generic rules ############################################################################## .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< .ml.mldepend: $(OCAMLC_CMD) -i $< clean:: rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# rm -f .depend distclean: clean rm -f coccilib/coccilib.cmi .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(MAKECMDGOALS),cleandoc) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/ocaml/run_ocamlcocci.mli0000644000175000017500000000044112247437436020145 0ustar eugeneugenval run : (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar) list -> Ast_c.metavars_binding (*virts*) -> Ast_cocci.meta_name list (*fresh vars*) -> string (*rule name*) -> string (*code*) -> string list (* final values of script vars *) coccinelle-1.0.0-rc19/ocaml/man.odocl0000644000175000017500000000007412247437436016261 0ustar eugeneugenCommon Ast_c Visitor_c Lib_parsing_c Iteration Flag Coccilibcoccinelle-1.0.0-rc19/ocaml/Makefile.doc0000644000175000017500000000252012247437436016666 0ustar eugeneugenifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif DEST=../docs FLAGS=$(INCLUDES) -hide Pervasives HTMLFLAGS=-all-params -colorize-code MANFLAGS=-man-mini .PHONY: doc doc: html man html: $(DEST)/html/index.html man: $(DEST)/man/Coccilib.3o ifneq ($(FEATURE_OCAMLBUILD),yes) $(DEST)/man/Coccilib.3o: coccilib.cmi ../parsing_c/ast_c.cmi $(MKDIR_P) $(DEST)/man $(OCAMLDOC) $(FLAGS) -hide Exposed_modules \ -man $(MANFLAGS) -d $(DEST)/man ../parsing_c/ast_c.ml coccilib.ml $(DEST)/html/index.html: coccilib.cmi ../parsing_c/ast_c.cmi $(MKDIR_P) $(DEST)/html $(OCAMLDOC) $(FLAGS) -hide Exposed_modules \ -html $(HTMLFLAGS) -d $(DEST)/html ../parsing_c/ast_c.ml coccilib.ml else $(DEST)/man/Coccilib.3o: ../_build/ocaml/coccilib.cmi coccilib.ml exposed_modules.ml man.odocl $(MKDIR_P) $(DEST)/man cd .. && $(OCAMLBUILD) ocaml/man.docdir/index.html cp -r ../_build/ocaml/man.docdir/* $(DEST)/man/ $(DEST)/html/index.html: ../_build/ocaml/coccilib.cmi coccilib.ml exposed_modules.ml html.odocl $(MKDIR_P) $(DEST)/html cd .. && $(OCAMLBUILD) ocaml/html.docdir/index.html cp -r ../_build/ocaml/html.docdir/* $(DEST)/html/ # build coccilib.cmi if needed ../_build/ocaml/coccilib.cmi: cd .. && $(OCAMLBUILD) ocaml/coccilib.cmi endif cleandoc: @if test -z "${KEEP_GENERATED}"; then \ rm -rf $(DEST)/html $(DEST)/man; fi coccinelle-1.0.0-rc19/ocaml/ocamlcocci_aux.ml0000644000175000017500000000371612247437436017775 0ustar eugeneugen(* sams as for python; perhaps this could be put somewhere else *) open Ast_c open Common let caller s f a = let str = ref ([] : string list) in let pr_elem info = str := (Ast_c.str_of_info info) :: !str in let pr_sp _ = () in f ~pr_elem ~pr_space:pr_sp a; String.concat s (List.rev !str) let call_pretty f a = caller " " f a let call_pretty0 f a = caller "" f a let exprrep = call_pretty Pretty_print_c.pp_expression_gen let stringrep = function Ast_c.MetaIdVal (s,_) -> s | Ast_c.MetaFuncVal s -> s | Ast_c.MetaLocalFuncVal s -> s | Ast_c.MetaExprVal (expr,_) -> exprrep expr | Ast_c.MetaExprListVal expr_list -> call_pretty Pretty_print_c.pp_arg_list_gen expr_list | Ast_c.MetaTypeVal typ -> call_pretty Pretty_print_c.pp_type_gen typ | Ast_c.MetaInitVal ini -> call_pretty Pretty_print_c.pp_init_gen ini | Ast_c.MetaInitListVal ini -> call_pretty Pretty_print_c.pp_init_list_gen ini | Ast_c.MetaDeclVal declaration -> call_pretty Pretty_print_c.pp_decl_gen declaration | Ast_c.MetaFieldVal field -> call_pretty Pretty_print_c.pp_field_gen field | Ast_c.MetaFieldListVal field -> call_pretty Pretty_print_c.pp_field_list_gen field | Ast_c.MetaStmtVal statement -> call_pretty Pretty_print_c.pp_statement_gen statement | Ast_c.MetaParamVal param -> call_pretty Pretty_print_c.pp_param_gen param | Ast_c.MetaParamListVal params -> call_pretty Pretty_print_c.pp_param_list_gen params | Ast_c.MetaFragListVal frags -> call_pretty0 Pretty_print_c.pp_string_fragment_list_gen frags | Ast_c.MetaFmtVal fmt -> call_pretty0 Pretty_print_c.pp_string_format_gen fmt | Ast_c.MetaListlenVal n -> string_of_int n | Ast_c.MetaPosVal (pos1, pos2) -> let print_pos = function Ast_cocci.Real x -> string_of_int x | Ast_cocci.Virt(x,off) -> Printf.sprintf "%d+%d" x off in Common.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2) | Ast_c.MetaPosValList positions -> "TODO: <>" coccinelle-1.0.0-rc19/copyright.txt0000644000175000017500000000202212247437436016135 0ustar eugeneugenCoccinelle - Julia Lawall, Yoann Padioleau, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix Copyright (C) 2010 INRIA, University of Copenhagen DIKU Copyright (C) 2005-2009 University of Copenhagen DIKU, Ecole des Mines de Nantes This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License (GPL) version 2 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file license.txt for more details. The contents of some files in this directory was derived from external sources with compatible licenses. The original copyright and license notice was preserved in the affected files. This software can be distributed under another license (dual license) making it possible to use Coccinelle in a commercial software. Contact one of the authors for more information. coccinelle-1.0.0-rc19/demos/0000755000175000017500000000000012247437436014477 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/platform_ifdef.c0000644000175000017500000000024312247437436017623 0ustar eugeneugenvoid main() { buf = alloca(3 #ifdef PLATFORM_A +5 #endif #ifdef PLATFORM_B +2 #endif ); } coccinelle-1.0.0-rc19/demos/orgmode.cocci0000644000175000017500000000151712247437436017141 0ustar eugeneugen@initialize:python@ from coccilib.org import print_todo, print_safe_todo, print_link, print_safe_link @r@ position p1, p2; identifier f; expression E; @@ f@p1(E@p2) @ script:python @ p1 << r.p1; p2 << r.p2; f << r.f; @@ print_todo (p1[0]) print_link (p2[0]) print "" print_safe_todo (p1[0], "arr[i]") print_safe_link (p2[0], "arr[i]") print "" coccilib.org.print_todo (p1[0]) coccilib.org.print_link (p2[0]) print "" coccilib.org.print_safe_todo (p1[0], "arr[i]") coccilib.org.print_safe_link (p2[0], "arr[i]") print "" cocci.print_main ("foo", p1) cocci.print_sec ("foo", p2) cocci.print_secs ("foo", p2) print "" cocci.print_main ("", p1) cocci.print_sec ("", p2) cocci.print_secs ("", p2) print "" cocci.print_main ("foo", p1, "ovl-face3") cocci.print_sec ("foo", p2, "ovl-face4") cocci.print_secs ("foo", p2, "ovl-face4") coccinelle-1.0.0-rc19/demos/first.cocci0000644000175000017500000000050212247437436016625 0ustar eugeneugen@initialize:python@ first = 0 @first_fct@ type T; identifier f; position p; @@ T f@p (...) {...} @script:python@ p << first_fct.p; @@ if p[0].line > first and first == 0: first = p[0].line else: cocci.include_match(False) @@ type T; identifier f; position first_fct.p; @@ +#include T f@p (...) {...} coccinelle-1.0.0-rc19/demos/itimer.cocci0000644000175000017500000000036112247437436016772 0ustar eugeneugen@@ @@ - if (cputime_eq(cputime, cputime_zero)) - cputime = jiffies_to_cputime(1); + if (cputime_gt(cputime, cputime_zero)) + cputime = cputime_add(cputime, + jiffies_to_cputime(1)); coccinelle-1.0.0-rc19/demos/iso-kzalloc.cocci0000644000175000017500000000024512247437436017731 0ustar eugeneugen// A*B is not just a toy isomorphism :) it's really useful sometimes. @@ expression E; constant c; type T; @@ -kzalloc(c * sizeof(T), E) +kcalloc(c, sizeof(T), E) coccinelle-1.0.0-rc19/demos/printloc.cocci0000644000175000017500000000123612247437436017335 0ustar eugeneugen@r@ position p1, p2; identifier f; expression E; @@ f@p1(E@p2) @ script:python @ p1 << r.p1; p2 << r.p2; f << r.f; @@ c1 = cocci.combine(f,p1) c2 = cocci.combine(f,p2) print "1. function in column %s" % c1.location.column print "1. argument in column %s" % c2.location.column c1 = cocci.combine(f,p1) print "2. function in column %s" % c1.location.column c2 = cocci.combine(f,p2) print "2. argument in column %s" % c2.location.column print "3. function in column %s" % ','.join([p.column for p in p1]) print "3. argument in column %s" % ','.join([p.column for p in p2]) print "4. function in column %s" % p1[0].column print "4. argument in column %s" % p2[0].column coccinelle-1.0.0-rc19/demos/launch.sh0000755000175000017500000000030712247437436016310 0ustar eugeneugen#! /bin/sh ARGS="-no_show_ctl_text -no_show_transinfo -no_parse_error_msg -no_show_misc -no_type_error_msg"; for i in *.c do ../spatch $ARGS -iso_file ../standard.iso -cocci_file ${i}occi $i done coccinelle-1.0.0-rc19/demos/pythontococci.cocci0000644000175000017500000000033112247437436020363 0ustar eugeneugen@a@ identifier x; @@ foo(x); @script:python b@ x << a.x; y; z; @@ print y coccinelle.y = x coccinelle.z = "something" print y @c@ identifier b.y; identifier b.z; identifier a.x; @@ - bar(); + matched_bar(y,z,x); coccinelle-1.0.0-rc19/demos/virt.c0000644000175000017500000000001712247437436015625 0ustar eugeneugenint main () {} coccinelle-1.0.0-rc19/demos/external_ana.cocci0000644000175000017500000000237312247437436020147 0ustar eugeneugen/* Given a file with data about the integer values that variables x can take at certain positions, this patch identifies some then-branches of if(x) ... statements. Run this example from the coccinelle main directory using: ./scripts/spatch --sp-file demos/external_ana.cocci demos/external_ana.c \ --external-analysis-file demos/external_ana.data The analysis input was produced with a custom-made plugin for frama-c that produced the external_ana.data file using the commandline: frama-c -load-module ValueExport.cmxs -value-export \ -export-file ./external_ana.data external_ana.c */ @r@ idexpression x; position p, q; statement S; @@ if@q (x@p) S @script:ocaml@ x << r.x; p << r.p; @@ let p1 = Coccilib.basename_pos (List.hd p) in Printf.printf "considering %s at position %s:(%d,%d)-(%d,%d):\n" x p1.Coccilib.file p1.Coccilib.line p1.Coccilib.col p1.Coccilib.line_end p1.Coccilib.col_end; let rs = Coccilib.Ana.find p1 in Printf.printf " results: %d\n" (List.length rs); List.iter (fun r -> Printf.printf " value: %s\n" (Coccilib.Ana.show_result r)) rs; let is_z = Coccilib.Ana.has_only_nul p1 in Printf.printf " Always zero: %B\n" is_z; Coccilib.include_match is_z @@ position r.q; statement S; @@ - if@q (...) S coccinelle-1.0.0-rc19/demos/pycocci.c0000644000175000017500000000041012247437436016267 0ustar eugeneugen#include const int qqq = 20; void foo() { int z[10]; z[2] = 34; } int main() { int buf[qqq], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/demos/manual/0000755000175000017500000000000012247437436015754 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/manual/already_tagged.c0000644000175000017500000000015212247437436021052 0ustar eugeneugen/* diamond example */ void main(int i) { foo(); if(1) bar(1); else bar(2); foobar(); } coccinelle-1.0.0-rc19/demos/manual/get_put_full.cocci0000644000175000017500000000010312247437436021441 0ustar eugeneugen@@ identifier fn; @@ fn(...) { ... get(); ... put(); ... } coccinelle-1.0.0-rc19/demos/manual/get_put_ver1.c0000644000175000017500000000011712247437436020523 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); return 0; } put(); } coccinelle-1.0.0-rc19/demos/manual/get_put.c0000644000175000017500000000010112247437436017557 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); } put(); } coccinelle-1.0.0-rc19/demos/manual/get_put_full.c0000644000175000017500000000010112247437436020601 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); } put(); } coccinelle-1.0.0-rc19/demos/manual/get_put.cocci0000644000175000017500000000004612247437436020425 0ustar eugeneugen@@ @@ get(); ... -put(); +putput(); coccinelle-1.0.0-rc19/demos/manual/already_tagged.cocci0000644000175000017500000000011112247437436021703 0ustar eugeneugen@@ expression x; @@ foo(); ... bar(x); ... - foobar(); + foobar(x); coccinelle-1.0.0-rc19/demos/ioctl_multiple_rules.cocci0000644000175000017500000000033712247437436021743 0ustar eugeneugen// can constraint to specific function by using multiple rules @ rule1 @ struct file_operations x; identifier ioctl_fn; @@ x.ioctl = ioctl_fn; @@ identifier rule1.ioctl_fn; @@ ioctl_fn(...) { - foo(1); + foo(2); } coccinelle-1.0.0-rc19/demos/check_region.cocci0000644000175000017500000000027112247437436020121 0ustar eugeneugen@@ expression e1, e2; @@ - if(check_region(e1,e2)!=0) + if(!request_region(e1,e2)) { ... return ...; } <... + release_region(e1); return ...; ...> - request_region(e1,e2); coccinelle-1.0.0-rc19/demos/assignment_matching.cocci0000644000175000017500000000124112247437436021521 0ustar eugeneugen// This only matches cases where the assignment is a complete statement @@ expression x; @@ -x = f(3); +matches_little(); // This matches also cases where the assignment is a subterm of another // statement, such as a conditional. @@ expression x; @@ -x = g(3) +matches_more() // An isomorphism will let this also match cases where the type is not there @@ expression x; type T; @@ -x = (T)h(3) +matches_even_more() // This matches a variable declaration too. There are constraints on // the transformation performed in this case, as it must ensure that the result // will also be a variable declaration. @@ expression x; type T; @@ x = -(T)i(3) +matches_most() coccinelle-1.0.0-rc19/demos/headers.cocci0000644000175000017500000000223112247437436017112 0ustar eugeneugen// This file illustrates the various items that can be used at the beginning // of a semantic patch, or at the beginning of a rule // The following illustrates how to include a file of isomorphisms located // in the default path, as indicated by config. Uncommenting the following // will give and error, because standard.iso is already loaded by default // and it is not allowed to load two isomorphisms with the same name // using using "headers.iso" // an iso file in the current directory @ rule0 @ @@ - a + b @ rule1 // rule name extends rule0 // inherit the metavariables from rule0 depends on rule0 && !rule0 // now this rule will never be applied ... using "headers2.iso" // more iso files can be included, separated by commas disable three, drop_cast // isos should apply to f and x, but not m @ @@ ( - f(3) + fff(12) | - x(3) + xxx(12) | - m(3) + mmm(12) ) @ rule2 // rule name extends rule0 // inherit the metavariables from rule0 depends on rule0 && !rule0 // now this rule will never be applied ... using "headers2.iso" // more iso files can be included, separated by commas @ @@ ( - f(3) + fff(12) | - x(3) + xxx(12) | - m(3) + mmm(12) ) coccinelle-1.0.0-rc19/demos/interprocedural_adhoc.c0000644000175000017500000000026112247437436021202 0ustar eugeneugen void ioctl(int i) { g(1); h(2); w(3); z(4); } void g(int i) { bar(1); } void h(int i) { bar(1); } void w(int i) { bar(1); } void z(int i) { bar(1); } coccinelle-1.0.0-rc19/demos/ctr_unit_test.c0000644000175000017500000000060612247437436017533 0ustar eugeneugen int classA(int i) { if(classA()) { x=0; } UnitTestEntry("A1"); if(MethodA1()) { } if(MethodA2()) { } UnitTestEntry("A3"); if(MethodA3()) { } if(MethodA4()) { } } int classB(int i) { if(classB()) { x=0; } if(MethodB1()) { } UnitTestEntry("B2"); if(MethodB2()) { } if(MethodB3()) { } UnitTestEntry("B4"); if(MethodB4()) { } } int lastfunction(int i) { } coccinelle-1.0.0-rc19/demos/ctr_unit_test.cocci0000644000175000017500000000246412247437436020375 0ustar eugeneugen@ rule1 @ identifier C; @@ int C(int i) { ... if(C()) { ... } ... + if(UnitTest()) { + int c; + C(); + } } @@ identifier TestMethod; expression name; statement S1,S2; identifier rule1.C; // if put identifier name; then cocci does not help // to say that there is a partial match :( @@ // int C(int i) { // ... // UnitTestEntry(name); // if(TestMethod()) { ... } // ... // if(UnitTest()) { // int c; // ... //+ c = C(); //+ Console.WriteLine("invoking test", name); //+ c.TestMethod(); // } // } // int C(int i) { // <... UnitTestEntry(...); ...> // UnitTestEntry(name); // if(TestMethod()) { ... } // <... UnitTestEntry(...); ...> // } // or simply (does not work ) // int C(int i) { // <... // UnitTestEntry(name); // if(TestMethod()) { ... } // ...> // } // or int C(int i) { // <... UnitTestEntry(name); if(TestMethod()) { ... } ...> // <... UnitTestEntry(...); if(...) { ... } ...> <... S1 ...> UnitTestEntry(name); if(TestMethod()) { ... } <... S2 ...> // <... UnitTestEntry(...); if(...) { ... } ...> // <... UnitTestEntry(name); if(TestMethod()) { ... } ...> } @@ identifier rule1.C; @@ int C(int i) { ... if(UnitTest()) { int c; ... + c = C(); + Console.WriteLine("invoking test", name); + c.TestMethod(); } } coccinelle-1.0.0-rc19/demos/itimer.res0000644000175000017500000000207112247437436016503 0ustar eugeneugen int do_setitimer(int which, struct itimerval *value, struct itimerval *ovalue) { unsigned long expire; cputime_t cputime; int k; if (ovalue && (k = do_getitimer(which, ovalue)) < 0) return k; switch (which) { case ITIMER_VIRTUAL: cputime = timeval_to_cputime(&value->it_value); if (cputime_gt(cputime, cputime_zero)) cputime = cputime_add(cputime, jiffies_to_cputime(1)); current->it_virt_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_virt_incr = cputime; break; case ITIMER_PROF: cputime = timeval_to_cputime(&value->it_value); if (cputime_gt(cputime, cputime_zero)) cputime = cputime_add(cputime, jiffies_to_cputime(1)); current->it_prof_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_prof_incr = cputime; break; default: return -EINVAL; } return 0; }coccinelle-1.0.0-rc19/demos/posmult.c0000644000175000017500000000017212247437436016346 0ustar eugeneugenint main() { int *x = NULL; int *y = NULL; if (r) x = ALLOC(); y = ALLOC(); if (!x) return; if (!y) return; } coccinelle-1.0.0-rc19/demos/check_region.c0000644000175000017500000000051112247437436017260 0ustar eugeneugenint main(int i) { if(check_region(piix,8)){ printk("error1"); return -ENODEV; } if(force_addr) { printk("warning1"); } else if((temp & 1) == 0) { if(force) { printk("warning2"); } else { printk("error2"); return -ENODEV; } } request_region(piix,8); printk("done"); } coccinelle-1.0.0-rc19/demos/macro_fix_standard.h0000644000175000017500000000026612247437436020503 0ustar eugeneugen// use this file with the -macro_file option of spatch. // ex: ./spatch -macro_file demos/macro_fix_standard.h -parse_c demos/macro_parsing_problem.c #define MALLOC(A) malloc(a); coccinelle-1.0.0-rc19/demos/foobar.c0000644000175000017500000000023212247437436016110 0ustar eugeneugen// cf first slide of OLS void main (int x) { foo(1); h("toto"); foo(2); foo(foo(2)); if(foo(3)) { int foo; do_something(foo); } } coccinelle-1.0.0-rc19/demos/type_fields.cocci0000644000175000017500000000007312247437436020010 0ustar eugeneugen@@ struct file_operations x; @@ - x.ioctl + x.new_ioctl coccinelle-1.0.0-rc19/demos/depend.cocci0000644000175000017500000000056512247437436016746 0ustar eugeneugen// this illustrates various complex dependencies @a@ position p; @@ a@p(); @b@ position p; @@ b@p(); @c@ position p; @@ c@p(); @script:python depends on a@ @@ print "a is ok" @script:python depends on !a@ @@ print "a is not ok" @script:python depends on (a && b) || c@ @@ print "a and b or c" @script:python depends on !(!a && !b) || c@ @@ print "a or b or c" coccinelle-1.0.0-rc19/demos/janitorings/0000755000175000017500000000000012247437436017026 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/janitorings/is_power_of_2.cocci0000644000175000017500000000511112247437436022562 0ustar eugeneugen// From: vignesh babu // Subject: [KJ] [PATCH]is_power_of_2-ntfs // To: aia21@cantab.net // Cc: linux-ntfs-dev@lists.sourceforge.net, // Kernel Janitors List , // linux-kernel // Date: Thu, 14 Jun 2007 13:39:04 +0530 // Organization: WIPRO Technologies // Reply-To: vignesh.babu@wipro.com // // // Replacing (n & (n-1)) in the context of power of 2 checks // with is_power_of_2 // // Signed-off-by: vignesh babu // --- // diff --git a/fs/ntfs/inode.c b/fs/ntfs/inode.c // index b532a73..8152f79 100644 // --- a/fs/ntfs/inode.c // +++ b/fs/ntfs/inode.c // @@ -27,6 +27,7 @@ // #include // #include // #include // +#include // // #include "aops.h" // #include "attrib.h" // @@ -1574,7 +1575,7 @@ static int ntfs_read_locked_index_inode(struct inode *base_vi, struct inode *vi) // ntfs_debug("Index collation rule is 0x%x.", // le32_to_cpu(ir->collation_rule)); // ni->itype.index.block_size = le32_to_cpu(ir->index_block_size); // - if (ni->itype.index.block_size & (ni->itype.index.block_size - 1)) { // + if (!is_power_of_2(ni->itype.index.block_size)) { // ntfs_error(vi->i_sb, "Index block size (%u) is not a power of " // "two.", ni->itype.index.block_size); // how deal with extra '()' // - while ((big_pow2 & (big_pow2 - 1)) != 0) // + while (!is_power_of_2(big_pow2)) // // // - if (ubi->min_io_size == 0 || // - (ubi->min_io_size & (ubi->min_io_size - 1))) { // + if (!is_power_of_2(ubi->min_io_size)) { // // - if ((arg & (arg-1)) != 0 || arg < 1) { // + if (!is_power_of_2(arg)) { // // // // do something general for those != 0 ? always redundant ? // - if (bsize < 512 || bsize > 4096 || (bsize & (bsize - 1)) != 0) // + if (bsize < 512 || bsize > 4096 || !is_power_of_2(bsize)) // // - if (!bits || (bits & (bits - 1))) // + if (!is_power_of_2(bits)) // // // - J_ASSERT ((hash_size & (hash_size-1)) == 0); // + J_ASSERT (is_power_of_2(hash_size)); // // - if ((new_size & (new_size - 1)) != 0) { // + if (!is_power_of_2(new_size)){ // // #include "xfs_quota.h" // #include "xfs_acl.h" // // +#include // // // - return !(size % (PAGE_SIZE >> 9) || (size & (size - 1)) || // + return !(size % (PAGE_SIZE >> 9) || !is_power_of_2(size) || // script found on KJ: // grep -e "([^\(\)]+) ?\& ?\(\1 ?- ?1\)" @ rule1 @ expression n; @@ - n & (n-1) + !is_power_of_2(n) @ rule2 depends on rule1 @ @@ #include + #include coccinelle-1.0.0-rc19/demos/janitorings/kzalloc-orig.cocci0000644000175000017500000001311312247437436022424 0ustar eugeneugen// have to duplicate a lot of rules because T E only matches if E has a known // type, even if T is not used elsewhere. // originally, the whens were when != x, but that doesn't work because x // only binds to the outermost expression, not all possible expressions, and // the value returned by kmalloc is usually used as a subexpression. // so we have considered the typical uses that may cause problems; a function // call or dereference //\(x->fld\|f(...,x,...)\|x=E\) @@ type T, T2; expression x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S; @@ - x = (T)kmalloc(E1,E2) + x = kzalloc(E1,E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); @@ type T, T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ - x = (T)kmalloc(sizeof(T1),E2) + x = kzalloc(sizeof(T1),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); @@ type T, T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ - x = (T)kmalloc(sizeof(*x),E2) + x = kzalloc(sizeof(*x),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T, T2; expression x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S, S1; @@ - x = (T)kmalloc(E1,E2) + x = kzalloc(E1,E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); ... } else S1 @@ type T, T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ - x = (T)kmalloc(sizeof(T1),E2) + x = kzalloc(sizeof(T1),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); ... } else S1 @@ type T, T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ - x = (T)kmalloc(sizeof(*x),E2) + x = kzalloc(sizeof(*x),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); ... } else S1 // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S; @@ - T1 x = (T)kmalloc(E1,E2); + T1 x = kzalloc(E1,E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ - T1 x = (T)kmalloc(sizeof(T1),E2); + T1 x = kzalloc(sizeof(T1),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ - T1 x = (T)kmalloc(sizeof(*x),E2); + T1 x = kzalloc(sizeof(*x),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S, S1; @@ - T1 x = (T)kmalloc(E1,E2); + T1 x = kzalloc(E1,E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); ... } else S1 @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ - T1 x = (T)kmalloc(sizeof(T1),E2); + T1 x = kzalloc(sizeof(T1),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); ... } else S1 @@ type T, T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ - T1 x = (T)kmalloc(sizeof(*x),E2); + T1 x = kzalloc(sizeof(*x),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); ... } else S1 // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ expression E1,E2,E3; @@ - kzalloc(E1 * E2,E3) + kcalloc(E1,E2,E3) coccinelle-1.0.0-rc19/demos/janitorings/netdev_find_allocfunc.c0000644000175000017500000000017012247437436023503 0ustar eugeneugenstruct net_device *alloc_etherdev(int sizeof_priv) { return alloc_netdev(sizeof_priv, "eth%d", ether_setup); } coccinelle-1.0.0-rc19/demos/janitorings/kzalloc-fix.cocci0000644000175000017500000000021212247437436022246 0ustar eugeneugen// iso X * Y will handle the variations @@ expression E; constant c; type T; @@ - kzalloc(sizeof(T) * c, E) + kcalloc(c, sizeof(T), E) coccinelle-1.0.0-rc19/demos/janitorings/list_for_each.cocci0000644000175000017500000000136612247437436022637 0ustar eugeneugen@@ iterator name list_for_each; statement S; expression head; struct list_head *pos; @@ - for (pos = head.next; pos != &head; pos = pos->next) + list_for_each(pos, &head) S @@ //iterator list_for_each; statement S; expression head; struct list_head *pos; @@ - for (pos = head->next; pos != head; pos = pos->next) + list_for_each(pos, head) S // list_add, list_del // list_move // list_del_init // list_add_tail // { ... when != // list_del() \| xxx->next = E \| list_add() \| f(...,xxx,...) // } // le cas single statement // in 0c5719c43d34073f6b4b0a2dd99f5317a5f63abd // //- struct list_head *walk = &pdev->bus_list; //+ struct list_head *walk; // //- for (walk = walk->next; walk != &pdev->bus_list; walk = walk->next) { coccinelle-1.0.0-rc19/demos/janitorings/useless_cast.cocci0000644000175000017500000000052712247437436022531 0ustar eugeneugen@@ type T; T E; @@ - (T) E // // special case //@@ //type T; //identifier x; //T E; //@@ // //T x = //- (T) // E; // // kmalloc for instance don't require cast. //@@ //type T; //identifier x; //void *E; //@@ // //T x = //- (T) // E; // kmalloc, etc // __get_free_page // get_zeroed_page // RING_GET_RESPONSEcoccinelle-1.0.0-rc19/demos/janitorings/list_for_each_safe.sgrep0000644000175000017500000000015012247437436023663 0ustar eugeneugen@@ iterator list_for_each_safe; statement S; expression a, b, c; @@ - list_for_each_safe(a, b, c) - S coccinelle-1.0.0-rc19/demos/janitorings/BUG_ON.cocci0000644000175000017500000000042212247437436021037 0ustar eugeneugen// is also mega10.cocci @@ expression E; @@ // super unreadable, but we don't want the isomorphism to apply, because then // two bindings of E drift up to the top - if (unlikely( + BUG_ON( E + ); - )) { BUG(); } @@ expression E; @@ - if (E) { BUG(); } + BUG_ON(E); coccinelle-1.0.0-rc19/demos/janitorings/netdev_find_allocfunc.sgrep0000644000175000017500000000027612247437436024410 0ustar eugeneugen@@ identifier fn; identifier sizeof_priv; @@ - fn(...,int sizeof_priv, ...) { <... ( alloc_netdev(sizeof_priv, ...) | alloc_netdev_mq(sizeof_priv, ...) ) ...> } coccinelle-1.0.0-rc19/demos/janitorings/bad_zero.cocci0000644000175000017500000000056212247437436021620 0ustar eugeneugen @ disable is_zero @ expression *E; @@ E == - 0 + NULL @ disable is_zero @ expression *E; @@ - 0 + NULL == E @ disable isnt_zero @ expression *E; @@ E != - 0 + NULL @ disable isnt_zero @ expression *E; @@ - 0 + NULL != E @@ idexpression *X; statement S; @@ - if(X == NULL) + if(!X) S @@ idexpression *X; statement S; @@ - if(X != NULL) + if(X) S coccinelle-1.0.0-rc19/demos/janitorings/bad_zero.c0000644000175000017500000000017612247437436020763 0ustar eugeneugenvoid main(int i) { struct netdev *bc; if ((bc = ch->brdchan) == 0) { tty->driver_data = NULL; return -ENODEV; } } coccinelle-1.0.0-rc19/demos/janitorings/static_initfunc.cocci0000644000175000017500000000224312247437436023217 0ustar eugeneugen// Thomas Surrel version. Error msg is "not handling multiple minirules" // @@ // identifier func; // @@ // - int __init func(void) // { ... } // + static int __init func(void) // { ... } // cant match on __init in cocci_vs_c //@@ //identifier func; //@@ // - int __init func(void) // + static int __init func(void) // { ... } // cant parse //@@ //identifier func; //@@ // ( // static int func(void) // { ... } // | // + static // int func(void) // { ... } // ) // wrong unparsing //@@ //identifier initfunc; //@@ // //+ static // int initfunc(void) // { ... } @ rule1 @ identifier initfunc; declarer name module_init; @@ module_init(initfunc); @ disable optional_storage @ identifier rule1.initfunc; @@ - int + static int initfunc(void) { ... } // cheat version // @ rule1 @ // identifier initfunc; // @@ // module_init(initfunc); // // @ rule2 @ // identifier rule1.initfunc; // @@ // // static int initfunc(...) // { ... } // // @ rule3 depends on !rule2 @ // identifier rule1.initfunc; // @@ // // //- int initfunc(void) // //+ static int initfunc(void) // // { ... } // // - int // + static int // initfunc(...) // { ... } coccinelle-1.0.0-rc19/demos/janitorings/kcalloc_un.cocci0000644000175000017500000000014412247437436022141 0ustar eugeneugen// Based on request from Michael D. Day @@ expression X, Y; @@ - kcalloc(1, X, Y) + kmalloc(X, Y) coccinelle-1.0.0-rc19/demos/janitorings/list_for_each_safe.c0000644000175000017500000000012512247437436022767 0ustar eugeneugenvoid main(int i) { list_for_each_safe(a,b,c) i++; list_for_each(a,b) i++; } coccinelle-1.0.0-rc19/demos/janitorings/string-array-decl-opti.cocci0000644000175000017500000000027512247437436024334 0ustar eugeneugen//@@ //identifier x; //expression s; //@@ // ( // char *x = NULL; // | // - char *x = s; // + char x[] = s; // ) @@ identifier x; constant char [] s; @@ - char *x = s; + char x[] = s; coccinelle-1.0.0-rc19/demos/janitorings/netdev_priv.c0000644000175000017500000000034012247437436021514 0ustar eugeneugenvoid foo(struct net_device *dev) { struct priv *priv = dev->priv; } void main(void) { struct priv *priv; struct net_device *dev; // dev = alloc_netdev(sizeof(struct priv), 0); dev = alloc_netdev(sizeof(*priv), 0); } coccinelle-1.0.0-rc19/demos/janitorings/static_initfunc.c0000644000175000017500000000023412247437436022357 0ustar eugeneugenstatic int __init foo1(void) { } int __init foo2(void) { } static int foo3(void) { } static int foo4(void) { } module_init(foo1); module_init(foo2); coccinelle-1.0.0-rc19/demos/janitorings/ARRAY_SIZE.cocci0000644000175000017500000000310412247437436021536 0ustar eugeneugen// empty.iso is used because there is an iso that converts sizeof(E) to // sizeof E, which causes a double match in an expression, and thus a // double modification @ rule1 using "empty.iso" @ expression E; @@ - (sizeof(E)/sizeof(*E)) + ARRAY_SIZE(E) @ rule2 using "empty.iso" @ expression E; @@ - sizeof(E)/sizeof(*E) + ARRAY_SIZE(E) @ rule3 using "empty.iso" @ expression E, E1; @@ - (sizeof(E)/sizeof(E[E1])) + ARRAY_SIZE(E) @ rule4 using "empty.iso" @ expression E, E1; @@ - sizeof(E)/sizeof(E[E1]) + ARRAY_SIZE(E) @ rule5 using "empty.iso" @ type T; T[] E; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) @ rule6 using "empty.iso" @ type T; T[] E; @@ - sizeof(E)/sizeof(T) + ARRAY_SIZE(E) // --------------------------------------------------------------------------- // some of the above rules with more parentheses // this can't be done with an isomorphism, as described above @ rule1p using "empty.iso" @ expression E; @@ - (sizeof(E)/sizeof(*(E))) + ARRAY_SIZE(E) @ rule2p using "empty.iso" @ expression E; @@ - sizeof(E)/sizeof(*(E)) + ARRAY_SIZE(E) @ rule3p using "empty.iso" @ expression E, E1; @@ - (sizeof(E)/sizeof((E)[E1])) + ARRAY_SIZE(E) @ rule4p using "empty.iso" @ expression E, E1; @@ - sizeof(E)/sizeof((E)[E1]) + ARRAY_SIZE(E) // --------------------------------------------------------------------------- @@ expression E; @@ - NUM_ELEMENTS(E) + ARRAY_SIZE(E) @ rule53 @ identifier NUM, x; @@ - #define NUM(x) ARRAY_SIZE(x) @@ expression E; identifier rule53.NUM; @@ - NUM(E) + ARRAY_SIZE(E) @@ expression E; @@ - ((int)ARRAY_SIZE(E)) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/demos/janitorings/empty.iso0000644000175000017500000000000012247437436020666 0ustar eugeneugencoccinelle-1.0.0-rc19/demos/janitorings/list_for_each.c0000644000175000017500000000021112247437436021765 0ustar eugeneugenvoid main(int i) { struct list_head *list; for (list = ymf_devs.next; list != &ymf_devs; list = list->next) { printf("cava"); } } coccinelle-1.0.0-rc19/demos/janitorings/string-array-decl-opti.c0000644000175000017500000000035712247437436023477 0ustar eugeneugen #define MYSTR "toto" #define MYSTR2 NULL const char *foo = NULL; const char *foo = MYSTR; const char *foo = MYSTR2; const char *foo = "blah"; char *foo = "blah"; char *foo = {1,2,3}; const char foo[] = "blah"; char foo[] = "blah"; coccinelle-1.0.0-rc19/demos/janitorings/clear_page.cocci0000644000175000017500000000164612247437436022121 0ustar eugeneugen// From: Shani Moideen // Subject: [KJ] [KJ PATCH] Replacing memset(,0,PAGE_SIZE) with // clear_page() in drivers/char/drm/i810_dma.c // // Replacing memset(,0,PAGE_SIZE) with clear_page() // in drivers/char/drm/i810_dma.c // // Signed-off-by: Shani Moideen // ---- // // diff --git a/drivers/char/drm/i810_dma.c b/drivers/char/drm/i810_dma.c // index 603d17f..4dbd97f 100644 // --- a/drivers/char/drm/i810_dma.c // +++ b/drivers/char/drm/i810_dma.c // @@ -413,7 +413,7 @@ static int i810_dma_initialize(drm_device_t * dev, // DRM_ERROR("Can not allocate hardware status page\n"); // return -ENOMEM; // } // - memset(dev_priv->hw_status_page, 0, PAGE_SIZE); // + clear_page(dev_priv->hw_status_page); // script found on KJ: // grep -e "memset ?\([^,]+, ?, ?0, ?PAGE_SIZE\) "   @@ expression X; @@ - memset(X, 0, PAGE_SIZE) + clear_page(X) coccinelle-1.0.0-rc19/demos/janitorings/netdev_priv2.cocci0000644000175000017500000000011212247437436022431 0ustar eugeneugen@@ struct net_device *dev; type T; @@ - (T) dev->priv + netdev_priv(dev) coccinelle-1.0.0-rc19/demos/janitorings/netdev_priv_dangerous.sgrep0000644000175000017500000000117512247437436024470 0ustar eugeneugen@ rule1 @ type T; struct net_device *dev; expression E; @@ dev = ( alloc_netdev | alloc_etherdev | alloc_fcdev | alloc_fddidev | alloc_hippi_dev | alloc_trdev | alloc_ltalkdev | alloc_irdadev | alloc_etherdev_mq ) (sizeof(T), ...) //sizeof(T) + E @ rule1bis @ struct net_device *dev; expression E; @@ dev->priv = E //+ DANGERRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR @ rule2 depends on !rule1 @ struct net_device *dev; @@ - netdev_priv(dev) + no_alloc_xxx @ rule3 depends on rule1bis @ struct net_device *dev; @@ - netdev_priv(dev) + with_danger coccinelle-1.0.0-rc19/demos/janitorings/bad_zero-orig.cocci0000644000175000017500000000024512247437436022554 0ustar eugeneugen @@ expression *E; @@ E == - 0 + NULL @@ expression *E; @@ - 0 + NULL == E @@ expression *E; @@ E != - 0 + NULL @@ expression *E; @@ - 0 + NULL != E coccinelle-1.0.0-rc19/demos/janitorings/useless_cast.c0000644000175000017500000000077212247437436021675 0ustar eugeneugen // from: http://kernelnewbies.org/KernelJanitors/Todo struct device { struct netdev_private *priv; struct netdev_private2 *priv2; void *priv3; }; struct net_device *dev; struct netdev_private *np = (struct netdev_private *)dev->priv; struct netdev_private *np2 = (struct netdev_private *)dev->priv2; struct netdev_private *np3 = (struct netdev_private *)dev->priv3; struct netdev_private *np4 = (struct netdev_private *) dev; int f(int i) { ssize_t x; if((ssize_t) x > 0) { return -1; } } coccinelle-1.0.0-rc19/demos/janitorings/BUG_ON.sgrep0000644000175000017500000000001612247437436021076 0ustar eugeneugen@@ @@ - BUG() coccinelle-1.0.0-rc19/demos/janitorings/netdev_priv.cocci0000644000175000017500000000301712247437436022356 0ustar eugeneugen// TODO: now that have the assign/affect iso, can perhaps // deal with the cast pb // rewriting // - (T*) dev->priv // + netdev_priv(dev) // into // x = // - (T*) dev-> priv // + netdev_priv(dev) // and then make another rule for the remaining case @ alloc disable plus_comm @ type T; expression E; @@ ( ( alloc_netdev | alloc_etherdev | alloc_fcdev | alloc_fddidev | alloc_hippi_dev | alloc_trdev | alloc_ltalkdev | alloc_irdadev | alloc_etherdev_mq ) (sizeof(T), ...) | ( alloc_netdev | alloc_etherdev | alloc_fcdev | alloc_fddidev | alloc_hippi_dev | alloc_trdev | alloc_ltalkdev | alloc_irdadev | alloc_etherdev_mq ) (sizeof(T) + E, ...) ) // if don't have the iso sizeof(T) => sizeof(E) // dev = alloc_netdev(sizeof(*x), ...) //>>> - alloc_irlandev // but dont pass the sizeof, so cant get the type T. //> alloc_orinocodev @ danger @ struct net_device *dev; expression E; @@ dev->priv = E //+ DANGER //@ danger @ //struct net_device dev; //expression E; //@@ // dev.priv = E // TODO wrong !!! can have ((T) a)->field, on peut pas remover le cast! @ rule1 depends on alloc && !danger @ struct net_device *dev; type alloc.T; @@ - (T*) dev->priv + netdev_priv(dev) // the iso drop_cast is not enough because T* in the previous rule // can not be dropped. It's not a pure T. @ rule2 depends on alloc && !danger @ struct net_device *dev; @@ - dev->priv + netdev_priv(dev) coccinelle-1.0.0-rc19/demos/janitorings/bad_zero_affect.cocci0000644000175000017500000000005212247437436023122 0ustar eugeneugen @@ expression *E; @@ E = - 0 + NULL coccinelle-1.0.0-rc19/demos/janitorings/set_current_state.cocci0000644000175000017500000000010212247437436023556 0ustar eugeneugen@@ expression E; @@ - current->state = E; + set_current_state(E);coccinelle-1.0.0-rc19/demos/janitorings/kzalloc.cocci0000644000175000017500000001302212247437436021465 0ustar eugeneugen// script on KJ: // You can probably find examples of that by running: // // $ grep -Er -B10 "memset ?\(.*,0 ?," * | less // // and searching for the string "kmalloc" in the output. // have to duplicate a lot of rules because T E only matches if E has a known // type, even if T is not used elsewhere. // originally, the whens were when != x, but that doesn't work because x // only binds to the outermost expression, not all possible expressions, and // the value returned by kmalloc is usually used as a subexpression. // so we have considered the typical uses that may cause problems; a function // call or dereference //\(x->fld\|f(...,x,...)\|x=E\) @@ type T2; expression x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S; @@ x = - kmalloc + kzalloc (E1,E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); @@ type T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ x = - kmalloc + kzalloc (sizeof(T1),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); @@ type T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ x = - kmalloc + kzalloc (sizeof(*x),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T2; expression x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S, S1; @@ x = - kmalloc + kzalloc (E1,E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); ... } else S1 @@ type T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ x = - kmalloc + kzalloc (sizeof(T1),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); ... } else S1 @@ type T2; type T1; T1 *x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ x = - kmalloc + kzalloc (sizeof(*x),E2) ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); ... } else S1 // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S; @@ T1 x = - kmalloc + kzalloc (E1,E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ T1 x = - kmalloc + kzalloc (sizeof(T1),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S; @@ T1 x = - kmalloc + kzalloc (sizeof(*x),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E1,E2; expression e1,e2,e3,y; statement S, S1; @@ T1 x = - kmalloc + kzalloc (E1,E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,E1); ... } else S1 @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ T1 x = - kmalloc + kzalloc (sizeof(T1),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(*x)); ... } else S1 @@ type T2; type T1; identifier x; identifier f,fld; expression E; expression E2; expression e1,e2,e3,y; statement S, S1; @@ T1 x = - kmalloc + kzalloc (sizeof(*x),E2); ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) if(x != NULL) { ... when != \(x->fld=E;\|y=f(...,x,...);\|f(...,x,...);\|x=E;\|while(...) S\|for(e1;e2;e3) S\) - memset((T2)x,0,sizeof(T1)); ... } else S1 // --------------------------------------------------------------------- // --------------------------------------------------------------------- @@ expression E1,E2,E3; @@ - kzalloc(E1 * E2,E3) + kcalloc(E1,E2,E3) coccinelle-1.0.0-rc19/demos/janitorings/remove_cast_kmalloc.cocci0000644000175000017500000000130312247437436024036 0ustar eugeneugen// commit 5cbded585d129d0226cb48ac4202b253c781be26 // Author: Robert P. J. Day // Date: Wed Dec 13 00:35:56 2006 -0800 // // [PATCH] getting rid of all casts of k[cmz]alloc() calls // // Run this: // // #! /bin/sh // for f in $(grep -Erl "\([^\)]*\) *k[cmz]alloc" *) ; do // echo "De-casting $f..." // perl -pi -e "s/ ?= ?\([^\)]*\) *(k[cmz]alloc) *\(/ = \1\(/" $f // done // // And then go through and reinstate those cases where code is // casting pointers to non-pointers. // // And then drop a few hunks which conflicted with outstanding work. @@ expression E; type T; @@ E = - (T) kmalloc(...) coccinelle-1.0.0-rc19/demos/janitorings/alloc_page.cocci0000644000175000017500000000201112247437436022110 0ustar eugeneugen// From: Shani Moideen // Subject: [KJ] [KJ PATCH] Replacing alloc_pages(gfp, // 0) with alloc_page(gfp) in net/core/sock.c // To: jgarzik@pobox.com, akpm@linux-foundation.org // Cc: netdev@vger.kernel.org, kernel-janitors@lists.osdl.org // Date: Wed, 13 Jun 2007 08:16:42 +0530 // Organization: Linux COE, Wipro Technolgies // // // Replacing alloc_pages(gfp,0) with alloc_page(gfp) // in net/core/sock.c // // Signed-off-by: Shani Moideen // ---- // // diff --git a/net/core/sock.c b/net/core/sock.c // index 22183c2..25bb52b 100644 // --- a/net/core/sock.c // +++ b/net/core/sock.c // @@ -1193,7 +1193,7 @@ static struct sk_buff *sock_alloc_send_pskb(struct sock *sk, // struct page *page; // skb_frag_t *frag; // // - page = alloc_pages(sk->sk_allocation, 0); // + page = alloc_page(sk->sk_allocation); // if (!page) { // err = -ENOBUFS; // skb_shinfo(skb)->nr_frags = i; @@ expression X; @@ - alloc_pages(X, 0) + alloc_page(X)coccinelle-1.0.0-rc19/demos/regexp.cocci0000644000175000017500000000122612247437436016774 0ustar eugeneugen@anyid@ type t; identifier id; @@ t id () { ... } @script:python@ x << anyid.id; @@ print "Identifier: %s" % x @contains@ type t; identifier foo =~ "foo"; @@ t foo () { ... } @script:python@ x << contains.foo; @@ print "Contains foo: %s" % x @nocontain@ type t; identifier foo !~ "foo"; @@ t foo () { ... } @script:python@ x << nocontain.foo; @@ print "Does not contain foo: %s" % x @endsby@ type t; identifier foo =~ "foo$"; @@ t foo () { ... } @script:python@ x << endsby.foo; @@ print "Ends by foo: %s" % x @beginsby@ type t; identifier foo =~ "^foo"; @@ t foo () { ... } @script:python@ x << beginsby.foo; @@ print "Begins by foo: %s" % x coccinelle-1.0.0-rc19/demos/camltococci.cocci0000644000175000017500000000026512247437436017764 0ustar eugeneugen@a@ identifier x; @@ foo(x); @script:ocaml b@ x << a.x; y; z; @@ y := x; z := "something" @c@ identifier b.y; identifier b.z; identifier a.x; @@ - bar(); + matched_bar(y,z,x); coccinelle-1.0.0-rc19/demos/regexp2.c0000644000175000017500000000003712247437436016217 0ustar eugeneugen void foo() { WINE_ERR(0); } coccinelle-1.0.0-rc19/demos/pythontococci.c0000644000175000017500000000004412247437436017526 0ustar eugeneugenint main () { foo(a0); bar(); } coccinelle-1.0.0-rc19/demos/regexp.c0000644000175000017500000000021112247437436016127 0ustar eugeneugenint foo () { return 0; } int bar () { return 0; } int foobar () { return 0; } int barfoobar () { return 0; } int barfoo () { return 0; } coccinelle-1.0.0-rc19/demos/macro_parsing_problem.c0000644000175000017500000001125012247437436021206 0ustar eugeneugen// note that some of our heuristics can deal with statement // without trailing ';', but currently our heuristics don't handle // those cases below: int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } int main(void) { /* Notice that there is NO semicolon at the end of next line. */ char *buf = MALLOC(3) return 0; } coccinelle-1.0.0-rc19/demos/usb_submit_urb.c0000644000175000017500000001131212247437436017665 0ustar eugeneugen// from usbnet.c static int gl_interrupt_read (struct usbnet *dev) { struct gl_priv *priv = dev->priv_data; int retval; // issue usb interrupt read if (priv && priv->irq_urb) { // submit urb if ((retval = usb_submit_urb (priv->irq_urb)) != 0) dbg ("gl_interrupt_read: submit fail - %X...", retval); else dbg ("gl_interrupt_read: submit success..."); } return 0; } static void rx_submit (struct usbnet *dev, struct urb *urb, int flags) { struct sk_buff *skb; struct skb_data *entry; int retval = 0; unsigned long lockflags; size_t size; #ifdef CONFIG_USB_NET1080 if (dev->driver_info->flags & FLAG_FRAMING_NC) size = FRAMED_SIZE (dev->net.mtu); else #endif #ifdef CONFIG_USB_GENESYS if (dev->driver_info->flags & FLAG_FRAMING_GL) size = GL_RCV_BUF_SIZE; else #endif size = (sizeof (struct ethhdr) + dev->net.mtu); if ((skb = alloc_skb (size, flags)) == 0) { dbg ("no rx skb"); tasklet_schedule (&dev->bh); usb_free_urb (urb); return; } entry = (struct skb_data *) skb->cb; entry->urb = urb; entry->dev = dev; entry->state = rx_start; entry->length = 0; FILL_BULK_URB (urb, dev->udev, usb_rcvbulkpipe (dev->udev, dev->driver_info->in), skb->data, size, rx_complete, skb); urb->transfer_flags |= USB_ASYNC_UNLINK; #ifdef REALLY_QUEUE urb->transfer_flags |= USB_QUEUE_BULK; #endif #if 0 // Idle-but-posted reads with UHCI really chew up // PCI bandwidth unless FSBR is disabled urb->transfer_flags |= USB_NO_FSBR; #endif spin_lock_irqsave (&dev->rxq.lock, lockflags); if (netif_running (&dev->net)) { if ((retval = usb_submit_urb (urb)) != 0) { dbg ("%s rx submit, %d", dev->net.name, retval); tasklet_schedule (&dev->bh); } else { __skb_queue_tail (&dev->rxq, skb); } } else { dbg ("rx: stopped"); retval = -ENOLINK; } spin_unlock_irqrestore (&dev->rxq.lock, lockflags); if (retval) { dev_kfree_skb_any (skb); usb_free_urb (urb); } } static int usbnet_start_xmit (struct sk_buff *skb, struct net_device *net) { struct usbnet *dev = (struct usbnet *) net->priv; int length = skb->len; int retval = NET_XMIT_SUCCESS; struct urb *urb = 0; struct skb_data *entry; struct driver_info *info = dev->driver_info; unsigned long flags; #ifdef CONFIG_USB_NET1080 struct nc_header *header = 0; struct nc_trailer *trailer = 0; #endif /* CONFIG_USB_NET1080 */ flags = in_interrupt () ? GFP_ATOMIC : GFP_NOIO; /* might be used for nfs */ // some devices want funky USB-level framing, for // win32 driver (usually) and/or hardware quirks if (info->tx_fixup) { skb = info->tx_fixup (dev, skb, flags); if (!skb) { dbg ("can't tx_fixup skb"); goto drop; } } if (!(urb = usb_alloc_urb (0))) { dbg ("no urb"); goto drop; } entry = (struct skb_data *) skb->cb; entry->urb = urb; entry->dev = dev; entry->state = tx_start; entry->length = length; // FIXME: reorganize a bit, so that fixup() fills out NetChip // framing too. (Packet ID update needs the spinlock...) #ifdef CONFIG_USB_NET1080 if (info->flags & FLAG_FRAMING_NC) { header = (struct nc_header *) skb_push (skb, sizeof *header); header->hdr_len = cpu_to_le16 (sizeof (*header)); header->packet_len = cpu_to_le16 (length); if (!((skb->len + sizeof *trailer) & 0x01)) *skb_put (skb, 1) = PAD_BYTE; trailer = (struct nc_trailer *) skb_put (skb, sizeof *trailer); } else #endif /* CONFIG_USB_NET1080 */ /* don't assume the hardware handles USB_ZERO_PACKET */ if ((length % EP_SIZE (dev)) == 0) skb->len++; FILL_BULK_URB (urb, dev->udev, usb_sndbulkpipe (dev->udev, info->out), skb->data, skb->len, tx_complete, skb); urb->transfer_flags |= USB_ASYNC_UNLINK; #ifdef REALLY_QUEUE urb->transfer_flags |= USB_QUEUE_BULK; #endif // FIXME urb->timeout = ... jiffies ... ; spin_lock_irqsave (&dev->txq.lock, flags); #ifdef CONFIG_USB_NET1080 if (info->flags & FLAG_FRAMING_NC) { header->packet_id = cpu_to_le16 (dev->packet_id++); put_unaligned (header->packet_id, &trailer->packet_id); #if 0 devdbg (dev, "frame >tx h %d p %d id %d", header->hdr_len, header->packet_len, header->packet_id); #endif } #endif /* CONFIG_USB_NET1080 */ netif_stop_queue (net); if ((retval = usb_submit_urb (urb)) != 0) { netif_start_queue (net); dbg ("%s tx: submit urb err %d", net->name, retval); } else { net->trans_start = jiffies; __skb_queue_tail (&dev->txq, skb); if (dev->txq.qlen < TX_QLEN) netif_start_queue (net); } spin_unlock_irqrestore (&dev->txq.lock, flags); if (retval) { devdbg (dev, "drop, code %d", retval); drop: retval = NET_XMIT_DROP; dev->stats.tx_dropped++; if (skb) dev_kfree_skb_any (skb); usb_free_urb (urb); #ifdef VERBOSE } else { devdbg (dev, "> tx, len %d, type 0x%x", length, skb->protocol); #endif } return retval; } coccinelle-1.0.0-rc19/demos/vm.cocci0000644000175000017500000000043112247437436016121 0ustar eugeneugen// Options: -D alloc=kmalloc -D free=kfree @r@ identifier virtual.alloc, virtual.free; expression x; position p1,p2; @@ x = alloc@p1(...); ... free@p2(x); @script:python@ p1 << r.p1; p2 << r.p2; alloc << virtual.alloc; @@ cocci.print_main(alloc,p1); cocci.print_secs("free",p2);coccinelle-1.0.0-rc19/demos/assignment_matching.c0000644000175000017500000000071212247437436020665 0ustar eugeneugenint first() { int a = f(3); b = f(3); if (c = f(3)) return 1; if (d = (int)f(3)) return 2; return 0; } int second() { int a = g(3); b = g(3); if (c = g(3)) return 1; if (d = (int)g(3)) return 2; return 0; } int third() { int a = h(3); b = h(3); if (c = h(3)) return 1; if (d = (int)h(3)) return 2; return 0; } int fourth() { int a = i(3); b = i(3); if (c = i(3)) return 1; if (d = (int)i(3)) return 2; return 0; } coccinelle-1.0.0-rc19/demos/format.c0000644000175000017500000000025412247437436016134 0ustar eugeneugenint main () { foo("one %d two %2x three\n"); foo("blah %d two %2x three %s xxx %d"); foo("xyz %d %d %0.2f %s three\n"); foo("xyz %d %0.2f abc"); foo("xxx %s"); } coccinelle-1.0.0-rc19/demos/python_regexp.cocci0000644000175000017500000000066212247437436020400 0ustar eugeneugen@initialize:python@ import re m = re.compile('_new$') @r_init@ expression E; identifier id; position p; @@ E = id@p(); @script:python@ id << r_init.id; @@ print "COCCI: Analyzing %s" % id if m.search(id.ident) != None: print "COCCI: %s matchs '_new$'" % id else: print "COCCI: %s discarded" % id cocci.include_match(False) @r_do@ expression E; identifier id; position r_init.p; @@ E = id@p(); + if (E == NULL) + goto err; coccinelle-1.0.0-rc19/demos/video_usercopy.c0000644000175000017500000000112512247437436017701 0ustar eugeneugenint p20_ioctl(int cmd, void*arg) { switch(cmd) { case VIDIOGCTUNER: { struct video_tuner v; if(copy_from_user(&v,arg)!=0) return -EFAULT; if(v.tuner) return -EINVAL; v.rangelow = 87*16000; v.rangehigh = 108 * 16000; if(copy_to_user(arg,&v)) return -EFAULT; return 0; } case AGCTUNER: { struct video_tuner v; if(copy_from_user(&v,arg)) { return -EFAULT; } if(v.tuner) return -EINVAL; v.rangelow = 0; v.rangehigh = 0; if(copy_to_user(arg,&v)) return -EFAULT; return 0; } } } coccinelle-1.0.0-rc19/demos/format.cocci0000644000175000017500000000122012247437436016764 0ustar eugeneugen@r@ format d =~ ".x$"; @@ foo("...%@d@...") @script:python@ d << r.d; @@ d = "%s" % (d) assert(d == "2x") @r1@ format list d; @@ foo("blah %@d@ xxx %d") @script:python@ d << r1.d; @@ d = "%s" % (d) assert(d == "%d two %2x three %s") @r2@ format list d; @@ foo("%@d@ xxx %d") @script:python@ d << r2.d; @@ d = "%s" % (d) assert(d == "blah %d two %2x three %s") @r3@ format list[4] d; @@ "xyz %@d@" @script:python@ d << r3.d; @@ d = "%s" % (d) assert(d == "%d %d %0.2f %s three\\n") @r4@ format list[2] d; @@ "xyz %@d@ abc" @script:python@ d << r4.d; @@ d = "%s" % (d) assert(d == "%d %0.2f") @r5@ format d; @@ - "xxx %@d@" + "yyy %@d@" coccinelle-1.0.0-rc19/demos/vm.c0000644000175000017500000000006712247437436015270 0ustar eugeneugenint main () { x = kmalloc(); r = 15; kfree(x); } coccinelle-1.0.0-rc19/demos/unsigned.txt0000644000175000017500000001005412247437436017054 0ustar eugeneugenFrom 12o3l@tiscali.nl Fri Apr 18 18:13:39 2008 Date: Fri, 18 Apr 2008 18:15:06 +0200 From: Roel Kluin <12o3l@tiscali.nl> To: kernel-janitors@vger.kernel.org, kernelnewbies-bounce@nl.linux.org Subject: script to find incorrect tests on unsigneds A bash script to find incorrect tests on unsigned values. for instance: unsigned int i; ... i = neg_ret_function(); ... if (i < 0) ... #!/bin/bash # (c) roel kluin 2008 GPL v2 # # TODO: make this working also for # ... $unsigned_var == $signed_var ... # ... $unsigned_var == \(-POSITIVE_DEF\|NEGATIVE_DEF\) ... # ... ( $unsigned_var [+*/%^&~-]?= ... ) < 0 ... # a number int="[0-9]" hex="[a-f0-9]" hEx="[A-Fa-f0-9]" HEX="[A-F0-9]" upp="[A-Z]" up_="[A-Z_]" low="[a-z0-9]" lo_="[a-z0-9_]" alp="[A-Za-z]" al_="[A-Za-z_]" ALN="[A-Z0-9]" AN_="[A-Z0-9_]" aln="[A-Za-z0-9]" an_="[A-Za-z0-9_]" # to match something like 1ul, floats or hexes as well: D="$int*\.\?$int\+x\?$hex*[uUlL]\{0,3\}[fF]\?" # more strict and catches it (costs one backreference for (git-)grep) d="\($int\+[uUlLfF]\?\|$int\+[uU]\?[lL][lL]\?\|0x$hex\+\|0x$HEX\+\|$i\+[lL][lL][uU]\|$i*\.$i\+[fF]\?\)" # capital: can be used to catch a definition or config option K="$UP_\+$AN_*"; # can be used for a variable/function name: V="$an_\+$an_*" # works the same as above, but also for members and arrays: one backreference # is more strict W="$V\(\[$s$V$s\]\|\[$s$D$s\]\|\.$V\|->$V\)*" # catches it at once (less strict) w="\($V\|${V}\[$s$an_*${s}\]\|$V\.\|$V->\)\+" # seperators: s="[[:space:]]*"; S="[[:space:]]\+" # useful to delimit a variable name: Q="[^[:alnum:]_]" # match the end of the line, including comments: one backreference (but at eol) cendl="$s\(\/[\*\/].*\)\?$" # match something that is not comment, string or character: 2 backreferences ccode="\([^\/\"']*\|\/[^\*\/]\|\/\*\([^\*]*\|\**[^\/\*]\)*\*\+\/\|'[^']*'\|\"[^\"]*\"\)*" # resp function open and end (only works when indentation is correct. fo="^[\{]$cendl" fe="^[\}]$cendl" se="^[\}];$cendl" # to match nested parentheses nps="[^()]*" nstdps="\(($nps\(($nps\(($nps\(($nps\(($nps)$nps\)*)$nps\)*)$nps\)*)$nps\)*)$nps\)*" # first determine unsigned typedefs arr="\(\[[^\]]*\]$s\)*" attr="__attribute__$s(([^;]*))" utype="${s}typedef${S}unsigned$S\($V$S\)*" uns="unsigned$( git-grep "^$utype\($V$s$arr\|$attr$S$V$s$arr\|$V$s$arr$S$attr\)$s;$cendl" | sed -n "s/^[^.]*\.[hc]:$utype\(\($V\)$s$arr\|$attr$S\($V\)$s$arr\|\($V\)$s$arr$S$attr\)$s;$cendl/\\\\|\3\5\7/p" | sort | uniq | tr -d "\n")" # define left and right operators # to decrease the number backrefences, these are assigned in loops opl= for op in "[;,|^?:(]" "[\!+*/%&|~^-]=" ">>=" "<<=" "\[" "&&" "$an_$s&"; do opl="$opl$op\|$op$s++\|$op$s--\|" done opl="\(${opl%|})" opr= for op in "[;,&|^?:)]" "[\!+*/%&|~^<>-]=" ">>=" "<<=" ">[^>]" "<[^<]" "\]"; do opr="$opr$op\|$op$s++\|$op$s--\|" done opr="\(${opr%|})" # string catches invalid comparison q1="$opl$s\($w$s\(>=${s}0\|<${s}0\|[><\!=]=$s-$s$D\|[<>]$s-$s$D\)\|\(0$s>\|0$s<=\|-$s$D${s}[><\!=]=\|-$s$D${s}[<>]\)$s$w\)$s$opr" start=0 end=$(echo $uns | tr -cd "|" | wc -c) # main function while [ $start -lt $end ]; do # we match 30 typedefs at a time tuns="$(echo $uns | cut -d "\\" -f$start-$(($start+29)))" # catch candidate files for f in $(git-grep -l "^\(${ccode}[,;]$s\)\?\($tuns\)$S" | grep "[^.]*\.[ch]" | xargs grep -l "$q1"); do for n in $(sed -n "/^.*$q1/=" $f); do # lines for v in $(sed -n "${n}s/^.*$q1.*$/\3\6/p" $f); do # n2 = wine there head -n$n $f | tac | sed -n "/^[{]/q; /^\(.*$Q\)\?\($tuns\)$S\($V$S\)*$v$Q.*$/=" | while read n2; do echo "# --- invalid test on unsigned variable '$v' --- #" echo "vi $f +$n2 # unsigned declaration" echo "vi $f +$n # invalid test" done done done done start=$(($start+30)) done | less -- To unsubscribe from this list: send the line "unsubscribe kernel-janitors" in the body of a message to majordomo@vger.kernel.org More majordomo info at http://vger.kernel.org/majordomo-info.html coccinelle-1.0.0-rc19/demos/format.res0000644000175000017500000000025412247437436016503 0ustar eugeneugenint main () { foo("one %d two %2x three\n"); foo("blah %d two %2x three %s xxx %d"); foo("xyz %d %d %0.2f %s three\n"); foo("xyz %d %0.2f abc"); foo("yyy %s"); } coccinelle-1.0.0-rc19/demos/hello/0000755000175000017500000000000012247437436015602 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/hello/helloworld.c0000644000175000017500000000006512247437436020122 0ustar eugeneugenint main() { printf("Hello world!"); return 0; } coccinelle-1.0.0-rc19/demos/hello/hello-regexp.cocci0000644000175000017500000000024012247437436021173 0ustar eugeneugen@main@ type T; parameter list P; symbol printf; expression E; identifier M; @@ T M(P) { printf(E); ... } @@ expression main.E; @@ - E + "world, hello!"coccinelle-1.0.0-rc19/demos/hello/hello-python.cocci0000644000175000017500000000026612247437436021232 0ustar eugeneugen@main@ type T; parameter list P; symbol printf; expression E; position p; @@ T main(P) { printf@p(E); ... } @script:python@ p << main.p; @@ print("Hello at: %s" % p[0].line); coccinelle-1.0.0-rc19/demos/hello/hello-smpl.cocci0000644000175000017500000000022512247437436020657 0ustar eugeneugen@main@ type T; parameter list P; symbol printf; expression E; @@ T main(P) { printf(E); ... } @@ expression main.E; @@ - E + "world, hello!"coccinelle-1.0.0-rc19/demos/hello/hello-ocaml.cocci0000644000175000017500000000031112247437436020773 0ustar eugeneugen@main@ type T; parameter list P; symbol printf; expression E; position p; @@ T main(P) { printf@p(E); ... } @script:ocaml@ p << main.p; @@ Printf.printf "Hello at: %d" (List.hd p).Coccilib.line coccinelle-1.0.0-rc19/demos/itimer.patch0000644000175000017500000000235112247437436017012 0ustar eugeneugen int do_setitimer(int which, struct itimerval *value, struct itimerval *ovalue) { unsigned long expire; cputime_t cputime; int k; if (ovalue && (k = do_getitimer(which, ovalue)) < 0) return k; switch (which) { case ITIMER_VIRTUAL: cputime = timeval_to_cputime(&value->it_value); - if (cputime_eq(cputime, cputime_zero)) - cputime = jiffies_to_cputime(1); + if (cputime_gt(cputime, cputime_zero)) + cputime = cputime_add(cputime, + jiffies_to_cputime(1)); current->it_virt_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_virt_incr = cputime; break; case ITIMER_PROF: cputime = timeval_to_cputime(&value->it_value); - if (cputime_eq(cputime, cputime_zero)) - cputime = jiffies_to_cputime(1); + if (cputime_gt(cputime, cputime_zero)) + cputime = cputime_add(cputime, + jiffies_to_cputime(1)); current->it_prof_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_prof_incr = cputime; break; default: return -EINVAL; } return 0; }coccinelle-1.0.0-rc19/demos/ocaml2.c0000644000175000017500000000013312247437436016015 0ustar eugeneugenint main () { if (f(3)) goto l; if (f(x)) x = 2; if (f(x+y)) return; l: return; } coccinelle-1.0.0-rc19/demos/depend.c0000644000175000017500000000003612247437436016101 0ustar eugeneugenint main() { aa(); c(); } coccinelle-1.0.0-rc19/demos/video_usercopy.cocci0000644000175000017500000000063112247437436020540 0ustar eugeneugen// - if(copy_from_user(&x, arg)) does not work. // the if-isomorphism does not work :( @@ type T; identifier x, fld; function ioctl; // should be caracterised by another rule @@ ioctl(..., void *arg, ...) { <... - T x; + T *x = arg; ... - if(copy_from_user(&x, arg)!=0) - { ... return ...; } <... ( - x.fld + x->fld | - &x + x ) ...> - if(copy_to_user(arg, &x)) - { ... return ...; } ...> }coccinelle-1.0.0-rc19/demos/demo_rule9/0000755000175000017500000000000012247437436016543 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/demo_rule9/rule9_4.cocci0000644000175000017500000000142212247437436021027 0ustar eugeneugen@ rule1 @ typedef Scsi_Host_Template; {struct SHT, Scsi_Host_Template} fops; identifier proc_info_func; @@ fops.proc_info = proc_info_func; @ rule2 @ identifier rule1.proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } @@ identifier rule1.proc_info_func; identifier rule2.hostno; identifier rule2.hostptr; @@ proc_info_func(...) { <... - hostno + hostptr->host_no ...> } coccinelle-1.0.0-rc19/demos/demo_rule9/rule9_1.cocci0000644000175000017500000000071512247437436021030 0ustar eugeneugen@@ identifier proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... - if (!hostptr) { ... return ...; } ... - scsi_host_put(hostptr); ... } coccinelle-1.0.0-rc19/demos/demo_rule9/README0000644000175000017500000000774612247437436017441 0ustar eugeneugen1. Motivate in some way the changes that need to be made. 2. Show the semantic patch in rule9_1.cocci. This could also be developed incrementally, with first the lines for get and put, then the line for the error checking on hostptr, then the - and + line for moving the declaration of hostptr to the parameter list. Finally, drop the hostno parameter. Explain the metavariables. Note that a rule is automatically generated to update the prototype of the proc_info function, if one is available. 3. Apply it to scsiglue.c and show what has changed. 4. Some issues: * In nsp_cs.c (and a lot of other files), there is no call to the put function. Indeed, the reason for the CE was that driver programmers were forgetting to call the put function. We thus would like to make it optional, the idea being that if we find it we should delete it, but if we don't find it, the rest of the transformation should still take place. * In g_NCR5380.c, there is no error checking on the result of calling the get function. Thus, that has to be optional as well. The result of making both of these changes is in rule9_2.cocci. * In sym53c8xx.c, there are no braces around the if branch in the error handling code. Explain about the isomorphisms. * In nsp_cs.c, hostptr is compared to NULL. There is an isomorphism for that as well. * The function is essentially identified by the types of its parameters. Since there are quite a lot of them, with quite varied typed, this is probably enough to uniquely identify the function within each driver in practice. But for greater safety, we should describe the function in terms of how it interacts with the SCSI library, because it is the SCSI library that will be responsible for supplying the extra argument. For this we add a new rule (rule9_3.cocci). This rule identifies the function as the one that is stored in the proc_info field of a structure of type SHT (also given the typedef name of Scsi_Host_Template). Isomorphisms take case of the case where this assignment has other forms, eg involving a pointer to the structure or is part of a top-level structure initialization. Now we want to inherit the binding of proc_info_func from the first rule to the second one. For this, we give the first one a name, and use that name in declaring the proc_info_func metavariable in the second rule. The second rule will be applied once for each successful match of the first rule, but in practice, there is only one. 5. The transformation that is implemented is not yet complete, as one can see by comparing with the .res file. We also have to rename the hostno variable everywhere that it occurs. Because it can in principle occur anywhere, we make a separate rule to avoid cluttering up the previous one. This rule inherits the name of the proc_info function from rule1 and the names of the hostno and hostptr variables from rule2. The transformation is to replace occurrences of hostno by a reference to the host_no field of hostptr everywhere hostno occurs, as indicated by the <... ...>. 6. Finally, the proc_info function may be called from other places within the current driver. These cases must be updated as well with the new argument. For this, we have to find an appropriate value somewhere. Because the get function has been deprecated, the driver will normally get this information as a parameter, and that is the only case we consider here. The name of the function enclosing the call is arbitrary (as indicated by a metavariable) as is the position of the Scsi_Host-typed parameter (as indicated by the dots in the parameter list). As for the previous rule, we use <... ...> to update a call to the proc_info function wherever it occurs. Note that although we have used the same names as for the parameter list in rule2, buffer, start, etc. are now arbitrary expressions. coccinelle-1.0.0-rc19/demos/demo_rule9/g_NCR5380.c0000644000175000017500000006253412247437436020171 0ustar eugeneugen/* * Generic Generic NCR5380 driver * * Copyright 1993, Drew Eckhardt * Visionary Computing * (Unix and Linux consulting and custom programming) * drew@colorado.edu * +1 (303) 440-4894 * * NCR53C400 extensions (c) 1994,1995,1996, Kevin Lentin * K.Lentin@cs.monash.edu.au * * NCR53C400A extensions (c) 1996, Ingmar Baumgart * ingmar@gonzo.schwaben.de * * DTC3181E extensions (c) 1997, Ronald van Cuijlenborg * ronald.van.cuijlenborg@tip.nl or nutty@dds.nl * * Added ISAPNP support for DTC436 adapters, * Thomas Sailer, sailer@ife.ee.ethz.ch * * ALPHA RELEASE 1. * * For more information, please consult * * NCR 5380 Family * SCSI Protocol Controller * Databook * * NCR Microelectronics * 1635 Aeroplaza Drive * Colorado Springs, CO 80916 * 1+ (719) 578-3400 * 1+ (800) 334-5454 */ /* * TODO : flesh out DMA support, find some one actually using this (I have * a memory mapped Trantor board that works fine) */ /* * Options : * * PARITY - enable parity checking. Not supported. * * SCSI2 - enable support for SCSI-II tagged queueing. Untested. * * USLEEP - enable support for devices that don't disconnect. Untested. * * The card is detected and initialized in one of several ways : * 1. With command line overrides - NCR5380=port,irq may be * used on the LILO command line to override the defaults. * * 2. With the GENERIC_NCR5380_OVERRIDE compile time define. This is * specified as an array of address, irq, dma, board tuples. Ie, for * one board at 0x350, IRQ5, no dma, I could say * -DGENERIC_NCR5380_OVERRIDE={{0xcc000, 5, DMA_NONE, BOARD_NCR5380}} * * -1 should be specified for no or DMA interrupt, -2 to autoprobe for an * IRQ line if overridden on the command line. * * 3. When included as a module, with arguments passed on the command line: * ncr_irq=xx the interrupt * ncr_addr=xx the port or base address (for port or memory * mapped, resp.) * ncr_dma=xx the DMA * ncr_5380=1 to set up for a NCR5380 board * ncr_53c400=1 to set up for a NCR53C400 board * e.g. * modprobe g_NCR5380 ncr_irq=5 ncr_addr=0x350 ncr_5380=1 * for a port mapped NCR5380 board or * modprobe g_NCR5380 ncr_irq=255 ncr_addr=0xc8000 ncr_53c400=1 * for a memory mapped NCR53C400 board with interrupts disabled. * * 255 should be specified for no or DMA interrupt, 254 to autoprobe for an * IRQ line if overridden on the command line. * */ /* * $Log$ * Revision 1.1.1.1 2007/03/28 16:38:53 pad * your commit message * * Revision 1.1 2006/09/20 01:30:53 pad * new files * */ /* settings for DTC3181E card with only Mustek scanner attached */ #define USLEEP #define USLEEP_POLL 1 #define USLEEP_SLEEP 20 #define USLEEP_WAITLONG 500 #define AUTOPROBE_IRQ #define AUTOSENSE #include #ifdef CONFIG_SCSI_GENERIC_NCR53C400 #define NCR53C400_PSEUDO_DMA 1 #define PSEUDO_DMA #define NCR53C400 #define NCR5380_STATS #undef NCR5380_STAT_LIMIT #endif #include #include #include #include #include #include "scsi.h" #include "hosts.h" #include "g_NCR5380.h" #include "NCR5380.h" #include #include #include #include #include #include #define NCR_NOT_SET 0 static int ncr_irq = NCR_NOT_SET; static int ncr_dma = NCR_NOT_SET; static int ncr_addr = NCR_NOT_SET; static int ncr_5380 = NCR_NOT_SET; static int ncr_53c400 = NCR_NOT_SET; static int ncr_53c400a = NCR_NOT_SET; static int dtc_3181e = NCR_NOT_SET; static struct override { NCR5380_implementation_fields; int irq; int dma; int board; /* Use NCR53c400, Ricoh, etc. extensions ? */ } overrides #ifdef GENERIC_NCR5380_OVERRIDE [] __initdata = GENERIC_NCR5380_OVERRIDE; #else [1] __initdata = { { 0,},}; #endif #define NO_OVERRIDES (sizeof(overrides) / sizeof(struct override)) #ifndef MODULE /** * internal_setup - handle lilo command string override * @board: BOARD_* identifier for the board * @str: unused * @ints: numeric parameters * * Do LILO command line initialization of the overrides array. Display * errors when needed * * Locks: none */ static void __init internal_setup(int board, char *str, int *ints) { static int commandline_current = 0; switch (board) { case BOARD_NCR5380: if (ints[0] != 2 && ints[0] != 3) { printk(KERN_ERR "generic_NCR5380_setup : usage ncr5380=" STRVAL(NCR5380_map_name) ",irq,dma\n"); return; } break; case BOARD_NCR53C400: if (ints[0] != 2) { printk(KERN_ERR "generic_NCR53C400_setup : usage ncr53c400=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; case BOARD_NCR53C400A: if (ints[0] != 2) { printk(KERN_ERR "generic_NCR53C400A_setup : usage ncr53c400a=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; case BOARD_DTC3181E: if (ints[0] != 2) { printk("generic_DTC3181E_setup : usage dtc3181e=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; } if (commandline_current < NO_OVERRIDES) { overrides[commandline_current].NCR5380_map_name = (NCR5380_map_type) ints[1]; overrides[commandline_current].irq = ints[2]; if (ints[0] == 3) overrides[commandline_current].dma = ints[3]; else overrides[commandline_current].dma = DMA_NONE; overrides[commandline_current].board = board; ++commandline_current; } } /** * do_NCR53C80_setup - set up entry point * @str: unused * * Setup function invoked at boot to parse the ncr5380= command * line. */ static int __init do_NCR5380_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR5380, str, ints); return 1; } /** * do_NCR53C400_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the ncr53c400= command * line. */ static int __init do_NCR53C400_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR53C400, str, ints); return 1; } /** * do_NCR53C400A_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the ncr53c400a= command * line. */ static int __init do_NCR53C400A_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR53C400A, str, ints); return 1; } /** * do_DTC3181E_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the dtc3181e= command * line. */ static int __init do_DTC3181E_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_DTC3181E, str, ints); return 1; } #endif /** * generic_NCR5380_detect - look for NCR5380 controllers * @tpnt: the scsi template * * Scan for the present of NCR5380, NCR53C400, NCR53C400A, DTC3181E * and DTC436(ISAPnP) controllers. If overrides have been set we use * them. * * The caller supplied NCR5380_init function is invoked from here, before * the interrupt line is taken. * * Locks: none */ int __init generic_NCR5380_detect(Scsi_Host_Template * tpnt) { static int current_override = 0; int count, i; unsigned int *ports; static unsigned int __initdata ncr_53c400a_ports[] = { 0x280, 0x290, 0x300, 0x310, 0x330, 0x340, 0x348, 0x350, 0 }; static unsigned int __initdata dtc_3181e_ports[] = { 0x220, 0x240, 0x280, 0x2a0, 0x2c0, 0x300, 0x320, 0x340, 0 }; int flags = 0; struct Scsi_Host *instance; if (ncr_irq != NCR_NOT_SET) overrides[0].irq = ncr_irq; if (ncr_dma != NCR_NOT_SET) overrides[0].dma = ncr_dma; if (ncr_addr != NCR_NOT_SET) overrides[0].NCR5380_map_name = (NCR5380_map_type) ncr_addr; if (ncr_5380 != NCR_NOT_SET) overrides[0].board = BOARD_NCR5380; else if (ncr_53c400 != NCR_NOT_SET) overrides[0].board = BOARD_NCR53C400; else if (ncr_53c400a != NCR_NOT_SET) overrides[0].board = BOARD_NCR53C400A; else if (dtc_3181e != NCR_NOT_SET) overrides[0].board = BOARD_DTC3181E; if (!current_override && isapnp_present()) { struct pnp_dev *dev = NULL; count = 0; while ((dev = pnp_find_dev(NULL, ISAPNP_VENDOR('D', 'T', 'C'), ISAPNP_FUNCTION(0x436e), dev))) { if (count >= NO_OVERRIDES) break; if (pnp_device_attach(dev) < 0) { printk(KERN_ERR "dtc436e probe: attach failed\n"); continue; } if (pnp_activate_dev(dev) < 0) { printk(KERN_ERR "dtc436e probe: activate failed\n"); pnp_device_detach(dev); continue; } if (!pnp_port_valid(dev, 0)) { printk(KERN_ERR "dtc436e probe: no valid port\n"); pnp_device_detach(dev); continue; } if (pnp_irq_valid(dev, 0)) overrides[count].irq = pnp_irq(dev, 0); else overrides[count].irq = SCSI_IRQ_NONE; if (pnp_dma_valid(dev, 0)) overrides[count].dma = pnp_dma(dev, 0); else overrides[count].dma = DMA_NONE; overrides[count].NCR5380_map_name = (NCR5380_map_type) pnp_port_start(dev, 0); overrides[count].board = BOARD_DTC3181E; count++; } } tpnt->proc_name = "g_NCR5380"; for (count = 0; current_override < NO_OVERRIDES; ++current_override) { if (!(overrides[current_override].NCR5380_map_name)) continue; ports = 0; switch (overrides[current_override].board) { case BOARD_NCR5380: flags = FLAG_NO_PSEUDO_DMA; break; case BOARD_NCR53C400: flags = FLAG_NCR53C400; break; case BOARD_NCR53C400A: flags = FLAG_NO_PSEUDO_DMA; ports = ncr_53c400a_ports; break; case BOARD_DTC3181E: flags = FLAG_NO_PSEUDO_DMA | FLAG_DTC3181E; ports = dtc_3181e_ports; break; } #ifndef CONFIG_SCSI_G_NCR5380_MEM if (ports) { /* wakeup sequence for the NCR53C400A and DTC3181E */ /* Disable the adapter and look for a free io port */ outb(0x59, 0x779); outb(0xb9, 0x379); outb(0xc5, 0x379); outb(0xae, 0x379); outb(0xa6, 0x379); outb(0x00, 0x379); if (overrides[current_override].NCR5380_map_name != PORT_AUTO) for (i = 0; ports[i]; i++) { if (overrides[current_override].NCR5380_map_name == ports[i]) break; } else for (i = 0; ports[i]; i++) { if ((!check_region(ports[i], 16)) && (inb(ports[i]) == 0xff)) break; } if (ports[i]) { outb(0x59, 0x779); outb(0xb9, 0x379); outb(0xc5, 0x379); outb(0xae, 0x379); outb(0xa6, 0x379); outb(0x80 | i, 0x379); /* set io port to be used */ outb(0xc0, ports[i] + 9); if (inb(ports[i] + 9) != 0x80) continue; else overrides[current_override].NCR5380_map_name = ports[i]; } else continue; } request_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size, "ncr5380"); #else if (check_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size)) continue; request_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size, "ncr5380"); #endif instance = scsi_register(tpnt, sizeof(struct NCR5380_hostdata)); if (instance == NULL) { #ifndef CONFIG_SCSI_G_NCR5380_MEM release_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size); #else release_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size); #endif continue; } instance->NCR5380_instance_name = overrides[current_override].NCR5380_map_name; NCR5380_init(instance, flags); if (overrides[current_override].irq != IRQ_AUTO) instance->irq = overrides[current_override].irq; else instance->irq = NCR5380_probe_irq(instance, 0xffff); if (instance->irq != SCSI_IRQ_NONE) if (request_irq(instance->irq, generic_NCR5380_intr, SA_INTERRUPT, "NCR5380", NULL)) { printk(KERN_WARNING "scsi%d : IRQ%d not free, interrupts disabled\n", instance->host_no, instance->irq); instance->irq = SCSI_IRQ_NONE; } if (instance->irq == SCSI_IRQ_NONE) { printk(KERN_INFO "scsi%d : interrupts not enabled. for better interactive performance,\n", instance->host_no); printk(KERN_INFO "scsi%d : please jumper the board for a free IRQ.\n", instance->host_no); } printk(KERN_INFO "scsi%d : at " STRVAL(NCR5380_map_name) " 0x%x", instance->host_no, (unsigned int) instance->NCR5380_instance_name); if (instance->irq == SCSI_IRQ_NONE) printk(" interrupts disabled"); else printk(" irq %d", instance->irq); printk(" options CAN_QUEUE=%d CMD_PER_LUN=%d release=%d", CAN_QUEUE, CMD_PER_LUN, GENERIC_NCR5380_PUBLIC_RELEASE); NCR5380_print_options(instance); printk("\n"); ++current_override; ++count; } return count; } /** * generic_NCR5380_info - reporting string * @host: NCR5380 to report on * * Report driver information for the NCR5380 */ const char *generic_NCR5380_info(struct Scsi_Host *host) { static const char string[] = "Generic NCR5380/53C400 Driver"; return string; } /** * generic_NCR5380_release_resources - free resources * @instance: host adapter to clean up * * Free the generic interface resources from this adapter. * * Locks: none */ int generic_NCR5380_release_resources(struct Scsi_Host *instance) { NCR5380_local_declare(); NCR5380_setup(instance); #ifndef CONFIG_SCSI_G_NCR5380_MEM release_region(instance->NCR5380_instance_name, NCR5380_region_size); #else release_mem_region(instance->NCR5380_instance_name, NCR5380_region_size); #endif if (instance->irq != SCSI_IRQ_NONE) free_irq(instance->irq, NULL); return 0; } #ifdef BIOSPARAM /** * generic_NCR5380_biosparam * @disk: disk to compute geometry for * @dev: device identifier for this disk * @ip: sizes to fill in * * Generates a BIOS / DOS compatible H-C-S mapping for the specified * device / size. * * XXX Most SCSI boards use this mapping, I could be incorrect. Someone * using hard disks on a trantor should verify that this mapping * corresponds to that used by the BIOS / ASPI driver by running the linux * fdisk program and matching the H_C_S coordinates to what DOS uses. * * Locks: none */ int generic_NCR5380_biosparam(struct scsi_device *sdev, struct block_device *bdev, sector_t capacity, int *ip) { ip[0] = 64; ip[1] = 32; ip[2] = capacity >> 11; return 0; } #endif #if NCR53C400_PSEUDO_DMA /** * NCR5380_pread - pseudo DMA read * @instance: adapter to read from * @dst: buffer to read into * @len: buffer length * * Perform a pseudo DMA mode read from an NCR53C400 or equivalent * controller */ static inline int NCR5380_pread(struct Scsi_Host *instance, unsigned char *dst, int len) { int blocks = len / 128; int start = 0; int bl; NCR5380_local_declare(); NCR5380_setup(instance); NCR5380_write(C400_CONTROL_STATUS_REG, CSR_BASE | CSR_TRANS_DIR); NCR5380_write(C400_BLOCK_COUNTER_REG, blocks); while (1) { if ((bl = NCR5380_read(C400_BLOCK_COUNTER_REG)) == 0) { break; } if (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ) { printk(KERN_ERR "53C400r: Got 53C80_IRQ start=%d, blocks=%d\n", start, blocks); return -1; } while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY); #ifndef CONFIG_SCSI_G_NCR5380_MEM { int i; for (i = 0; i < 128; i++) dst[start + i] = NCR5380_read(C400_HOST_BUFFER); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_fromio(dst + start, NCR53C400_host_buffer + NCR5380_map_name, 128); #endif start += 128; blocks--; } if (blocks) { while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) { // FIXME - no timeout } #ifndef CONFIG_SCSI_G_NCR5380_MEM { int i; for (i = 0; i < 128; i++) dst[start + i] = NCR5380_read(C400_HOST_BUFFER); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_fromio(dst + start, NCR53C400_host_buffer + NCR5380_map_name, 128); #endif start += 128; blocks--; } if (!(NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ)) printk("53C400r: no 53C80 gated irq after transfer"); #if 0 /* * DON'T DO THIS - THEY NEVER ARRIVE! */ printk("53C400r: Waiting for 53C80 registers\n"); while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_53C80_REG) ; #endif if (!(NCR5380_read(BUS_AND_STATUS_REG) & BASR_END_DMA_TRANSFER)) printk(KERN_ERR "53C400r: no end dma signal\n"); NCR5380_write(MODE_REG, MR_BASE); NCR5380_read(RESET_PARITY_INTERRUPT_REG); return 0; } /** * NCR5380_write - pseudo DMA write * @instance: adapter to read from * @dst: buffer to read into * @len: buffer length * * Perform a pseudo DMA mode read from an NCR53C400 or equivalent * controller */ static inline int NCR5380_pwrite(struct Scsi_Host *instance, unsigned char *src, int len) { int blocks = len / 128; int start = 0; int bl; int i; NCR5380_local_declare(); NCR5380_setup(instance); NCR5380_write(C400_CONTROL_STATUS_REG, CSR_BASE); NCR5380_write(C400_BLOCK_COUNTER_REG, blocks); while (1) { if (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ) { printk(KERN_ERR "53C400w: Got 53C80_IRQ start=%d, blocks=%d\n", start, blocks); return -1; } if ((bl = NCR5380_read(C400_BLOCK_COUNTER_REG)) == 0) { break; } while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) ; // FIXME - timeout #ifndef CONFIG_SCSI_G_NCR5380_MEM { for (i = 0; i < 128; i++) NCR5380_write(C400_HOST_BUFFER, src[start + i]); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_toio(NCR53C400_host_buffer + NCR5380_map_name, src + start, 128); #endif start += 128; blocks--; } if (blocks) { while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) ; // FIXME - no timeout #ifndef CONFIG_SCSI_G_NCR5380_MEM { for (i = 0; i < 128; i++) NCR5380_write(C400_HOST_BUFFER, src[start + i]); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_toio(NCR53C400_host_buffer + NCR5380_map_name, src + start, 128); #endif start += 128; blocks--; } #if 0 printk("53C400w: waiting for registers to be available\n"); THEY NEVER DO ! while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_53C80_REG); printk("53C400w: Got em\n"); #endif /* Let's wait for this instead - could be ugly */ /* All documentation says to check for this. Maybe my hardware is too * fast. Waiting for it seems to work fine! KLL */ while (!(i = NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ)) ; // FIXME - no timeout /* * I know. i is certainly != 0 here but the loop is new. See previous * comment. */ if (i) { if (!((i = NCR5380_read(BUS_AND_STATUS_REG)) & BASR_END_DMA_TRANSFER)) printk(KERN_ERR "53C400w: No END OF DMA bit - WHOOPS! BASR=%0x\n", i); } else printk(KERN_ERR "53C400w: no 53C80 gated irq after transfer (last block)\n"); #if 0 if (!(NCR5380_read(BUS_AND_STATUS_REG) & BASR_END_DMA_TRANSFER)) { printk(KERN_ERR "53C400w: no end dma signal\n"); } #endif while (!(NCR5380_read(TARGET_COMMAND_REG) & TCR_LAST_BYTE_SENT)) ; // TIMEOUT return 0; } #endif /* PSEUDO_DMA */ /* * Include the NCR5380 core code that we build our driver around */ #include "NCR5380.c" #define PRINTP(x) len += sprintf(buffer+len, x) #define ANDP , static int sprint_opcode(char *buffer, int len, int opcode) { int start = len; PRINTP("0x%02x " ANDP opcode); return len - start; } static int sprint_command(char *buffer, int len, unsigned char *command) { int i, s, start = len; len += sprint_opcode(buffer, len, command[0]); for (i = 1, s = COMMAND_SIZE(command[0]); i < s; ++i) PRINTP("%02x " ANDP command[i]); PRINTP("\n"); return len - start; } /** * sprintf_Scsi_Cmnd - print a scsi command * @buffer: buffr to print into * @len: buffer length * @cmd: SCSI command block * * Print out the target and command data in hex */ static int sprint_Scsi_Cmnd(char *buffer, int len, Scsi_Cmnd * cmd) { int start = len; PRINTP("host number %d destination target %d, lun %d\n" ANDP cmd->device->host->host_no ANDP cmd->device->id ANDP cmd->device->lun); PRINTP(" command = "); len += sprint_command(buffer, len, cmd->cmnd); return len - start; } /** * generic_NCR5380_proc_info - /proc for NCR5380 driver * @buffer: buffer to print into * @start: start position * @offset: offset into buffer * @len: length * @hostno: instance to affect * @inout: read/write * * Provide the procfs information for the 5380 controller. We fill * this with useful debugging information including the commands * being executed, disconnected command queue and the statistical * data * * Locks: global cli/lock for queue walk */ int generic_NCR5380_proc_info(char *buffer, char **start, off_t offset, int length, int hostno, int inout) { int len = 0; NCR5380_local_declare(); unsigned long flags; unsigned char status; int i; struct Scsi_Host *scsi_ptr; Scsi_Cmnd *ptr; struct NCR5380_hostdata *hostdata; #ifdef NCR5380_STATS Scsi_Device *dev; extern const char *const scsi_device_types[MAX_SCSI_DEVICE_CODE]; #endif /* For now this is constant so we may walk it */ scsi_ptr = scsi_host_hn_get(hostno); NCR5380_setup(scsi_ptr); hostdata = (struct NCR5380_hostdata *) scsi_ptr->hostdata; spin_lock_irqsave(scsi_ptr->host_lock, flags); PRINTP("SCSI host number %d : %s\n" ANDP scsi_ptr->host_no ANDP scsi_ptr->hostt->name); PRINTP("Generic NCR5380 driver version %d\n" ANDP GENERIC_NCR5380_PUBLIC_RELEASE); PRINTP("NCR5380 core version %d\n" ANDP NCR5380_PUBLIC_RELEASE); #ifdef NCR53C400 PRINTP("NCR53C400 extension version %d\n" ANDP NCR53C400_PUBLIC_RELEASE); PRINTP("NCR53C400 card%s detected\n" ANDP(((struct NCR5380_hostdata *) scsi_ptr->hostdata)->flags & FLAG_NCR53C400) ? "" : " not"); # if NCR53C400_PSEUDO_DMA PRINTP("NCR53C400 pseudo DMA used\n"); # endif #else PRINTP("NO NCR53C400 driver extensions\n"); #endif PRINTP("Using %s mapping at %s 0x%lx, " ANDP STRVAL(NCR5380_map_config) ANDP STRVAL(NCR5380_map_name) ANDP scsi_ptr->NCR5380_instance_name); if (scsi_ptr->irq == SCSI_IRQ_NONE) PRINTP("no interrupt\n"); else PRINTP("on interrupt %d\n" ANDP scsi_ptr->irq); #ifdef NCR5380_STATS if (hostdata->connected || hostdata->issue_queue || hostdata->disconnected_queue) PRINTP("There are commands pending, transfer rates may be crud\n"); if (hostdata->pendingr) PRINTP(" %d pending reads" ANDP hostdata->pendingr); if (hostdata->pendingw) PRINTP(" %d pending writes" ANDP hostdata->pendingw); if (hostdata->pendingr || hostdata->pendingw) PRINTP("\n"); list_for_each_entry (dev, &scsi_ptr->my_devices, siblings) { unsigned long br = hostdata->bytes_read[dev->id]; unsigned long bw = hostdata->bytes_write[dev->id]; long tr = hostdata->time_read[dev->id] / HZ; long tw = hostdata->time_write[dev->id] / HZ; PRINTP(" T:%d %s " ANDP dev->id ANDP(dev->type < MAX_SCSI_DEVICE_CODE) ? scsi_device_types[(int) dev->type] : "Unknown"); for (i = 0; i < 8; i++) if (dev->vendor[i] >= 0x20) *(buffer + (len++)) = dev->vendor[i]; *(buffer + (len++)) = ' '; for (i = 0; i < 16; i++) if (dev->model[i] >= 0x20) *(buffer + (len++)) = dev->model[i]; *(buffer + (len++)) = ' '; for (i = 0; i < 4; i++) if (dev->rev[i] >= 0x20) *(buffer + (len++)) = dev->rev[i]; *(buffer + (len++)) = ' '; PRINTP("\n%10ld kb read in %5ld secs" ANDP br / 1024 ANDP tr); if (tr) PRINTP(" @ %5ld bps" ANDP br / tr); PRINTP("\n%10ld kb written in %5ld secs" ANDP bw / 1024 ANDP tw); if (tw) PRINTP(" @ %5ld bps" ANDP bw / tw); PRINTP("\n"); } #endif status = NCR5380_read(STATUS_REG); if (!(status & SR_REQ)) PRINTP("REQ not asserted, phase unknown.\n"); else { for (i = 0; (phases[i].value != PHASE_UNKNOWN) && (phases[i].value != (status & PHASE_MASK)); ++i); PRINTP("Phase %s\n" ANDP phases[i].name); } if (!hostdata->connected) { PRINTP("No currently connected command\n"); } else { len += sprint_Scsi_Cmnd(buffer, len, (Scsi_Cmnd *) hostdata->connected); } PRINTP("issue_queue\n"); for (ptr = (Scsi_Cmnd *) hostdata->issue_queue; ptr; ptr = (Scsi_Cmnd *) ptr->host_scribble) len += sprint_Scsi_Cmnd(buffer, len, ptr); PRINTP("disconnected_queue\n"); for (ptr = (Scsi_Cmnd *) hostdata->disconnected_queue; ptr; ptr = (Scsi_Cmnd *) ptr->host_scribble) len += sprint_Scsi_Cmnd(buffer, len, ptr); *start = buffer + offset; len -= offset; if (len > length) len = length; spin_unlock_irqrestore(scsi_ptr->host_lock, flags); return len; } #undef PRINTP #undef ANDP static Scsi_Host_Template driver_template = { .proc_info = generic_NCR5380_proc_info, .name = "Generic NCR5380/NCR53C400 Scsi Driver", .detect = generic_NCR5380_detect, .release = generic_NCR5380_release_resources, .info = generic_NCR5380_info, .queuecommand = generic_NCR5380_queue_command, .eh_abort_handler = generic_NCR5380_abort, .eh_bus_reset_handler = generic_NCR5380_bus_reset, .eh_device_reset_handler = generic_NCR5380_device_reset, .eh_host_reset_handler = generic_NCR5380_host_reset, .bios_param = NCR5380_BIOSPARAM, .can_queue = CAN_QUEUE, .this_id = 7, .sg_tablesize = SG_ALL, .cmd_per_lun = CMD_PER_LUN, .use_clustering = DISABLE_CLUSTERING, }; #include #include "scsi_module.c" MODULE_PARM(ncr_irq, "i"); MODULE_PARM(ncr_dma, "i"); MODULE_PARM(ncr_addr, "i"); MODULE_PARM(ncr_5380, "i"); MODULE_PARM(ncr_53c400, "i"); MODULE_PARM(ncr_53c400a, "i"); MODULE_PARM(dtc_3181e, "i"); MODULE_LICENSE("GPL"); static struct isapnp_device_id id_table[] __devinitdata = { { ISAPNP_ANY_ID, ISAPNP_ANY_ID, ISAPNP_VENDOR('D', 'T', 'C'), ISAPNP_FUNCTION(0x436e), 0}, {0} }; MODULE_DEVICE_TABLE(isapnp, id_table); __setup("ncr5380=", do_NCR5380_setup); __setup("ncr53c400=", do_NCR53C400_setup); __setup("ncr53c400a=", do_NCR53C400A_setup); __setup("dtc3181e=", do_DTC3181E_setup); coccinelle-1.0.0-rc19/demos/demo_rule9/g_NCR5380.res0000644000175000017500000006242012247437436020532 0ustar eugeneugen/* * Generic Generic NCR5380 driver * * Copyright 1993, Drew Eckhardt * Visionary Computing * (Unix and Linux consulting and custom programming) * drew@colorado.edu * +1 (303) 440-4894 * * NCR53C400 extensions (c) 1994,1995,1996, Kevin Lentin * K.Lentin@cs.monash.edu.au * * NCR53C400A extensions (c) 1996, Ingmar Baumgart * ingmar@gonzo.schwaben.de * * DTC3181E extensions (c) 1997, Ronald van Cuijlenborg * ronald.van.cuijlenborg@tip.nl or nutty@dds.nl * * Added ISAPNP support for DTC436 adapters, * Thomas Sailer, sailer@ife.ee.ethz.ch * * ALPHA RELEASE 1. * * For more information, please consult * * NCR 5380 Family * SCSI Protocol Controller * Databook * * NCR Microelectronics * 1635 Aeroplaza Drive * Colorado Springs, CO 80916 * 1+ (719) 578-3400 * 1+ (800) 334-5454 */ /* * TODO : flesh out DMA support, find some one actually using this (I have * a memory mapped Trantor board that works fine) */ /* * Options : * * PARITY - enable parity checking. Not supported. * * SCSI2 - enable support for SCSI-II tagged queueing. Untested. * * USLEEP - enable support for devices that don't disconnect. Untested. * * The card is detected and initialized in one of several ways : * 1. With command line overrides - NCR5380=port,irq may be * used on the LILO command line to override the defaults. * * 2. With the GENERIC_NCR5380_OVERRIDE compile time define. This is * specified as an array of address, irq, dma, board tuples. Ie, for * one board at 0x350, IRQ5, no dma, I could say * -DGENERIC_NCR5380_OVERRIDE={{0xcc000, 5, DMA_NONE, BOARD_NCR5380}} * * -1 should be specified for no or DMA interrupt, -2 to autoprobe for an * IRQ line if overridden on the command line. * * 3. When included as a module, with arguments passed on the command line: * ncr_irq=xx the interrupt * ncr_addr=xx the port or base address (for port or memory * mapped, resp.) * ncr_dma=xx the DMA * ncr_5380=1 to set up for a NCR5380 board * ncr_53c400=1 to set up for a NCR53C400 board * e.g. * modprobe g_NCR5380 ncr_irq=5 ncr_addr=0x350 ncr_5380=1 * for a port mapped NCR5380 board or * modprobe g_NCR5380 ncr_irq=255 ncr_addr=0xc8000 ncr_53c400=1 * for a memory mapped NCR53C400 board with interrupts disabled. * * 255 should be specified for no or DMA interrupt, 254 to autoprobe for an * IRQ line if overridden on the command line. * */ /* * $Log: not supported by cvs2svn $ * Revision 1.1.1.1 2007/03/28 16:38:53 pad * your commit message * * Revision 1.1 2006/09/20 01:30:53 pad * new files * */ /* settings for DTC3181E card with only Mustek scanner attached */ #define USLEEP #define USLEEP_POLL 1 #define USLEEP_SLEEP 20 #define USLEEP_WAITLONG 500 #define AUTOPROBE_IRQ #define AUTOSENSE #include #ifdef CONFIG_SCSI_GENERIC_NCR53C400 #define NCR53C400_PSEUDO_DMA 1 #define PSEUDO_DMA #define NCR53C400 #define NCR5380_STATS #undef NCR5380_STAT_LIMIT #endif #include #include #include #include #include #include "scsi.h" #include "hosts.h" #include "g_NCR5380.h" #include "NCR5380.h" #include #include #include #include #include #include #define NCR_NOT_SET 0 static int ncr_irq = NCR_NOT_SET; static int ncr_dma = NCR_NOT_SET; static int ncr_addr = NCR_NOT_SET; static int ncr_5380 = NCR_NOT_SET; static int ncr_53c400 = NCR_NOT_SET; static int ncr_53c400a = NCR_NOT_SET; static int dtc_3181e = NCR_NOT_SET; static struct override { NCR5380_implementation_fields; int irq; int dma; int board; /* Use NCR53c400, Ricoh, etc. extensions ? */ } overrides #ifdef GENERIC_NCR5380_OVERRIDE [] __initdata = GENERIC_NCR5380_OVERRIDE; #else [1] __initdata = { { 0,},}; #endif #define NO_OVERRIDES (sizeof(overrides) / sizeof(struct override)) #ifndef MODULE /** * internal_setup - handle lilo command string override * @board: BOARD_* identifier for the board * @str: unused * @ints: numeric parameters * * Do LILO command line initialization of the overrides array. Display * errors when needed * * Locks: none */ static void __init internal_setup(int board, char *str, int *ints) { static int commandline_current = 0; switch (board) { case BOARD_NCR5380: if (ints[0] != 2 && ints[0] != 3) { printk(KERN_ERR "generic_NCR5380_setup : usage ncr5380=" STRVAL(NCR5380_map_name) ",irq,dma\n"); return; } break; case BOARD_NCR53C400: if (ints[0] != 2) { printk(KERN_ERR "generic_NCR53C400_setup : usage ncr53c400=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; case BOARD_NCR53C400A: if (ints[0] != 2) { printk(KERN_ERR "generic_NCR53C400A_setup : usage ncr53c400a=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; case BOARD_DTC3181E: if (ints[0] != 2) { printk("generic_DTC3181E_setup : usage dtc3181e=" STRVAL(NCR5380_map_name) ",irq\n"); return; } break; } if (commandline_current < NO_OVERRIDES) { overrides[commandline_current].NCR5380_map_name = (NCR5380_map_type) ints[1]; overrides[commandline_current].irq = ints[2]; if (ints[0] == 3) overrides[commandline_current].dma = ints[3]; else overrides[commandline_current].dma = DMA_NONE; overrides[commandline_current].board = board; ++commandline_current; } } /** * do_NCR53C80_setup - set up entry point * @str: unused * * Setup function invoked at boot to parse the ncr5380= command * line. */ static int __init do_NCR5380_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR5380, str, ints); return 1; } /** * do_NCR53C400_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the ncr53c400= command * line. */ static int __init do_NCR53C400_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR53C400, str, ints); return 1; } /** * do_NCR53C400A_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the ncr53c400a= command * line. */ static int __init do_NCR53C400A_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_NCR53C400A, str, ints); return 1; } /** * do_DTC3181E_setup - set up entry point * @str: unused * @ints: integer parameters from kernel setup code * * Setup function invoked at boot to parse the dtc3181e= command * line. */ static int __init do_DTC3181E_setup(char *str) { int ints[10]; get_options(str, sizeof(ints) / sizeof(int), ints); internal_setup(BOARD_DTC3181E, str, ints); return 1; } #endif /** * generic_NCR5380_detect - look for NCR5380 controllers * @tpnt: the scsi template * * Scan for the present of NCR5380, NCR53C400, NCR53C400A, DTC3181E * and DTC436(ISAPnP) controllers. If overrides have been set we use * them. * * The caller supplied NCR5380_init function is invoked from here, before * the interrupt line is taken. * * Locks: none */ int __init generic_NCR5380_detect(Scsi_Host_Template * tpnt) { static int current_override = 0; int count, i; unsigned int *ports; static unsigned int __initdata ncr_53c400a_ports[] = { 0x280, 0x290, 0x300, 0x310, 0x330, 0x340, 0x348, 0x350, 0 }; static unsigned int __initdata dtc_3181e_ports[] = { 0x220, 0x240, 0x280, 0x2a0, 0x2c0, 0x300, 0x320, 0x340, 0 }; int flags = 0; struct Scsi_Host *instance; if (ncr_irq != NCR_NOT_SET) overrides[0].irq = ncr_irq; if (ncr_dma != NCR_NOT_SET) overrides[0].dma = ncr_dma; if (ncr_addr != NCR_NOT_SET) overrides[0].NCR5380_map_name = (NCR5380_map_type) ncr_addr; if (ncr_5380 != NCR_NOT_SET) overrides[0].board = BOARD_NCR5380; else if (ncr_53c400 != NCR_NOT_SET) overrides[0].board = BOARD_NCR53C400; else if (ncr_53c400a != NCR_NOT_SET) overrides[0].board = BOARD_NCR53C400A; else if (dtc_3181e != NCR_NOT_SET) overrides[0].board = BOARD_DTC3181E; if (!current_override && isapnp_present()) { struct pnp_dev *dev = NULL; count = 0; while ((dev = pnp_find_dev(NULL, ISAPNP_VENDOR('D', 'T', 'C'), ISAPNP_FUNCTION(0x436e), dev))) { if (count >= NO_OVERRIDES) break; if (pnp_device_attach(dev) < 0) { printk(KERN_ERR "dtc436e probe: attach failed\n"); continue; } if (pnp_activate_dev(dev) < 0) { printk(KERN_ERR "dtc436e probe: activate failed\n"); pnp_device_detach(dev); continue; } if (!pnp_port_valid(dev, 0)) { printk(KERN_ERR "dtc436e probe: no valid port\n"); pnp_device_detach(dev); continue; } if (pnp_irq_valid(dev, 0)) overrides[count].irq = pnp_irq(dev, 0); else overrides[count].irq = SCSI_IRQ_NONE; if (pnp_dma_valid(dev, 0)) overrides[count].dma = pnp_dma(dev, 0); else overrides[count].dma = DMA_NONE; overrides[count].NCR5380_map_name = (NCR5380_map_type) pnp_port_start(dev, 0); overrides[count].board = BOARD_DTC3181E; count++; } } tpnt->proc_name = "g_NCR5380"; for (count = 0; current_override < NO_OVERRIDES; ++current_override) { if (!(overrides[current_override].NCR5380_map_name)) continue; ports = 0; switch (overrides[current_override].board) { case BOARD_NCR5380: flags = FLAG_NO_PSEUDO_DMA; break; case BOARD_NCR53C400: flags = FLAG_NCR53C400; break; case BOARD_NCR53C400A: flags = FLAG_NO_PSEUDO_DMA; ports = ncr_53c400a_ports; break; case BOARD_DTC3181E: flags = FLAG_NO_PSEUDO_DMA | FLAG_DTC3181E; ports = dtc_3181e_ports; break; } #ifndef CONFIG_SCSI_G_NCR5380_MEM if (ports) { /* wakeup sequence for the NCR53C400A and DTC3181E */ /* Disable the adapter and look for a free io port */ outb(0x59, 0x779); outb(0xb9, 0x379); outb(0xc5, 0x379); outb(0xae, 0x379); outb(0xa6, 0x379); outb(0x00, 0x379); if (overrides[current_override].NCR5380_map_name != PORT_AUTO) for (i = 0; ports[i]; i++) { if (overrides[current_override].NCR5380_map_name == ports[i]) break; } else for (i = 0; ports[i]; i++) { if ((!check_region(ports[i], 16)) && (inb(ports[i]) == 0xff)) break; } if (ports[i]) { outb(0x59, 0x779); outb(0xb9, 0x379); outb(0xc5, 0x379); outb(0xae, 0x379); outb(0xa6, 0x379); outb(0x80 | i, 0x379); /* set io port to be used */ outb(0xc0, ports[i] + 9); if (inb(ports[i] + 9) != 0x80) continue; else overrides[current_override].NCR5380_map_name = ports[i]; } else continue; } request_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size, "ncr5380"); #else if (check_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size)) continue; request_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size, "ncr5380"); #endif instance = scsi_register(tpnt, sizeof(struct NCR5380_hostdata)); if (instance == NULL) { #ifndef CONFIG_SCSI_G_NCR5380_MEM release_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size); #else release_mem_region(overrides[current_override].NCR5380_map_name, NCR5380_region_size); #endif continue; } instance->NCR5380_instance_name = overrides[current_override].NCR5380_map_name; NCR5380_init(instance, flags); if (overrides[current_override].irq != IRQ_AUTO) instance->irq = overrides[current_override].irq; else instance->irq = NCR5380_probe_irq(instance, 0xffff); if (instance->irq != SCSI_IRQ_NONE) if (request_irq(instance->irq, generic_NCR5380_intr, SA_INTERRUPT, "NCR5380", NULL)) { printk(KERN_WARNING "scsi%d : IRQ%d not free, interrupts disabled\n", instance->host_no, instance->irq); instance->irq = SCSI_IRQ_NONE; } if (instance->irq == SCSI_IRQ_NONE) { printk(KERN_INFO "scsi%d : interrupts not enabled. for better interactive performance,\n", instance->host_no); printk(KERN_INFO "scsi%d : please jumper the board for a free IRQ.\n", instance->host_no); } printk(KERN_INFO "scsi%d : at " STRVAL(NCR5380_map_name) " 0x%x", instance->host_no, (unsigned int) instance->NCR5380_instance_name); if (instance->irq == SCSI_IRQ_NONE) printk(" interrupts disabled"); else printk(" irq %d", instance->irq); printk(" options CAN_QUEUE=%d CMD_PER_LUN=%d release=%d", CAN_QUEUE, CMD_PER_LUN, GENERIC_NCR5380_PUBLIC_RELEASE); NCR5380_print_options(instance); printk("\n"); ++current_override; ++count; } return count; } /** * generic_NCR5380_info - reporting string * @host: NCR5380 to report on * * Report driver information for the NCR5380 */ const char *generic_NCR5380_info(struct Scsi_Host *host) { static const char string[] = "Generic NCR5380/53C400 Driver"; return string; } /** * generic_NCR5380_release_resources - free resources * @instance: host adapter to clean up * * Free the generic interface resources from this adapter. * * Locks: none */ int generic_NCR5380_release_resources(struct Scsi_Host *instance) { NCR5380_local_declare(); NCR5380_setup(instance); #ifndef CONFIG_SCSI_G_NCR5380_MEM release_region(instance->NCR5380_instance_name, NCR5380_region_size); #else release_mem_region(instance->NCR5380_instance_name, NCR5380_region_size); #endif if (instance->irq != SCSI_IRQ_NONE) free_irq(instance->irq, NULL); return 0; } #ifdef BIOSPARAM /** * generic_NCR5380_biosparam * @disk: disk to compute geometry for * @dev: device identifier for this disk * @ip: sizes to fill in * * Generates a BIOS / DOS compatible H-C-S mapping for the specified * device / size. * * XXX Most SCSI boards use this mapping, I could be incorrect. Someone * using hard disks on a trantor should verify that this mapping * corresponds to that used by the BIOS / ASPI driver by running the linux * fdisk program and matching the H_C_S coordinates to what DOS uses. * * Locks: none */ int generic_NCR5380_biosparam(struct scsi_device *sdev, struct block_device *bdev, sector_t capacity, int *ip) { ip[0] = 64; ip[1] = 32; ip[2] = capacity >> 11; return 0; } #endif #if NCR53C400_PSEUDO_DMA /** * NCR5380_pread - pseudo DMA read * @instance: adapter to read from * @dst: buffer to read into * @len: buffer length * * Perform a psuedo DMA mode read from an NCR53C400 or equivalent * controller */ static inline int NCR5380_pread(struct Scsi_Host *instance, unsigned char *dst, int len) { int blocks = len / 128; int start = 0; int bl; NCR5380_local_declare(); NCR5380_setup(instance); NCR5380_write(C400_CONTROL_STATUS_REG, CSR_BASE | CSR_TRANS_DIR); NCR5380_write(C400_BLOCK_COUNTER_REG, blocks); while (1) { if ((bl = NCR5380_read(C400_BLOCK_COUNTER_REG)) == 0) { break; } if (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ) { printk(KERN_ERR "53C400r: Got 53C80_IRQ start=%d, blocks=%d\n", start, blocks); return -1; } while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY); #ifndef CONFIG_SCSI_G_NCR5380_MEM { int i; for (i = 0; i < 128; i++) dst[start + i] = NCR5380_read(C400_HOST_BUFFER); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_fromio(dst + start, NCR53C400_host_buffer + NCR5380_map_name, 128); #endif start += 128; blocks--; } if (blocks) { while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) { // FIXME - no timeout } #ifndef CONFIG_SCSI_G_NCR5380_MEM { int i; for (i = 0; i < 128; i++) dst[start + i] = NCR5380_read(C400_HOST_BUFFER); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_fromio(dst + start, NCR53C400_host_buffer + NCR5380_map_name, 128); #endif start += 128; blocks--; } if (!(NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ)) printk("53C400r: no 53C80 gated irq after transfer"); #if 0 /* * DON'T DO THIS - THEY NEVER ARRIVE! */ printk("53C400r: Waiting for 53C80 registers\n"); while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_53C80_REG) ; #endif if (!(NCR5380_read(BUS_AND_STATUS_REG) & BASR_END_DMA_TRANSFER)) printk(KERN_ERR "53C400r: no end dma signal\n"); NCR5380_write(MODE_REG, MR_BASE); NCR5380_read(RESET_PARITY_INTERRUPT_REG); return 0; } /** * NCR5380_write - pseudo DMA write * @instance: adapter to read from * @dst: buffer to read into * @len: buffer length * * Perform a psuedo DMA mode read from an NCR53C400 or equivalent * controller */ static inline int NCR5380_pwrite(struct Scsi_Host *instance, unsigned char *src, int len) { int blocks = len / 128; int start = 0; int bl; int i; NCR5380_local_declare(); NCR5380_setup(instance); NCR5380_write(C400_CONTROL_STATUS_REG, CSR_BASE); NCR5380_write(C400_BLOCK_COUNTER_REG, blocks); while (1) { if (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ) { printk(KERN_ERR "53C400w: Got 53C80_IRQ start=%d, blocks=%d\n", start, blocks); return -1; } if ((bl = NCR5380_read(C400_BLOCK_COUNTER_REG)) == 0) { break; } while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) ; // FIXME - timeout #ifndef CONFIG_SCSI_G_NCR5380_MEM { for (i = 0; i < 128; i++) NCR5380_write(C400_HOST_BUFFER, src[start + i]); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_toio(NCR53C400_host_buffer + NCR5380_map_name, src + start, 128); #endif start += 128; blocks--; } if (blocks) { while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_HOST_BUF_NOT_RDY) ; // FIXME - no timeout #ifndef CONFIG_SCSI_G_NCR5380_MEM { for (i = 0; i < 128; i++) NCR5380_write(C400_HOST_BUFFER, src[start + i]); } #else /* implies CONFIG_SCSI_G_NCR5380_MEM */ isa_memcpy_toio(NCR53C400_host_buffer + NCR5380_map_name, src + start, 128); #endif start += 128; blocks--; } #if 0 printk("53C400w: waiting for registers to be available\n"); THEY NEVER DO ! while (NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_53C80_REG); printk("53C400w: Got em\n"); #endif /* Let's wait for this instead - could be ugly */ /* All documentation says to check for this. Maybe my hardware is too * fast. Waiting for it seems to work fine! KLL */ while (!(i = NCR5380_read(C400_CONTROL_STATUS_REG) & CSR_GATED_53C80_IRQ)) ; // FIXME - no timeout /* * I know. i is certainly != 0 here but the loop is new. See previous * comment. */ if (i) { if (!((i = NCR5380_read(BUS_AND_STATUS_REG)) & BASR_END_DMA_TRANSFER)) printk(KERN_ERR "53C400w: No END OF DMA bit - WHOOPS! BASR=%0x\n", i); } else printk(KERN_ERR "53C400w: no 53C80 gated irq after transfer (last block)\n"); #if 0 if (!(NCR5380_read(BUS_AND_STATUS_REG) & BASR_END_DMA_TRANSFER)) { printk(KERN_ERR "53C400w: no end dma signal\n"); } #endif while (!(NCR5380_read(TARGET_COMMAND_REG) & TCR_LAST_BYTE_SENT)) ; // TIMEOUT return 0; } #endif /* PSEUDO_DMA */ /* * Include the NCR5380 core code that we build our driver around */ #include "NCR5380.c" #define PRINTP(x) len += sprintf(buffer+len, x) #define ANDP , static int sprint_opcode(char *buffer, int len, int opcode) { int start = len; PRINTP("0x%02x " ANDP opcode); return len - start; } static int sprint_command(char *buffer, int len, unsigned char *command) { int i, s, start = len; len += sprint_opcode(buffer, len, command[0]); for (i = 1, s = COMMAND_SIZE(command[0]); i < s; ++i) PRINTP("%02x " ANDP command[i]); PRINTP("\n"); return len - start; } /** * sprintf_Scsi_Cmnd - print a scsi command * @buffer: buffr to print into * @len: buffer length * @cmd: SCSI command block * * Print out the target and command data in hex */ static int sprint_Scsi_Cmnd(char *buffer, int len, Scsi_Cmnd * cmd) { int start = len; PRINTP("host number %d destination target %d, lun %d\n" ANDP cmd->device->host->host_no ANDP cmd->device->id ANDP cmd->device->lun); PRINTP(" command = "); len += sprint_command(buffer, len, cmd->cmnd); return len - start; } /** * generic_NCR5380_proc_info - /proc for NCR5380 driver * @buffer: buffer to print into * @start: start position * @offset: offset into buffer * @len: length * @hostno: instance to affect * @inout: read/write * * Provide the procfs information for the 5380 controller. We fill * this with useful debugging information including the commands * being executed, disconnected command queue and the statistical * data * * Locks: global cli/lock for queue walk */ int generic_NCR5380_proc_info(struct Scsi_Host *scsi_ptr, char *buffer, char **start, off_t offset, int length, int inout) { int len = 0; NCR5380_local_declare(); unsigned long flags; unsigned char status; int i; Scsi_Cmnd *ptr; struct NCR5380_hostdata *hostdata; #ifdef NCR5380_STATS Scsi_Device *dev; extern const char *const scsi_device_types[MAX_SCSI_DEVICE_CODE]; #endif NCR5380_setup(scsi_ptr); hostdata = (struct NCR5380_hostdata *) scsi_ptr->hostdata; spin_lock_irqsave(scsi_ptr->host_lock, flags); PRINTP("SCSI host number %d : %s\n" ANDP scsi_ptr->host_no ANDP scsi_ptr->hostt->name); PRINTP("Generic NCR5380 driver version %d\n" ANDP GENERIC_NCR5380_PUBLIC_RELEASE); PRINTP("NCR5380 core version %d\n" ANDP NCR5380_PUBLIC_RELEASE); #ifdef NCR53C400 PRINTP("NCR53C400 extension version %d\n" ANDP NCR53C400_PUBLIC_RELEASE); PRINTP("NCR53C400 card%s detected\n" ANDP(((struct NCR5380_hostdata *) scsi_ptr->hostdata)->flags & FLAG_NCR53C400) ? "" : " not"); # if NCR53C400_PSEUDO_DMA PRINTP("NCR53C400 pseudo DMA used\n"); # endif #else PRINTP("NO NCR53C400 driver extensions\n"); #endif PRINTP("Using %s mapping at %s 0x%lx, " ANDP STRVAL(NCR5380_map_config) ANDP STRVAL(NCR5380_map_name) ANDP scsi_ptr->NCR5380_instance_name); if (scsi_ptr->irq == SCSI_IRQ_NONE) PRINTP("no interrupt\n"); else PRINTP("on interrupt %d\n" ANDP scsi_ptr->irq); #ifdef NCR5380_STATS if (hostdata->connected || hostdata->issue_queue || hostdata->disconnected_queue) PRINTP("There are commands pending, transfer rates may be crud\n"); if (hostdata->pendingr) PRINTP(" %d pending reads" ANDP hostdata->pendingr); if (hostdata->pendingw) PRINTP(" %d pending writes" ANDP hostdata->pendingw); if (hostdata->pendingr || hostdata->pendingw) PRINTP("\n"); list_for_each_entry (dev, &scsi_ptr->my_devices, siblings) { unsigned long br = hostdata->bytes_read[dev->id]; unsigned long bw = hostdata->bytes_write[dev->id]; long tr = hostdata->time_read[dev->id] / HZ; long tw = hostdata->time_write[dev->id] / HZ; PRINTP(" T:%d %s " ANDP dev->id ANDP(dev->type < MAX_SCSI_DEVICE_CODE) ? scsi_device_types[(int) dev->type] : "Unknown"); for (i = 0; i < 8; i++) if (dev->vendor[i] >= 0x20) *(buffer + (len++)) = dev->vendor[i]; *(buffer + (len++)) = ' '; for (i = 0; i < 16; i++) if (dev->model[i] >= 0x20) *(buffer + (len++)) = dev->model[i]; *(buffer + (len++)) = ' '; for (i = 0; i < 4; i++) if (dev->rev[i] >= 0x20) *(buffer + (len++)) = dev->rev[i]; *(buffer + (len++)) = ' '; PRINTP("\n%10ld kb read in %5ld secs" ANDP br / 1024 ANDP tr); if (tr) PRINTP(" @ %5ld bps" ANDP br / tr); PRINTP("\n%10ld kb written in %5ld secs" ANDP bw / 1024 ANDP tw); if (tw) PRINTP(" @ %5ld bps" ANDP bw / tw); PRINTP("\n"); } #endif status = NCR5380_read(STATUS_REG); if (!(status & SR_REQ)) PRINTP("REQ not asserted, phase unknown.\n"); else { for (i = 0; (phases[i].value != PHASE_UNKNOWN) && (phases[i].value != (status & PHASE_MASK)); ++i); PRINTP("Phase %s\n" ANDP phases[i].name); } if (!hostdata->connected) { PRINTP("No currently connected command\n"); } else { len += sprint_Scsi_Cmnd(buffer, len, (Scsi_Cmnd *) hostdata->connected); } PRINTP("issue_queue\n"); for (ptr = (Scsi_Cmnd *) hostdata->issue_queue; ptr; ptr = (Scsi_Cmnd *) ptr->host_scribble) len += sprint_Scsi_Cmnd(buffer, len, ptr); PRINTP("disconnected_queue\n"); for (ptr = (Scsi_Cmnd *) hostdata->disconnected_queue; ptr; ptr = (Scsi_Cmnd *) ptr->host_scribble) len += sprint_Scsi_Cmnd(buffer, len, ptr); *start = buffer + offset; len -= offset; if (len > length) len = length; spin_unlock_irqrestore(scsi_ptr->host_lock, flags); return len; } #undef PRINTP #undef ANDP static Scsi_Host_Template driver_template = { .proc_info = generic_NCR5380_proc_info, .name = "Generic NCR5380/NCR53C400 Scsi Driver", .detect = generic_NCR5380_detect, .release = generic_NCR5380_release_resources, .info = generic_NCR5380_info, .queuecommand = generic_NCR5380_queue_command, .eh_abort_handler = generic_NCR5380_abort, .eh_bus_reset_handler = generic_NCR5380_bus_reset, .eh_device_reset_handler = generic_NCR5380_device_reset, .eh_host_reset_handler = generic_NCR5380_host_reset, .bios_param = NCR5380_BIOSPARAM, .can_queue = CAN_QUEUE, .this_id = 7, .sg_tablesize = SG_ALL, .cmd_per_lun = CMD_PER_LUN, .use_clustering = DISABLE_CLUSTERING, }; #include #include "scsi_module.c" MODULE_PARM(ncr_irq, "i"); MODULE_PARM(ncr_dma, "i"); MODULE_PARM(ncr_addr, "i"); MODULE_PARM(ncr_5380, "i"); MODULE_PARM(ncr_53c400, "i"); MODULE_PARM(ncr_53c400a, "i"); MODULE_PARM(dtc_3181e, "i"); MODULE_LICENSE("GPL"); static struct isapnp_device_id id_table[] __devinitdata = { { ISAPNP_ANY_ID, ISAPNP_ANY_ID, ISAPNP_VENDOR('D', 'T', 'C'), ISAPNP_FUNCTION(0x436e), 0}, {0} }; MODULE_DEVICE_TABLE(isapnp, id_table); __setup("ncr5380=", do_NCR5380_setup); __setup("ncr53c400=", do_NCR53C400_setup); __setup("ncr53c400a=", do_NCR53C400A_setup); __setup("dtc3181e=", do_DTC3181E_setup); coccinelle-1.0.0-rc19/demos/demo_rule9/scsiglue.res0000644000175000017500000005667112247437436021113 0ustar eugeneugen/* Driver for USB Mass Storage compliant devices * SCSI layer glue code * * * * Current development and maintenance by: * (c) 1999-2002 Matthew Dharm (mdharm-usb@one-eyed-alien.net) * * Developed with the assistance of: * (c) 2000 David L. Brown, Jr. (usb-storage@davidb.org) * (c) 2000 Stephen J. Gowdy (SGowdy@lbl.gov) * * Initial work by: * (c) 1999 Michael Gee (michael@linuxspecific.com) * * This driver is based on the 'USB Mass Storage Class' document. This * describes in detail the protocol used to communicate with such * devices. Clearly, the designers had SCSI and ATAPI commands in * mind when they created this document. The commands are all very * similar to commands in the SCSI-II and ATAPI specifications. * * It is important to note that in a number of cases this class * exhibits class-specific exemptions from the USB specification. * Notably the usage of NAK, STALL and ACK differs from the norm, in * that they are used to communicate wait, failed and OK on commands. * * Also, for certain devices, the interrupt endpoint is used to convey * status of a command. * * Please see http://www.one-eyed-alien.net/~mdharm/linux-usb for more * information about this driver. * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the * Free Software Foundation; either version 2, or (at your option) any * later version. * * This program is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "scsiglue.h" #include "usb.h" #include "debug.h" #include "transport.h" #include #include /*********************************************************************** * Host functions ***********************************************************************/ static const char* usb_storage_info(struct Scsi_Host *host) { return "SCSI emulation for USB Mass Storage devices"; } #if 0 /* detect a virtual adapter (always works) * Synchronization: 2.4: with the io_request_lock * 2.5: no locks. * fortunately we don't care. * */ static int usb_storage_detect(struct SHT *sht) { struct us_data *us; char local_name[32]; /* This is not nice at all, but how else are we to get the * data here? */ us = (struct us_data *)sht->proc_dir; /* set up the name of our subdirectory under /proc/scsi/ */ sprintf(local_name, "usb-storage-%d", us->host_number); sht->proc_name = kmalloc (strlen(local_name) + 1, GFP_ATOMIC); if (!sht->proc_name) return 0; strcpy(sht->proc_name, local_name); /* we start with no /proc directory entry */ sht->proc_dir = NULL; /* register the host */ us->host = scsi_register(sht, sizeof(us)); if (us->host) { struct usb_interface *iface; us->host->hostdata[0] = (unsigned long)us; us->host_no = us->host->host_no; iface = usb_ifnum_to_if(us->pusb_dev, us->ifnum); if (iface) scsi_set_device(us->host, &iface->dev); return 1; } /* odd... didn't register properly. Abort and free pointers */ kfree(sht->proc_name); sht->proc_name = NULL; return 0; } /* Release all resources used by the virtual host * * NOTE: There is no contention here, because we're already deregistered * the driver and we're doing each virtual host in turn, not in parallel * Synchronization: BKL, no spinlock. */ static int usb_storage_release(struct Scsi_Host *psh) { struct us_data *us = (struct us_data *)psh->hostdata[0]; US_DEBUGP("release() called for host %s\n", us->htmplt.name); /* Kill the control threads * * Enqueue the command, wake up the thread, and wait for * notification that it has exited. */ US_DEBUGP("-- sending exit command to thread\n"); BUG_ON(atomic_read(&us->sm_state) != US_STATE_IDLE); us->srb = NULL; up(&(us->sema)); wait_for_completion(&(us->notify)); /* remove the pointer to the data structure we were using */ (struct us_data*)psh->hostdata[0] = NULL; /* we always have a successful release */ return 0; } #endif /* queue a command */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_queuecommand( Scsi_Cmnd *srb , void (*done)(Scsi_Cmnd *)) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; int state = atomic_read(&us->sm_state); US_DEBUGP("queuecommand() called\n"); srb->host_scribble = (unsigned char *)us; /* enqueue the command */ if (state != US_STATE_IDLE || us->srb != NULL) { printk(KERN_ERR USB_STORAGE "Error in %s: " "state = %d, us->srb = %p\n", __FUNCTION__, state, us->srb); return SCSI_MLQUEUE_HOST_BUSY; } srb->scsi_done = done; us->srb = srb; /* wake up the process task */ up(&(us->sema)); return 0; } /*********************************************************************** * Error handling functions ***********************************************************************/ /* Command abort */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_command_abort( Scsi_Cmnd *srb ) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; US_DEBUGP("command_abort() called\n"); /* Is this command still active? */ if (us->srb != srb) { US_DEBUGP ("-- nothing to abort\n"); return FAILED; } return usb_stor_abort_transport(us); } /* This invokes the transport reset mechanism to reset the state of the * device */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_device_reset( Scsi_Cmnd *srb ) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; int state = atomic_read(&us->sm_state); int result; US_DEBUGP("device_reset() called\n" ); if (state != US_STATE_IDLE) { printk(KERN_ERR USB_STORAGE "Error in %s: " "invalid state %d\n", __FUNCTION__, state); return FAILED; } /* set the state and release the lock */ atomic_set(&us->sm_state, US_STATE_RESETTING); scsi_unlock(srb->device->host); /* lock the device pointers */ down(&(us->dev_semaphore)); /* do the reset */ result = us->transport_reset(us); /* unlock */ up(&(us->dev_semaphore)); /* lock access to the state and clear it */ scsi_lock(srb->device->host); atomic_set(&us->sm_state, US_STATE_IDLE); return result; } /* This resets the device port */ /* It refuses to work if there's more than one interface in this device, so that other users are not affected. */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_bus_reset( Scsi_Cmnd *srb ) { struct us_data *us; int result; /* we use the usb_reset_device() function to handle this for us */ US_DEBUGP("bus_reset() called\n"); scsi_unlock(srb->device->host); us = (struct us_data *)srb->device->host->hostdata[0]; /* The USB subsystem doesn't handle synchronisation between a device's several drivers. Therefore we reset only devices with one interface which we of course own. */ //FIXME: needs locking against config changes if ( us->pusb_dev->actconfig->desc.bNumInterfaces == 1) { /* attempt to reset the port */ result = usb_reset_device(us->pusb_dev); US_DEBUGP("usb_reset_device returns %d\n", result); } else { result = -EBUSY; US_DEBUGP("cannot reset a multiinterface device. failing to reset.\n"); } US_DEBUGP("bus_reset() complete\n"); scsi_lock(srb->device->host); return result < 0 ? FAILED : SUCCESS; } /*********************************************************************** * /proc/scsi/ functions ***********************************************************************/ /* we use this macro to help us write into the buffer */ #undef SPRINTF #define SPRINTF(args...) \ do { if (pos < buffer+length) pos += sprintf(pos, ## args); } while (0) static int usb_storage_proc_info (struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, int inout) { struct us_data *us; char *pos = buffer; unsigned long f; /* if someone is sending us data, just throw it away */ if (inout) return length; us = (struct us_data*)hostptr->hostdata[0]; /* print the controller name */ SPRINTF(" Host scsi%d: usb-storage\n", hostptr->host_no); /* print product, vendor, and serial number strings */ SPRINTF(" Vendor: %s\n", us->vendor); SPRINTF(" Product: %s\n", us->product); SPRINTF("Serial Number: %s\n", us->serial); /* show the protocol and transport */ SPRINTF(" Protocol: %s\n", us->protocol_name); SPRINTF(" Transport: %s\n", us->transport_name); /* show the device flags */ if (pos < buffer + length) { pos += sprintf(pos, " Quirks:"); f = us->flags; #define DO_FLAG(a) if (f & US_FL_##a) pos += sprintf(pos, " " #a) DO_FLAG(SINGLE_LUN); DO_FLAG(MODE_XLATE); DO_FLAG(START_STOP); DO_FLAG(IGNORE_SER); DO_FLAG(SCM_MULT_TARG); DO_FLAG(FIX_INQUIRY); DO_FLAG(FIX_CAPACITY); #undef DO_FLAG *(pos++) = '\n'; } /* * Calculate start of next buffer, and return value. */ *start = buffer + offset; if ((pos - buffer) < offset) return (0); else if ((pos - buffer - offset) < length) return (pos - buffer - offset); else return (length); } /* * this defines our host template, with which we'll allocate hosts */ struct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; /* For a device that is "Not Ready" */ unsigned char usb_stor_sense_notready[18] = { [0] = 0x70, /* current error */ [2] = 0x02, /* not ready */ [7] = 0x0a, /* additional length */ [12] = 0x04, /* not ready */ [13] = 0x03 /* manual intervention */ }; /* To Report "Illegal Request: Invalid Field in CDB */ unsigned char usb_stor_sense_invalidCDB[18] = { [0] = 0x70, /* current error */ [2] = ILLEGAL_REQUEST, /* Illegal Request = 0x05 */ [7] = 0x0a, /* additional length */ [12] = 0x24 /* Invalid Field in CDB */ }; #define USB_STOR_SCSI_SENSE_HDRSZ 4 #define USB_STOR_SCSI_SENSE_10_HDRSZ 8 struct usb_stor_scsi_sense_hdr { __u8* dataLength; __u8* mediumType; __u8* devSpecParms; __u8* blkDescLength; }; typedef struct usb_stor_scsi_sense_hdr Usb_Stor_Scsi_Sense_Hdr; union usb_stor_scsi_sense_hdr_u { Usb_Stor_Scsi_Sense_Hdr hdr; __u8* array[USB_STOR_SCSI_SENSE_HDRSZ]; }; typedef union usb_stor_scsi_sense_hdr_u Usb_Stor_Scsi_Sense_Hdr_u; struct usb_stor_scsi_sense_hdr_10 { __u8* dataLengthMSB; __u8* dataLengthLSB; __u8* mediumType; __u8* devSpecParms; __u8* reserved1; __u8* reserved2; __u8* blkDescLengthMSB; __u8* blkDescLengthLSB; }; typedef struct usb_stor_scsi_sense_hdr_10 Usb_Stor_Scsi_Sense_Hdr_10; union usb_stor_scsi_sense_hdr_10_u { Usb_Stor_Scsi_Sense_Hdr_10 hdr; __u8* array[USB_STOR_SCSI_SENSE_10_HDRSZ]; }; typedef union usb_stor_scsi_sense_hdr_10_u Usb_Stor_Scsi_Sense_Hdr_10_u; void usb_stor_scsiSenseParseBuffer( Scsi_Cmnd* , Usb_Stor_Scsi_Sense_Hdr_u*, Usb_Stor_Scsi_Sense_Hdr_10_u*, int* ); int usb_stor_scsiSense10to6( Scsi_Cmnd* the10 ) { __u8 *buffer=0; int outputBufferSize = 0; int length=0; struct scatterlist *sg = 0; int i=0, j=0, element=0; Usb_Stor_Scsi_Sense_Hdr_u the6Locations; Usb_Stor_Scsi_Sense_Hdr_10_u the10Locations; int sb=0,si=0,db=0,di=0; int sgLength=0; US_DEBUGP("-- converting 10 byte sense data to 6 byte\n"); the10->cmnd[0] = the10->cmnd[0] & 0xBF; /* Determine buffer locations */ usb_stor_scsiSenseParseBuffer( the10, &the6Locations, &the10Locations, &length ); /* Work out minimum buffer to output */ outputBufferSize = *the10Locations.hdr.dataLengthLSB; outputBufferSize += USB_STOR_SCSI_SENSE_HDRSZ; /* Check to see if we need to trucate the output */ if ( outputBufferSize > length ) { printk( KERN_WARNING USB_STORAGE "Had to truncate MODE_SENSE_10 buffer into MODE_SENSE.\n" ); printk( KERN_WARNING USB_STORAGE "outputBufferSize is %d and length is %d.\n", outputBufferSize, length ); } outputBufferSize = length; /* Data length */ if ( *the10Locations.hdr.dataLengthMSB != 0 ) /* MSB must be zero */ { printk( KERN_WARNING USB_STORAGE "Command will be truncated to fit in SENSE6 buffer.\n" ); *the6Locations.hdr.dataLength = 0xff; } else { *the6Locations.hdr.dataLength = *the10Locations.hdr.dataLengthLSB; } /* Medium type and DevSpecific parms */ *the6Locations.hdr.mediumType = *the10Locations.hdr.mediumType; *the6Locations.hdr.devSpecParms = *the10Locations.hdr.devSpecParms; /* Block descriptor length */ if ( *the10Locations.hdr.blkDescLengthMSB != 0 ) /* MSB must be zero */ { printk( KERN_WARNING USB_STORAGE "Command will be truncated to fit in SENSE6 buffer.\n" ); *the6Locations.hdr.blkDescLength = 0xff; } else { *the6Locations.hdr.blkDescLength = *the10Locations.hdr.blkDescLengthLSB; } if ( the10->use_sg == 0 ) { buffer = the10->request_buffer; /* Copy the rest of the data */ memmove( &(buffer[USB_STOR_SCSI_SENSE_HDRSZ]), &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), outputBufferSize - USB_STOR_SCSI_SENSE_HDRSZ ); /* initialise last bytes left in buffer due to smaller header */ memset( &(buffer[outputBufferSize -(USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ)]), 0, USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ ); } else { sg = (struct scatterlist *) the10->request_buffer; /* scan through this scatterlist and figure out starting positions */ for ( i=0; i < the10->use_sg; i++) { sgLength = sg[i].length; for ( j=0; juse_sg; } element++; } } /* Now we know where to start the copy from */ element = USB_STOR_SCSI_SENSE_HDRSZ; while ( element < outputBufferSize -(USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ) ) { /* check limits */ if ( sb >= the10->use_sg || si >= sg[sb].length || db >= the10->use_sg || di >= sg[db].length ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } /* copy one byte */ { char *src = sg_address(sg[sb]) + si; char *dst = sg_address(sg[db]) + di; *dst = *src; } /* get next destination */ if ( sg[db].length-1 == di ) { db++; di=0; } else { di++; } /* get next source */ if ( sg[sb].length-1 == si ) { sb++; si=0; } else { si++; } element++; } /* zero the remaining bytes */ while ( element < outputBufferSize ) { /* check limits */ if ( db >= the10->use_sg || di >= sg[db].length ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } *(char*)(sg_address(sg[db])) = 0; /* get next destination */ if ( sg[db].length-1 == di ) { db++; di=0; } else { di++; } element++; } } /* All done any everything was fine */ return 0; } int usb_stor_scsiSense6to10( Scsi_Cmnd* the6 ) { /* will be used to store part of buffer */ __u8 tempBuffer[USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ], *buffer=0; int outputBufferSize = 0; int length=0; struct scatterlist *sg = 0; int i=0, j=0, element=0; Usb_Stor_Scsi_Sense_Hdr_u the6Locations; Usb_Stor_Scsi_Sense_Hdr_10_u the10Locations; int sb=0,si=0,db=0,di=0; int lsb=0,lsi=0,ldb=0,ldi=0; US_DEBUGP("-- converting 6 byte sense data to 10 byte\n"); the6->cmnd[0] = the6->cmnd[0] | 0x40; /* Determine buffer locations */ usb_stor_scsiSenseParseBuffer( the6, &the6Locations, &the10Locations, &length ); /* Work out minimum buffer to output */ outputBufferSize = *the6Locations.hdr.dataLength; outputBufferSize += USB_STOR_SCSI_SENSE_10_HDRSZ; /* Check to see if we need to trucate the output */ if ( outputBufferSize > length ) { printk( KERN_WARNING USB_STORAGE "Had to truncate MODE_SENSE into MODE_SENSE_10 buffer.\n" ); printk( KERN_WARNING USB_STORAGE "outputBufferSize is %d and length is %d.\n", outputBufferSize, length ); } outputBufferSize = length; /* Block descriptor length - save these before overwriting */ tempBuffer[2] = *the10Locations.hdr.blkDescLengthMSB; tempBuffer[3] = *the10Locations.hdr.blkDescLengthLSB; *the10Locations.hdr.blkDescLengthLSB = *the6Locations.hdr.blkDescLength; *the10Locations.hdr.blkDescLengthMSB = 0; /* reserved - save these before overwriting */ tempBuffer[0] = *the10Locations.hdr.reserved1; tempBuffer[1] = *the10Locations.hdr.reserved2; *the10Locations.hdr.reserved1 = *the10Locations.hdr.reserved2 = 0; /* Medium type and DevSpecific parms */ *the10Locations.hdr.devSpecParms = *the6Locations.hdr.devSpecParms; *the10Locations.hdr.mediumType = *the6Locations.hdr.mediumType; /* Data length */ *the10Locations.hdr.dataLengthLSB = *the6Locations.hdr.dataLength; *the10Locations.hdr.dataLengthMSB = 0; if ( !the6->use_sg ) { buffer = the6->request_buffer; /* Copy the rest of the data */ memmove( &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), &(buffer[USB_STOR_SCSI_SENSE_HDRSZ]), outputBufferSize-USB_STOR_SCSI_SENSE_10_HDRSZ ); /* Put the first four bytes (after header) in place */ memcpy( &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), tempBuffer, USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ ); } else { sg = (struct scatterlist *) the6->request_buffer; /* scan through this scatterlist and figure out ending positions */ for ( i=0; i < the6->use_sg; i++) { for ( j=0; juse_sg; break; } element++; } } /* scan through this scatterlist and figure out starting positions */ element = length-1; /* destination is the last element */ db=the6->use_sg-1; di=sg[db].length-1; for ( i=the6->use_sg-1; i >= 0; i--) { for ( j=sg[i].length-1; j>=0; j-- ) { /* get to end of header and find source for copy */ if ( element == length - 1 - (USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ) ) { sb=i; si=j; /* we've found both sets now, exit loops */ j=-1; i=-1; } element--; } } /* Now we know where to start the copy from */ element = length-1 - (USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ); while ( element >= USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* check limits */ if ( ( sb <= lsb && si < lsi ) || ( db <= ldb && di < ldi ) ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } /* copy one byte */ { char *src = sg_address(sg[sb]) + si; char *dst = sg_address(sg[db]) + di; *dst = *src; } /* get next destination */ if ( di == 0 ) { db--; di=sg[db].length-1; } else { di--; } /* get next source */ if ( si == 0 ) { sb--; si=sg[sb].length-1; } else { si--; } element--; } /* copy the remaining four bytes */ while ( element >= USB_STOR_SCSI_SENSE_HDRSZ ) { /* check limits */ if ( db <= ldb && di < ldi ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } { char *dst = sg_address(sg[db]) + di; *dst = tempBuffer[element-USB_STOR_SCSI_SENSE_HDRSZ]; } /* get next destination */ if ( di == 0 ) { db--; di=sg[db].length-1; } else { di--; } element--; } } /* All done and everything was fine */ return 0; } void usb_stor_scsiSenseParseBuffer( Scsi_Cmnd* srb, Usb_Stor_Scsi_Sense_Hdr_u* the6, Usb_Stor_Scsi_Sense_Hdr_10_u* the10, int* length_p ) { int i = 0, j=0, element=0; struct scatterlist *sg = 0; int length = 0; __u8* buffer=0; /* are we scatter-gathering? */ if ( srb->use_sg != 0 ) { /* loop over all the scatter gather structures and * get pointer to the data members in the headers * (also work out the length while we're here) */ sg = (struct scatterlist *) srb->request_buffer; for (i = 0; i < srb->use_sg; i++) { length += sg[i].length; /* We only do the inner loop for the headers */ if ( element < USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* scan through this scatterlist */ for ( j=0; jarray[element] = sg_address(sg[i]) + j; the10->array[element] = sg_address(sg[i]) + j; } else if ( element < USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* only the longer headers still cares now */ the10->array[element] = sg_address(sg[i]) + j; } /* increase element counter */ element++; } } } } else { length = srb->request_bufflen; buffer = srb->request_buffer; if ( length < USB_STOR_SCSI_SENSE_10_HDRSZ ) printk( KERN_ERR USB_STORAGE "Buffer length smaller than header!!" ); for( i=0; iarray[i] = &(buffer[i]); the10->array[i] = &(buffer[i]); } else { the10->array[i] = &(buffer[i]); } } } /* Set value of length passed in */ *length_p = length; } coccinelle-1.0.0-rc19/demos/demo_rule9/rule9_3.cocci0000644000175000017500000000114212247437436021025 0ustar eugeneugen@ rule1 @ typedef Scsi_Host_Template; {struct SHT, Scsi_Host_Template} fops; identifier proc_info_func; @@ fops.proc_info = proc_info_func; @@ identifier rule1.proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } coccinelle-1.0.0-rc19/demos/demo_rule9/rule9_5.cocci0000644000175000017500000000210412247437436021026 0ustar eugeneugen@ rule1 @ typedef Scsi_Host_Template; {struct SHT, Scsi_Host_Template} fops; identifier proc_info_func; @@ fops.proc_info = proc_info_func; @ rule2 @ identifier rule1.proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } @@ identifier rule1.proc_info_func; identifier rule2.hostno; identifier rule2.hostptr; @@ proc_info_func(...) { <... - hostno + hostptr->host_no ...> } @@ identifier rule1.proc_info_func; identifier func; expression buffer, start, offset, length, inout, hostno; identifier hostptr; @@ func(..., struct Scsi_Host *hostptr, ...) { <... proc_info_func( + hostptr, buffer, start, offset, length, - hostno, inout) ...> } coccinelle-1.0.0-rc19/demos/demo_rule9/nsp_cs.res0000644000175000017500000014377612247437436020565 0ustar eugeneugen/*====================================================================== NinjaSCSI-3 / NinjaSCSI-32Bi PCMCIA SCSI host adapter card driver By: YOKOTA Hiroshi Ver.2.8 Support 32bit MMIO mode Support Synchronous Data TRansfer (SDTR) mode Ver.2.0 Support 32bit PIO mode Ver.1.1.2 Fix for scatter list buffer exceeds Ver.1.1 Support scatter list Ver.0.1 Initial version This software may be used and distributed according to the terms of the GNU General Public License. ======================================================================*/ /*********************************************************************** This driver is for these PCcards. I-O DATA PCSC-F (Workbit NinjaSCSI-3) "WBT", "NinjaSCSI-3", "R1.0" I-O DATA CBSC-II (Workbit NinjaSCSI-32Bi in 16bit mode) "IO DATA", "CBSC16 ", "1" ***********************************************************************/ /* */ #ifdef NSP_KERNEL_2_2 #include #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "scsi.h" #include "hosts.h" #include #include #include #include #include #include #include #include #include "nsp_cs.h" MODULE_AUTHOR("YOKOTA Hiroshi "); MODULE_DESCRIPTION("WorkBit NinjaSCSI-3 / NinjaSCSI-32Bi(16bit) PCMCIA SCSI host adapter module $Revision: 1.1 $"); MODULE_SUPPORTED_DEVICE("sd,sr,sg,st"); #ifdef MODULE_LICENSE MODULE_LICENSE("GPL"); #endif #ifdef PCMCIA_DEBUG static int pc_debug = PCMCIA_DEBUG; MODULE_PARM(pc_debug, "i"); MODULE_PARM_DESC(pc_debug, "set debug level"); static char *version = ""; #define DEBUG(n, args...) if (pc_debug>(n)) printk(KERN_DEBUG args) #else #define DEBUG(n, args...) /* */ #endif #include "nsp_io.h" /*====================================================================*/ typedef struct scsi_info_t { dev_link_t link; dev_node_t node; struct Scsi_Host *host; int stop; } scsi_info_t; /*----------------------------------------------------------------*/ #if (KERNEL_VERSION(2,4,0) > LINUX_VERSION_CODE) #define PROC_SCSI_NSP PROC_SCSI_IBMMCA /* bad hack... */ static struct proc_dir_entry proc_scsi_nsp = { PROC_SCSI_NSP, 6, "nsp_cs", S_IFDIR | S_IRUGO | S_IXUGO, 2 }; #endif /*====================================================================*/ /* Parameters that can be set with 'insmod' */ static unsigned int irq_mask = 0xffff; MODULE_PARM(irq_mask, "i"); MODULE_PARM_DESC(irq_mask, "IRQ mask bits (default: 0xffff)"); static int irq_list[4] = { -1 }; MODULE_PARM(irq_list, "1-4i"); MODULE_PARM_DESC(irq_list, "Use specified IRQ number. (default: auto select)"); static int nsp_burst_mode = 2; MODULE_PARM(nsp_burst_mode, "i"); MODULE_PARM_DESC(nsp_burst_mode, "Burst transfer mode (0=io8, 1=io32, 2=mem32(default))"); /* Release IO ports after configuration? */ static int free_ports = 0; MODULE_PARM(free_ports, "i"); MODULE_PARM_DESC(free_ports, "Release IO ports after configuration? (default: 0 (=no))"); /* /usr/src/linux/drivers/scsi/hosts.h */ static Scsi_Host_Template nsp_driver_template = { #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,0)) .proc_name = "nsp_cs", /* kernel 2.4 */ #else .proc_dir = &proc_scsi_nsp, /* kernel 2.2 */ #endif .proc_info = nsp_proc_info, .name = "WorkBit NinjaSCSI-3/32Bi(16bit)", #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) .detect = nsp_detect, .release = nsp_release, #endif .info = nsp_info, .queuecommand = nsp_queuecommand, /* .eh_strategy_handler = nsp_eh_strategy,*/ /* .eh_abort_handler = nsp_eh_abort,*/ /* .eh_device_reset_handler = nsp_eh_device_reset,*/ .eh_bus_reset_handler = nsp_eh_bus_reset, .eh_host_reset_handler = nsp_eh_host_reset, .can_queue = 1, .this_id = NSP_INITIATOR_ID, .sg_tablesize = SG_ALL, .cmd_per_lun = 1, .use_clustering = DISABLE_CLUSTERING, #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,2)) .use_new_eh_code = 1, #endif }; static dev_link_t *dev_list = NULL; static dev_info_t dev_info = {"nsp_cs"}; static nsp_hw_data nsp_data; /***********************************************************/ static int nsp_queuecommand(Scsi_Cmnd *SCpnt, void (*done)(Scsi_Cmnd *)) { #ifdef PCMCIA_DEBUG /*unsigned int host_id = SCpnt->host->this_id;*/ /*unsigned int base = SCpnt->host->io_port;*/ unsigned char target = SCpnt->target; #endif nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: SCpnt=0x%p target=%d lun=%d buff=0x%p bufflen=%d use_sg=%d\n", __FUNCTION__, SCpnt, target, SCpnt->lun, SCpnt->request_buffer, SCpnt->request_bufflen, SCpnt->use_sg); //DEBUG(0, " before CurrentSC=0x%p\n", data->CurrentSC); if(data->CurrentSC != NULL) { printk(KERN_DEBUG " %s: CurrentSC!=NULL this can't be happen\n", __FUNCTION__); data->CurrentSC = NULL; SCpnt->result = DID_BAD_TARGET << 16; done(SCpnt); return -1; } show_command(SCpnt); SCpnt->scsi_done = done; data->CurrentSC = SCpnt; SCpnt->SCp.Status = CHECK_CONDITION; SCpnt->SCp.Message = 0; SCpnt->SCp.have_data_in = IO_UNKNOWN; SCpnt->SCp.sent_command = 0; SCpnt->SCp.phase = PH_UNDETERMINED; RESID = SCpnt->request_bufflen; /* setup scratch area SCp.ptr : buffer pointer SCp.this_residual : buffer length SCp.buffer : next buffer SCp.buffers_residual : left buffers in list SCp.phase : current state of the command */ if (SCpnt->use_sg) { SCpnt->SCp.buffer = (struct scatterlist *) SCpnt->request_buffer; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; SCpnt->SCp.buffers_residual = SCpnt->use_sg - 1; } else { SCpnt->SCp.ptr = (char *) SCpnt->request_buffer; SCpnt->SCp.this_residual = SCpnt->request_bufflen; SCpnt->SCp.buffer = NULL; SCpnt->SCp.buffers_residual = 0; } if(nsphw_start_selection(SCpnt, data) == FALSE) { DEBUG(0, " selection fail\n"); data->CurrentSC = NULL; SCpnt->result = DID_NO_CONNECT << 16; done(SCpnt); return -1; } //DEBUG(0, "%s: out\n", __FUNCTION__); return 0; } /* * setup PIO FIFO transfer mode and enable/disable to data out */ static void nsp_setup_fifo(nsp_hw_data *data, int enabled) { unsigned int base = data->BaseAddress; unsigned char transfer_mode_reg; //DEBUG(0, "%s: enabled=%d\n", __FUNCTION__, enabled); if (enabled != FALSE) { transfer_mode_reg = TRANSFER_GO | BRAIND; } else { transfer_mode_reg = 0; } transfer_mode_reg |= data->TransferMode; nsp_index_write(base, TRANSFERMODE, transfer_mode_reg); } static void nsphw_init_sync(nsp_hw_data *data) { sync_data tmp_sync = { .SyncNegotiation = SYNC_NOT_YET, .SyncPeriod = 0, .SyncOffset = 0 }; int i; /* setup sync data */ for ( i = 0; i < NUMBER(data->Sync); i++ ) { data->Sync[i] = tmp_sync; } } /* * Initialize Ninja hardware */ static int nsphw_init(nsp_hw_data *data) { unsigned int base = data->BaseAddress; DEBUG(0, "%s: in base=0x%x\n", __FUNCTION__, base); data->ScsiClockDiv = CLOCK_40M | FAST_20; data->CurrentSC = NULL; data->FifoCount = 0; data->TransferMode = MODE_IO8; nsphw_init_sync(data); /* block all interrupts */ nsp_write(base, IRQCONTROL, IRQCONTROL_ALLMASK); /* setup SCSI interface */ nsp_write(base, IFSELECT, IF_IFSEL); nsp_index_write(base, SCSIIRQMODE, 0); nsp_index_write(base, TRANSFERMODE, MODE_IO8); nsp_index_write(base, CLOCKDIV, data->ScsiClockDiv); nsp_index_write(base, PARITYCTRL, 0); nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER_CLEAR | REQ_COUNTER_CLEAR | HOST_COUNTER_CLEAR); /* setup fifo asic */ nsp_write(base, IFSELECT, IF_REGSEL); nsp_index_write(base, TERMPWRCTRL, 0); if ((nsp_index_read(base, OTHERCONTROL) & TPWR_SENSE) == 0) { printk(KERN_INFO "nsp_cs: terminator power on\n"); nsp_index_write(base, TERMPWRCTRL, POWER_ON); } nsp_index_write(base, TIMERCOUNT, 0); nsp_index_write(base, TIMERCOUNT, 0); /* requires 2 times!! */ nsp_index_write(base, SYNCREG, 0); nsp_index_write(base, ACKWIDTH, 0); /* enable interrupts and ack them */ nsp_index_write(base, SCSIIRQMODE, SCSI_PHASE_CHANGE_EI | RESELECT_EI | SCSI_RESET_IRQ_EI ); nsp_write(base, IRQCONTROL, IRQCONTROL_ALLCLEAR); nsp_setup_fifo(data, FALSE); return TRUE; } /* * Start selection phase */ static unsigned int nsphw_start_selection(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int host_id = SCpnt->device->host->this_id; unsigned int base = SCpnt->device->host->io_port; unsigned char target = SCpnt->device->id; int time_out; unsigned char phase, arbit; //DEBUG(0, "%s:in\n", __FUNCTION__); phase = nsp_index_read(base, SCSIBUSMON); if(phase != BUSMON_BUS_FREE) { //DEBUG(0, " bus busy\n"); return FALSE; } /* start arbitration */ //DEBUG(0, " start arbit\n"); SCpnt->SCp.phase = PH_ARBSTART; nsp_index_write(base, SETARBIT, ARBIT_GO); time_out = 1000; do { /* XXX: what a stupid chip! */ arbit = nsp_index_read(base, ARBITSTATUS); //DEBUG(0, " arbit=%d, wait_count=%d\n", arbit, wait_count); udelay(1); /* hold 1.2us */ } while((arbit & (ARBIT_WIN | ARBIT_FAIL)) == 0 && (time_out-- != 0)); if((arbit & ARBIT_WIN) == 0) { //DEBUG(0, " arbit fail\n"); nsp_index_write(base, SETARBIT, ARBIT_FLAG_CLEAR); return FALSE; } /* assert select line */ //DEBUG(0, " assert SEL line\n"); SCpnt->SCp.phase = PH_SELSTART; udelay(3); nsp_index_write(base, SCSIDATALATCH, BIT(host_id) | BIT(target)); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_BSY | SCSI_ATN); udelay(3); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_BSY | SCSI_DATAOUT_ENB | SCSI_ATN); nsp_index_write(base, SETARBIT, ARBIT_FLAG_CLEAR); udelay(3); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_DATAOUT_ENB | SCSI_ATN); /* check selection timeout */ nsp_start_timer(SCpnt, data, 1000/51); data->SelectionTimeOut = 1; return TRUE; } struct nsp_sync_table { unsigned int min_period; unsigned int max_period; unsigned int chip_period; unsigned int ack_width; }; static struct nsp_sync_table nsp_sync_table_40M[] = { {0x0c,0x0c,0x1,0}, /* 20MB 50ns*/ {0x19,0x19,0x3,1}, /* 10MB 100ns*/ {0x1a,0x25,0x5,2}, /* 7.5MB 150ns*/ {0x26,0x32,0x7,3}, /* 5MB 200ns*/ {0x0, 0, 0, 0} }; static struct nsp_sync_table nsp_sync_table_20M[] = { {0x19,0x19,0x1,0}, /* 10MB 100ns*/ {0x1a,0x25,0x2,0}, /* 7.5MB 150ns*/ {0x26,0x32,0x3,1}, /* 5MB 200ns*/ {0x0, 0, 0, 0} }; /* * setup synchronous data transfer mode */ static int nsp_msg(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned char target = SCpnt->device->id; // unsigned char lun = SCpnt->lun; sync_data *sync = &(data->Sync[target]); struct nsp_sync_table *sync_table; unsigned int period, offset; int i; DEBUG(0, "%s:\n", __FUNCTION__); period = sync->SyncPeriod; offset = sync->SyncOffset; DEBUG(0, " period=0x%x, offset=0x%x\n", period, offset); if ((data->ScsiClockDiv & (BIT(0)|BIT(1))) == CLOCK_20M) { sync_table = &nsp_sync_table_20M[0]; } else { sync_table = &nsp_sync_table_40M[0]; } for ( i = 0; sync_table->max_period != 0; i++, sync_table++) { if ( period >= sync_table->min_period && period <= sync_table->max_period ) { break; } } if (period != 0 && sync_table->max_period == 0) { /* * No proper period/offset found */ DEBUG(0, " no proper period/offset\n"); sync->SyncPeriod = 0; sync->SyncOffset = 0; sync->SyncRegister = 0; sync->AckWidth = 0; return FALSE; } sync->SyncRegister = (sync_table->chip_period << SYNCREG_PERIOD_SHIFT) | (offset & SYNCREG_OFFSET_MASK); sync->AckWidth = sync_table->ack_width; DEBUG(0, " sync_reg=0x%x, ack_width=0x%x\n", sync->SyncRegister, sync->AckWidth); return TRUE; } /* * start ninja hardware timer */ static void nsp_start_timer(Scsi_Cmnd *SCpnt, nsp_hw_data *data, int time) { unsigned int base = SCpnt->device->host->io_port; //DEBUG(0, "%s: in SCpnt=0x%p, time=%d\n", __FUNCTION__, SCpnt, time); data->TimerCount = time; nsp_index_write(base, TIMERCOUNT, time); } /* * wait for bus phase change */ static int nsp_negate_signal(Scsi_Cmnd *SCpnt, unsigned char mask, char *str) { unsigned int base = SCpnt->device->host->io_port; unsigned char reg; int time_out; //DEBUG(0, "%s:\n", __FUNCTION__); time_out = 100; do { reg = nsp_index_read(base, SCSIBUSMON); if (reg == 0xff) { break; } } while ((time_out-- != 0) && (reg & mask) != 0); if (time_out == 0) { printk(KERN_DEBUG "%s:: %s signal off timeut\n", __FUNCTION__, str); } return 0; } /* * expect Ninja Irq */ static int nsp_expect_signal(Scsi_Cmnd *SCpnt, unsigned char current_phase, unsigned char mask) { unsigned int base = SCpnt->device->host->io_port; int time_out; unsigned char phase, i_src; //DEBUG(0, "%s: current_phase=0x%x, mask=0x%x\n", __FUNCTION__, current_phase, mask); time_out = 100; do { phase = nsp_index_read(base, SCSIBUSMON); if (phase == 0xff) { //DEBUG(0, " ret -1\n"); return -1; } i_src = nsp_read(base, IRQSTATUS); if (i_src & IRQSTATUS_SCSI) { //DEBUG(0, " ret 0 found scsi signal\n"); return 0; } if ((phase & mask) != 0 && (phase & BUSMON_PHASE_MASK) == current_phase) { //DEBUG(0, " ret 1 phase=0x%x\n", phase); return 1; } } while(time_out-- != 0); //DEBUG(0, "%s: timeout\n", __FUNCTION__); return -1; } /* * transfer SCSI message */ static int nsp_xfer(Scsi_Cmnd *SCpnt, nsp_hw_data *data, int phase) { unsigned int base = SCpnt->device->host->io_port; char *buf = data->MsgBuffer; int len = MIN(MSGBUF_SIZE, data->MsgLen); int ptr; int ret; //DEBUG(0, "%s:\n", __FUNCTION__); for (ptr = 0; len > 0; len --, ptr ++) { ret = nsp_expect_signal(SCpnt, phase, BUSMON_REQ); if (ret <= 0) { DEBUG(0, " xfer quit\n"); return 0; } /* if last byte, negate ATN */ if (len == 1 && SCpnt->SCp.phase == PH_MSG_OUT) { nsp_index_write(base, SCSIBUSCTRL, AUTODIRECTION | ACKENB); } /* read & write message */ if (phase & BUSMON_IO) { DEBUG(0, " read msg\n"); buf[ptr] = nsp_index_read(base, SCSIDATAWITHACK); } else { DEBUG(0, " write msg\n"); nsp_index_write(base, SCSIDATAWITHACK, buf[ptr]); } nsp_negate_signal(SCpnt, BUSMON_ACK, "xfer"); } return len; } /* * get extra SCSI data from fifo */ static int nsp_dataphase_bypass(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int count; //DEBUG(0, "%s:\n", __FUNCTION__); if (SCpnt->SCp.have_data_in != IO_IN) { return 0; } count = nsp_fifo_count(SCpnt); if (data->FifoCount == count) { //DEBUG(0, " not use bypass quirk\n"); return 0; } /* * XXX: NSP_QUIRK * data phase skip only occures in case of SCSI_LOW_READ */ DEBUG(0, " use bypass quirk\n"); SCpnt->SCp.phase = PH_DATA; nsp_pio_read(SCpnt, data); nsp_setup_fifo(data, FALSE); return 0; } /* * accept reselection */ static int nsp_reselected(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned char reg; //DEBUG(0, "%s:\n", __FUNCTION__); nsp_negate_signal(SCpnt, BUSMON_SEL, "reselect"); nsp_nexus(SCpnt, data); reg = nsp_index_read(base, SCSIBUSCTRL) & ~(SCSI_BSY | SCSI_ATN); nsp_index_write(base, SCSIBUSCTRL, reg); nsp_index_write(base, SCSIBUSCTRL, reg | AUTODIRECTION | ACKENB); return TRUE; } /* * count how many data transferd */ static int nsp_fifo_count(Scsi_Cmnd *SCpnt) { unsigned int base = SCpnt->device->host->io_port; unsigned int count; unsigned int l, m, h, dummy; nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER); l = nsp_index_read(base, TRANSFERCOUNT); m = nsp_index_read(base, TRANSFERCOUNT); h = nsp_index_read(base, TRANSFERCOUNT); dummy = nsp_index_read(base, TRANSFERCOUNT); count = (h << 16) | (m << 8) | (l << 0); //DEBUG(0, "%s: =0x%x\n", __FUNCTION__, count); return count; } /* fifo size */ #define RFIFO_CRIT 64 #define WFIFO_CRIT 64 /* * read data in DATA IN phase */ static void nsp_pio_read(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned long mmio_base = SCpnt->device->host->base; long time_out; int ocount, res; unsigned char stat, fifo_stat; ocount = data->FifoCount; DEBUG(0, "%s: in SCpnt=0x%p resid=%d ocount=%d ptr=0x%p this_residual=%d buffers=0x%p nbuf=%d\n", __FUNCTION__, SCpnt, RESID, ocount, SCpnt->SCp.ptr, SCpnt->SCp.this_residual, SCpnt->SCp.buffer, SCpnt->SCp.buffers_residual); time_out = 1000; while ((time_out-- != 0) && (SCpnt->SCp.this_residual > 0 || SCpnt->SCp.buffers_residual > 0 ) ) { stat = nsp_index_read(base, SCSIBUSMON); stat &= BUSMON_PHASE_MASK; res = nsp_fifo_count(SCpnt) - ocount; //DEBUG(0, " ptr=0x%p this=0x%x ocount=0x%x res=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, ocount, res); if (res == 0) { /* if some data avilable ? */ if (stat == BUSPHASE_DATA_IN) { /* phase changed? */ //DEBUG(0, " wait for data this=%d\n", SCpnt->SCp.this_residual); continue; } else { DEBUG(0, " phase changed stat=0x%x\n", stat); break; } } fifo_stat = nsp_read(base, FIFOSTATUS); if ((fifo_stat & FIFOSTATUS_FULL_EMPTY) == 0 && stat == BUSPHASE_DATA_IN) { continue; } res = MIN(res, SCpnt->SCp.this_residual); switch (data->TransferMode) { case MODE_IO32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_fifo32_read(base, SCpnt->SCp.ptr, res >> 2); break; case MODE_IO8: nsp_fifo8_read (base, SCpnt->SCp.ptr, res ); break; case MODE_MEM32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_mmio_fifo32_read(mmio_base, SCpnt->SCp.ptr, res >> 2); break; default: DEBUG(0, "unknown read mode\n"); return; } RESID -= res; SCpnt->SCp.ptr += res; SCpnt->SCp.this_residual -= res; ocount += res; //DEBUG(0, " ptr=0x%p this_residual=0x%x ocount=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, ocount); /* go to next scatter list if availavle */ if (SCpnt->SCp.this_residual == 0 && SCpnt->SCp.buffers_residual != 0 ) { //DEBUG(0, " scatterlist next timeout=%d\n", time_out); SCpnt->SCp.buffers_residual--; SCpnt->SCp.buffer++; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; time_out = 1000; //DEBUG(0, "page: 0x%p, off: 0x%x\n", SCpnt->SCp.buffer->page, SCpnt->SCp.buffer->offset); } } data->FifoCount = ocount; if (time_out == 0) { printk(KERN_DEBUG "%s: pio read timeout resid=%d this_residual=%d buffers_residual=%d\n", __FUNCTION__, RESID, SCpnt->SCp.this_residual, SCpnt->SCp.buffers_residual); } DEBUG(0, " read ocount=0x%x\n", ocount); } /* * write data in DATA OUT phase */ static void nsp_pio_write(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned long mmio_base = SCpnt->device->host->base; int time_out; int ocount, res; unsigned char stat; ocount = data->FifoCount; DEBUG(0, "%s: in fifocount=%d ptr=0x%p this_residual=%d buffers=0x%p nbuf=%d resid=0x%x\n", __FUNCTION__, data->FifoCount, SCpnt->SCp.ptr, SCpnt->SCp.this_residual, SCpnt->SCp.buffer, SCpnt->SCp.buffers_residual, RESID); time_out = 1000; while ((time_out-- != 0) && (SCpnt->SCp.this_residual > 0 || SCpnt->SCp.buffers_residual > 0)) { stat = nsp_index_read(base, SCSIBUSMON); stat &= BUSMON_PHASE_MASK; if (stat != BUSPHASE_DATA_OUT) { res = ocount - nsp_fifo_count(SCpnt); DEBUG(0, " phase changed stat=0x%x, res=%d\n", stat, res); /* Put back pointer */ RESID += res; SCpnt->SCp.ptr -= res; SCpnt->SCp.this_residual += res; ocount -= res; break; } res = ocount - nsp_fifo_count(SCpnt); if (res > 0) { /* write all data? */ DEBUG(0, " wait for all data out. ocount=0x%x res=%d\n", ocount, res); continue; } res = MIN(SCpnt->SCp.this_residual, WFIFO_CRIT); //DEBUG(0, " ptr=0x%p this=0x%x res=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, res); switch (data->TransferMode) { case MODE_IO32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_fifo32_write(base, SCpnt->SCp.ptr, res >> 2); break; case MODE_IO8: nsp_fifo8_write (base, SCpnt->SCp.ptr, res ); break; case MODE_MEM32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_mmio_fifo32_write(mmio_base, SCpnt->SCp.ptr, res >> 2); break; default: DEBUG(0, "unknown write mode\n"); break; } RESID -= res; SCpnt->SCp.ptr += res; SCpnt->SCp.this_residual -= res; ocount += res; /* go to next scatter list if availavle */ if (SCpnt->SCp.this_residual == 0 && SCpnt->SCp.buffers_residual != 0 ) { //DEBUG(0, " scatterlist next\n"); SCpnt->SCp.buffers_residual--; SCpnt->SCp.buffer++; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; time_out = 1000; } } data->FifoCount = ocount; if (time_out == 0) { printk(KERN_DEBUG "%s: pio write timeout resid=0x%x\n", __FUNCTION__, RESID); } DEBUG(0, " write ocount=0x%x\n", ocount); } #undef RFIFO_CRIT #undef WFIFO_CRIT /* * setup synchronous/asynchronous data transfer mode */ static int nsp_nexus(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned char target = SCpnt->device->id; // unsigned char lun = SCpnt->lun; sync_data *sync = &(data->Sync[target]); //DEBUG(0, "%s: in SCpnt=0x%p\n", __FUNCTION__, SCpnt); /* setup synch transfer registers */ nsp_index_write(base, SYNCREG, sync->SyncRegister); nsp_index_write(base, ACKWIDTH, sync->AckWidth); if (SCpnt->use_sg == 0 || RESID % 4 != 0 || RESID <= PAGE_SIZE ) { data->TransferMode = MODE_IO8; } else if (nsp_burst_mode == BURST_MEM32) { data->TransferMode = MODE_MEM32; } else if (nsp_burst_mode == BURST_IO32) { data->TransferMode = MODE_IO32; } else { data->TransferMode = MODE_IO8; } /* setup pdma fifo */ nsp_setup_fifo(data, TRUE); /* clear ack counter */ data->FifoCount = 0; nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER_CLEAR | REQ_COUNTER_CLEAR | HOST_COUNTER_CLEAR); return 0; } #include "nsp_message.c" /* * interrupt handler */ static void nspintr(int irq, void *dev_id, struct pt_regs *regs) { unsigned int base; unsigned char i_src, irq_phase, phase; Scsi_Cmnd *tmpSC; unsigned char target, lun; unsigned int *sync_neg; int i, tmp; nsp_hw_data *data = dev_id; //printk("&nsp_data=0x%p, dev_id=0x%p\n", &nsp_data, dev_id); base = data->BaseAddress; //DEBUG(0, " base=0x%x\n", base); /* * interrupt check */ nsp_write(base, IRQCONTROL, IRQCONTROL_IRQDISABLE); i_src = nsp_read(base, IRQSTATUS); //DEBUG(0, " i_src=0x%x\n", i_src); if ((i_src == 0xff) || ((i_src & IRQSTATUS_MASK) == 0)) { nsp_write(base, IRQCONTROL, 0); //DEBUG(0, " no irq/shared irq\n"); return; } /* XXX: IMPORTANT * Do not read an irq_phase register if no scsi phase interrupt. * Unless, you should lose a scsi phase interrupt. */ phase = nsp_index_read(base, SCSIBUSMON); if((i_src & IRQSTATUS_SCSI) != 0) { irq_phase = nsp_index_read(base, IRQPHASESENCE); } else { irq_phase = 0; } //DEBUG(0, " irq_phase=0x%x\n", irq_phase); /* * timer interrupt handler (scsi vs timer interrupts) */ //DEBUG(0, " timercount=%d\n", data->TimerCount); if (data->TimerCount != 0) { //DEBUG(0, " stop timer\n"); nsp_index_write(base, TIMERCOUNT, 0); nsp_index_write(base, TIMERCOUNT, 0); data->TimerCount = 0; } if ((i_src & IRQSTATUS_MASK) == IRQSTATUS_TIMER && data->SelectionTimeOut == 0) { //DEBUG(0, " timer start\n"); nsp_write(base, IRQCONTROL, IRQCONTROL_TIMER_CLEAR); return; } nsp_write(base, IRQCONTROL, IRQCONTROL_TIMER_CLEAR | IRQCONTROL_FIFO_CLEAR); if (data->CurrentSC == NULL) { printk(KERN_DEBUG "%s: CurrentSC==NULL irq_status=0x%x phase=0x%x irq_phase=0x%x this can't be happen\n", __FUNCTION__, i_src, phase, irq_phase); return; } else { tmpSC = data->CurrentSC; target = tmpSC->device->id; lun = tmpSC->device->lun; sync_neg = &(data->Sync[target].SyncNegotiation); } /* * parse hardware SCSI irq reasons register */ if ((i_src & IRQSTATUS_SCSI) != 0) { if ((irq_phase & SCSI_RESET_IRQ) != 0) { printk(KERN_DEBUG " %s: bus reset (power off?)\n", __FUNCTION__); *sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = (DID_RESET << 16) | ((tmpSC->SCp.Message & 0xff) << 8) | ((tmpSC->SCp.Status & 0xff) << 0); tmpSC->scsi_done(tmpSC); return; } if ((irq_phase & RESELECT_IRQ) != 0) { DEBUG(0, " reselect\n"); nsp_write(base, IRQCONTROL, IRQCONTROL_RESELECT_CLEAR); if (nsp_reselected(tmpSC, data) != FALSE) { return; } } if ((irq_phase & (PHASE_CHANGE_IRQ | LATCHED_BUS_FREE)) == 0) { return; } } //show_phase(tmpSC); switch(tmpSC->SCp.phase) { case PH_SELSTART: //*sync_neg = SYNC_NOT_YET; if ((phase & BUSMON_BSY) == 0) { //DEBUG(0, " selection count=%d\n", data->SelectionTimeOut); if (data->SelectionTimeOut >= NSP_SELTIMEOUT) { DEBUG(0, " selection time out\n"); data->SelectionTimeOut = 0; nsp_index_write(base, SCSIBUSCTRL, 0); data->CurrentSC = NULL; tmpSC->result = DID_NO_CONNECT << 16; tmpSC->scsi_done(tmpSC); return; } data->SelectionTimeOut += 1; nsp_start_timer(tmpSC, data, 1000/51); return; } /* attention assert */ //DEBUG(0, " attention assert\n"); data->SelectionTimeOut = 0; tmpSC->SCp.phase = PH_SELECTED; nsp_index_write(base, SCSIBUSCTRL, SCSI_ATN); udelay(1); nsp_index_write(base, SCSIBUSCTRL, SCSI_ATN | AUTODIRECTION | ACKENB); return; break; case PH_RESELECT: //DEBUG(0, " phase reselect\n"); //*sync_neg = SYNC_NOT_YET; if ((phase & BUSMON_PHASE_MASK) != BUSPHASE_MESSAGE_IN) { data->CurrentSC = NULL; tmpSC->result = DID_ABORT << 16; tmpSC->scsi_done(tmpSC); return; } /* fall thru */ default: if ((i_src & (IRQSTATUS_SCSI | IRQSTATUS_FIFO)) == 0) { return; } break; } /* * SCSI sequencer */ //DEBUG(0, " start scsi seq\n"); /* normal disconnect */ if (((tmpSC->SCp.phase == PH_MSG_IN) || (tmpSC->SCp.phase == PH_MSG_OUT)) && (irq_phase & LATCHED_BUS_FREE) != 0 ) { DEBUG(0, " normal disconnect i_src=0x%x, phase=0x%x, irq_phase=0x%x\n", i_src, phase, irq_phase); if ((tmpSC->SCp.Message == MSG_COMMAND_COMPLETE)) { /* all command complete and return status */ //*sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = (DID_OK << 16) | ((tmpSC->SCp.Message & 0xff) << 8) | ((tmpSC->SCp.Status & 0xff) << 0); DEBUG(0, " command complete result=0x%x\n", tmpSC->result); tmpSC->scsi_done(tmpSC); return; } return; } /* check unexpected bus free state */ if (phase == 0) { printk(KERN_DEBUG " %s: unexpected bus free. i_src=0x%x, phase=0x%x, irq_phase=0x%x\n", __FUNCTION__, i_src, phase, irq_phase); *sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = DID_ERROR << 16; tmpSC->scsi_done(tmpSC); return; } switch (phase & BUSMON_PHASE_MASK) { case BUSPHASE_COMMAND: DEBUG(0, " BUSPHASE_COMMAND\n"); if ((phase & BUSMON_REQ) == 0) { DEBUG(0, " REQ == 0\n"); return; } tmpSC->SCp.phase = PH_COMMAND; nsp_nexus(tmpSC, data); /* write scsi command */ DEBUG(0, " cmd_len=%d\n", tmpSC->cmd_len); nsp_index_write(base, COMMANDCTRL, CLEAR_COMMAND_POINTER); for (i = 0; i < tmpSC->cmd_len; i++) { nsp_index_write(base, COMMANDDATA, tmpSC->cmnd[i]); } nsp_index_write(base, COMMANDCTRL, CLEAR_COMMAND_POINTER | AUTO_COMMAND_GO); break; case BUSPHASE_DATA_OUT: DEBUG(0, " BUSPHASE_DATA_OUT\n"); tmpSC->SCp.phase = PH_DATA; tmpSC->SCp.have_data_in = IO_OUT; nsp_pio_write(tmpSC, data); break; case BUSPHASE_DATA_IN: DEBUG(0, " BUSPHASE_DATA_IN\n"); tmpSC->SCp.phase = PH_DATA; tmpSC->SCp.have_data_in = IO_IN; nsp_pio_read(tmpSC, data); break; case BUSPHASE_STATUS: nsp_dataphase_bypass(tmpSC, data); DEBUG(0, " BUSPHASE_STATUS\n"); tmpSC->SCp.phase = PH_STATUS; tmpSC->SCp.Status = nsp_index_read(base, SCSIDATAWITHACK); DEBUG(0, " message=0x%x status=0x%x\n", tmpSC->SCp.Message, tmpSC->SCp.Status); break; case BUSPHASE_MESSAGE_OUT: DEBUG(0, " BUSPHASE_MESSAGE_OUT\n"); if ((phase & BUSMON_REQ) == 0) { goto timer_out; } tmpSC->SCp.phase = PH_MSG_OUT; data->MsgLen = i = 0; data->MsgBuffer[i] = IDENTIFY(TRUE, lun); i++; if (*sync_neg == SYNC_NOT_YET) { data->Sync[target].SyncPeriod = 0; data->Sync[target].SyncOffset = 0; /**/ data->MsgBuffer[i] = MSG_EXTENDED; i++; data->MsgBuffer[i] = 3; i++; data->MsgBuffer[i] = MSG_EXT_SDTR; i++; data->MsgBuffer[i] = 0x0c; i++; data->MsgBuffer[i] = 15; i++; /**/ } data->MsgLen = i; nsp_msg(tmpSC, data); show_message(data); nsp_message_out(tmpSC, data); break; case BUSPHASE_MESSAGE_IN: nsp_dataphase_bypass(tmpSC, data); DEBUG(0, " BUSPHASE_MESSAGE_IN\n"); if ((phase & BUSMON_REQ) == 0) { goto timer_out; } tmpSC->SCp.phase = PH_MSG_IN; nsp_message_in(tmpSC, data); /**/ if (*sync_neg == SYNC_NOT_YET) { //printk("%d,%d\n",target,lun); if (data->MsgLen >= 5 && data->MsgBuffer[0] == MSG_EXTENDED && data->MsgBuffer[1] == 3 && data->MsgBuffer[2] == MSG_EXT_SDTR ) { data->Sync[target].SyncPeriod = data->MsgBuffer[3]; data->Sync[target].SyncOffset = data->MsgBuffer[4]; //printk("sync ok, %d %d\n", data->MsgBuffer[3], data->MsgBuffer[4]); *sync_neg = SYNC_OK; } else { data->Sync[target].SyncPeriod = 0; data->Sync[target].SyncOffset = 0; *sync_neg = SYNC_NG; } nsp_msg(tmpSC, data); } /**/ /* search last messeage byte */ tmp = -1; for (i = 0; i < data->MsgLen; i++) { tmp = data->MsgBuffer[i]; if (data->MsgBuffer[i] == MSG_EXTENDED) { i += (1 + data->MsgBuffer[i+1]); } } tmpSC->SCp.Message = tmp; DEBUG(0, " message=0x%x len=%d\n", tmpSC->SCp.Message, data->MsgLen); show_message(data); break; case BUSPHASE_SELECT: default: DEBUG(0, " BUSPHASE other\n"); break; } //DEBUG(0, "%s: out\n", __FUNCTION__); return; timer_out: nsp_start_timer(tmpSC, data, 1000/102); return; } #ifdef PCMCIA_DEBUG #include "nsp_debug.c" #endif /* DBG_SHOWCOMMAND */ /*----------------------------------------------------------------*/ /* look for ninja3 card and init if found */ /*----------------------------------------------------------------*/ static struct Scsi_Host *__nsp_detect(Scsi_Host_Template *sht) { struct Scsi_Host *host; /* registered host structure */ nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: this_id=%d\n", __FUNCTION__, sht->this_id); request_region(data->BaseAddress, data->NumAddress, "nsp_cs"); host = scsi_register(sht, 0); if(host == NULL) return NULL; host->unique_id = data->BaseAddress; host->io_port = data->BaseAddress; host->n_io_port = data->NumAddress; host->irq = data->IrqNumber; #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,0)) host->base = data->MmioAddress; /* kernel 2.4 */ #else host->base = (char *)(data->MmioAddress); /* 2.2 */ #endif spin_lock_init(&(data->Lock)); snprintf(data->nspinfo, sizeof(data->nspinfo), "NinjaSCSI-3/32Bi Driver $Revision: 1.1 $ IO:0x%04lx-0x%04lx MMIO(virt addr):0x%04lx IRQ:%02d", host->io_port, host->io_port + host->n_io_port - 1, host->base, host->irq); data->nspinfo[sizeof(data->nspinfo) - 1] = '\0'; sht->name = data->nspinfo; DEBUG(0, "%s: end\n", __FUNCTION__); //MOD_INC_USE_COUNT; return host; } #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) static int nsp_detect(Scsi_Host_Template *sht) { return (__nsp_detect(sht) != NULL); } static int nsp_release(struct Scsi_Host *shpnt) { //nsp_hw_data *data = &nsp_data; /* PCMCIA Card Service dose same things */ //if (shpnt->irq) { // free_irq(shpnt->irq, data); //} //if (shpnt->io_port) { // release_region(shpnt->io_port, shpnt->n_io_port); //} //MOD_DEC_USE_COUNT; return 0; } #endif /*----------------------------------------------------------------*/ /* return info string */ /*----------------------------------------------------------------*/ static const char *nsp_info(struct Scsi_Host *shpnt) { nsp_hw_data *data = &nsp_data; return data->nspinfo; } #undef SPRINTF #define SPRINTF(args...) \ do { if(pos < buffer + length) pos += sprintf(pos, ## args); } while(0) static int nsp_proc_info(struct Scsi_Host *host, char *buffer, char **start, off_t offset, int length, int inout) { int id; char *pos = buffer; int thislength; int speed; unsigned long flags; nsp_hw_data *data = &nsp_data; if (inout) { return -EINVAL; } SPRINTF("NinjaSCSI status\n\n"); SPRINTF("Driver version: $Revision: 1.1 $\n"); SPRINTF("SCSI host No.: %d\n", host->host_no); SPRINTF("IRQ: %d\n", host->irq); SPRINTF("IO: 0x%lx-0x%lx\n", host->io_port, host->io_port + host->n_io_port - 1); SPRINTF("MMIO(virtual address): 0x%lx\n", host->base); SPRINTF("sg_tablesize: %d\n", host->sg_tablesize); SPRINTF("burst transfer mode: "); switch (nsp_burst_mode) { case BURST_IO8: SPRINTF("io8"); break; case BURST_IO32: SPRINTF("io32"); break; case BURST_MEM32: SPRINTF("mem32"); break; default: SPRINTF("???"); break; } SPRINTF("\n"); spin_lock_irqsave(&(data->Lock), flags); SPRINTF("CurrentSC: 0x%p\n\n", data->CurrentSC); spin_unlock_irqrestore(&(data->Lock), flags); SPRINTF("SDTR status\n"); for(id = 0; id < N_TARGET; id++) { SPRINTF("id %d: ", id); if (id == host->this_id) { SPRINTF("----- NinjaSCSI-3 host adapter\n"); continue; } switch(data->Sync[id].SyncNegotiation) { case SYNC_OK: SPRINTF(" sync"); break; case SYNC_NG: SPRINTF("async"); break; case SYNC_NOT_YET: SPRINTF(" none"); break; default: SPRINTF("?????"); break; } if (data->Sync[id].SyncPeriod != 0) { speed = 1000000 / (data->Sync[id].SyncPeriod * 4); SPRINTF(" transfer %d.%dMB/s, offset %d", speed / 1000, speed % 1000, data->Sync[id].SyncOffset ); } SPRINTF("\n"); } thislength = pos - (buffer + offset); if(thislength < 0) { *start = 0; return 0; } thislength = MIN(thislength, length); *start = buffer + offset; return thislength; } #undef SPRINTF /*static int nsp_eh_strategy(struct Scsi_Host *Shost) { return FAILED; }*/ /* static int nsp_eh_abort(Scsi_Cmnd *SCpnt) { DEBUG(0, "%s: SCpnt=0x%p\n", __FUNCTION__, SCpnt); return nsp_eh_bus_reset(SCpnt); }*/ /* static int nsp_eh_device_reset(Scsi_Cmnd *SCpnt) { DEBUG(0, "%s: SCpnt=0x%p\n", __FUNCTION__, SCpnt); return FAILED; }*/ static int nsp_eh_bus_reset(Scsi_Cmnd *SCpnt) { nsp_hw_data *data = &nsp_data; unsigned int base = SCpnt->device->host->io_port; int i; DEBUG(0, "%s: SCpnt=0x%p base=0x%x\n", __FUNCTION__, SCpnt, base); nsp_write(base, IRQCONTROL, IRQCONTROL_ALLMASK); nsp_index_write(base, SCSIBUSCTRL, SCSI_RST); mdelay(100); /* 100ms */ nsp_index_write(base, SCSIBUSCTRL, 0); for(i = 0; i < 5; i++) { nsp_index_read(base, IRQPHASESENCE); /* dummy read */ } nsp_write(base, IRQCONTROL, IRQCONTROL_ALLCLEAR); nsphw_init_sync(data); return SUCCESS; } static int nsp_eh_host_reset(Scsi_Cmnd *SCpnt) { nsp_hw_data *data = &nsp_data; DEBUG(0, "%s:\n", __FUNCTION__); nsphw_init(data); return SUCCESS; } /********************************************************************** PCMCIA functions **********************************************************************/ /*====================================================================== nsp_cs_attach() creates an "instance" of the driver, allocating local data structures for one device. The device is registered with Card Services. The dev_link structure is initialized, but we don't actually configure the card at this point -- we wait until we receive a card insertion event. ======================================================================*/ static dev_link_t *nsp_cs_attach(void) { scsi_info_t *info; client_reg_t client_reg; dev_link_t *link; int ret, i; DEBUG(0, "%s:\n", __FUNCTION__); /* Create new SCSI device */ info = kmalloc(sizeof(*info), GFP_KERNEL); if (!info) { return NULL; } memset(info, 0, sizeof(*info)); link = &info->link; link->priv = info; /* Initialize the dev_link_t structure */ link->release.function = &nsp_cs_release; link->release.data = (u_long)link; /* The io structure describes IO port mapping */ link->io.NumPorts1 = 0x10; link->io.Attributes1 = IO_DATA_PATH_WIDTH_AUTO; link->io.IOAddrLines = 10; /* not used */ /* Interrupt setup */ link->irq.Attributes = IRQ_TYPE_EXCLUSIVE | IRQ_HANDLE_PRESENT; link->irq.IRQInfo1 = IRQ_INFO2_VALID | IRQ_LEVEL_ID; if (irq_list[0] == -1) { link->irq.IRQInfo2 = irq_mask; } else { for (i = 0; i < 4; i++) { link->irq.IRQInfo2 |= 1 << irq_list[i]; } } /* IRQ $B$N3NJ]$O$3$3$G(B PCMCIA $B$N4X?t$rMQ$$$F9T$J$&$N$G(B * host->hostdata $B$r(B irq.Instance $B$KBeF~$G$-$J$$!#(B * host->hostdata $B$,;H$($l$PJ#?t$N(B NinjaSCSI $B$,(B * $B;HMQ$G$-$k$N$@$,!#(B */ link->irq.Handler = &nspintr; link->irq.Instance = &nsp_data; link->irq.Attributes |= (SA_SHIRQ | SA_SAMPLE_RANDOM); /* General socket configuration */ link->conf.Attributes = CONF_ENABLE_IRQ; link->conf.Vcc = 50; link->conf.IntType = INT_MEMORY_AND_IO; link->conf.Present = PRESENT_OPTION; /* Register with Card Services */ link->next = dev_list; dev_list = link; client_reg.dev_info = &dev_info; client_reg.Attributes = INFO_IO_CLIENT | INFO_CARD_SHARE; client_reg.EventMask = CS_EVENT_CARD_INSERTION | CS_EVENT_CARD_REMOVAL | CS_EVENT_RESET_PHYSICAL | CS_EVENT_CARD_RESET | CS_EVENT_PM_SUSPEND | CS_EVENT_PM_RESUME ; client_reg.event_handler = &nsp_cs_event; client_reg.Version = 0x0210; client_reg.event_callback_args.client_data = link; ret = CardServices(RegisterClient, &link->handle, &client_reg); if (ret != CS_SUCCESS) { cs_error(link->handle, RegisterClient, ret); nsp_cs_detach(link); return NULL; } return link; } /* nsp_cs_attach */ /*====================================================================== This deletes a driver "instance". The device is de-registered with Card Services. If it has been released, all local data structures are freed. Otherwise, the structures will be freed when the device is released. ======================================================================*/ static void nsp_cs_detach(dev_link_t *link) { dev_link_t **linkp; DEBUG(0, "%s(0x%p)\n", __FUNCTION__, link); /* Locate device structure */ for (linkp = &dev_list; *linkp; linkp = &(*linkp)->next) { if (*linkp == link) { break; } } if (*linkp == NULL) { return; } del_timer(&link->release); if (link->state & DEV_CONFIG) { nsp_cs_release((u_long)link); if (link->state & DEV_STALE_CONFIG) { link->state |= DEV_STALE_LINK; return; } } /* Break the link with Card Services */ if (link->handle) { CardServices(DeregisterClient, link->handle); } /* Unlink device structure, free bits */ *linkp = link->next; kfree(link->priv); link->priv = NULL; } /* nsp_cs_detach */ /*====================================================================== nsp_cs_config() is scheduled to run after a CARD_INSERTION event is received, to configure the PCMCIA socket, and to make the ethernet device available to the system. ======================================================================*/ #define CS_CHECK(fn, args...) \ while ((last_ret=CardServices(last_fn=(fn),args))!=0) goto cs_failed #define CFG_CHECK(fn, args...) \ if (CardServices(fn, args) != 0) goto next_entry /*====================================================================*/ static void nsp_cs_config(dev_link_t *link) { client_handle_t handle = link->handle; scsi_info_t *info = link->priv; tuple_t tuple; cisparse_t parse; int last_ret, last_fn; u_char tuple_data[64]; config_info_t conf; win_req_t req; memreq_t map; cistpl_cftable_entry_t dflt = { 0 }; struct Scsi_Host *host; nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: in\n", __FUNCTION__); tuple.DesiredTuple = CISTPL_CONFIG; tuple.Attributes = 0; tuple.TupleData = tuple_data; tuple.TupleDataMax = sizeof(tuple_data); tuple.TupleOffset = 0; CS_CHECK(GetFirstTuple, handle, &tuple); CS_CHECK(GetTupleData, handle, &tuple); CS_CHECK(ParseTuple, handle, &tuple, &parse); link->conf.ConfigBase = parse.config.base; link->conf.Present = parse.config.rmask[0]; /* Configure card */ link->state |= DEV_CONFIG; /* Look up the current Vcc */ CS_CHECK(GetConfigurationInfo, handle, &conf); link->conf.Vcc = conf.Vcc; tuple.DesiredTuple = CISTPL_CFTABLE_ENTRY; CS_CHECK(GetFirstTuple, handle, &tuple); while (1) { cistpl_cftable_entry_t *cfg = &(parse.cftable_entry); CFG_CHECK(GetTupleData, handle, &tuple); CFG_CHECK(ParseTuple, handle, &tuple, &parse); if (cfg->flags & CISTPL_CFTABLE_DEFAULT) { dflt = *cfg; } if (cfg->index == 0) { goto next_entry; } link->conf.ConfigIndex = cfg->index; /* Does this card need audio output? */ if (cfg->flags & CISTPL_CFTABLE_AUDIO) { link->conf.Attributes |= CONF_ENABLE_SPKR; link->conf.Status = CCSR_AUDIO_ENA; } /* Use power settings for Vcc and Vpp if present */ /* Note that the CIS values need to be rescaled */ if (cfg->vcc.present & (1<vcc.param[CISTPL_POWER_VNOM]/10000) { goto next_entry; } } else if (dflt.vcc.present & (1<vpp1.present & (1<conf.Vpp1 = link->conf.Vpp2 = cfg->vpp1.param[CISTPL_POWER_VNOM]/10000; } else if (dflt.vpp1.present & (1<conf.Vpp1 = link->conf.Vpp2 = dflt.vpp1.param[CISTPL_POWER_VNOM]/10000; } /* Do we need to allocate an interrupt? */ if (cfg->irq.IRQInfo1 || dflt.irq.IRQInfo1) { link->conf.Attributes |= CONF_ENABLE_IRQ; } /* IO window settings */ link->io.NumPorts1 = link->io.NumPorts2 = 0; if ((cfg->io.nwin > 0) || (dflt.io.nwin > 0)) { cistpl_io_t *io = (cfg->io.nwin) ? &cfg->io : &dflt.io; link->io.Attributes1 = IO_DATA_PATH_WIDTH_AUTO; if (!(io->flags & CISTPL_IO_8BIT)) link->io.Attributes1 = IO_DATA_PATH_WIDTH_16; if (!(io->flags & CISTPL_IO_16BIT)) link->io.Attributes1 = IO_DATA_PATH_WIDTH_8; link->io.IOAddrLines = io->flags & CISTPL_IO_LINES_MASK; link->io.BasePort1 = io->win[0].base; link->io.NumPorts1 = io->win[0].len; if (io->nwin > 1) { link->io.Attributes2 = link->io.Attributes1; link->io.BasePort2 = io->win[1].base; link->io.NumPorts2 = io->win[1].len; } /* This reserves IO space but doesn't actually enable it */ CFG_CHECK(RequestIO, link->handle, &link->io); } if ((cfg->mem.nwin > 0) || (dflt.mem.nwin > 0)) { cistpl_mem_t *mem = (cfg->mem.nwin) ? &cfg->mem : &dflt.mem; req.Attributes = WIN_DATA_WIDTH_16|WIN_MEMORY_TYPE_CM; req.Attributes |= WIN_ENABLE; req.Base = mem->win[0].host_addr; req.Size = mem->win[0].len; if (req.Size < 0x1000) req.Size = 0x1000; req.AccessSpeed = 0; link->win = (window_handle_t)link->handle; CFG_CHECK(RequestWindow, &link->win, &req); map.Page = 0; map.CardOffset = mem->win[0].card_addr; CFG_CHECK(MapMemPage, link->win, &map); data->MmioAddress = (u_long)ioremap_nocache(req.Base, req.Size); } /* If we got this far, we're cool! */ break; next_entry: DEBUG(0, "%s: next\n", __FUNCTION__); if (link->io.NumPorts1) CardServices(ReleaseIO, link->handle, &link->io); CS_CHECK(GetNextTuple, handle, &tuple); } if (link->conf.Attributes & CONF_ENABLE_IRQ) CS_CHECK(RequestIRQ, link->handle, &link->irq); CS_CHECK(RequestConfiguration, handle, &link->conf); if (free_ports) { if (link->io.BasePort1) release_region(link->io.BasePort1, link->io.NumPorts1); if (link->io.BasePort2) release_region(link->io.BasePort2, link->io.NumPorts2); } /* Set port and IRQ */ data->BaseAddress = link->io.BasePort1; data->NumAddress = link->io.NumPorts1; data->IrqNumber = link->irq.AssignedIRQ; DEBUG(0, "%s: I/O[0x%x+0x%x] IRQ %d\n", __FUNCTION__, data->BaseAddress, data->NumAddress, data->IrqNumber); if(nsphw_init(data) == FALSE) { goto cs_failed; } host = __nsp_detect(&nsp_driver_template); if (!host) goto cs_failed; sprintf(info->node.dev_name, "scsi%d", host->host_no); link->dev = &info->node; info->host = host; /* Finally, report what we've done */ printk(KERN_INFO "nsp_cs: index 0x%02x: Vcc %d.%d", link->conf.ConfigIndex, link->conf.Vcc/10, link->conf.Vcc%10); if (link->conf.Vpp1) { printk(", Vpp %d.%d", link->conf.Vpp1/10, link->conf.Vpp1%10); } if (link->conf.Attributes & CONF_ENABLE_IRQ) { printk(", irq %d", link->irq.AssignedIRQ); } if (link->io.NumPorts1) { printk(", io 0x%04x-0x%04x", link->io.BasePort1, link->io.BasePort1+link->io.NumPorts1-1); } if (link->io.NumPorts2) printk(" & 0x%04x-0x%04x", link->io.BasePort2, link->io.BasePort2+link->io.NumPorts2-1); if (link->win) printk(", mem 0x%06lx-0x%06lx", req.Base, req.Base+req.Size-1); printk("\n"); scsi_add_host(host, NULL); link->state &= ~DEV_CONFIG_PENDING; return; cs_failed: cs_error(link->handle, last_fn, last_ret); nsp_cs_release((u_long)link); return; } /* nsp_cs_config */ #undef CS_CHECK #undef CFG_CHECK /*====================================================================== After a card is removed, nsp_cs_release() will unregister the net device, and release the PCMCIA configuration. If the device is still open, this will be postponed until it is closed. ======================================================================*/ static void nsp_cs_release(u_long arg) { dev_link_t *link = (dev_link_t *)arg; scsi_info_t *info = link->priv; DEBUG(0, "%s(0x%p)\n", __FUNCTION__, link); /* * If the device is currently in use, we won't release until it * is actually closed. */ if (link->open) { DEBUG(1, "nsp_cs: release postponed, '%s' still open\n", link->dev->dev_name); link->state |= DEV_STALE_CONFIG; return; } /* Unlink the device chain */ #if (LINUX_VERSION_CODE <= KERNEL_VERSION(2,5,2)) scsi_unregister_module(MODULE_SCSI_HA, &nsp_driver_template); #else scsi_remove_host(info->host); scsi_unregister(info->host); #endif link->dev = NULL; if (link->win) { iounmap((void *)(nsp_data.MmioAddress)); CardServices(ReleaseWindow, link->win); } CardServices(ReleaseConfiguration, link->handle); if (link->io.NumPorts1) { CardServices(ReleaseIO, link->handle, &link->io); } if (link->irq.AssignedIRQ) { CardServices(ReleaseIRQ, link->handle, &link->irq); } link->state &= ~DEV_CONFIG; if (link->state & DEV_STALE_LINK) { nsp_cs_detach(link); } } /* nsp_cs_release */ /*====================================================================== The card status event handler. Mostly, this schedules other stuff to run after an event is received. A CARD_REMOVAL event also sets some flags to discourage the net drivers from trying to talk to the card any more. When a CARD_REMOVAL event is received, we immediately set a flag to block future accesses to this device. All the functions that actually access the device should check this flag to make sure the card is still present. ======================================================================*/ static int nsp_cs_event(event_t event, int priority, event_callback_args_t *args) { dev_link_t *link = args->client_data; scsi_info_t *info = link->priv; Scsi_Cmnd tmp; DEBUG(1, "%s(0x%06x)\n", __FUNCTION__, event); switch (event) { case CS_EVENT_CARD_REMOVAL: DEBUG(0, " event: remove\n"); link->state &= ~DEV_PRESENT; if (link->state & DEV_CONFIG) { ((scsi_info_t *)link->priv)->stop = 1; mod_timer(&link->release, jiffies + HZ/20); } break; case CS_EVENT_CARD_INSERTION: DEBUG(0, " event: insert\n"); link->state |= DEV_PRESENT | DEV_CONFIG_PENDING; nsp_cs_config(link); break; case CS_EVENT_PM_SUSPEND: link->state |= DEV_SUSPEND; /* Fall through... */ case CS_EVENT_RESET_PHYSICAL: /* Mark the device as stopped, to block IO until later */ info->stop = 1; if (link->state & DEV_CONFIG) { CardServices(ReleaseConfiguration, link->handle); } break; case CS_EVENT_PM_RESUME: link->state &= ~DEV_SUSPEND; /* Fall through... */ case CS_EVENT_CARD_RESET: DEBUG(0, " event: reset\n"); if (link->state & DEV_CONFIG) { CardServices(RequestConfiguration, link->handle, &link->conf); } info->stop = 0; tmp.device->host = info->host; nsp_eh_host_reset(&tmp); nsp_eh_bus_reset(&tmp); break; default: DEBUG(0, " event: unknown\n"); break; } DEBUG(0, "%s: end\n", __FUNCTION__); return 0; } /* nsp_cs_event */ static struct pcmcia_driver nsp_driver = { .owner = THIS_MODULE, .drv = { .name = "nsp_cs", }, .attach = nsp_cs_attach, .detach = nsp_cs_detach, }; static int __init nsp_cs_init(void) { return pcmcia_register_driver(&nsp_driver); } static void __exit nsp_cs_exit(void) { pcmcia_unregister_driver(&nsp_driver); /* XXX: this really needs to move into generic code.. */ while (dev_list != NULL) { if (dev_list->state & DEV_CONFIG) { nsp_cs_release((u_long)dev_list); } nsp_cs_detach(dev_list); } } module_init(nsp_cs_init) module_exit(nsp_cs_exit) coccinelle-1.0.0-rc19/demos/demo_rule9/rule9_2.cocci0000644000175000017500000000071512247437436021031 0ustar eugeneugen@@ identifier proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } coccinelle-1.0.0-rc19/demos/demo_rule9/rule9.cocci0000644000175000017500000000224012247437436020603 0ustar eugeneugen// the order of rules in standard.iso is important to makes this SP works. @ rule1 @ typedef Scsi_Host_Template; {struct SHT, Scsi_Host_Template} fops; identifier proc_info_func; @@ fops.proc_info = proc_info_func; @ rule2 @ identifier rule1.proc_info_func; identifier buffer, start, offset, length, inout, hostno; identifier hostptr; typedef off_t; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } @ rule3 @ identifier rule1.proc_info_func; identifier rule2.hostno; identifier rule2.hostptr; @@ proc_info_func(...) { <... - hostno + hostptr->host_no ...> } @ rule4 @ identifier rule1.proc_info_func; identifier func; expression buffer, start, offset, length, inout, hostno; identifier hostptr; @@ func(..., struct Scsi_Host *hostptr, ...) { <... proc_info_func( + hostptr, buffer, start, offset, length, - hostno, inout) ...> } coccinelle-1.0.0-rc19/demos/demo_rule9/sym53c8xx.res0000644000175000017500000134102512247437436021057 0ustar eugeneugen/****************************************************************************** ** High Performance device driver for the Symbios 53C896 controller. ** ** Copyright (C) 1998-2001 Gerard Roudier ** ** This driver also supports all the Symbios 53C8XX controller family, ** except 53C810 revisions < 16, 53C825 revisions < 16 and all ** revisions of 53C815 controllers. ** ** This driver is based on the Linux port of the FreeBSD ncr driver. ** ** Copyright (C) 1994 Wolfgang Stanglmeier ** **----------------------------------------------------------------------------- ** ** This program is free software; you can redistribute it and/or modify ** it under the terms of the GNU General Public License as published by ** the Free Software Foundation; either version 2 of the License, or ** (at your option) any later version. ** ** This program is distributed in the hope that it will be useful, ** but WITHOUT ANY WARRANTY; without even the implied warranty of ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ** GNU General Public License for more details. ** ** You should have received a copy of the GNU General Public License ** along with this program; if not, write to the Free Software ** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ** **----------------------------------------------------------------------------- ** ** The Linux port of the FreeBSD ncr driver has been achieved in ** november 1995 by: ** ** Gerard Roudier ** ** Being given that this driver originates from the FreeBSD version, and ** in order to keep synergy on both, any suggested enhancements and corrections ** received on Linux are automatically a potential candidate for the FreeBSD ** version. ** ** The original driver has been written for 386bsd and FreeBSD by ** Wolfgang Stanglmeier ** Stefan Esser ** **----------------------------------------------------------------------------- ** ** Major contributions: ** -------------------- ** ** NVRAM detection and reading. ** Copyright (C) 1997 Richard Waltham ** ******************************************************************************* */ /* ** Supported SCSI features: ** Synchronous data transfers ** Wide16 SCSI BUS ** Disconnection/Reselection ** Tagged command queuing ** SCSI Parity checking ** ** Supported NCR/SYMBIOS chips: ** 53C810A (8 bits, Fast 10, no rom BIOS) ** 53C825A (Wide, Fast 10, on-board rom BIOS) ** 53C860 (8 bits, Fast 20, no rom BIOS) ** 53C875 (Wide, Fast 20, on-board rom BIOS) ** 53C876 (Wide, Fast 20 Dual, on-board rom BIOS) ** 53C895 (Wide, Fast 40, on-board rom BIOS) ** 53C895A (Wide, Fast 40, on-board rom BIOS) ** 53C896 (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C897 (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C1510D (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C1010 (Wide, Fast 80 Dual, on-board rom BIOS) ** 53C1010_66(Wide, Fast 80 Dual, on-board rom BIOS, 33/66MHz PCI) ** ** Other features: ** Memory mapped IO ** Module ** Shared IRQ */ /* ** Name and version of the driver */ #define SCSI_NCR_DRIVER_NAME "sym53c8xx-1.7.3c-20010512" #define SCSI_NCR_DEBUG_FLAGS (0) #define NAME53C "sym53c" #define NAME53C8XX "sym53c8xx" /*========================================================== ** ** Include files ** **========================================================== */ #include #include #include #include #include #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,17) #include #elif LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,35) #include #endif #ifndef __init #define __init #endif #ifndef __initdata #define __initdata #endif #if LINUX_VERSION_CODE <= KERNEL_VERSION(2,1,92) #include #endif #include "scsi.h" #include "hosts.h" #include /* ** Define BITS_PER_LONG for earlier linux versions. */ #ifndef BITS_PER_LONG #if (~0UL) == 0xffffffffUL #define BITS_PER_LONG 32 #else #define BITS_PER_LONG 64 #endif #endif /* ** Define the BSD style u_int32 and u_int64 type. ** Are in fact u_int32_t and u_int64_t :-) */ typedef u32 u_int32; typedef u64 u_int64; #include "sym53c8xx.h" /* ** Donnot compile integrity checking code for Linux-2.3.0 ** and above since SCSI data structures are not ready yet. */ /* #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,0) */ #if 0 #define SCSI_NCR_INTEGRITY_CHECKING #endif #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define MAX(a,b) (((a) > (b)) ? (a) : (b)) /* ** Hmmm... What complex some PCI-HOST bridges actually are, ** despite the fact that the PCI specifications are looking ** so smart and simple! ;-) */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,47) #define SCSI_NCR_DYNAMIC_DMA_MAPPING #endif /*========================================================== ** ** A la VMS/CAM-3 queue management. ** Implemented from linux list management. ** **========================================================== */ typedef struct xpt_quehead { struct xpt_quehead *flink; /* Forward pointer */ struct xpt_quehead *blink; /* Backward pointer */ } XPT_QUEHEAD; #define xpt_que_init(ptr) do { \ (ptr)->flink = (ptr); (ptr)->blink = (ptr); \ } while (0) static inline void __xpt_que_add(struct xpt_quehead * new, struct xpt_quehead * blink, struct xpt_quehead * flink) { flink->blink = new; new->flink = flink; new->blink = blink; blink->flink = new; } static inline void __xpt_que_del(struct xpt_quehead * blink, struct xpt_quehead * flink) { flink->blink = blink; blink->flink = flink; } static inline int xpt_que_empty(struct xpt_quehead *head) { return head->flink == head; } static inline void xpt_que_splice(struct xpt_quehead *list, struct xpt_quehead *head) { struct xpt_quehead *first = list->flink; if (first != list) { struct xpt_quehead *last = list->blink; struct xpt_quehead *at = head->flink; first->blink = head; head->flink = first; last->flink = at; at->blink = last; } } #define xpt_que_entry(ptr, type, member) \ ((type *)((char *)(ptr)-(unsigned long)(&((type *)0)->member))) #define xpt_insque(new, pos) __xpt_que_add(new, pos, (pos)->flink) #define xpt_remque(el) __xpt_que_del((el)->blink, (el)->flink) #define xpt_insque_head(new, head) __xpt_que_add(new, head, (head)->flink) static inline struct xpt_quehead *xpt_remque_head(struct xpt_quehead *head) { struct xpt_quehead *elem = head->flink; if (elem != head) __xpt_que_del(head, elem->flink); else elem = 0; return elem; } #define xpt_insque_tail(new, head) __xpt_que_add(new, (head)->blink, head) static inline struct xpt_quehead *xpt_remque_tail(struct xpt_quehead *head) { struct xpt_quehead *elem = head->blink; if (elem != head) __xpt_que_del(elem->blink, head); else elem = 0; return elem; } /*========================================================== ** ** Configuration and Debugging ** **========================================================== */ /* ** SCSI address of this device. ** The boot routines should have set it. ** If not, use this. */ #ifndef SCSI_NCR_MYADDR #define SCSI_NCR_MYADDR (7) #endif /* ** The maximum number of tags per logic unit. ** Used only for devices that support tags. */ #ifndef SCSI_NCR_MAX_TAGS #define SCSI_NCR_MAX_TAGS (8) #endif /* ** TAGS are actually unlimited (256 tags/lun). ** But Linux only supports 255. :) */ #if SCSI_NCR_MAX_TAGS > 255 #define MAX_TAGS 255 #else #define MAX_TAGS SCSI_NCR_MAX_TAGS #endif /* ** Since the ncr chips only have a 8 bit ALU, we try to be clever ** about offset calculation in the TASK TABLE per LUN that is an ** array of DWORDS = 4 bytes. */ #if MAX_TAGS > (512/4) #define MAX_TASKS (1024/4) #elif MAX_TAGS > (256/4) #define MAX_TASKS (512/4) #else #define MAX_TASKS (256/4) #endif /* ** This one means 'NO TAG for this job' */ #define NO_TAG (256) /* ** Number of targets supported by the driver. ** n permits target numbers 0..n-1. ** Default is 16, meaning targets #0..#15. ** #7 .. is myself. */ #ifdef SCSI_NCR_MAX_TARGET #define MAX_TARGET (SCSI_NCR_MAX_TARGET) #else #define MAX_TARGET (16) #endif /* ** Number of logic units supported by the driver. ** n enables logic unit numbers 0..n-1. ** The common SCSI devices require only ** one lun, so take 1 as the default. */ #ifdef SCSI_NCR_MAX_LUN #define MAX_LUN 64 #else #define MAX_LUN (1) #endif /* ** Asynchronous pre-scaler (ns). Shall be 40 for ** the SCSI timings to be compliant. */ #ifndef SCSI_NCR_MIN_ASYNC #define SCSI_NCR_MIN_ASYNC (40) #endif /* ** The maximum number of jobs scheduled for starting. ** We allocate 4 entries more than the value we announce ** to the SCSI upper layer. Guess why ! :-) */ #ifdef SCSI_NCR_CAN_QUEUE #define MAX_START (SCSI_NCR_CAN_QUEUE + 4) #else #define MAX_START (MAX_TARGET + 7 * MAX_TAGS) #endif /* ** We donnot want to allocate more than 1 PAGE for the ** the start queue and the done queue. We hard-code entry ** size to 8 in order to let cpp do the checking. ** Allows 512-4=508 pending IOs for i386 but Linux seems for ** now not able to provide the driver with this amount of IOs. */ #if MAX_START > PAGE_SIZE/8 #undef MAX_START #define MAX_START (PAGE_SIZE/8) #endif /* ** The maximum number of segments a transfer is split into. ** We support up to 127 segments for both read and write. */ #define MAX_SCATTER (SCSI_NCR_MAX_SCATTER) #define SCR_SG_SIZE (2) /* ** other */ #define NCR_SNOOP_TIMEOUT (1000000) /*========================================================== ** ** Miscallaneous BSDish defines. ** **========================================================== */ #define u_char unsigned char #define u_short unsigned short #define u_int unsigned int #define u_long unsigned long #ifndef bcopy #define bcopy(s, d, n) memcpy((d), (s), (n)) #endif #ifndef bzero #define bzero(d, n) memset((d), 0, (n)) #endif #ifndef offsetof #define offsetof(t, m) ((size_t) (&((t *)0)->m)) #endif /* ** Simple Wrapper to kernel PCI bus interface. ** ** This wrapper allows to get rid of old kernel PCI interface ** and still allows to preserve linux-2.0 compatibilty. ** In fact, it is mostly an incomplete emulation of the new ** PCI code for pre-2.2 kernels. When kernel-2.0 support ** will be dropped, we will just have to remove most of this ** code. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,2,0) typedef struct pci_dev *pcidev_t; #define PCIDEV_NULL (0) #define PciBusNumber(d) (d)->bus->number #define PciDeviceFn(d) (d)->devfn #define PciVendorId(d) (d)->vendor #define PciDeviceId(d) (d)->device #define PciIrqLine(d) (d)->irq static u_long __init pci_get_base_cookie(struct pci_dev *pdev, int index) { u_long base; #if LINUX_VERSION_CODE > KERNEL_VERSION(2,3,12) base = pdev->resource[index].start; #else base = pdev->base_address[index]; #if BITS_PER_LONG > 32 if ((base & 0x7) == 0x4) *base |= (((u_long)pdev->base_address[++index]) << 32); #endif #endif return (base & ~0x7ul); } static int __init pci_get_base_address(struct pci_dev *pdev, int index, u_long *base) { u32 tmp; #define PCI_BAR_OFFSET(index) (PCI_BASE_ADDRESS_0 + (index<<2)) pci_read_config_dword(pdev, PCI_BAR_OFFSET(index), &tmp); *base = tmp; ++index; if ((tmp & 0x7) == 0x4) { #if BITS_PER_LONG > 32 pci_read_config_dword(pdev, PCI_BAR_OFFSET(index), &tmp); *base |= (((u_long)tmp) << 32); #endif ++index; } return index; #undef PCI_BAR_OFFSET } #else /* Incomplete emulation of current PCI code for pre-2.2 kernels */ typedef unsigned int pcidev_t; #define PCIDEV_NULL (~0u) #define PciBusNumber(d) ((d)>>8) #define PciDeviceFn(d) ((d)&0xff) #define __PciDev(busn, devfn) (((busn)<<8)+(devfn)) #define pci_present pcibios_present #define pci_read_config_byte(d, w, v) \ pcibios_read_config_byte(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_read_config_word(d, w, v) \ pcibios_read_config_word(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_read_config_dword(d, w, v) \ pcibios_read_config_dword(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_byte(d, w, v) \ pcibios_write_config_byte(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_word(d, w, v) \ pcibios_write_config_word(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_dword(d, w, v) \ pcibios_write_config_dword(PciBusNumber(d), PciDeviceFn(d), w, v) static pcidev_t __init pci_find_device(unsigned int vendor, unsigned int device, pcidev_t prev) { static unsigned short pci_index; int retv; unsigned char bus_number, device_fn; if (prev == PCIDEV_NULL) pci_index = 0; else ++pci_index; retv = pcibios_find_device (vendor, device, pci_index, &bus_number, &device_fn); return retv ? PCIDEV_NULL : __PciDev(bus_number, device_fn); } static u_short __init PciVendorId(pcidev_t dev) { u_short vendor_id; pci_read_config_word(dev, PCI_VENDOR_ID, &vendor_id); return vendor_id; } static u_short __init PciDeviceId(pcidev_t dev) { u_short device_id; pci_read_config_word(dev, PCI_DEVICE_ID, &device_id); return device_id; } static u_int __init PciIrqLine(pcidev_t dev) { u_char irq; pci_read_config_byte(dev, PCI_INTERRUPT_LINE, &irq); return irq; } static int __init pci_get_base_address(pcidev_t dev, int offset, u_long *base) { u_int32 tmp; pci_read_config_dword(dev, PCI_BASE_ADDRESS_0 + offset, &tmp); *base = tmp; offset += sizeof(u_int32); if ((tmp & 0x7) == 0x4) { #if BITS_PER_LONG > 32 pci_read_config_dword(dev, PCI_BASE_ADDRESS_0 + offset, &tmp); *base |= (((u_long)tmp) << 32); #endif offset += sizeof(u_int32); } return offset; } static u_long __init pci_get_base_cookie(struct pci_dev *pdev, int offset) { u_long base; (void) pci_get_base_address(dev, offset, &base); return base; } #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(2,2,0) */ /* Does not make sense in earlier kernels */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,4,0) #define pci_enable_device(pdev) (0) #endif #if LINUX_VERSION_CODE < KERNEL_VERSION(2,4,4) #define scsi_set_pci_device(inst, pdev) (0) #endif /*========================================================== ** ** Debugging tags ** **========================================================== */ #define DEBUG_ALLOC (0x0001) #define DEBUG_PHASE (0x0002) #define DEBUG_QUEUE (0x0008) #define DEBUG_RESULT (0x0010) #define DEBUG_POINTER (0x0020) #define DEBUG_SCRIPT (0x0040) #define DEBUG_TINY (0x0080) #define DEBUG_TIMING (0x0100) #define DEBUG_NEGO (0x0200) #define DEBUG_TAGS (0x0400) #define DEBUG_IC (0x0800) /* ** Enable/Disable debug messages. ** Can be changed at runtime too. */ #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT static int ncr_debug = SCSI_NCR_DEBUG_FLAGS; #define DEBUG_FLAGS ncr_debug #else #define DEBUG_FLAGS SCSI_NCR_DEBUG_FLAGS #endif /* ** SMP threading. ** ** Assuming that SMP systems are generally high end systems and may ** use several SCSI adapters, we are using one lock per controller ** instead of some global one. For the moment (linux-2.1.95), driver's ** entry points are called with the 'io_request_lock' lock held, so: ** - We are uselessly loosing a couple of micro-seconds to lock the ** controller data structure. ** - But the driver is not broken by design for SMP and so can be ** more resistant to bugs or bad changes in the IO sub-system code. ** - A small advantage could be that the interrupt code is grained as ** wished (e.g.: threaded by controller). */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) spinlock_t sym53c8xx_lock = SPIN_LOCK_UNLOCKED; #define NCR_LOCK_DRIVER(flags) spin_lock_irqsave(&sym53c8xx_lock, flags) #define NCR_UNLOCK_DRIVER(flags) spin_unlock_irqrestore(&sym53c8xx_lock,flags) #define NCR_INIT_LOCK_NCB(np) spin_lock_init(&np->smp_lock); #define NCR_LOCK_NCB(np, flags) spin_lock_irqsave(&np->smp_lock, flags) #define NCR_UNLOCK_NCB(np, flags) spin_unlock_irqrestore(&np->smp_lock, flags) #define NCR_LOCK_SCSI_DONE(host, flags) \ spin_lock_irqsave(((host)->host_lock), flags) #define NCR_UNLOCK_SCSI_DONE(host, flags) \ spin_unlock_irqrestore(((host)->host_lock), flags) #else #define NCR_LOCK_DRIVER(flags) do { save_flags(flags); cli(); } while (0) #define NCR_UNLOCK_DRIVER(flags) do { restore_flags(flags); } while (0) #define NCR_INIT_LOCK_NCB(np) do { } while (0) #define NCR_LOCK_NCB(np, flags) do { save_flags(flags); cli(); } while (0) #define NCR_UNLOCK_NCB(np, flags) do { restore_flags(flags); } while (0) #define NCR_LOCK_SCSI_DONE(host, flags) do {;} while (0) #define NCR_UNLOCK_SCSI_DONE(host, flags) do {;} while (0) #endif /* ** Memory mapped IO ** ** Since linux-2.1, we must use ioremap() to map the io memory space. ** iounmap() to unmap it. That allows portability. ** Linux 1.3.X and 2.0.X allow to remap physical pages addresses greater ** than the highest physical memory address to kernel virtual pages with ** vremap() / vfree(). That was not portable but worked with i386 ** architecture. */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,1,0) #define ioremap vremap #define iounmap vfree #endif #ifdef __sparc__ # include # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #elif defined(__alpha__) # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #else /* others */ # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #endif #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED static u_long __init remap_pci_mem(u_long base, u_long size) { u_long page_base = ((u_long) base) & PAGE_MASK; u_long page_offs = ((u_long) base) - page_base; u_long page_remapped = (u_long) ioremap(page_base, page_offs+size); return page_remapped? (page_remapped + page_offs) : 0UL; } static void __init unmap_pci_mem(u_long vaddr, u_long size) { if (vaddr) iounmap((void *) (vaddr & PAGE_MASK)); } #endif /* not def SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ /* ** Insert a delay in micro-seconds and milli-seconds. ** ------------------------------------------------- ** Under Linux, udelay() is restricted to delay < 1 milli-second. ** In fact, it generally works for up to 1 second delay. ** Since 2.1.105, the mdelay() function is provided for delays ** in milli-seconds. ** Under 2.0 kernels, udelay() is an inline function that is very ** inaccurate on Pentium processors. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,105) #define UDELAY udelay #define MDELAY mdelay #else static void UDELAY(long us) { udelay(us); } static void MDELAY(long ms) { while (ms--) UDELAY(1000); } #endif /* ** Simple power of two buddy-like allocator ** ---------------------------------------- ** This simple code is not intended to be fast, but to provide ** power of 2 aligned memory allocations. ** Since the SCRIPTS processor only supplies 8 bit arithmetic, ** this allocator allows simple and fast address calculations ** from the SCRIPTS code. In addition, cache line alignment ** is guaranteed for power of 2 cache line size. ** Enhanced in linux-2.3.44 to provide a memory pool per pcidev ** to support dynamic dma mapping. (I would have preferred a ** real bus astraction, btw). */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,0) #define __GetFreePages(flags, order) __get_free_pages(flags, order) #else #define __GetFreePages(flags, order) __get_free_pages(flags, order, 0) #endif #define MEMO_SHIFT 4 /* 16 bytes minimum memory chunk */ #if PAGE_SIZE >= 8192 #define MEMO_PAGE_ORDER 0 /* 1 PAGE maximum */ #else #define MEMO_PAGE_ORDER 1 /* 2 PAGES maximum */ #endif #define MEMO_FREE_UNUSED /* Free unused pages immediately */ #define MEMO_WARN 1 #define MEMO_GFP_FLAGS GFP_ATOMIC #define MEMO_CLUSTER_SHIFT (PAGE_SHIFT+MEMO_PAGE_ORDER) #define MEMO_CLUSTER_SIZE (1UL << MEMO_CLUSTER_SHIFT) #define MEMO_CLUSTER_MASK (MEMO_CLUSTER_SIZE-1) typedef u_long m_addr_t; /* Enough bits to bit-hack addresses */ typedef pcidev_t m_bush_t; /* Something that addresses DMAable */ typedef struct m_link { /* Link between free memory chunks */ struct m_link *next; } m_link_s; #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING typedef struct m_vtob { /* Virtual to Bus address translation */ struct m_vtob *next; m_addr_t vaddr; m_addr_t baddr; } m_vtob_s; #define VTOB_HASH_SHIFT 5 #define VTOB_HASH_SIZE (1UL << VTOB_HASH_SHIFT) #define VTOB_HASH_MASK (VTOB_HASH_SIZE-1) #define VTOB_HASH_CODE(m) \ ((((m_addr_t) (m)) >> MEMO_CLUSTER_SHIFT) & VTOB_HASH_MASK) #endif typedef struct m_pool { /* Memory pool of a given kind */ #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING m_bush_t bush; m_addr_t (*getp)(struct m_pool *); void (*freep)(struct m_pool *, m_addr_t); #define M_GETP() mp->getp(mp) #define M_FREEP(p) mp->freep(mp, p) #define GetPages() __GetFreePages(MEMO_GFP_FLAGS, MEMO_PAGE_ORDER) #define FreePages(p) free_pages(p, MEMO_PAGE_ORDER) int nump; m_vtob_s *(vtob[VTOB_HASH_SIZE]); struct m_pool *next; #else #define M_GETP() __GetFreePages(MEMO_GFP_FLAGS, MEMO_PAGE_ORDER) #define M_FREEP(p) free_pages(p, MEMO_PAGE_ORDER) #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ struct m_link h[PAGE_SHIFT-MEMO_SHIFT+MEMO_PAGE_ORDER+1]; } m_pool_s; static void *___m_alloc(m_pool_s *mp, int size) { int i = 0; int s = (1 << MEMO_SHIFT); int j; m_addr_t a; m_link_s *h = mp->h; if (size > (PAGE_SIZE << MEMO_PAGE_ORDER)) return 0; while (size > s) { s <<= 1; ++i; } j = i; while (!h[j].next) { if (s == (PAGE_SIZE << MEMO_PAGE_ORDER)) { h[j].next = (m_link_s *) M_GETP(); if (h[j].next) h[j].next->next = 0; break; } ++j; s <<= 1; } a = (m_addr_t) h[j].next; if (a) { h[j].next = h[j].next->next; while (j > i) { j -= 1; s >>= 1; h[j].next = (m_link_s *) (a+s); h[j].next->next = 0; } } #ifdef DEBUG printk("___m_alloc(%d) = %p\n", size, (void *) a); #endif return (void *) a; } static void ___m_free(m_pool_s *mp, void *ptr, int size) { int i = 0; int s = (1 << MEMO_SHIFT); m_link_s *q; m_addr_t a, b; m_link_s *h = mp->h; #ifdef DEBUG printk("___m_free(%p, %d)\n", ptr, size); #endif if (size > (PAGE_SIZE << MEMO_PAGE_ORDER)) return; while (size > s) { s <<= 1; ++i; } a = (m_addr_t) ptr; while (1) { #ifdef MEMO_FREE_UNUSED if (s == (PAGE_SIZE << MEMO_PAGE_ORDER)) { M_FREEP(a); break; } #endif b = a ^ s; q = &h[i]; while (q->next && q->next != (m_link_s *) b) { q = q->next; } if (!q->next) { ((m_link_s *) a)->next = h[i].next; h[i].next = (m_link_s *) a; break; } q->next = q->next->next; a = a & b; s <<= 1; ++i; } } static void *__m_calloc2(m_pool_s *mp, int size, char *name, int uflags) { void *p; p = ___m_alloc(mp, size); if (DEBUG_FLAGS & DEBUG_ALLOC) printk ("new %-10s[%4d] @%p.\n", name, size, p); if (p) bzero(p, size); else if (uflags & MEMO_WARN) printk (NAME53C8XX ": failed to allocate %s[%d]\n", name, size); return p; } #define __m_calloc(mp, s, n) __m_calloc2(mp, s, n, MEMO_WARN) static void __m_free(m_pool_s *mp, void *ptr, int size, char *name) { if (DEBUG_FLAGS & DEBUG_ALLOC) printk ("freeing %-10s[%4d] @%p.\n", name, size, ptr); ___m_free(mp, ptr, size); } /* * With pci bus iommu support, we use a default pool of unmapped memory * for memory we donnot need to DMA from/to and one pool per pcidev for * memory accessed by the PCI chip. `mp0' is the default not DMAable pool. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING static m_pool_s mp0; #else static m_addr_t ___mp0_getp(m_pool_s *mp) { m_addr_t m = GetPages(); if (m) ++mp->nump; return m; } static void ___mp0_freep(m_pool_s *mp, m_addr_t m) { FreePages(m); --mp->nump; } static m_pool_s mp0 = {0, ___mp0_getp, ___mp0_freep}; #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ static void *m_calloc(int size, char *name) { u_long flags; void *m; NCR_LOCK_DRIVER(flags); m = __m_calloc(&mp0, size, name); NCR_UNLOCK_DRIVER(flags); return m; } static void m_free(void *ptr, int size, char *name) { u_long flags; NCR_LOCK_DRIVER(flags); __m_free(&mp0, ptr, size, name); NCR_UNLOCK_DRIVER(flags); } /* * DMAable pools. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Without pci bus iommu support, all the memory is assumed DMAable */ #define __m_calloc_dma(b, s, n) m_calloc(s, n) #define __m_free_dma(b, p, s, n) m_free(p, s, n) #define __vtobus(b, p) virt_to_bus(p) #else /* * With pci bus iommu support, we maintain one pool per pcidev and a * hashed reverse table for virtual to bus physical address translations. */ static m_addr_t ___dma_getp(m_pool_s *mp) { m_addr_t vp; m_vtob_s *vbp; vbp = __m_calloc(&mp0, sizeof(*vbp), "VTOB"); if (vbp) { dma_addr_t daddr; vp = (m_addr_t) pci_alloc_consistent(mp->bush, PAGE_SIZE<vaddr = vp; vbp->baddr = daddr; vbp->next = mp->vtob[hc]; mp->vtob[hc] = vbp; ++mp->nump; return vp; } else __m_free(&mp0, vbp, sizeof(*vbp), "VTOB"); } return 0; } static void ___dma_freep(m_pool_s *mp, m_addr_t m) { m_vtob_s **vbpp, *vbp; int hc = VTOB_HASH_CODE(m); vbpp = &mp->vtob[hc]; while (*vbpp && (*vbpp)->vaddr != m) vbpp = &(*vbpp)->next; if (*vbpp) { vbp = *vbpp; *vbpp = (*vbpp)->next; pci_free_consistent(mp->bush, PAGE_SIZE<vaddr, (dma_addr_t)vbp->baddr); __m_free(&mp0, vbp, sizeof(*vbp), "VTOB"); --mp->nump; } } static inline m_pool_s *___get_dma_pool(m_bush_t bush) { m_pool_s *mp; for (mp = mp0.next; mp && mp->bush != bush; mp = mp->next); return mp; } static m_pool_s *___cre_dma_pool(m_bush_t bush) { m_pool_s *mp; mp = __m_calloc(&mp0, sizeof(*mp), "MPOOL"); if (mp) { bzero(mp, sizeof(*mp)); mp->bush = bush; mp->getp = ___dma_getp; mp->freep = ___dma_freep; mp->next = mp0.next; mp0.next = mp; } return mp; } static void ___del_dma_pool(m_pool_s *p) { struct m_pool **pp = &mp0.next; while (*pp && *pp != p) pp = &(*pp)->next; if (*pp) { *pp = (*pp)->next; __m_free(&mp0, p, sizeof(*p), "MPOOL"); } } static void *__m_calloc_dma(m_bush_t bush, int size, char *name) { u_long flags; struct m_pool *mp; void *m = 0; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (!mp) mp = ___cre_dma_pool(bush); if (mp) m = __m_calloc(mp, size, name); if (mp && !mp->nump) ___del_dma_pool(mp); NCR_UNLOCK_DRIVER(flags); return m; } static void __m_free_dma(m_bush_t bush, void *m, int size, char *name) { u_long flags; struct m_pool *mp; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (mp) __m_free(mp, m, size, name); if (mp && !mp->nump) ___del_dma_pool(mp); NCR_UNLOCK_DRIVER(flags); } static m_addr_t __vtobus(m_bush_t bush, void *m) { u_long flags; m_pool_s *mp; int hc = VTOB_HASH_CODE(m); m_vtob_s *vp = 0; m_addr_t a = ((m_addr_t) m) & ~MEMO_CLUSTER_MASK; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (mp) { vp = mp->vtob[hc]; while (vp && (m_addr_t) vp->vaddr != a) vp = vp->next; } NCR_UNLOCK_DRIVER(flags); return vp ? vp->baddr + (((m_addr_t) m) - a) : 0; } #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ #define _m_calloc_dma(np, s, n) __m_calloc_dma(np->pdev, s, n) #define _m_free_dma(np, p, s, n) __m_free_dma(np->pdev, p, s, n) #define m_calloc_dma(s, n) _m_calloc_dma(np, s, n) #define m_free_dma(p, s, n) _m_free_dma(np, p, s, n) #define _vtobus(np, p) __vtobus(np->pdev, p) #define vtobus(p) _vtobus(np, p) /* * Deal with DMA mapping/unmapping. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Linux versions prior to pci bus iommu kernel interface */ #define __unmap_scsi_data(pdev, cmd) do {; } while (0) #define __map_scsi_single_data(pdev, cmd) (__vtobus(pdev,(cmd)->request_buffer)) #define __map_scsi_sg_data(pdev, cmd) ((cmd)->use_sg) #define __sync_scsi_data(pdev, cmd) do {; } while (0) #define scsi_sg_dma_address(sc) vtobus((sc)->address) #define scsi_sg_dma_len(sc) ((sc)->length) #else /* Linux version with pci bus iommu kernel interface */ /* To keep track of the dma mapping (sg/single) that has been set */ #define __data_mapped(cmd) (cmd)->SCp.phase #define __data_mapping(cmd) (cmd)->SCp.dma_handle static void __unmap_scsi_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); switch(__data_mapped(cmd)) { case 2: pci_unmap_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); break; case 1: pci_unmap_page(pdev, __data_mapping(cmd), cmd->request_bufflen, dma_dir); break; } __data_mapped(cmd) = 0; } static dma_addr_t __map_scsi_single_data(pcidev_t pdev, Scsi_Cmnd *cmd) { dma_addr_t mapping; int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); if (cmd->request_bufflen == 0) return 0; mapping = pci_map_page(pdev, virt_to_page(cmd->request_buffer), ((unsigned long)cmd->request_buffer & ~PAGE_MASK), cmd->request_bufflen, dma_dir); __data_mapped(cmd) = 1; __data_mapping(cmd) = mapping; return mapping; } static int __map_scsi_sg_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int use_sg; int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); if (cmd->use_sg == 0) return 0; use_sg = pci_map_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); __data_mapped(cmd) = 2; __data_mapping(cmd) = use_sg; return use_sg; } static void __sync_scsi_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); switch(__data_mapped(cmd)) { case 2: pci_dma_sync_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); break; case 1: pci_dma_sync_single(pdev, __data_mapping(cmd), cmd->request_bufflen, dma_dir); break; } } #define scsi_sg_dma_address(sc) sg_dma_address(sc) #define scsi_sg_dma_len(sc) sg_dma_len(sc) #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ #define unmap_scsi_data(np, cmd) __unmap_scsi_data(np->pdev, cmd) #define map_scsi_single_data(np, cmd) __map_scsi_single_data(np->pdev, cmd) #define map_scsi_sg_data(np, cmd) __map_scsi_sg_data(np->pdev, cmd) #define sync_scsi_data(np, cmd) __sync_scsi_data(np->pdev, cmd) /* * Print out some buffer. */ static void ncr_print_hex(u_char *p, int n) { while (n-- > 0) printk (" %x", *p++); } static void ncr_printl_hex(char *label, u_char *p, int n) { printk("%s", label); ncr_print_hex(p, n); printk (".\n"); } /* ** Transfer direction ** ** Until some linux kernel version near 2.3.40, low-level scsi ** drivers were not told about data transfer direction. ** We check the existence of this feature that has been expected ** for a _long_ time by all SCSI driver developers by just ** testing against the definition of SCSI_DATA_UNKNOWN. Indeed ** this is a hack, but testing against a kernel version would ** have been a shame. ;-) */ #ifdef SCSI_DATA_UNKNOWN #define scsi_data_direction(cmd) (cmd->sc_data_direction) #else #define SCSI_DATA_UNKNOWN 0 #define SCSI_DATA_WRITE 1 #define SCSI_DATA_READ 2 #define SCSI_DATA_NONE 3 static __inline__ int scsi_data_direction(Scsi_Cmnd *cmd) { int direction; switch((int) cmd->cmnd[0]) { case 0x08: /* READ(6) 08 */ case 0x28: /* READ(10) 28 */ case 0xA8: /* READ(12) A8 */ direction = SCSI_DATA_READ; break; case 0x0A: /* WRITE(6) 0A */ case 0x2A: /* WRITE(10) 2A */ case 0xAA: /* WRITE(12) AA */ direction = SCSI_DATA_WRITE; break; default: direction = SCSI_DATA_UNKNOWN; break; } return direction; } #endif /* SCSI_DATA_UNKNOWN */ /* ** /proc directory entry and proc_info function */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,27) static struct proc_dir_entry proc_scsi_sym53c8xx = { PROC_SCSI_SYM53C8XX, 9, NAME53C8XX, S_IFDIR | S_IRUGO | S_IXUGO, 2 }; #endif #ifdef SCSI_NCR_PROC_INFO_SUPPORT static int sym53c8xx_proc_info(struct Scsi_Host *host, char *buffer, char **start, off_t offset, int length, int func); #endif /* ** Driver setup. ** ** This structure is initialized from linux config options. ** It can be overridden at boot-up by the boot command line. */ static struct ncr_driver_setup driver_setup = SCSI_NCR_DRIVER_SETUP; #ifdef SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT static struct ncr_driver_setup driver_safe_setup __initdata = SCSI_NCR_DRIVER_SAFE_SETUP; # ifdef MODULE char *sym53c8xx = 0; /* command line passed by insmod */ # if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,30) MODULE_PARM(sym53c8xx, "s"); # endif # endif #endif /* ** Other Linux definitions */ #define SetScsiResult(cmd, h_sts, s_sts) \ cmd->result = (((h_sts) << 16) + ((s_sts) & 0x7f)) /* We may have to remind our amnesiac SCSI layer of the reason of the abort */ #if 0 #define SetScsiAbortResult(cmd) \ SetScsiResult( \ cmd, \ (cmd)->abort_reason == DID_TIME_OUT ? DID_TIME_OUT : DID_ABORT, \ 0xff) #else #define SetScsiAbortResult(cmd) SetScsiResult(cmd, DID_ABORT, 0xff) #endif static void sym53c8xx_intr(int irq, void *dev_id, struct pt_regs * regs); static void sym53c8xx_timeout(unsigned long np); #define initverbose (driver_setup.verbose) #define bootverbose (np->verbose) #ifdef SCSI_NCR_NVRAM_SUPPORT static u_char Tekram_sync[16] __initdata = {25,31,37,43, 50,62,75,125, 12,15,18,21, 6,7,9,10}; #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Structures used by sym53c8xx_detect/sym53c8xx_pci_init to ** transmit device configuration to the ncr_attach() function. */ typedef struct { int bus; u_char device_fn; u_long base; u_long base_2; u_long io_port; u_long base_c; u_long base_2_c; int irq; /* port and reg fields to use INB, OUTB macros */ u_long base_io; volatile struct ncr_reg *reg; } ncr_slot; typedef struct { int type; #define SCSI_NCR_SYMBIOS_NVRAM (1) #define SCSI_NCR_TEKRAM_NVRAM (2) #ifdef SCSI_NCR_NVRAM_SUPPORT union { Symbios_nvram Symbios; Tekram_nvram Tekram; } data; #endif } ncr_nvram; /* ** Structure used by sym53c8xx_detect/sym53c8xx_pci_init ** to save data on each detected board for ncr_attach(). */ typedef struct { pcidev_t pdev; ncr_slot slot; ncr_chip chip; ncr_nvram *nvram; u_char host_id; #ifdef SCSI_NCR_PQS_PDS_SUPPORT u_char pqs_pds; #endif int attach_done; } ncr_device; /*========================================================== ** ** assert () ** **========================================================== ** ** modified copy from 386bsd:/usr/include/sys/assert.h ** **---------------------------------------------------------- */ #define assert(expression) { \ if (!(expression)) { \ (void)panic( \ "assertion \"%s\" failed: file \"%s\", line %d\n", \ #expression, \ __FILE__, __LINE__); \ } \ } /*========================================================== ** ** Command control block states. ** **========================================================== */ #define HS_IDLE (0) #define HS_BUSY (1) #define HS_NEGOTIATE (2) /* sync/wide data transfer*/ #define HS_DISCONNECT (3) /* Disconnected by target */ #define HS_DONEMASK (0x80) #define HS_COMPLETE (4|HS_DONEMASK) #define HS_SEL_TIMEOUT (5|HS_DONEMASK) /* Selection timeout */ #define HS_RESET (6|HS_DONEMASK) /* SCSI reset */ #define HS_ABORTED (7|HS_DONEMASK) /* Transfer aborted */ #define HS_TIMEOUT (8|HS_DONEMASK) /* Software timeout */ #define HS_FAIL (9|HS_DONEMASK) /* SCSI or PCI bus errors */ #define HS_UNEXPECTED (10|HS_DONEMASK)/* Unexpected disconnect */ #define DSA_INVALID 0xffffffff /*========================================================== ** ** Software Interrupt Codes ** **========================================================== */ #define SIR_BAD_STATUS (1) #define SIR_SEL_ATN_NO_MSG_OUT (2) #define SIR_MSG_RECEIVED (3) #define SIR_MSG_WEIRD (4) #define SIR_NEGO_FAILED (5) #define SIR_NEGO_PROTO (6) #define SIR_SCRIPT_STOPPED (7) #define SIR_REJECT_TO_SEND (8) #define SIR_SWIDE_OVERRUN (9) #define SIR_SODL_UNDERRUN (10) #define SIR_RESEL_NO_MSG_IN (11) #define SIR_RESEL_NO_IDENTIFY (12) #define SIR_RESEL_BAD_LUN (13) #define SIR_TARGET_SELECTED (14) #define SIR_RESEL_BAD_I_T_L (15) #define SIR_RESEL_BAD_I_T_L_Q (16) #define SIR_ABORT_SENT (17) #define SIR_RESEL_ABORTED (18) #define SIR_MSG_OUT_DONE (19) #define SIR_AUTO_SENSE_DONE (20) #define SIR_DUMMY_INTERRUPT (21) #define SIR_DATA_OVERRUN (22) #define SIR_BAD_PHASE (23) #define SIR_MAX (23) /*========================================================== ** ** Extended error bits. ** xerr_status field of struct ccb. ** **========================================================== */ #define XE_EXTRA_DATA (1) /* unexpected data phase */ #define XE_BAD_PHASE (2) /* illegal phase (4/5) */ #define XE_PARITY_ERR (4) /* unrecovered SCSI parity error */ #define XE_SODL_UNRUN (1<<3) #define XE_SWIDE_OVRUN (1<<4) /*========================================================== ** ** Negotiation status. ** nego_status field of struct ccb. ** **========================================================== */ #define NS_NOCHANGE (0) #define NS_SYNC (1) #define NS_WIDE (2) #define NS_PPR (4) /*========================================================== ** ** "Special features" of targets. ** quirks field of struct tcb. ** actualquirks field of struct ccb. ** **========================================================== */ #define QUIRK_AUTOSAVE (0x01) /*========================================================== ** ** Capability bits in Inquire response byte 7. ** **========================================================== */ #define INQ7_QUEUE (0x02) #define INQ7_SYNC (0x10) #define INQ7_WIDE16 (0x20) /*========================================================== ** ** A CCB hashed table is used to retrieve CCB address ** from DSA value. ** **========================================================== */ #define CCB_HASH_SHIFT 8 #define CCB_HASH_SIZE (1UL << CCB_HASH_SHIFT) #define CCB_HASH_MASK (CCB_HASH_SIZE-1) #define CCB_HASH_CODE(dsa) (((dsa) >> 11) & CCB_HASH_MASK) /*========================================================== ** ** Declaration of structs. ** **========================================================== */ struct tcb; struct lcb; struct ccb; struct ncb; struct script; typedef struct ncb * ncb_p; typedef struct tcb * tcb_p; typedef struct lcb * lcb_p; typedef struct ccb * ccb_p; struct link { ncrcmd l_cmd; ncrcmd l_paddr; }; struct usrcmd { u_long target; u_long lun; u_long data; u_long cmd; }; #define UC_SETSYNC 10 #define UC_SETTAGS 11 #define UC_SETDEBUG 12 #define UC_SETORDER 13 #define UC_SETWIDE 14 #define UC_SETFLAG 15 #define UC_SETVERBOSE 17 #define UC_RESETDEV 18 #define UC_CLEARDEV 19 #define UF_TRACE (0x01) #define UF_NODISC (0x02) #define UF_NOSCAN (0x04) /*======================================================================== ** ** Declaration of structs: target control block ** **======================================================================== */ struct tcb { /*---------------------------------------------------------------- ** LUN tables. ** An array of bus addresses is used on reselection by ** the SCRIPT. **---------------------------------------------------------------- */ u_int32 *luntbl; /* lcbs bus address table */ u_int32 b_luntbl; /* bus address of this table */ u_int32 b_lun0; /* bus address of lun0 */ lcb_p l0p; /* lcb of LUN #0 (normal case) */ #if MAX_LUN > 1 lcb_p *lmp; /* Other lcb's [1..MAX_LUN] */ #endif /*---------------------------------------------------------------- ** Target capabilities. **---------------------------------------------------------------- */ u_char inq_done; /* Target capabilities received */ u_char inq_byte7; /* Contains these capabilities */ /*---------------------------------------------------------------- ** Some flags. **---------------------------------------------------------------- */ u_char to_reset; /* This target is to be reset */ /*---------------------------------------------------------------- ** Pointer to the ccb used for negotiation. ** Prevent from starting a negotiation for all queued commands ** when tagged command queuing is enabled. **---------------------------------------------------------------- */ ccb_p nego_cp; /*---------------------------------------------------------------- ** negotiation of wide and synch transfer and device quirks. ** sval, wval and uval are read from SCRIPTS and so have alignment ** constraints. **---------------------------------------------------------------- */ /*0*/ u_char uval; /*1*/ u_char sval; /*2*/ u_char filler2; /*3*/ u_char wval; u_short period; u_char minsync; u_char maxoffs; u_char quirks; u_char widedone; #ifdef SCSI_NCR_INTEGRITY_CHECKING u_char ic_min_sync; u_char ic_max_width; u_char ic_done; #endif u_char ic_maximums_set; u_char ppr_negotiation; /*---------------------------------------------------------------- ** User settable limits and options. ** These limits are read from the NVRAM if present. **---------------------------------------------------------------- */ u_char usrsync; u_char usrwide; u_short usrtags; u_char usrflag; }; /*======================================================================== ** ** Declaration of structs: lun control block ** **======================================================================== */ struct lcb { /*---------------------------------------------------------------- ** On reselection, SCRIPTS use this value as a JUMP address ** after the IDENTIFY has been successfully received. ** This field is set to 'resel_tag' if TCQ is enabled and ** to 'resel_notag' if TCQ is disabled. ** (Must be at zero due to bad lun handling on reselection) **---------------------------------------------------------------- */ /*0*/ u_int32 resel_task; /*---------------------------------------------------------------- ** Task table used by the script processor to retrieve the ** task corresponding to a reselected nexus. The TAG is used ** as offset to determine the corresponding entry. ** Each entry contains the associated CCB bus address. **---------------------------------------------------------------- */ u_int32 tasktbl_0; /* Used if TCQ not enabled */ u_int32 *tasktbl; u_int32 b_tasktbl; /*---------------------------------------------------------------- ** CCB queue management. **---------------------------------------------------------------- */ XPT_QUEHEAD busy_ccbq; /* Queue of busy CCBs */ XPT_QUEHEAD wait_ccbq; /* Queue of waiting for IO CCBs */ u_short busyccbs; /* CCBs busy for this lun */ u_short queuedccbs; /* CCBs queued to the controller*/ u_short queuedepth; /* Queue depth for this lun */ u_short scdev_depth; /* SCSI device queue depth */ u_short maxnxs; /* Max possible nexuses */ /*---------------------------------------------------------------- ** Control of tagged command queuing. ** Tags allocation is performed using a circular buffer. ** This avoids using a loop for tag allocation. **---------------------------------------------------------------- */ u_short ia_tag; /* Tag allocation index */ u_short if_tag; /* Tag release index */ u_char *cb_tags; /* Circular tags buffer */ u_char inq_byte7; /* Store unit CmdQ capability */ u_char usetags; /* Command queuing is active */ u_char to_clear; /* User wants to clear all tasks*/ u_short maxtags; /* Max NR of tags asked by user */ u_short numtags; /* Current number of tags */ /*---------------------------------------------------------------- ** QUEUE FULL and ORDERED tag control. **---------------------------------------------------------------- */ u_short num_good; /* Nr of GOOD since QUEUE FULL */ u_short tags_sum[2]; /* Tags sum counters */ u_char tags_si; /* Current index to tags sum */ u_long tags_stime; /* Last time we switch tags_sum */ }; /*======================================================================== ** ** Declaration of structs: actions for a task. ** **======================================================================== ** ** It is part of the CCB and is called by the scripts processor to ** start or restart the data structure (nexus). ** **------------------------------------------------------------------------ */ struct action { u_int32 start; u_int32 restart; }; /*======================================================================== ** ** Declaration of structs: Phase mismatch context. ** **======================================================================== ** ** It is part of the CCB and is used as parameters for the DATA ** pointer. We need two contexts to handle correctly the SAVED ** DATA POINTER. ** **------------------------------------------------------------------------ */ struct pm_ctx { struct scr_tblmove sg; /* Updated interrupted SG block */ u_int32 ret; /* SCRIPT return address */ }; /*======================================================================== ** ** Declaration of structs: global HEADER. ** **======================================================================== ** ** In earlier driver versions, this substructure was copied from the ** ccb to a global address after selection (or reselection) and copied ** back before disconnect. Since we are now using LOAD/STORE DSA ** RELATIVE instructions, the script is able to access directly these ** fields, and so, this header is no more copied. ** **------------------------------------------------------------------------ */ struct head { /*---------------------------------------------------------------- ** Start and restart SCRIPTS addresses (must be at 0). **---------------------------------------------------------------- */ struct action go; /*---------------------------------------------------------------- ** Saved data pointer. ** Points to the position in the script responsible for the ** actual transfer of data. ** It's written after reception of a SAVE_DATA_POINTER message. ** The goalpointer points after the last transfer command. **---------------------------------------------------------------- */ u_int32 savep; u_int32 lastp; u_int32 goalp; /*---------------------------------------------------------------- ** Alternate data pointer. ** They are copied back to savep/lastp/goalp by the SCRIPTS ** when the direction is unknown and the device claims data out. **---------------------------------------------------------------- */ u_int32 wlastp; u_int32 wgoalp; /*---------------------------------------------------------------- ** Status fields. **---------------------------------------------------------------- */ u_char status[4]; /* host status */ }; /* ** LUN control block lookup. ** We use a direct pointer for LUN #0, and a table of pointers ** which is only allocated for devices that support LUN(s) > 0. */ #if MAX_LUN <= 1 #define ncr_lp(np, tp, lun) (!lun) ? (tp)->l0p : 0 #else #define ncr_lp(np, tp, lun) \ (!lun) ? (tp)->l0p : (tp)->lmp ? (tp)->lmp[(lun)] : 0 #endif /* ** The status bytes are used by the host and the script processor. ** ** The four bytes (status[4]) are copied to the scratchb register ** (declared as scr0..scr3 in ncr_reg.h) just after the select/reselect, ** and copied back just after disconnecting. ** Inside the script the XX_REG are used. */ /* ** Last four bytes (script) */ #define QU_REG scr0 #define HS_REG scr1 #define HS_PRT nc_scr1 #define SS_REG scr2 #define SS_PRT nc_scr2 #define HF_REG scr3 #define HF_PRT nc_scr3 /* ** Last four bytes (host) */ #define actualquirks phys.header.status[0] #define host_status phys.header.status[1] #define scsi_status phys.header.status[2] #define host_flags phys.header.status[3] /* ** Host flags */ #define HF_IN_PM0 1u #define HF_IN_PM1 (1u<<1) #define HF_ACT_PM (1u<<2) #define HF_DP_SAVED (1u<<3) #define HF_AUTO_SENSE (1u<<4) #define HF_DATA_IN (1u<<5) #define HF_PM_TO_C (1u<<6) #define HF_EXT_ERR (1u<<7) #ifdef SCSI_NCR_IARB_SUPPORT #define HF_HINT_IARB (1u<<7) #endif /* ** This one is stolen from QU_REG.:) */ #define HF_DATA_ST (1u<<7) /*========================================================== ** ** Declaration of structs: Data structure block ** **========================================================== ** ** During execution of a ccb by the script processor, ** the DSA (data structure address) register points ** to this substructure of the ccb. ** This substructure contains the header with ** the script-processor-changable data and ** data blocks for the indirect move commands. ** **---------------------------------------------------------- */ struct dsb { /* ** Header. */ struct head header; /* ** Table data for Script */ struct scr_tblsel select; struct scr_tblmove smsg ; struct scr_tblmove smsg_ext ; struct scr_tblmove cmd ; struct scr_tblmove sense ; struct scr_tblmove wresid; struct scr_tblmove data [MAX_SCATTER]; /* ** Phase mismatch contexts. ** We need two to handle correctly the ** SAVED DATA POINTER. */ struct pm_ctx pm0; struct pm_ctx pm1; }; /*======================================================================== ** ** Declaration of structs: Command control block. ** **======================================================================== */ struct ccb { /*---------------------------------------------------------------- ** This is the data structure which is pointed by the DSA ** register when it is executed by the script processor. ** It must be the first entry. **---------------------------------------------------------------- */ struct dsb phys; /*---------------------------------------------------------------- ** The general SCSI driver provides a ** pointer to a control block. **---------------------------------------------------------------- */ Scsi_Cmnd *cmd; /* SCSI command */ u_char cdb_buf[16]; /* Copy of CDB */ u_char sense_buf[64]; int data_len; /* Total data length */ int segments; /* Number of SG segments */ /*---------------------------------------------------------------- ** Message areas. ** We prepare a message to be sent after selection. ** We may use a second one if the command is rescheduled ** due to CHECK_CONDITION or QUEUE FULL status. ** Contents are IDENTIFY and SIMPLE_TAG. ** While negotiating sync or wide transfer, ** a SDTR or WDTR message is appended. **---------------------------------------------------------------- */ u_char scsi_smsg [12]; u_char scsi_smsg2[12]; /*---------------------------------------------------------------- ** Miscellaneous status'. **---------------------------------------------------------------- */ u_char nego_status; /* Negotiation status */ u_char xerr_status; /* Extended error flags */ u_int32 extra_bytes; /* Extraneous bytes transferred */ /*---------------------------------------------------------------- ** Saved info for auto-sense **---------------------------------------------------------------- */ u_char sv_scsi_status; u_char sv_xerr_status; /*---------------------------------------------------------------- ** Other fields. **---------------------------------------------------------------- */ u_long p_ccb; /* BUS address of this CCB */ u_char sensecmd[6]; /* Sense command */ u_char to_abort; /* This CCB is to be aborted */ u_short tag; /* Tag for this transfer */ /* NO_TAG means no tag */ u_char tags_si; /* Lun tags sum index (0,1) */ u_char target; u_char lun; u_short queued; ccb_p link_ccb; /* Host adapter CCB chain */ ccb_p link_ccbh; /* Host adapter CCB hash chain */ XPT_QUEHEAD link_ccbq; /* Link to unit CCB queue */ u_int32 startp; /* Initial data pointer */ u_int32 lastp0; /* Initial 'lastp' */ int ext_sg; /* Extreme data pointer, used */ int ext_ofs; /* to calculate the residual. */ int resid; }; #define CCB_PHYS(cp,lbl) (cp->p_ccb + offsetof(struct ccb, lbl)) /*======================================================================== ** ** Declaration of structs: NCR device descriptor ** **======================================================================== */ struct ncb { /*---------------------------------------------------------------- ** Idle task and invalid task actions and their bus ** addresses. **---------------------------------------------------------------- */ struct action idletask; struct action notask; struct action bad_i_t_l; struct action bad_i_t_l_q; u_long p_idletask; u_long p_notask; u_long p_bad_i_t_l; u_long p_bad_i_t_l_q; /*---------------------------------------------------------------- ** Dummy lun table to protect us against target returning bad ** lun number on reselection. **---------------------------------------------------------------- */ u_int32 *badluntbl; /* Table physical address */ u_int32 resel_badlun; /* SCRIPT handler BUS address */ /*---------------------------------------------------------------- ** Bit 32-63 of the on-chip RAM bus address in LE format. ** The START_RAM64 script loads the MMRS and MMWS from this ** field. **---------------------------------------------------------------- */ u_int32 scr_ram_seg; /*---------------------------------------------------------------- ** CCBs management queues. **---------------------------------------------------------------- */ Scsi_Cmnd *waiting_list; /* Commands waiting for a CCB */ /* when lcb is not allocated. */ Scsi_Cmnd *done_list; /* Commands waiting for done() */ /* callback to be invoked. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) spinlock_t smp_lock; /* Lock for SMP threading */ #endif /*---------------------------------------------------------------- ** Chip and controller indentification. **---------------------------------------------------------------- */ int unit; /* Unit number */ char chip_name[8]; /* Chip name */ char inst_name[16]; /* ncb instance name */ /*---------------------------------------------------------------- ** Initial value of some IO register bits. ** These values are assumed to have been set by BIOS, and may ** be used for probing adapter implementation differences. **---------------------------------------------------------------- */ u_char sv_scntl0, sv_scntl3, sv_dmode, sv_dcntl, sv_ctest3, sv_ctest4, sv_ctest5, sv_gpcntl, sv_stest2, sv_stest4, sv_stest1, sv_scntl4; /*---------------------------------------------------------------- ** Actual initial value of IO register bits used by the ** driver. They are loaded at initialisation according to ** features that are to be enabled. **---------------------------------------------------------------- */ u_char rv_scntl0, rv_scntl3, rv_dmode, rv_dcntl, rv_ctest3, rv_ctest4, rv_ctest5, rv_stest2, rv_ccntl0, rv_ccntl1, rv_scntl4; /*---------------------------------------------------------------- ** Target data. ** Target control block bus address array used by the SCRIPT ** on reselection. **---------------------------------------------------------------- */ struct tcb target[MAX_TARGET]; u_int32 *targtbl; /*---------------------------------------------------------------- ** Virtual and physical bus addresses of the chip. **---------------------------------------------------------------- */ #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED u_long base_va; /* MMIO base virtual address */ u_long base2_va; /* On-chip RAM virtual address */ #endif u_long base_ba; /* MMIO base bus address */ u_long base_io; /* IO space base address */ u_long base_ws; /* (MM)IO window size */ u_long base2_ba; /* On-chip RAM bus address */ u_long base2_ws; /* On-chip RAM window size */ u_int irq; /* IRQ number */ volatile /* Pointer to volatile for */ struct ncr_reg *reg; /* memory mapped IO. */ /*---------------------------------------------------------------- ** SCRIPTS virtual and physical bus addresses. ** 'script' is loaded in the on-chip RAM if present. ** 'scripth' stays in main memory for all chips except the ** 53C895A and 53C896 that provide 8K on-chip RAM. **---------------------------------------------------------------- */ struct script *script0; /* Copies of script and scripth */ struct scripth *scripth0; /* relocated for this ncb. */ u_long p_script; /* Actual script and scripth */ u_long p_scripth; /* bus addresses. */ u_long p_scripth0; /*---------------------------------------------------------------- ** General controller parameters and configuration. **---------------------------------------------------------------- */ pcidev_t pdev; u_short device_id; /* PCI device id */ u_char revision_id; /* PCI device revision id */ u_char bus; /* PCI BUS number */ u_char device_fn; /* PCI BUS device and function */ u_char myaddr; /* SCSI id of the adapter */ u_char maxburst; /* log base 2 of dwords burst */ u_char maxwide; /* Maximum transfer width */ u_char minsync; /* Minimum sync period factor */ u_char maxsync; /* Maximum sync period factor */ u_char maxoffs; /* Max scsi offset */ u_char maxoffs_st; /* Max scsi offset in ST mode */ u_char multiplier; /* Clock multiplier (1,2,4) */ u_char clock_divn; /* Number of clock divisors */ u_long clock_khz; /* SCSI clock frequency in KHz */ u_int features; /* Chip features map */ /*---------------------------------------------------------------- ** Range for the PCI clock frequency measurement result ** that ensures the algorithm used by the driver can be ** trusted for the SCSI clock frequency measurement. ** (Assuming a PCI clock frequency of 33 MHz). **---------------------------------------------------------------- */ u_int pciclock_min; u_int pciclock_max; /*---------------------------------------------------------------- ** Start queue management. ** It is filled up by the host processor and accessed by the ** SCRIPTS processor in order to start SCSI commands. **---------------------------------------------------------------- */ u_long p_squeue; /* Start queue BUS address */ u_int32 *squeue; /* Start queue virtual address */ u_short squeueput; /* Next free slot of the queue */ u_short actccbs; /* Number of allocated CCBs */ u_short queuedepth; /* Start queue depth */ /*---------------------------------------------------------------- ** Command completion queue. ** It is the same size as the start queue to avoid overflow. **---------------------------------------------------------------- */ u_short dqueueget; /* Next position to scan */ u_int32 *dqueue; /* Completion (done) queue */ /*---------------------------------------------------------------- ** Timeout handler. **---------------------------------------------------------------- */ struct timer_list timer; /* Timer handler link header */ u_long lasttime; u_long settle_time; /* Resetting the SCSI BUS */ /*---------------------------------------------------------------- ** Debugging and profiling. **---------------------------------------------------------------- */ struct ncr_reg regdump; /* Register dump */ u_long regtime; /* Time it has been done */ /*---------------------------------------------------------------- ** Miscellaneous buffers accessed by the scripts-processor. ** They shall be DWORD aligned, because they may be read or ** written with a script command. **---------------------------------------------------------------- */ u_char msgout[12]; /* Buffer for MESSAGE OUT */ u_char msgin [12]; /* Buffer for MESSAGE IN */ u_int32 lastmsg; /* Last SCSI message sent */ u_char scratch; /* Scratch for SCSI receive */ /*---------------------------------------------------------------- ** Miscellaneous configuration and status parameters. **---------------------------------------------------------------- */ u_char scsi_mode; /* Current SCSI BUS mode */ u_char order; /* Tag order to use */ u_char verbose; /* Verbosity for this controller*/ u_int32 ncr_cache; /* Used for cache test at init. */ u_long p_ncb; /* BUS address of this NCB */ /*---------------------------------------------------------------- ** CCB lists and queue. **---------------------------------------------------------------- */ ccb_p ccbh[CCB_HASH_SIZE]; /* CCB hashed by DSA value */ struct ccb *ccbc; /* CCB chain */ XPT_QUEHEAD free_ccbq; /* Queue of available CCBs */ /*---------------------------------------------------------------- ** IMMEDIATE ARBITRATION (IARB) control. ** We keep track in 'last_cp' of the last CCB that has been ** queued to the SCRIPTS processor and clear 'last_cp' when ** this CCB completes. If last_cp is not zero at the moment ** we queue a new CCB, we set a flag in 'last_cp' that is ** used by the SCRIPTS as a hint for setting IARB. ** We donnot set more than 'iarb_max' consecutive hints for ** IARB in order to leave devices a chance to reselect. ** By the way, any non zero value of 'iarb_max' is unfair. :) **---------------------------------------------------------------- */ #ifdef SCSI_NCR_IARB_SUPPORT struct ccb *last_cp; /* Last queud CCB used for IARB */ u_short iarb_max; /* Max. # consecutive IARB hints*/ u_short iarb_count; /* Actual # of these hints */ #endif /*---------------------------------------------------------------- ** We need the LCB in order to handle disconnections and ** to count active CCBs for task management. So, we use ** a unique CCB for LUNs we donnot have the LCB yet. ** This queue normally should have at most 1 element. **---------------------------------------------------------------- */ XPT_QUEHEAD b0_ccbq; /*---------------------------------------------------------------- ** We use a different scatter function for 896 rev 1. **---------------------------------------------------------------- */ int (*scatter) (ncb_p, ccb_p, Scsi_Cmnd *); /*---------------------------------------------------------------- ** Command abort handling. ** We need to synchronize tightly with the SCRIPTS ** processor in order to handle things correctly. **---------------------------------------------------------------- */ u_char abrt_msg[4]; /* Message to send buffer */ struct scr_tblmove abrt_tbl; /* Table for the MOV of it */ struct scr_tblsel abrt_sel; /* Sync params for selection */ u_char istat_sem; /* Tells the chip to stop (SEM) */ /*---------------------------------------------------------------- ** Fields that should be removed or changed. **---------------------------------------------------------------- */ struct usrcmd user; /* Command from user */ volatile u_char release_stage; /* Synchronisation stage on release */ /*---------------------------------------------------------------- ** Fields that are used (primarily) for integrity check **---------------------------------------------------------------- */ unsigned char check_integrity; /* Enable midlayer integ. check on * bus scan. */ #ifdef SCSI_NCR_INTEGRITY_CHECKING unsigned char check_integ_par; /* Set if par or Init. Det. error * used only during integ check */ #endif }; #define NCB_PHYS(np, lbl) (np->p_ncb + offsetof(struct ncb, lbl)) #define NCB_SCRIPT_PHYS(np,lbl) (np->p_script + offsetof (struct script, lbl)) #define NCB_SCRIPTH_PHYS(np,lbl) (np->p_scripth + offsetof (struct scripth,lbl)) #define NCB_SCRIPTH0_PHYS(np,lbl) (np->p_scripth0+offsetof (struct scripth,lbl)) /*========================================================== ** ** ** Script for NCR-Processor. ** ** Use ncr_script_fill() to create the variable parts. ** Use ncr_script_copy_and_bind() to make a copy and ** bind to physical addresses. ** ** **========================================================== ** ** We have to know the offsets of all labels before ** we reach them (for forward jumps). ** Therefore we declare a struct here. ** If you make changes inside the script, ** DONT FORGET TO CHANGE THE LENGTHS HERE! ** **---------------------------------------------------------- */ /* ** Script fragments which are loaded into the on-chip RAM ** of 825A, 875, 876, 895, 895A and 896 chips. */ struct script { ncrcmd start [ 14]; ncrcmd getjob_begin [ 4]; ncrcmd getjob_end [ 4]; ncrcmd select [ 8]; ncrcmd wf_sel_done [ 2]; ncrcmd send_ident [ 2]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd select2 [ 8]; #else ncrcmd select2 [ 2]; #endif ncrcmd command [ 2]; ncrcmd dispatch [ 28]; ncrcmd sel_no_cmd [ 10]; ncrcmd init [ 6]; ncrcmd clrack [ 4]; ncrcmd disp_status [ 4]; ncrcmd datai_done [ 26]; ncrcmd datao_done [ 12]; ncrcmd ign_i_w_r_msg [ 4]; ncrcmd datai_phase [ 2]; ncrcmd datao_phase [ 4]; ncrcmd msg_in [ 2]; ncrcmd msg_in2 [ 10]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd status [ 14]; #else ncrcmd status [ 10]; #endif ncrcmd complete [ 8]; #ifdef SCSI_NCR_PCIQ_MAY_REORDER_WRITES ncrcmd complete2 [ 12]; #else ncrcmd complete2 [ 10]; #endif #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR ncrcmd done [ 18]; #else ncrcmd done [ 14]; #endif ncrcmd done_end [ 2]; ncrcmd save_dp [ 8]; ncrcmd restore_dp [ 4]; ncrcmd disconnect [ 20]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd idle [ 4]; #else ncrcmd idle [ 2]; #endif #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd ungetjob [ 6]; #else ncrcmd ungetjob [ 4]; #endif ncrcmd reselect [ 4]; ncrcmd reselected [ 20]; ncrcmd resel_scntl4 [ 30]; #if MAX_TASKS*4 > 512 ncrcmd resel_tag [ 18]; #elif MAX_TASKS*4 > 256 ncrcmd resel_tag [ 12]; #else ncrcmd resel_tag [ 8]; #endif ncrcmd resel_go [ 6]; ncrcmd resel_notag [ 2]; ncrcmd resel_dsa [ 8]; ncrcmd data_in [MAX_SCATTER * SCR_SG_SIZE]; ncrcmd data_in2 [ 4]; ncrcmd data_out [MAX_SCATTER * SCR_SG_SIZE]; ncrcmd data_out2 [ 4]; ncrcmd pm0_data [ 12]; ncrcmd pm0_data_out [ 6]; ncrcmd pm0_data_end [ 6]; ncrcmd pm1_data [ 12]; ncrcmd pm1_data_out [ 6]; ncrcmd pm1_data_end [ 6]; }; /* ** Script fragments which stay in main memory for all chips ** except for the 895A and 896 that support 8K on-chip RAM. */ struct scripth { ncrcmd start64 [ 2]; ncrcmd no_data [ 2]; ncrcmd sel_for_abort [ 18]; ncrcmd sel_for_abort_1 [ 2]; ncrcmd select_no_atn [ 8]; ncrcmd wf_sel_done_no_atn [ 4]; ncrcmd msg_in_etc [ 14]; ncrcmd msg_received [ 4]; ncrcmd msg_weird_seen [ 4]; ncrcmd msg_extended [ 20]; ncrcmd msg_bad [ 6]; ncrcmd msg_weird [ 4]; ncrcmd msg_weird1 [ 8]; ncrcmd wdtr_resp [ 6]; ncrcmd send_wdtr [ 4]; ncrcmd sdtr_resp [ 6]; ncrcmd send_sdtr [ 4]; ncrcmd ppr_resp [ 6]; ncrcmd send_ppr [ 4]; ncrcmd nego_bad_phase [ 4]; ncrcmd msg_out [ 4]; ncrcmd msg_out_done [ 4]; ncrcmd data_ovrun [ 2]; ncrcmd data_ovrun1 [ 22]; ncrcmd data_ovrun2 [ 8]; ncrcmd abort_resel [ 16]; ncrcmd resend_ident [ 4]; ncrcmd ident_break [ 4]; ncrcmd ident_break_atn [ 4]; ncrcmd sdata_in [ 6]; ncrcmd data_io [ 2]; ncrcmd data_io_com [ 8]; ncrcmd data_io_out [ 12]; ncrcmd resel_bad_lun [ 4]; ncrcmd bad_i_t_l [ 4]; ncrcmd bad_i_t_l_q [ 4]; ncrcmd bad_status [ 6]; ncrcmd tweak_pmj [ 12]; ncrcmd pm_handle [ 20]; ncrcmd pm_handle1 [ 4]; ncrcmd pm_save [ 4]; ncrcmd pm0_save [ 14]; ncrcmd pm1_save [ 14]; /* WSR handling */ #ifdef SYM_DEBUG_PM_WITH_WSR ncrcmd pm_wsr_handle [ 44]; #else ncrcmd pm_wsr_handle [ 42]; #endif ncrcmd wsr_ma_helper [ 4]; /* Data area */ ncrcmd zero [ 1]; ncrcmd scratch [ 1]; ncrcmd scratch1 [ 1]; ncrcmd pm0_data_addr [ 1]; ncrcmd pm1_data_addr [ 1]; ncrcmd saved_dsa [ 1]; ncrcmd saved_drs [ 1]; ncrcmd done_pos [ 1]; ncrcmd startpos [ 1]; ncrcmd targtbl [ 1]; /* End of data area */ #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED ncrcmd start_ram [ 1]; ncrcmd script0_ba [ 4]; ncrcmd start_ram64 [ 3]; ncrcmd script0_ba64 [ 3]; ncrcmd scripth0_ba64 [ 6]; ncrcmd ram_seg64 [ 1]; #endif ncrcmd snooptest [ 6]; ncrcmd snoopend [ 2]; }; /*========================================================== ** ** ** Function headers. ** ** **========================================================== */ static ccb_p ncr_alloc_ccb (ncb_p np); static void ncr_complete (ncb_p np, ccb_p cp); static void ncr_exception (ncb_p np); static void ncr_free_ccb (ncb_p np, ccb_p cp); static ccb_p ncr_ccb_from_dsa(ncb_p np, u_long dsa); static void ncr_init_tcb (ncb_p np, u_char tn); static lcb_p ncr_alloc_lcb (ncb_p np, u_char tn, u_char ln); static lcb_p ncr_setup_lcb (ncb_p np, u_char tn, u_char ln, u_char *inq_data); static void ncr_getclock (ncb_p np, int mult); static u_int ncr_getpciclock (ncb_p np); static void ncr_selectclock (ncb_p np, u_char scntl3); static ccb_p ncr_get_ccb (ncb_p np, u_char tn, u_char ln); static void ncr_init (ncb_p np, int reset, char * msg, u_long code); static void ncr_int_sbmc (ncb_p np); static void ncr_int_par (ncb_p np, u_short sist); static void ncr_int_ma (ncb_p np); static void ncr_int_sir (ncb_p np); static void ncr_int_sto (ncb_p np); static void ncr_int_udc (ncb_p np); static void ncr_negotiate (ncb_p np, tcb_p tp); static int ncr_prepare_nego(ncb_p np, ccb_p cp, u_char *msgptr); #ifdef SCSI_NCR_INTEGRITY_CHECKING static int ncr_ic_nego(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd, u_char *msgptr); #endif static void ncr_script_copy_and_bind (ncb_p np, ncrcmd *src, ncrcmd *dst, int len); static void ncr_script_fill (struct script * scr, struct scripth * scripth); static int ncr_scatter_896R1 (ncb_p np, ccb_p cp, Scsi_Cmnd *cmd); static int ncr_scatter (ncb_p np, ccb_p cp, Scsi_Cmnd *cmd); static void ncr_getsync (ncb_p np, u_char sfac, u_char *fakp, u_char *scntl3p); static void ncr_get_xfer_info(ncb_p np, tcb_p tp, u_char *factor, u_char *offset, u_char *width); static void ncr_setsync (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4); static void ncr_set_sync_wide_status (ncb_p np, u_char target); static void ncr_setup_tags (ncb_p np, u_char tn, u_char ln); static void ncr_setwide (ncb_p np, ccb_p cp, u_char wide, u_char ack); static void ncr_setsyncwide (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4, u_char wide); static int ncr_show_msg (u_char * msg); static void ncr_print_msg (ccb_p cp, char *label, u_char * msg); static int ncr_snooptest (ncb_p np); static void ncr_timeout (ncb_p np); static void ncr_wakeup (ncb_p np, u_long code); static int ncr_wakeup_done (ncb_p np); static void ncr_start_next_ccb (ncb_p np, lcb_p lp, int maxn); static void ncr_put_start_queue(ncb_p np, ccb_p cp); static void ncr_chip_reset (ncb_p np); static void ncr_soft_reset (ncb_p np); static void ncr_start_reset (ncb_p np); static int ncr_reset_scsi_bus (ncb_p np, int enab_int, int settle_delay); static int ncr_compute_residual (ncb_p np, ccb_p cp); #ifdef SCSI_NCR_USER_COMMAND_SUPPORT static void ncr_usercmd (ncb_p np); #endif static int ncr_attach (Scsi_Host_Template *tpnt, int unit, ncr_device *device); static void ncr_free_resources(ncb_p np); static void insert_into_waiting_list(ncb_p np, Scsi_Cmnd *cmd); static Scsi_Cmnd *retrieve_from_waiting_list(int to_remove, ncb_p np, Scsi_Cmnd *cmd); static void process_waiting_list(ncb_p np, int sts); #define remove_from_waiting_list(np, cmd) \ retrieve_from_waiting_list(1, (np), (cmd)) #define requeue_waiting_list(np) process_waiting_list((np), DID_OK) #define reset_waiting_list(np) process_waiting_list((np), DID_RESET) #ifdef SCSI_NCR_NVRAM_SUPPORT static void ncr_get_nvram (ncr_device *devp, ncr_nvram *nvp); static int sym_read_Tekram_nvram (ncr_slot *np, u_short device_id, Tekram_nvram *nvram); static int sym_read_Symbios_nvram (ncr_slot *np, Symbios_nvram *nvram); #endif /*========================================================== ** ** ** Global static data. ** ** **========================================================== */ static inline char *ncr_name (ncb_p np) { return np->inst_name; } /*========================================================== ** ** ** Scripts for NCR-Processor. ** ** Use ncr_script_bind for binding to physical addresses. ** ** **========================================================== ** ** NADDR generates a reference to a field of the controller data. ** PADDR generates a reference to another part of the script. ** RADDR generates a reference to a script processor register. ** FADDR generates a reference to a script processor register ** with offset. ** **---------------------------------------------------------- */ #define RELOC_SOFTC 0x40000000 #define RELOC_LABEL 0x50000000 #define RELOC_REGISTER 0x60000000 #if 0 #define RELOC_KVAR 0x70000000 #endif #define RELOC_LABELH 0x80000000 #define RELOC_MASK 0xf0000000 #define NADDR(label) (RELOC_SOFTC | offsetof(struct ncb, label)) #define PADDR(label) (RELOC_LABEL | offsetof(struct script, label)) #define PADDRH(label) (RELOC_LABELH | offsetof(struct scripth, label)) #define RADDR(label) (RELOC_REGISTER | REG(label)) #define FADDR(label,ofs)(RELOC_REGISTER | ((REG(label))+(ofs))) #define KVAR(which) (RELOC_KVAR | (which)) #define SCR_DATA_ZERO 0xf00ff00f #ifdef RELOC_KVAR #define SCRIPT_KVAR_JIFFIES (0) #define SCRIPT_KVAR_FIRST SCRIPT_KVAR_JIFFIES #define SCRIPT_KVAR_LAST SCRIPT_KVAR_JIFFIES /* * Kernel variables referenced in the scripts. * THESE MUST ALL BE ALIGNED TO A 4-BYTE BOUNDARY. */ static void *script_kvars[] __initdata = { (void *)&jiffies }; #endif static struct script script0 __initdata = { /*--------------------------< START >-----------------------*/ { /* ** This NOP will be patched with LED ON ** SCR_REG_REG (gpreg, SCR_AND, 0xfe) */ SCR_NO_OP, 0, /* ** Clear SIGP. */ SCR_FROM_REG (ctest2), 0, /* ** Stop here if the C code wants to perform ** some error recovery procedure manually. ** (Indicate this by setting SEM in ISTAT) */ SCR_FROM_REG (istat), 0, /* ** Report to the C code the next position in ** the start queue the SCRIPTS will schedule. ** The C code must not change SCRATCHA. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (startpos), SCR_INT ^ IFTRUE (MASK (SEM, SEM)), SIR_SCRIPT_STOPPED, /* ** Start the next job. ** ** @DSA = start point for this job. ** SCRATCHA = address of this job in the start queue. ** ** We will restore startpos with SCRATCHA if we fails the ** arbitration or if it is the idle job. ** ** The below GETJOB_BEGIN to GETJOB_END section of SCRIPTS ** is a critical path. If it is partially executed, it then ** may happen that the job address is not yet in the DSA ** and the next queue position points to the next JOB. */ SCR_LOAD_ABS (dsa, 4), PADDRH (startpos), SCR_LOAD_REL (temp, 4), 4, }/*-------------------------< GETJOB_BEGIN >------------------*/,{ SCR_STORE_ABS (temp, 4), PADDRH (startpos), SCR_LOAD_REL (dsa, 4), 0, }/*-------------------------< GETJOB_END >--------------------*/,{ SCR_LOAD_REL (temp, 4), 0, SCR_RETURN, 0, }/*-------------------------< SELECT >----------------------*/,{ /* ** DSA contains the address of a scheduled ** data structure. ** ** SCRATCHA contains the address of the start queue ** entry which points to the next job. ** ** Set Initiator mode. ** ** (Target mode is left as an exercise for the reader) */ SCR_CLR (SCR_TRG), 0, /* ** And try to select this target. */ SCR_SEL_TBL_ATN ^ offsetof (struct dsb, select), PADDR (ungetjob), /* ** Now there are 4 possibilities: ** ** (1) The ncr loses arbitration. ** This is ok, because it will try again, ** when the bus becomes idle. ** (But beware of the timeout function!) ** ** (2) The ncr is reselected. ** Then the script processor takes the jump ** to the RESELECT label. ** ** (3) The ncr wins arbitration. ** Then it will execute SCRIPTS instruction until ** the next instruction that checks SCSI phase. ** Then will stop and wait for selection to be ** complete or selection time-out to occur. ** ** After having won arbitration, the ncr SCRIPTS ** processor is able to execute instructions while ** the SCSI core is performing SCSI selection. But ** some script instruction that is not waiting for ** a valid phase (or selection timeout) to occur ** breaks the selection procedure, by probably ** affecting timing requirements. ** So we have to wait immediately for the next phase ** or the selection to complete or time-out. */ /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), }/*-------------------------< WF_SEL_DONE >----------------------*/,{ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_OUT)), SIR_SEL_ATN_NO_MSG_OUT, }/*-------------------------< SEND_IDENT >----------------------*/,{ /* ** Selection complete. ** Send the IDENTIFY and SIMPLE_TAG messages ** (and the M_X_SYNC_REQ / M_X_WIDE_REQ message) */ SCR_MOVE_TBL ^ SCR_MSG_OUT, offsetof (struct dsb, smsg), }/*-------------------------< SELECT2 >----------------------*/,{ #ifdef SCSI_NCR_IARB_SUPPORT /* ** Set IMMEDIATE ARBITRATION if we have been given ** a hint to do so. (Some job to do after this one). */ SCR_FROM_REG (HF_REG), 0, SCR_JUMPR ^ IFFALSE (MASK (HF_HINT_IARB, HF_HINT_IARB)), 8, SCR_REG_REG (scntl1, SCR_OR, IARB), 0, #endif /* ** Anticipate the COMMAND phase. ** This is the PHASE we expect at this point. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_COMMAND)), PADDR (sel_no_cmd), }/*-------------------------< COMMAND >--------------------*/,{ /* ** ... and send the command */ SCR_MOVE_TBL ^ SCR_COMMAND, offsetof (struct dsb, cmd), }/*-----------------------< DISPATCH >----------------------*/,{ /* ** MSG_IN is the only phase that shall be ** entered at least once for each (re)selection. ** So we test it first. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (msg_in), SCR_JUMP ^ IFTRUE (IF (SCR_DATA_OUT)), PADDR (datao_phase), SCR_JUMP ^ IFTRUE (IF (SCR_DATA_IN)), PADDR (datai_phase), SCR_JUMP ^ IFTRUE (IF (SCR_STATUS)), PADDR (status), SCR_JUMP ^ IFTRUE (IF (SCR_COMMAND)), PADDR (command), SCR_JUMP ^ IFTRUE (IF (SCR_MSG_OUT)), PADDRH (msg_out), /* * Discard as many illegal phases as * required and tell the C code about. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_ILG_OUT)), 16, SCR_MOVE_ABS (1) ^ SCR_ILG_OUT, NADDR (scratch), SCR_JUMPR ^ IFTRUE (WHEN (SCR_ILG_OUT)), -16, SCR_JUMPR ^ IFFALSE (WHEN (SCR_ILG_IN)), 16, SCR_MOVE_ABS (1) ^ SCR_ILG_IN, NADDR (scratch), SCR_JUMPR ^ IFTRUE (WHEN (SCR_ILG_IN)), -16, SCR_INT, SIR_BAD_PHASE, SCR_JUMP, PADDR (dispatch), }/*---------------------< SEL_NO_CMD >----------------------*/,{ /* ** The target does not switch to command ** phase after IDENTIFY has been sent. ** ** If it stays in MSG OUT phase send it ** the IDENTIFY again. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_OUT)), PADDRH (resend_ident), /* ** If target does not switch to MSG IN phase ** and we sent a negotiation, assert the ** failure immediately. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (dispatch), SCR_FROM_REG (HS_REG), 0, SCR_INT ^ IFTRUE (DATA (HS_NEGOTIATE)), SIR_NEGO_FAILED, /* ** Jump to dispatcher. */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< INIT >------------------------*/,{ /* ** Wait for the SCSI RESET signal to be ** inactive before restarting operations, ** since the chip may hang on SEL_ATN ** if SCSI RESET is active. */ SCR_FROM_REG (sstat0), 0, SCR_JUMPR ^ IFTRUE (MASK (IRST, IRST)), -16, SCR_JUMP, PADDR (start), }/*-------------------------< CLRACK >----------------------*/,{ /* ** Terminate possible pending message phase. */ SCR_CLR (SCR_ACK), 0, SCR_JUMP, PADDR (dispatch), }/*-------------------------< DISP_STATUS >----------------------*/,{ /* ** Anticipate STATUS phase. ** ** Does spare 3 SCRIPTS instructions when we have ** completed the INPUT of the data. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_STATUS)), PADDR (status), SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATAI_DONE >-------------------*/,{ /* * If the device wants us to send more data, * we must count the extra bytes. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_IN)), PADDRH (data_ovrun), /* ** If the SWIDE is not full, jump to dispatcher. ** We anticipate a STATUS phase. ** If we get later an IGNORE WIDE RESIDUE, we ** will alias it as a MODIFY DP (-1). */ SCR_FROM_REG (scntl2), 0, SCR_JUMP ^ IFFALSE (MASK (WSR, WSR)), PADDR (disp_status), /* ** The SWIDE is full. ** Clear this condition. */ SCR_REG_REG (scntl2, SCR_OR, WSR), 0, /* * We are expecting an IGNORE RESIDUE message * from the device, otherwise we are in data * overrun condition. Check against MSG_IN phase. */ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_IN)), SIR_SWIDE_OVERRUN, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_IN)), PADDR (disp_status), /* * We are in MSG_IN phase, * Read the first byte of the message. * If it is not an IGNORE RESIDUE message, * signal overrun and jump to message * processing. */ SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[0]), SCR_INT ^ IFFALSE (DATA (M_IGN_RESIDUE)), SIR_SWIDE_OVERRUN, SCR_JUMP ^ IFFALSE (DATA (M_IGN_RESIDUE)), PADDR (msg_in2), /* * We got the message we expected. * Read the 2nd byte, and jump to dispatcher. */ SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), SCR_CLR (SCR_ACK), 0, SCR_JUMP, PADDR (disp_status), }/*-------------------------< DATAO_DONE >-------------------*/,{ /* * If the device wants us to send more data, * we must count the extra bytes. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_OUT)), PADDRH (data_ovrun), /* ** If the SODL is not full jump to dispatcher. ** We anticipate a MSG IN phase or a STATUS phase. */ SCR_FROM_REG (scntl2), 0, SCR_JUMP ^ IFFALSE (MASK (WSS, WSS)), PADDR (disp_status), /* ** The SODL is full, clear this condition. */ SCR_REG_REG (scntl2, SCR_OR, WSS), 0, /* ** And signal a DATA UNDERRUN condition ** to the C code. */ SCR_INT, SIR_SODL_UNDERRUN, SCR_JUMP, PADDR (dispatch), }/*-------------------------< IGN_I_W_R_MSG >--------------*/,{ /* ** We jump here from the phase mismatch interrupt, ** When we have a SWIDE and the device has presented ** a IGNORE WIDE RESIDUE message on the BUS. ** We just have to throw away this message and then ** to jump to dispatcher. */ SCR_MOVE_ABS (2) ^ SCR_MSG_IN, NADDR (scratch), /* ** Clear ACK and jump to dispatcher. */ SCR_JUMP, PADDR (clrack), }/*-------------------------< DATAI_PHASE >------------------*/,{ SCR_RETURN, 0, }/*-------------------------< DATAO_PHASE >------------------*/,{ /* ** Patch for 53c1010_66 only - to allow A0 part ** to operate properly in a 33MHz PCI bus. ** ** SCR_REG_REG(scntl4, SCR_OR, 0x0c), ** 0, */ SCR_NO_OP, 0, SCR_RETURN, 0, }/*-------------------------< MSG_IN >--------------------*/,{ /* ** Get the first byte of the message. ** ** The script processor doesn't negate the ** ACK signal after this transfer. */ SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[0]), }/*-------------------------< MSG_IN2 >--------------------*/,{ /* ** Check first against 1 byte messages ** that we handle from SCRIPTS. */ SCR_JUMP ^ IFTRUE (DATA (M_COMPLETE)), PADDR (complete), SCR_JUMP ^ IFTRUE (DATA (M_DISCONNECT)), PADDR (disconnect), SCR_JUMP ^ IFTRUE (DATA (M_SAVE_DP)), PADDR (save_dp), SCR_JUMP ^ IFTRUE (DATA (M_RESTORE_DP)), PADDR (restore_dp), /* ** We handle all other messages from the ** C code, so no need to waste on-chip RAM ** for those ones. */ SCR_JUMP, PADDRH (msg_in_etc), }/*-------------------------< STATUS >--------------------*/,{ /* ** get the status */ SCR_MOVE_ABS (1) ^ SCR_STATUS, NADDR (scratch), #ifdef SCSI_NCR_IARB_SUPPORT /* ** If STATUS is not GOOD, clear IMMEDIATE ARBITRATION, ** since we may have to tamper the start queue from ** the C code. */ SCR_JUMPR ^ IFTRUE (DATA (S_GOOD)), 8, SCR_REG_REG (scntl1, SCR_AND, ~IARB), 0, #endif /* ** save status to scsi_status. ** mark as complete. */ SCR_TO_REG (SS_REG), 0, SCR_LOAD_REG (HS_REG, HS_COMPLETE), 0, /* ** Anticipate the MESSAGE PHASE for ** the TASK COMPLETE message. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (msg_in), SCR_JUMP, PADDR (dispatch), }/*-------------------------< COMPLETE >-----------------*/,{ /* ** Complete message. ** ** Copy the data pointer to LASTP in header. */ SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.lastp), /* ** When we terminate the cycle by clearing ACK, ** the target may disconnect immediately. ** ** We don't want to be told of an ** "unexpected disconnect", ** so we disable this feature. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, /* ** Terminate cycle ... */ SCR_CLR (SCR_ACK|SCR_ATN), 0, /* ** ... and wait for the disconnect. */ SCR_WAIT_DISC, 0, }/*-------------------------< COMPLETE2 >-----------------*/,{ /* ** Save host status to header. */ SCR_STORE_REL (scr0, 4), offsetof (struct ccb, phys.header.status), #ifdef SCSI_NCR_PCIQ_MAY_REORDER_WRITES /* ** Some bridges may reorder DMA writes to memory. ** We donnot want the CPU to deal with completions ** without all the posted write having been flushed ** to memory. This DUMMY READ should flush posted ** buffers prior to the CPU having to deal with ** completions. */ SCR_LOAD_REL (scr0, 4), /* DUMMY READ */ offsetof (struct ccb, phys.header.status), #endif /* ** If command resulted in not GOOD status, ** call the C code if needed. */ SCR_FROM_REG (SS_REG), 0, SCR_CALL ^ IFFALSE (DATA (S_GOOD)), PADDRH (bad_status), /* ** If we performed an auto-sense, call ** the C code to synchronyze task aborts ** with UNIT ATTENTION conditions. */ SCR_FROM_REG (HF_REG), 0, SCR_INT ^ IFTRUE (MASK (HF_AUTO_SENSE, HF_AUTO_SENSE)), SIR_AUTO_SENSE_DONE, }/*------------------------< DONE >-----------------*/,{ #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR /* ** It seems that some bridges flush everything ** when the INTR line is raised. For these ones, ** we can just ensure that the INTR line will be ** raised before each completion. So, if it happens ** that we have been faster that the CPU, we just ** have to synchronize with it. A dummy programmed ** interrupt will do the trick. ** Note that we overlap at most 1 IO with the CPU ** in this situation and that the IRQ line must not ** be shared. */ SCR_FROM_REG (istat), 0, SCR_INT ^ IFTRUE (MASK (INTF, INTF)), SIR_DUMMY_INTERRUPT, #endif /* ** Copy the DSA to the DONE QUEUE and ** signal completion to the host. ** If we are interrupted between DONE ** and DONE_END, we must reset, otherwise ** the completed CCB will be lost. */ SCR_STORE_ABS (dsa, 4), PADDRH (saved_dsa), SCR_LOAD_ABS (dsa, 4), PADDRH (done_pos), SCR_LOAD_ABS (scratcha, 4), PADDRH (saved_dsa), SCR_STORE_REL (scratcha, 4), 0, /* ** The instruction below reads the DONE QUEUE next ** free position from memory. ** In addition it ensures that all PCI posted writes ** are flushed and so the DSA value of the done ** CCB is visible by the CPU before INTFLY is raised. */ SCR_LOAD_REL (temp, 4), 4, SCR_INT_FLY, 0, SCR_STORE_ABS (temp, 4), PADDRH (done_pos), }/*------------------------< DONE_END >-----------------*/,{ SCR_JUMP, PADDR (start), }/*-------------------------< SAVE_DP >------------------*/,{ /* ** Clear ACK immediately. ** No need to delay it. */ SCR_CLR (SCR_ACK), 0, /* ** Keep track we received a SAVE DP, so ** we will switch to the other PM context ** on the next PM since the DP may point ** to the current PM context. */ SCR_REG_REG (HF_REG, SCR_OR, HF_DP_SAVED), 0, /* ** SAVE_DP message: ** Copy the data pointer to SAVEP in header. */ SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (dispatch), }/*-------------------------< RESTORE_DP >---------------*/,{ /* ** RESTORE_DP message: ** Copy SAVEP in header to actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (clrack), }/*-------------------------< DISCONNECT >---------------*/,{ /* ** DISCONNECTing ... ** ** disable the "unexpected disconnect" feature, ** and remove the ACK signal. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_CLR (SCR_ACK|SCR_ATN), 0, /* ** Wait for the disconnect. */ SCR_WAIT_DISC, 0, /* ** Status is: DISCONNECTED. */ SCR_LOAD_REG (HS_REG, HS_DISCONNECT), 0, /* ** Save host status to header. */ SCR_STORE_REL (scr0, 4), offsetof (struct ccb, phys.header.status), /* ** If QUIRK_AUTOSAVE is set, ** do an "save pointer" operation. */ SCR_FROM_REG (QU_REG), 0, SCR_JUMP ^ IFFALSE (MASK (QUIRK_AUTOSAVE, QUIRK_AUTOSAVE)), PADDR (start), /* ** like SAVE_DP message: ** Remember we saved the data pointer. ** Copy data pointer to SAVEP in header. */ SCR_REG_REG (HF_REG, SCR_OR, HF_DP_SAVED), 0, SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (start), }/*-------------------------< IDLE >------------------------*/,{ /* ** Nothing to do? ** Wait for reselect. ** This NOP will be patched with LED OFF ** SCR_REG_REG (gpreg, SCR_OR, 0x01) */ SCR_NO_OP, 0, #ifdef SCSI_NCR_IARB_SUPPORT SCR_JUMPR, 8, #endif }/*-------------------------< UNGETJOB >-----------------*/,{ #ifdef SCSI_NCR_IARB_SUPPORT /* ** Set IMMEDIATE ARBITRATION, for the next time. ** This will give us better chance to win arbitration ** for the job we just wanted to do. */ SCR_REG_REG (scntl1, SCR_OR, IARB), 0, #endif /* ** We are not able to restart the SCRIPTS if we are ** interrupted and these instruction haven't been ** all executed. BTW, this is very unlikely to ** happen, but we check that from the C code. */ SCR_LOAD_REG (dsa, 0xff), 0, SCR_STORE_ABS (scratcha, 4), PADDRH (startpos), }/*-------------------------< RESELECT >--------------------*/,{ /* ** make the host status invalid. */ SCR_CLR (SCR_TRG), 0, /* ** Sleep waiting for a reselection. ** If SIGP is set, special treatment. ** ** Zu allem bereit .. */ SCR_WAIT_RESEL, PADDR(start), }/*-------------------------< RESELECTED >------------------*/,{ /* ** This NOP will be patched with LED ON ** SCR_REG_REG (gpreg, SCR_AND, 0xfe) */ SCR_NO_OP, 0, /* ** load the target id into the sdid */ SCR_REG_SFBR (ssid, SCR_AND, 0x8F), 0, SCR_TO_REG (sdid), 0, /* ** load the target control block address */ SCR_LOAD_ABS (dsa, 4), PADDRH (targtbl), SCR_SFBR_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_AND, 0x3c), 0, SCR_LOAD_REL (dsa, 4), 0, /* ** Load the synchronous transfer registers. */ SCR_LOAD_REL (scntl3, 1), offsetof(struct tcb, wval), SCR_LOAD_REL (sxfer, 1), offsetof(struct tcb, sval), }/*-------------------------< RESEL_SCNTL4 >------------------*/,{ /* ** Write with uval value. Patch if device ** does not support Ultra3. ** ** SCR_LOAD_REL (scntl4, 1), ** offsetof(struct tcb, uval), */ SCR_NO_OP, 0, /* * We expect MESSAGE IN phase. * If not, get help from the C code. */ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_IN)), SIR_RESEL_NO_MSG_IN, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin), /* * If IDENTIFY LUN #0, use a faster path * to find the LCB structure. */ SCR_JUMPR ^ IFTRUE (MASK (0x80, 0xbf)), 56, /* * If message isn't an IDENTIFY, * tell the C code about. */ SCR_INT ^ IFFALSE (MASK (0x80, 0x80)), SIR_RESEL_NO_IDENTIFY, /* * It is an IDENTIFY message, * Load the LUN control block address. */ SCR_LOAD_REL (dsa, 4), offsetof(struct tcb, b_luntbl), SCR_SFBR_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_AND, 0xfc), 0, SCR_LOAD_REL (dsa, 4), 0, SCR_JUMPR, 8, /* ** LUN 0 special case (but usual one :)) */ SCR_LOAD_REL (dsa, 4), offsetof(struct tcb, b_lun0), /* ** Load the reselect task action for this LUN. ** Load the tasks DSA array for this LUN. ** Call the action. */ SCR_LOAD_REL (temp, 4), offsetof(struct lcb, resel_task), SCR_LOAD_REL (dsa, 4), offsetof(struct lcb, b_tasktbl), SCR_RETURN, 0, }/*-------------------------< RESEL_TAG >-------------------*/,{ /* ** ACK the IDENTIFY or TAG previously received */ SCR_CLR (SCR_ACK), 0, /* ** Read IDENTIFY + SIMPLE + TAG using a single MOVE. ** Agressive optimization, is'nt it? ** No need to test the SIMPLE TAG message, since the ** driver only supports conformant devices for tags. ;-) */ SCR_MOVE_ABS (2) ^ SCR_MSG_IN, NADDR (msgin), /* ** Read the TAG from the SIDL. ** Still an aggressive optimization. ;-) ** Compute the CCB indirect jump address which ** is (#TAG*2 & 0xfc) due to tag numbering using ** 1,3,5..MAXTAGS*2+1 actual values. */ SCR_REG_SFBR (sidl, SCR_SHL, 0), 0, #if MAX_TASKS*4 > 512 SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 2), 0, SCR_REG_REG (sfbr, SCR_SHL, 0), 0, SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 1), 0, #elif MAX_TASKS*4 > 256 SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 1), 0, #endif /* ** Retrieve the DSA of this task. ** JUMP indirectly to the restart point of the CCB. */ SCR_SFBR_REG (dsa, SCR_AND, 0xfc), 0, }/*-------------------------< RESEL_GO >-------------------*/,{ SCR_LOAD_REL (dsa, 4), 0, SCR_LOAD_REL (temp, 4), offsetof(struct ccb, phys.header.go.restart), SCR_RETURN, 0, /* In normal situations we branch to RESEL_DSA */ }/*-------------------------< RESEL_NOTAG >-------------------*/,{ /* ** JUMP indirectly to the restart point of the CCB. */ SCR_JUMP, PADDR (resel_go), }/*-------------------------< RESEL_DSA >-------------------*/,{ /* ** Ack the IDENTIFY or TAG previously received. */ SCR_CLR (SCR_ACK), 0, /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), /* ** Jump to dispatcher. */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATA_IN >--------------------*/,{ /* ** Because the size depends on the ** #define MAX_SCATTER parameter, ** it is filled in at runtime. ** ** ##===========< i=0; i========= ** || SCR_CHMOV_TBL ^ SCR_DATA_IN, ** || offsetof (struct dsb, data[ i]), ** ##========================================== ** **--------------------------------------------------------- */ 0 }/*-------------------------< DATA_IN2 >-------------------*/,{ SCR_CALL, PADDR (datai_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< DATA_OUT >--------------------*/,{ /* ** Because the size depends on the ** #define MAX_SCATTER parameter, ** it is filled in at runtime. ** ** ##===========< i=0; i========= ** || SCR_CHMOV_TBL ^ SCR_DATA_OUT, ** || offsetof (struct dsb, data[ i]), ** ##========================================== ** **--------------------------------------------------------- */ 0 }/*-------------------------< DATA_OUT2 >-------------------*/,{ SCR_CALL, PADDR (datao_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< PM0_DATA >--------------------*/,{ /* ** Read our host flags to SFBR, so we will be able ** to check against the data direction we expect. */ SCR_FROM_REG (HF_REG), 0, /* ** Check against actual DATA PHASE. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_DATA_IN)), PADDR (pm0_data_out), /* ** Actual phase is DATA IN. ** Check against expected direction. */ SCR_JUMP ^ IFFALSE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM0), 0, /* ** Move the data to memory. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.pm0.sg), SCR_JUMP, PADDR (pm0_data_end), }/*-------------------------< PM0_DATA_OUT >----------------*/,{ /* ** Actual phase is DATA OUT. ** Check against expected direction. */ SCR_JUMP ^ IFTRUE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM0), 0, /* ** Move the data from memory. */ SCR_CHMOV_TBL ^ SCR_DATA_OUT, offsetof (struct ccb, phys.pm0.sg), }/*-------------------------< PM0_DATA_END >----------------*/,{ /* ** Clear the flag that told we were moving ** data from the PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_IN_PM0)), 0, /* ** Return to the previous DATA script which ** is guaranteed by design (if no bug) to be ** the main DATA script for this transfer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.pm0.ret), SCR_RETURN, 0, }/*-------------------------< PM1_DATA >--------------------*/,{ /* ** Read our host flags to SFBR, so we will be able ** to check against the data direction we expect. */ SCR_FROM_REG (HF_REG), 0, /* ** Check against actual DATA PHASE. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_DATA_IN)), PADDR (pm1_data_out), /* ** Actual phase is DATA IN. ** Check against expected direction. */ SCR_JUMP ^ IFFALSE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM1), 0, /* ** Move the data to memory. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.pm1.sg), SCR_JUMP, PADDR (pm1_data_end), }/*-------------------------< PM1_DATA_OUT >----------------*/,{ /* ** Actual phase is DATA OUT. ** Check against expected direction. */ SCR_JUMP ^ IFTRUE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM1), 0, /* ** Move the data from memory. */ SCR_CHMOV_TBL ^ SCR_DATA_OUT, offsetof (struct ccb, phys.pm1.sg), }/*-------------------------< PM1_DATA_END >----------------*/,{ /* ** Clear the flag that told we were moving ** data from the PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_IN_PM1)), 0, /* ** Return to the previous DATA script which ** is guaranteed by design (if no bug) to be ** the main DATA script for this transfer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.pm1.ret), SCR_RETURN, 0, }/*---------------------------------------------------------*/ }; static struct scripth scripth0 __initdata = { /*------------------------< START64 >-----------------------*/{ /* ** SCRIPT entry point for the 895A and the 896. ** For now, there is no specific stuff for that ** chip at this point, but this may come. */ SCR_JUMP, PADDR (init), }/*-------------------------< NO_DATA >-------------------*/,{ SCR_JUMP, PADDRH (data_ovrun), }/*-----------------------< SEL_FOR_ABORT >------------------*/,{ /* ** We are jumped here by the C code, if we have ** some target to reset or some disconnected ** job to abort. Since error recovery is a serious ** busyness, we will really reset the SCSI BUS, if ** case of a SCSI interrupt occurring in this path. */ /* ** Set initiator mode. */ SCR_CLR (SCR_TRG), 0, /* ** And try to select this target. */ SCR_SEL_TBL_ATN ^ offsetof (struct ncb, abrt_sel), PADDR (reselect), /* ** Wait for the selection to complete or ** the selection to time out. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_MSG_OUT)), -8, /* ** Call the C code. */ SCR_INT, SIR_TARGET_SELECTED, /* ** The C code should let us continue here. ** Send the 'kiss of death' message. ** We expect an immediate disconnect once ** the target has eaten the message. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_MOVE_TBL ^ SCR_MSG_OUT, offsetof (struct ncb, abrt_tbl), SCR_CLR (SCR_ACK|SCR_ATN), 0, SCR_WAIT_DISC, 0, /* ** Tell the C code that we are done. */ SCR_INT, SIR_ABORT_SENT, }/*-----------------------< SEL_FOR_ABORT_1 >--------------*/,{ /* ** Jump at scheduler. */ SCR_JUMP, PADDR (start), }/*------------------------< SELECT_NO_ATN >-----------------*/,{ /* ** Set Initiator mode. ** And try to select this target without ATN. */ SCR_CLR (SCR_TRG), 0, SCR_SEL_TBL ^ offsetof (struct dsb, select), PADDR (ungetjob), /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), }/*------------------------< WF_SEL_DONE_NO_ATN >-----------------*/,{ /* ** Wait immediately for the next phase or ** the selection to complete or time-out. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_MSG_OUT)), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< MSG_IN_ETC >--------------------*/,{ /* ** If it is an EXTENDED (variable size message) ** Handle it. */ SCR_JUMP ^ IFTRUE (DATA (M_EXTENDED)), PADDRH (msg_extended), /* ** Let the C code handle any other ** 1 byte message. */ SCR_JUMP ^ IFTRUE (MASK (0x00, 0xf0)), PADDRH (msg_received), SCR_JUMP ^ IFTRUE (MASK (0x10, 0xf0)), PADDRH (msg_received), /* ** We donnot handle 2 bytes messages from SCRIPTS. ** So, let the C code deal with these ones too. */ SCR_JUMP ^ IFFALSE (MASK (0x20, 0xf0)), PADDRH (msg_weird_seen), SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), SCR_JUMP, PADDRH (msg_received), }/*-------------------------< MSG_RECEIVED >--------------------*/,{ SCR_LOAD_REL (scratcha, 4), /* DUMMY READ */ 0, SCR_INT, SIR_MSG_RECEIVED, }/*-------------------------< MSG_WEIRD_SEEN >------------------*/,{ SCR_LOAD_REL (scratcha, 4), /* DUMMY READ */ 0, SCR_INT, SIR_MSG_WEIRD, }/*-------------------------< MSG_EXTENDED >--------------------*/,{ /* ** Clear ACK and get the next byte ** assumed to be the message length. */ SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), /* ** Try to catch some unlikely situations as 0 length ** or too large the length. */ SCR_JUMP ^ IFTRUE (DATA (0)), PADDRH (msg_weird_seen), SCR_TO_REG (scratcha), 0, SCR_REG_REG (sfbr, SCR_ADD, (256-8)), 0, SCR_JUMP ^ IFTRUE (CARRYSET), PADDRH (msg_weird_seen), /* ** We donnot handle extended messages from SCRIPTS. ** Read the amount of data correponding to the ** message length and call the C code. */ SCR_STORE_REL (scratcha, 1), offsetof (struct dsb, smsg_ext.size), SCR_CLR (SCR_ACK), 0, SCR_MOVE_TBL ^ SCR_MSG_IN, offsetof (struct dsb, smsg_ext), SCR_JUMP, PADDRH (msg_received), }/*-------------------------< MSG_BAD >------------------*/,{ /* ** unimplemented message - reject it. */ SCR_INT, SIR_REJECT_TO_SEND, SCR_SET (SCR_ATN), 0, SCR_JUMP, PADDR (clrack), }/*-------------------------< MSG_WEIRD >--------------------*/,{ /* ** weird message received ** ignore all MSG IN phases and reject it. */ SCR_INT, SIR_REJECT_TO_SEND, SCR_SET (SCR_ATN), 0, }/*-------------------------< MSG_WEIRD1 >--------------------*/,{ SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_IN)), PADDR (dispatch), SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (scratch), SCR_JUMP, PADDRH (msg_weird1), }/*-------------------------< WDTR_RESP >----------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_WDTR >----------------*/,{ /* ** Send the M_X_WIDE_REQ */ SCR_MOVE_ABS (4) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< SDTR_RESP >-------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_SDTR >-------------*/,{ /* ** Send the M_X_SYNC_REQ */ SCR_MOVE_ABS (5) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< PPR_RESP >-------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_PPR >-------------*/,{ /* ** Send the M_X_PPR_REQ */ SCR_MOVE_ABS (8) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< NEGO_BAD_PHASE >------------*/,{ SCR_INT, SIR_NEGO_PROTO, SCR_JUMP, PADDR (dispatch), }/*-------------------------< MSG_OUT >-------------------*/,{ /* ** The target requests a message. */ SCR_MOVE_ABS (1) ^ SCR_MSG_OUT, NADDR (msgout), /* ** ... wait for the next phase ** if it's a message out, send it again, ... */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_OUT)), PADDRH (msg_out), }/*-------------------------< MSG_OUT_DONE >--------------*/,{ /* ** ... else clear the message ... */ SCR_INT, SIR_MSG_OUT_DONE, /* ** ... and process the next phase */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATA_OVRUN >-----------------------*/,{ /* * Use scratcha to count the extra bytes. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (zero), }/*-------------------------< DATA_OVRUN1 >----------------------*/,{ /* * The target may want to transfer too much data. * * If phase is DATA OUT write 1 byte and count it. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_DATA_OUT)), 16, SCR_CHMOV_ABS (1) ^ SCR_DATA_OUT, NADDR (scratch), SCR_JUMP, PADDRH (data_ovrun2), /* * If WSR is set, clear this condition, and * count this byte. */ SCR_FROM_REG (scntl2), 0, SCR_JUMPR ^ IFFALSE (MASK (WSR, WSR)), 16, SCR_REG_REG (scntl2, SCR_OR, WSR), 0, SCR_JUMP, PADDRH (data_ovrun2), /* * Finally check against DATA IN phase. * Signal data overrun to the C code * and jump to dispatcher if not so. * Read 1 byte otherwise and count it. */ SCR_JUMPR ^ IFTRUE (WHEN (SCR_DATA_IN)), 16, SCR_INT, SIR_DATA_OVERRUN, SCR_JUMP, PADDR (dispatch), SCR_CHMOV_ABS (1) ^ SCR_DATA_IN, NADDR (scratch), }/*-------------------------< DATA_OVRUN2 >----------------------*/,{ /* * Count this byte. * This will allow to return a negative * residual to user. */ SCR_REG_REG (scratcha, SCR_ADD, 0x01), 0, SCR_REG_REG (scratcha1, SCR_ADDC, 0), 0, SCR_REG_REG (scratcha2, SCR_ADDC, 0), 0, /* * .. and repeat as required. */ SCR_JUMP, PADDRH (data_ovrun1), }/*-------------------------< ABORT_RESEL >----------------*/,{ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, /* ** send the abort/abortag/reset message ** we expect an immediate disconnect */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_OUT, NADDR (msgout), SCR_CLR (SCR_ACK|SCR_ATN), 0, SCR_WAIT_DISC, 0, SCR_INT, SIR_RESEL_ABORTED, SCR_JUMP, PADDR (start), }/*-------------------------< RESEND_IDENT >-------------------*/,{ /* ** The target stays in MSG OUT phase after having acked ** Identify [+ Tag [+ Extended message ]]. Targets shall ** behave this way on parity error. ** We must send it again all the messages. */ SCR_SET (SCR_ATN), /* Shall be asserted 2 deskew delays before the */ 0, /* 1rst ACK = 90 ns. Hope the NCR is'nt too fast */ SCR_JUMP, PADDR (send_ident), }/*-------------------------< IDENT_BREAK >-------------------*/,{ SCR_CLR (SCR_ATN), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< IDENT_BREAK_ATN >----------------*/,{ SCR_SET (SCR_ATN), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< SDATA_IN >-------------------*/,{ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct dsb, sense), SCR_CALL, PADDR (datai_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< DATA_IO >--------------------*/,{ /* ** We jump here if the data direction was unknown at the ** time we had to queue the command to the scripts processor. ** Pointers had been set as follow in this situation: ** savep --> DATA_IO ** lastp --> start pointer when DATA_IN ** goalp --> goal pointer when DATA_IN ** wlastp --> start pointer when DATA_OUT ** wgoalp --> goal pointer when DATA_OUT ** This script sets savep/lastp/goalp according to the ** direction chosen by the target. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_OUT)), PADDRH(data_io_out), }/*-------------------------< DATA_IO_COM >-----------------*/,{ /* ** Direction is DATA IN. ** Warning: we jump here, even when phase is DATA OUT. */ SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.lastp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.savep), /* ** Jump to the SCRIPTS according to actual direction. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_RETURN, 0, }/*-------------------------< DATA_IO_OUT >-----------------*/,{ /* ** Direction is DATA OUT. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_DATA_IN)), 0, SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.wlastp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.lastp), SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.wgoalp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.goalp), SCR_JUMP, PADDRH(data_io_com), }/*-------------------------< RESEL_BAD_LUN >---------------*/,{ /* ** Message is an IDENTIFY, but lun is unknown. ** Signal problem to C code for logging the event. ** Send a M_ABORT to clear all pending tasks. */ SCR_INT, SIR_RESEL_BAD_LUN, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_I_T_L >------------------*/,{ /* ** We donnot have a task for that I_T_L. ** Signal problem to C code for logging the event. ** Send a M_ABORT message. */ SCR_INT, SIR_RESEL_BAD_I_T_L, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_I_T_L_Q >----------------*/,{ /* ** We donnot have a task that matches the tag. ** Signal problem to C code for logging the event. ** Send a M_ABORTTAG message. */ SCR_INT, SIR_RESEL_BAD_I_T_L_Q, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_STATUS >-----------------*/,{ /* ** Anything different from INTERMEDIATE ** CONDITION MET should be a bad SCSI status, ** given that GOOD status has already been tested. ** Call the C code. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (startpos), SCR_INT ^ IFFALSE (DATA (S_COND_MET)), SIR_BAD_STATUS, SCR_RETURN, 0, }/*-------------------------< TWEAK_PMJ >------------------*/,{ /* ** Disable PM handling from SCRIPTS for the data phase ** and so force PM to be handled from C code if HF_PM_TO_C ** flag is set. */ SCR_FROM_REG(HF_REG), 0, SCR_JUMPR ^ IFTRUE (MASK (HF_PM_TO_C, HF_PM_TO_C)), 16, SCR_REG_REG (ccntl0, SCR_OR, ENPMJ), 0, SCR_RETURN, 0, SCR_REG_REG (ccntl0, SCR_AND, (~ENPMJ)), 0, SCR_RETURN, 0, }/*-------------------------< PM_HANDLE >------------------*/,{ /* ** Phase mismatch handling. ** ** Since we have to deal with 2 SCSI data pointers ** (current and saved), we need at least 2 contexts. ** Each context (pm0 and pm1) has a saved area, a ** SAVE mini-script and a DATA phase mini-script. */ /* ** Get the PM handling flags. */ SCR_FROM_REG (HF_REG), 0, /* ** If no flags (1rst PM for example), avoid ** all the below heavy flags testing. ** This makes the normal case a bit faster. */ SCR_JUMP ^ IFTRUE (MASK (0, (HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED))), PADDRH (pm_handle1), /* ** If we received a SAVE DP, switch to the ** other PM context since the savep may point ** to the current PM context. */ SCR_JUMPR ^ IFFALSE (MASK (HF_DP_SAVED, HF_DP_SAVED)), 8, SCR_REG_REG (sfbr, SCR_XOR, HF_ACT_PM), 0, /* ** If we have been interrupt in a PM DATA mini-script, ** we take the return address from the corresponding ** saved area. ** This ensure the return address always points to the ** main DATA script for this transfer. */ SCR_JUMP ^ IFTRUE (MASK (0, (HF_IN_PM0 | HF_IN_PM1))), PADDRH (pm_handle1), SCR_JUMPR ^ IFFALSE (MASK (HF_IN_PM0, HF_IN_PM0)), 16, SCR_LOAD_REL (ia, 4), offsetof(struct ccb, phys.pm0.ret), SCR_JUMP, PADDRH (pm_save), SCR_LOAD_REL (ia, 4), offsetof(struct ccb, phys.pm1.ret), SCR_JUMP, PADDRH (pm_save), }/*-------------------------< PM_HANDLE1 >-----------------*/,{ /* ** Normal case. ** Update the return address so that it ** will point after the interrupted MOVE. */ SCR_REG_REG (ia, SCR_ADD, 8), 0, SCR_REG_REG (ia1, SCR_ADDC, 0), 0, }/*-------------------------< PM_SAVE >--------------------*/,{ /* ** Clear all the flags that told us if we were ** interrupted in a PM DATA mini-script and/or ** we received a SAVE DP. */ SCR_SFBR_REG (HF_REG, SCR_AND, (~(HF_IN_PM0|HF_IN_PM1|HF_DP_SAVED))), 0, /* ** Choose the current PM context. */ SCR_JUMP ^ IFTRUE (MASK (HF_ACT_PM, HF_ACT_PM)), PADDRH (pm1_save), }/*-------------------------< PM0_SAVE >-------------------*/,{ SCR_STORE_REL (ia, 4), offsetof(struct ccb, phys.pm0.ret), /* ** If WSR bit is set, either UA and RBC may ** have to be changed whatever the device wants ** to ignore this residue ot not. */ SCR_FROM_REG (scntl2), 0, SCR_CALL ^ IFTRUE (MASK (WSR, WSR)), PADDRH (pm_wsr_handle), /* ** Save the remaining byte count, the updated ** address and the return address. */ SCR_STORE_REL (rbc, 4), offsetof(struct ccb, phys.pm0.sg.size), SCR_STORE_REL (ua, 4), offsetof(struct ccb, phys.pm0.sg.addr), /* ** Set the current pointer at the PM0 DATA mini-script. */ SCR_LOAD_ABS (temp, 4), PADDRH (pm0_data_addr), SCR_JUMP, PADDR (dispatch), }/*-------------------------< PM1_SAVE >-------------------*/,{ SCR_STORE_REL (ia, 4), offsetof(struct ccb, phys.pm1.ret), /* ** If WSR bit is set, either UA and RBC may ** have been changed whatever the device wants ** to ignore this residue or not. */ SCR_FROM_REG (scntl2), 0, SCR_CALL ^ IFTRUE (MASK (WSR, WSR)), PADDRH (pm_wsr_handle), /* ** Save the remaining byte count, the updated ** address and the return address. */ SCR_STORE_REL (rbc, 4), offsetof(struct ccb, phys.pm1.sg.size), SCR_STORE_REL (ua, 4), offsetof(struct ccb, phys.pm1.sg.addr), /* ** Set the current pointer at the PM1 DATA mini-script. */ SCR_LOAD_ABS (temp, 4), PADDRH (pm1_data_addr), SCR_JUMP, PADDR (dispatch), }/*--------------------------< PM_WSR_HANDLE >-----------------------*/,{ /* * Phase mismatch handling from SCRIPT with WSR set. * Such a condition can occur if the chip wants to * execute a CHMOV(size > 1) when the WSR bit is * set and the target changes PHASE. */ #ifdef SYM_DEBUG_PM_WITH_WSR /* * Some debugging may still be needed.:) */ SCR_INT, SIR_PM_WITH_WSR, #endif /* * We must move the residual byte to memory. * * UA contains bit 0..31 of the address to * move the residual byte. * Move it to the table indirect. */ SCR_STORE_REL (ua, 4), offsetof (struct ccb, phys.wresid.addr), /* * Increment UA (move address to next position). */ SCR_REG_REG (ua, SCR_ADD, 1), 0, SCR_REG_REG (ua1, SCR_ADDC, 0), 0, SCR_REG_REG (ua2, SCR_ADDC, 0), 0, SCR_REG_REG (ua3, SCR_ADDC, 0), 0, /* * Compute SCRATCHA as: * - size to transfer = 1 byte. * - bit 24..31 = high address bit [32...39]. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (zero), SCR_REG_REG (scratcha, SCR_OR, 1), 0, SCR_FROM_REG (rbc3), 0, SCR_TO_REG (scratcha3), 0, /* * Move this value to the table indirect. */ SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.wresid.size), /* * Wait for a valid phase. * While testing with bogus QUANTUM drives, the C1010 * sometimes raised a spurious phase mismatch with * WSR and the CHMOV(1) triggered another PM. * Waiting explicitely for the PHASE seemed to avoid * the nested phase mismatch. Btw, this didn't happen * using my IBM drives. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_DATA_IN)), 0, /* * Perform the move of the residual byte. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.wresid), /* * We can now handle the phase mismatch with UA fixed. * RBC[0..23]=0 is a special case that does not require * a PM context. The C code also checks against this. */ SCR_FROM_REG (rbc), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, SCR_FROM_REG (rbc1), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, SCR_FROM_REG (rbc2), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, /* * RBC[0..23]=0. * Not only we donnot need a PM context, but this would * lead to a bogus CHMOV(0). This condition means that * the residual was the last byte to move from this CHMOV. * So, we just have to move the current data script pointer * (i.e. TEMP) to the SCRIPTS address following the * interrupted CHMOV and jump to dispatcher. */ SCR_STORE_ABS (ia, 4), PADDRH (scratch), SCR_LOAD_ABS (temp, 4), PADDRH (scratch), SCR_JUMP, PADDR (dispatch), }/*--------------------------< WSR_MA_HELPER >-----------------------*/,{ /* * Helper for the C code when WSR bit is set. * Perform the move of the residual byte. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.wresid), SCR_JUMP, PADDR (dispatch), }/*-------------------------< ZERO >------------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SCRATCH >---------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SCRATCH1 >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< PM0_DATA_ADDR >---------------*/,{ SCR_DATA_ZERO, }/*-------------------------< PM1_DATA_ADDR >---------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SAVED_DSA >-------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SAVED_DRS >-------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< DONE_POS >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< STARTPOS >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< TARGTBL >---------------------*/,{ SCR_DATA_ZERO, /* ** We may use MEMORY MOVE instructions to load the on chip-RAM, ** if it happens that mapping PCI memory is not possible. ** But writing the RAM from the CPU is the preferred method, ** since PCI 2.2 seems to disallow PCI self-mastering. */ #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED }/*-------------------------< START_RAM >-------------------*/,{ /* ** Load the script into on-chip RAM, ** and jump to start point. */ SCR_COPY (sizeof (struct script)), }/*-------------------------< SCRIPT0_BA >--------------------*/,{ 0, PADDR (start), SCR_JUMP, PADDR (init), }/*-------------------------< START_RAM64 >--------------------*/,{ /* ** Load the RAM and start for 64 bit PCI (895A,896). ** Both scripts (script and scripth) are loaded into ** the RAM which is 8K (4K for 825A/875/895). ** We also need to load some 32-63 bit segments ** address of the SCRIPTS processor. ** LOAD/STORE ABSOLUTE always refers to on-chip RAM ** in our implementation. The main memory is ** accessed using LOAD/STORE DSA RELATIVE. */ SCR_LOAD_REL (mmws, 4), offsetof (struct ncb, scr_ram_seg), SCR_COPY (sizeof(struct script)), }/*-------------------------< SCRIPT0_BA64 >--------------------*/,{ 0, PADDR (start), SCR_COPY (sizeof(struct scripth)), }/*-------------------------< SCRIPTH0_BA64 >--------------------*/,{ 0, PADDRH (start64), SCR_LOAD_REL (mmrs, 4), offsetof (struct ncb, scr_ram_seg), SCR_JUMP64, PADDRH (start64), }/*-------------------------< RAM_SEG64 >--------------------*/,{ 0, #endif /* SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ }/*-------------------------< SNOOPTEST >-------------------*/,{ /* ** Read the variable. */ SCR_LOAD_REL (scratcha, 4), offsetof(struct ncb, ncr_cache), SCR_STORE_REL (temp, 4), offsetof(struct ncb, ncr_cache), SCR_LOAD_REL (temp, 4), offsetof(struct ncb, ncr_cache), }/*-------------------------< SNOOPEND >-------------------*/,{ /* ** And stop. */ SCR_INT, 99, }/*--------------------------------------------------------*/ }; /*========================================================== ** ** ** Fill in #define dependent parts of the script ** ** **========================================================== */ void __init ncr_script_fill (struct script * scr, struct scripth * scrh) { int i; ncrcmd *p; p = scr->data_in; for (i=0; idata_in + sizeof (scr->data_in)); p = scr->data_out; for (i=0; idata_out + sizeof (scr->data_out)); } /*========================================================== ** ** ** Copy and rebind a script. ** ** **========================================================== */ static void __init ncr_script_copy_and_bind (ncb_p np,ncrcmd *src,ncrcmd *dst,int len) { ncrcmd opcode, new, old, tmp1, tmp2; ncrcmd *start, *end; int relocs; int opchanged = 0; start = src; end = src + len/4; while (src < end) { opcode = *src++; *dst++ = cpu_to_scr(opcode); /* ** If we forget to change the length ** in struct script, a field will be ** padded with 0. This is an illegal ** command. */ if (opcode == 0) { printk (KERN_INFO "%s: ERROR0 IN SCRIPT at %d.\n", ncr_name(np), (int) (src-start-1)); MDELAY (10000); continue; }; /* ** We use the bogus value 0xf00ff00f ;-) ** to reserve data area in SCRIPTS. */ if (opcode == SCR_DATA_ZERO) { dst[-1] = 0; continue; } if (DEBUG_FLAGS & DEBUG_SCRIPT) printk (KERN_INFO "%p: <%x>\n", (src-1), (unsigned)opcode); /* ** We don't have to decode ALL commands */ switch (opcode >> 28) { case 0xf: /* ** LOAD / STORE DSA relative, don't relocate. */ relocs = 0; break; case 0xe: /* ** LOAD / STORE absolute. */ relocs = 1; break; case 0xc: /* ** COPY has TWO arguments. */ relocs = 2; tmp1 = src[0]; tmp2 = src[1]; #ifdef RELOC_KVAR if ((tmp1 & RELOC_MASK) == RELOC_KVAR) tmp1 = 0; if ((tmp2 & RELOC_MASK) == RELOC_KVAR) tmp2 = 0; #endif if ((tmp1 ^ tmp2) & 3) { printk (KERN_ERR"%s: ERROR1 IN SCRIPT at %d.\n", ncr_name(np), (int) (src-start-1)); MDELAY (1000); } /* ** If PREFETCH feature not enabled, remove ** the NO FLUSH bit if present. */ if ((opcode & SCR_NO_FLUSH) && !(np->features & FE_PFEN)) { dst[-1] = cpu_to_scr(opcode & ~SCR_NO_FLUSH); ++opchanged; } break; case 0x0: /* ** MOVE/CHMOV (absolute address) */ if (!(np->features & FE_WIDE)) dst[-1] = cpu_to_scr(opcode | OPC_MOVE); relocs = 1; break; case 0x1: /* ** MOVE/CHMOV (table indirect) */ if (!(np->features & FE_WIDE)) dst[-1] = cpu_to_scr(opcode | OPC_MOVE); relocs = 0; break; case 0x8: /* ** JUMP / CALL ** don't relocate if relative :-) */ if (opcode & 0x00800000) relocs = 0; else if ((opcode & 0xf8400000) == 0x80400000)/*JUMP64*/ relocs = 2; else relocs = 1; break; case 0x4: case 0x5: case 0x6: case 0x7: relocs = 1; break; default: relocs = 0; break; }; if (!relocs) { *dst++ = cpu_to_scr(*src++); continue; } while (relocs--) { old = *src++; switch (old & RELOC_MASK) { case RELOC_REGISTER: new = (old & ~RELOC_MASK) + np->base_ba; break; case RELOC_LABEL: new = (old & ~RELOC_MASK) + np->p_script; break; case RELOC_LABELH: new = (old & ~RELOC_MASK) + np->p_scripth; break; case RELOC_SOFTC: new = (old & ~RELOC_MASK) + np->p_ncb; break; #ifdef RELOC_KVAR case RELOC_KVAR: new=0; if (((old & ~RELOC_MASK) < SCRIPT_KVAR_FIRST) || ((old & ~RELOC_MASK) > SCRIPT_KVAR_LAST)) panic("ncr KVAR out of range"); new = vtobus(script_kvars[old & ~RELOC_MASK]); #endif break; case 0: /* Don't relocate a 0 address. */ if (old == 0) { new = old; break; } /* fall through */ default: new = 0; /* For 'cc' not to complain */ panic("ncr_script_copy_and_bind: " "weird relocation %x\n", old); break; } *dst++ = cpu_to_scr(new); } }; } /*========================================================== ** ** ** Auto configuration: attach and init a host adapter. ** ** **========================================================== */ /* ** Linux host data structure. */ struct host_data { struct ncb *ncb; }; /* ** Print something which allows to retrieve the controler type, unit, ** target, lun concerned by a kernel message. */ static void PRINT_TARGET(ncb_p np, int target) { printk(KERN_INFO "%s-<%d,*>: ", ncr_name(np), target); } static void PRINT_LUN(ncb_p np, int target, int lun) { printk(KERN_INFO "%s-<%d,%d>: ", ncr_name(np), target, lun); } static void PRINT_ADDR(Scsi_Cmnd *cmd) { struct host_data *host_data = (struct host_data *) cmd->device->host->hostdata; PRINT_LUN(host_data->ncb, cmd->device->id, cmd->device->lun); } /*========================================================== ** ** NCR chip clock divisor table. ** Divisors are multiplied by 10,000,000 in order to make ** calculations more simple. ** **========================================================== */ #define _5M 5000000 static u_long div_10M[] = {2*_5M, 3*_5M, 4*_5M, 6*_5M, 8*_5M, 12*_5M, 16*_5M}; /*=============================================================== ** ** Prepare io register values used by ncr_init() according ** to selected and supported features. ** ** NCR/SYMBIOS chips allow burst lengths of 2, 4, 8, 16, 32, 64, ** 128 transfers. All chips support at least 16 transfers bursts. ** The 825A, 875 and 895 chips support bursts of up to 128 ** transfers and the 895A and 896 support bursts of up to 64 ** transfers. All other chips support up to 16 transfers bursts. ** ** For PCI 32 bit data transfers each transfer is a DWORD (4 bytes). ** It is a QUADWORD (8 bytes) for PCI 64 bit data transfers. ** Only the 896 is able to perform 64 bit data transfers. ** ** We use log base 2 (burst length) as internal code, with ** value 0 meaning "burst disabled". ** **=============================================================== */ /* * Burst length from burst code. */ #define burst_length(bc) (!(bc))? 0 : 1 << (bc) /* * Burst code from io register bits. */ #define burst_code(dmode, ctest4, ctest5) \ (ctest4) & 0x80? 0 : (((dmode) & 0xc0) >> 6) + ((ctest5) & 0x04) + 1 /* * Set initial io register bits from burst code. */ static inline void ncr_init_burst(ncb_p np, u_char bc) { np->rv_ctest4 &= ~0x80; np->rv_dmode &= ~(0x3 << 6); np->rv_ctest5 &= ~0x4; if (!bc) { np->rv_ctest4 |= 0x80; } else { --bc; np->rv_dmode |= ((bc & 0x3) << 6); np->rv_ctest5 |= (bc & 0x4); } } #ifdef SCSI_NCR_NVRAM_SUPPORT /* ** Get target set-up from Symbios format NVRAM. */ static void __init ncr_Symbios_setup_target(ncb_p np, int target, Symbios_nvram *nvram) { tcb_p tp = &np->target[target]; Symbios_target *tn = &nvram->target[target]; tp->usrsync = tn->sync_period ? (tn->sync_period + 3) / 4 : 255; tp->usrwide = tn->bus_width == 0x10 ? 1 : 0; tp->usrtags = (tn->flags & SYMBIOS_QUEUE_TAGS_ENABLED)? MAX_TAGS : 0; if (!(tn->flags & SYMBIOS_DISCONNECT_ENABLE)) tp->usrflag |= UF_NODISC; if (!(tn->flags & SYMBIOS_SCAN_AT_BOOT_TIME)) tp->usrflag |= UF_NOSCAN; } /* ** Get target set-up from Tekram format NVRAM. */ static void __init ncr_Tekram_setup_target(ncb_p np, int target, Tekram_nvram *nvram) { tcb_p tp = &np->target[target]; struct Tekram_target *tn = &nvram->target[target]; int i; if (tn->flags & TEKRAM_SYNC_NEGO) { i = tn->sync_index & 0xf; tp->usrsync = Tekram_sync[i]; } tp->usrwide = (tn->flags & TEKRAM_WIDE_NEGO) ? 1 : 0; if (tn->flags & TEKRAM_TAGGED_COMMANDS) { tp->usrtags = 2 << nvram->max_tags_index; } if (!(tn->flags & TEKRAM_DISCONNECT_ENABLE)) tp->usrflag = UF_NODISC; /* If any device does not support parity, we will not use this option */ if (!(tn->flags & TEKRAM_PARITY_CHECK)) np->rv_scntl0 &= ~0x0a; /* SCSI parity checking disabled */ } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Save initial settings of some IO registers. ** Assumed to have been set by BIOS. */ static void __init ncr_save_initial_setting(ncb_p np) { np->sv_scntl0 = INB(nc_scntl0) & 0x0a; np->sv_dmode = INB(nc_dmode) & 0xce; np->sv_dcntl = INB(nc_dcntl) & 0xa8; np->sv_ctest3 = INB(nc_ctest3) & 0x01; np->sv_ctest4 = INB(nc_ctest4) & 0x80; np->sv_gpcntl = INB(nc_gpcntl); np->sv_stest2 = INB(nc_stest2) & 0x20; np->sv_stest4 = INB(nc_stest4); np->sv_stest1 = INB(nc_stest1); np->sv_scntl3 = INB(nc_scntl3) & 0x07; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66) ){ /* ** C1010 always uses large fifo, bit 5 rsvd ** scntl4 used ONLY with C1010 */ np->sv_ctest5 = INB(nc_ctest5) & 0x04 ; np->sv_scntl4 = INB(nc_scntl4); } else { np->sv_ctest5 = INB(nc_ctest5) & 0x24 ; np->sv_scntl4 = 0; } } /* ** Prepare io register values used by ncr_init() ** according to selected and supported features. */ static int __init ncr_prepare_setting(ncb_p np, ncr_nvram *nvram) { u_char burst_max; u_long period; int i; #ifdef CONFIG_PARISC char scsi_mode = -1; struct hardware_path hwpath; #endif /* ** Wide ? */ np->maxwide = (np->features & FE_WIDE)? 1 : 0; /* * Guess the frequency of the chip's clock. */ if (np->features & (FE_ULTRA3 | FE_ULTRA2)) np->clock_khz = 160000; else if (np->features & FE_ULTRA) np->clock_khz = 80000; else np->clock_khz = 40000; /* * Get the clock multiplier factor. */ if (np->features & FE_QUAD) np->multiplier = 4; else if (np->features & FE_DBLR) np->multiplier = 2; else np->multiplier = 1; /* * Measure SCSI clock frequency for chips * it may vary from assumed one. */ if (np->features & FE_VARCLK) ncr_getclock(np, np->multiplier); /* * Divisor to be used for async (timer pre-scaler). * * Note: For C1010 the async divisor is 2(8) if he * quadrupler is disabled (enabled). */ if ( (np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { np->rv_scntl3 = 0; } else { i = np->clock_divn - 1; while (--i >= 0) { if (10ul * SCSI_NCR_MIN_ASYNC * np->clock_khz > div_10M[i]) { ++i; break; } } np->rv_scntl3 = i+1; } /* * Save the ultra3 register for the C1010/C1010_66 */ np->rv_scntl4 = np->sv_scntl4; /* * Minimum synchronous period factor supported by the chip. * Btw, 'period' is in tenths of nanoseconds. */ period = (4 * div_10M[0] + np->clock_khz - 1) / np->clock_khz; #ifdef CONFIG_PARISC /* Host firmware (PDC) keeps a table for crippling SCSI capabilities. * Many newer machines export one channel of 53c896 chip * as SE, 50-pin HD. Also used for Multi-initiator SCSI clusters * to set the SCSI Initiator ID. */ get_pci_node_path(np->pdev, &hwpath); if (pdc_get_initiator(&hwpath, &np->myaddr, &period, &np->maxwide, &scsi_mode)) { if (np->maxwide) np->features |= FE_WIDE; if (scsi_mode >= 0) { /* C3000 PDC reports period/mode */ driver_setup.diff_support = 0; switch(scsi_mode) { case 0: np->scsi_mode = SMODE_SE; break; case 1: np->scsi_mode = SMODE_HVD; break; case 2: np->scsi_mode = SMODE_LVD; break; default: break; } } } #endif if (period <= 250) np->minsync = 10; else if (period <= 303) np->minsync = 11; else if (period <= 500) np->minsync = 12; else np->minsync = (period + 40 - 1) / 40; /* * Fix up. If sync. factor is 10 (160000Khz clock) and chip * supports ultra3, then min. sync. period 12.5ns and the factor is 9 * Also keep track of the maximum offset in ST mode which may differ * from the maximum offset in DT mode. For now hardcoded to 31. */ if (np->features & FE_ULTRA3) { if (np->minsync == 10) np->minsync = 9; np->maxoffs_st = 31; } else np->maxoffs_st = np->maxoffs; /* * Check against chip SCSI standard support (SCSI-2,ULTRA,ULTRA2). * * Transfer period minimums: SCSI-1 200 (50); Fast 100 (25) * Ultra 50 (12); Ultra2 (6); Ultra3 (3) */ if (np->minsync < 25 && !(np->features & (FE_ULTRA|FE_ULTRA2|FE_ULTRA3))) np->minsync = 25; else if (np->minsync < 12 && (np->features & FE_ULTRA)) np->minsync = 12; else if (np->minsync < 10 && (np->features & FE_ULTRA2)) np->minsync = 10; else if (np->minsync < 9 && (np->features & FE_ULTRA3)) np->minsync = 9; /* * Maximum synchronous period factor supported by the chip. */ period = (11 * div_10M[np->clock_divn - 1]) / (4 * np->clock_khz); np->maxsync = period > 2540 ? 254 : period / 10; /* ** 64 bit (53C895A or 53C896) ? */ if (np->features & FE_DAC) { if (np->features & FE_DAC_IN_USE) np->rv_ccntl1 |= (XTIMOD | EXTIBMV); else np->rv_ccntl1 |= (DDAC); } /* ** Phase mismatch handled by SCRIPTS (53C895A, 53C896 or C1010) ? */ if (np->features & FE_NOPM) np->rv_ccntl0 |= (ENPMJ); /* ** Prepare initial value of other IO registers */ #if defined SCSI_NCR_TRUST_BIOS_SETTING np->rv_scntl0 = np->sv_scntl0; np->rv_dmode = np->sv_dmode; np->rv_dcntl = np->sv_dcntl; np->rv_ctest3 = np->sv_ctest3; np->rv_ctest4 = np->sv_ctest4; np->rv_ctest5 = np->sv_ctest5; burst_max = burst_code(np->sv_dmode, np->sv_ctest4, np->sv_ctest5); #else /* ** Select burst length (dwords) */ burst_max = driver_setup.burst_max; if (burst_max == 255) burst_max = burst_code(np->sv_dmode, np->sv_ctest4, np->sv_ctest5); if (burst_max > 7) burst_max = 7; if (burst_max > np->maxburst) burst_max = np->maxburst; /* ** DEL 352 - 53C810 Rev x11 - Part Number 609-0392140 - ITEM 2. ** This chip and the 860 Rev 1 may wrongly use PCI cache line ** based transactions on LOAD/STORE instructions. So we have ** to prevent these chips from using such PCI transactions in ** this driver. The generic sym53c8xx driver that does not use ** LOAD/STORE instructions does not need this work-around. */ if ((np->device_id == PCI_DEVICE_ID_NCR_53C810 && np->revision_id >= 0x10 && np->revision_id <= 0x11) || (np->device_id == PCI_DEVICE_ID_NCR_53C860 && np->revision_id <= 0x1)) np->features &= ~(FE_WRIE|FE_ERL|FE_ERMP); /* ** DEL ? - 53C1010 Rev 1 - Part Number 609-0393638 ** 64-bit Slave Cycles must be disabled. */ if ( ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) && (np->revision_id < 0x02) ) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 ) ) np->rv_ccntl1 |= 0x10; /* ** Select all supported special features. ** If we are using on-board RAM for scripts, prefetch (PFEN) ** does not help, but burst op fetch (BOF) does. ** Disabling PFEN makes sure BOF will be used. */ if (np->features & FE_ERL) np->rv_dmode |= ERL; /* Enable Read Line */ if (np->features & FE_BOF) np->rv_dmode |= BOF; /* Burst Opcode Fetch */ if (np->features & FE_ERMP) np->rv_dmode |= ERMP; /* Enable Read Multiple */ #if 1 if ((np->features & FE_PFEN) && !np->base2_ba) #else if (np->features & FE_PFEN) #endif np->rv_dcntl |= PFEN; /* Prefetch Enable */ if (np->features & FE_CLSE) np->rv_dcntl |= CLSE; /* Cache Line Size Enable */ if (np->features & FE_WRIE) np->rv_ctest3 |= WRIE; /* Write and Invalidate */ if ( (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (np->features & FE_DFS)) np->rv_ctest5 |= DFS; /* Dma Fifo Size */ /* C1010/C1010_66 always large fifo */ /* ** Select some other */ if (driver_setup.master_parity) np->rv_ctest4 |= MPEE; /* Master parity checking */ if (driver_setup.scsi_parity) np->rv_scntl0 |= 0x0a; /* full arb., ena parity, par->ATN */ #ifdef SCSI_NCR_NVRAM_SUPPORT /* ** Get parity checking, host ID and verbose mode from NVRAM **/ if (nvram) { switch(nvram->type) { case SCSI_NCR_TEKRAM_NVRAM: np->myaddr = nvram->data.Tekram.host_id & 0x0f; break; case SCSI_NCR_SYMBIOS_NVRAM: if (!(nvram->data.Symbios.flags & SYMBIOS_PARITY_ENABLE)) np->rv_scntl0 &= ~0x0a; np->myaddr = nvram->data.Symbios.host_id & 0x0f; if (nvram->data.Symbios.flags & SYMBIOS_VERBOSE_MSGS) np->verbose += 1; break; } } #endif /* ** Get SCSI addr of host adapter (set by bios?). */ if (np->myaddr == 255) { np->myaddr = INB(nc_scid) & 0x07; if (!np->myaddr) np->myaddr = SCSI_NCR_MYADDR; } #endif /* SCSI_NCR_TRUST_BIOS_SETTING */ /* * Prepare initial io register bits for burst length */ ncr_init_burst(np, burst_max); /* ** Set SCSI BUS mode. ** ** - ULTRA2 chips (895/895A/896) ** and ULTRA 3 chips (1010) report the current ** BUS mode through the STEST4 IO register. ** - For previous generation chips (825/825A/875), ** user has to tell us how to check against HVD, ** since a 100% safe algorithm is not possible. */ np->scsi_mode = SMODE_SE; if (np->features & (FE_ULTRA2 | FE_ULTRA3)) np->scsi_mode = (np->sv_stest4 & SMODE); else if (np->features & FE_DIFF) { switch(driver_setup.diff_support) { case 4: /* Trust previous settings if present, then GPIO3 */ if (np->sv_scntl3) { if (np->sv_stest2 & 0x20) np->scsi_mode = SMODE_HVD; break; } case 3: /* SYMBIOS controllers report HVD through GPIO3 */ if (nvram && nvram->type != SCSI_NCR_SYMBIOS_NVRAM) break; if (INB(nc_gpreg) & 0x08) break; case 2: /* Set HVD unconditionally */ np->scsi_mode = SMODE_HVD; case 1: /* Trust previous settings for HVD */ if (np->sv_stest2 & 0x20) np->scsi_mode = SMODE_HVD; break; default:/* Don't care about HVD */ break; } } if (np->scsi_mode == SMODE_HVD) np->rv_stest2 |= 0x20; /* ** Set LED support from SCRIPTS. ** Ignore this feature for boards known to use a ** specific GPIO wiring and for the 895A or 896 ** that drive the LED directly. ** Also probe initial setting of GPIO0 as output. */ if ((driver_setup.led_pin || (nvram && nvram->type == SCSI_NCR_SYMBIOS_NVRAM)) && !(np->features & FE_LEDC) && !(np->sv_gpcntl & 0x01)) np->features |= FE_LED0; /* ** Set irq mode. */ switch(driver_setup.irqm & 3) { case 2: np->rv_dcntl |= IRQM; break; case 1: np->rv_dcntl |= (np->sv_dcntl & IRQM); break; default: break; } /* ** Configure targets according to driver setup. ** If NVRAM present get targets setup from NVRAM. ** Allow to override sync, wide and NOSCAN from ** boot command line. */ for (i = 0 ; i < MAX_TARGET ; i++) { tcb_p tp = &np->target[i]; tp->usrsync = 255; #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvram) { switch(nvram->type) { case SCSI_NCR_TEKRAM_NVRAM: ncr_Tekram_setup_target(np, i, &nvram->data.Tekram); break; case SCSI_NCR_SYMBIOS_NVRAM: ncr_Symbios_setup_target(np, i, &nvram->data.Symbios); break; } if (driver_setup.use_nvram & 0x2) tp->usrsync = driver_setup.default_sync; if (driver_setup.use_nvram & 0x4) tp->usrwide = driver_setup.max_wide; if (driver_setup.use_nvram & 0x8) tp->usrflag &= ~UF_NOSCAN; } else { #else if (1) { #endif tp->usrsync = driver_setup.default_sync; tp->usrwide = driver_setup.max_wide; tp->usrtags = MAX_TAGS; if (!driver_setup.disconnection) np->target[i].usrflag = UF_NODISC; } } /* ** Announce all that stuff to user. */ i = nvram ? nvram->type : 0; printk(KERN_INFO "%s: %sID %d, Fast-%d%s%s\n", ncr_name(np), i == SCSI_NCR_SYMBIOS_NVRAM ? "Symbios format NVRAM, " : (i == SCSI_NCR_TEKRAM_NVRAM ? "Tekram format NVRAM, " : ""), np->myaddr, np->minsync < 10 ? 80 : (np->minsync < 12 ? 40 : (np->minsync < 25 ? 20 : 10) ), (np->rv_scntl0 & 0xa) ? ", Parity Checking" : ", NO Parity", (np->rv_stest2 & 0x20) ? ", Differential" : ""); if (bootverbose > 1) { printk (KERN_INFO "%s: initial SCNTL3/DMODE/DCNTL/CTEST3/4/5 = " "(hex) %02x/%02x/%02x/%02x/%02x/%02x\n", ncr_name(np), np->sv_scntl3, np->sv_dmode, np->sv_dcntl, np->sv_ctest3, np->sv_ctest4, np->sv_ctest5); printk (KERN_INFO "%s: final SCNTL3/DMODE/DCNTL/CTEST3/4/5 = " "(hex) %02x/%02x/%02x/%02x/%02x/%02x\n", ncr_name(np), np->rv_scntl3, np->rv_dmode, np->rv_dcntl, np->rv_ctest3, np->rv_ctest4, np->rv_ctest5); } if (bootverbose && np->base2_ba) printk (KERN_INFO "%s: on-chip RAM at 0x%lx\n", ncr_name(np), np->base2_ba); return 0; } #ifdef SCSI_NCR_DEBUG_NVRAM void __init ncr_display_Symbios_nvram(ncb_p np, Symbios_nvram *nvram) { int i; /* display Symbios nvram host data */ printk(KERN_DEBUG "%s: HOST ID=%d%s%s%s%s%s\n", ncr_name(np), nvram->host_id & 0x0f, (nvram->flags & SYMBIOS_SCAM_ENABLE) ? " SCAM" :"", (nvram->flags & SYMBIOS_PARITY_ENABLE) ? " PARITY" :"", (nvram->flags & SYMBIOS_VERBOSE_MSGS) ? " VERBOSE" :"", (nvram->flags & SYMBIOS_CHS_MAPPING) ? " CHS_ALT" :"", (nvram->flags1 & SYMBIOS_SCAN_HI_LO) ? " HI_LO" :""); /* display Symbios nvram drive data */ for (i = 0 ; i < 15 ; i++) { struct Symbios_target *tn = &nvram->target[i]; printk(KERN_DEBUG "%s-%d:%s%s%s%s WIDTH=%d SYNC=%d TMO=%d\n", ncr_name(np), i, (tn->flags & SYMBIOS_DISCONNECT_ENABLE) ? " DISC" : "", (tn->flags & SYMBIOS_SCAN_AT_BOOT_TIME) ? " SCAN_BOOT" : "", (tn->flags & SYMBIOS_SCAN_LUNS) ? " SCAN_LUNS" : "", (tn->flags & SYMBIOS_QUEUE_TAGS_ENABLED)? " TCQ" : "", tn->bus_width, tn->sync_period / 4, tn->timeout); } } static u_char Tekram_boot_delay[7] __initdata = {3, 5, 10, 20, 30, 60, 120}; void __init ncr_display_Tekram_nvram(ncb_p np, Tekram_nvram *nvram) { int i, tags, boot_delay; char *rem; /* display Tekram nvram host data */ tags = 2 << nvram->max_tags_index; boot_delay = 0; if (nvram->boot_delay_index < 6) boot_delay = Tekram_boot_delay[nvram->boot_delay_index]; switch((nvram->flags & TEKRAM_REMOVABLE_FLAGS) >> 6) { default: case 0: rem = ""; break; case 1: rem = " REMOVABLE=boot device"; break; case 2: rem = " REMOVABLE=all"; break; } printk(KERN_DEBUG "%s: HOST ID=%d%s%s%s%s%s%s%s%s%s BOOT DELAY=%d tags=%d\n", ncr_name(np), nvram->host_id & 0x0f, (nvram->flags1 & SYMBIOS_SCAM_ENABLE) ? " SCAM" :"", (nvram->flags & TEKRAM_MORE_THAN_2_DRIVES) ? " >2DRIVES" :"", (nvram->flags & TEKRAM_DRIVES_SUP_1GB) ? " >1GB" :"", (nvram->flags & TEKRAM_RESET_ON_POWER_ON) ? " RESET" :"", (nvram->flags & TEKRAM_ACTIVE_NEGATION) ? " ACT_NEG" :"", (nvram->flags & TEKRAM_IMMEDIATE_SEEK) ? " IMM_SEEK" :"", (nvram->flags & TEKRAM_SCAN_LUNS) ? " SCAN_LUNS" :"", (nvram->flags1 & TEKRAM_F2_F6_ENABLED) ? " F2_F6" :"", rem, boot_delay, tags); /* display Tekram nvram drive data */ for (i = 0; i <= 15; i++) { int sync, j; struct Tekram_target *tn = &nvram->target[i]; j = tn->sync_index & 0xf; sync = Tekram_sync[j]; printk(KERN_DEBUG "%s-%d:%s%s%s%s%s%s PERIOD=%d\n", ncr_name(np), i, (tn->flags & TEKRAM_PARITY_CHECK) ? " PARITY" : "", (tn->flags & TEKRAM_SYNC_NEGO) ? " SYNC" : "", (tn->flags & TEKRAM_DISCONNECT_ENABLE) ? " DISC" : "", (tn->flags & TEKRAM_START_CMD) ? " START" : "", (tn->flags & TEKRAM_TAGGED_COMMANDS) ? " TCQ" : "", (tn->flags & TEKRAM_WIDE_NEGO) ? " WIDE" : "", sync); } } #endif /* SCSI_NCR_DEBUG_NVRAM */ /* ** Host attach and initialisations. ** ** Allocate host data and ncb structure. ** Request IO region and remap MMIO region. ** Do chip initialization. ** If all is OK, install interrupt handling and ** start the timer daemon. */ static int __init ncr_attach (Scsi_Host_Template *tpnt, int unit, ncr_device *device) { struct host_data *host_data; ncb_p np = 0; struct Scsi_Host *instance = 0; u_long flags = 0; ncr_nvram *nvram = device->nvram; int i; printk(KERN_INFO NAME53C "%s-%d: rev 0x%x on pci bus %d device %d function %d " #ifdef __sparc__ "irq %s\n", #else "irq %d\n", #endif device->chip.name, unit, device->chip.revision_id, device->slot.bus, (device->slot.device_fn & 0xf8) >> 3, device->slot.device_fn & 7, #ifdef __sparc__ __irq_itoa(device->slot.irq)); #else device->slot.irq); #endif /* ** Allocate host_data structure */ if (!(instance = scsi_register(tpnt, sizeof(*host_data)))) goto attach_error; host_data = (struct host_data *) instance->hostdata; /* ** Allocate the host control block. */ np = __m_calloc_dma(device->pdev, sizeof(struct ncb), "NCB"); if (!np) goto attach_error; NCR_INIT_LOCK_NCB(np); np->pdev = device->pdev; np->p_ncb = vtobus(np); host_data->ncb = np; /* ** Store input informations in the host data structure. */ strncpy(np->chip_name, device->chip.name, sizeof(np->chip_name) - 1); np->unit = unit; np->verbose = driver_setup.verbose; sprintf(np->inst_name, NAME53C "%s-%d", np->chip_name, np->unit); np->device_id = device->chip.device_id; np->revision_id = device->chip.revision_id; np->bus = device->slot.bus; np->device_fn = device->slot.device_fn; np->features = device->chip.features; np->clock_divn = device->chip.nr_divisor; np->maxoffs = device->chip.offset_max; np->maxburst = device->chip.burst_max; np->myaddr = device->host_id; /* ** Allocate the start queue. */ np->squeue = (ncrcmd *) m_calloc_dma(sizeof(ncrcmd)*(MAX_START*2), "SQUEUE"); if (!np->squeue) goto attach_error; np->p_squeue = vtobus(np->squeue); /* ** Allocate the done queue. */ np->dqueue = (ncrcmd *) m_calloc_dma(sizeof(ncrcmd)*(MAX_START*2), "DQUEUE"); if (!np->dqueue) goto attach_error; /* ** Allocate the target bus address array. */ np->targtbl = (u_int32 *) m_calloc_dma(256, "TARGTBL"); if (!np->targtbl) goto attach_error; /* ** Allocate SCRIPTS areas */ np->script0 = (struct script *) m_calloc_dma(sizeof(struct script), "SCRIPT"); if (!np->script0) goto attach_error; np->scripth0 = (struct scripth *) m_calloc_dma(sizeof(struct scripth), "SCRIPTH"); if (!np->scripth0) goto attach_error; /* ** Initialyze the CCB free queue and, ** allocate some CCB. We need at least ONE. */ xpt_que_init(&np->free_ccbq); xpt_que_init(&np->b0_ccbq); if (!ncr_alloc_ccb(np)) goto attach_error; /* ** Initialize timer structure ** */ init_timer(&np->timer); np->timer.data = (unsigned long) np; np->timer.function = sym53c8xx_timeout; /* ** Try to map the controller chip to ** virtual and physical memory. */ np->base_ba = device->slot.base; np->base_ws = (np->features & FE_IO256)? 256 : 128; np->base2_ba = (np->features & FE_RAM)? device->slot.base_2 : 0; #ifndef SCSI_NCR_IOMAPPED np->base_va = remap_pci_mem(device->slot.base_c, np->base_ws); if (!np->base_va) { printk(KERN_ERR "%s: can't map PCI MMIO region\n",ncr_name(np)); goto attach_error; } else if (bootverbose > 1) printk(KERN_INFO "%s: using memory mapped IO\n", ncr_name(np)); /* ** Make the controller's registers available. ** Now the INB INW INL OUTB OUTW OUTL macros ** can be used safely. */ np->reg = (struct ncr_reg *) np->base_va; #endif /* !defined SCSI_NCR_IOMAPPED */ /* ** If on-chip RAM is used, make sure SCRIPTS isn't too large. */ if (np->base2_ba && sizeof(struct script) > 4096) { printk(KERN_ERR "%s: script too large.\n", ncr_name(np)); goto attach_error; } /* ** Try to map the controller chip into iospace. */ if (device->slot.io_port) { request_region(device->slot.io_port, np->base_ws, NAME53C8XX); np->base_io = device->slot.io_port; } #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvram) { switch(nvram->type) { case SCSI_NCR_SYMBIOS_NVRAM: #ifdef SCSI_NCR_DEBUG_NVRAM ncr_display_Symbios_nvram(np, &nvram->data.Symbios); #endif break; case SCSI_NCR_TEKRAM_NVRAM: #ifdef SCSI_NCR_DEBUG_NVRAM ncr_display_Tekram_nvram(np, &nvram->data.Tekram); #endif break; default: nvram = 0; #ifdef SCSI_NCR_DEBUG_NVRAM printk(KERN_DEBUG "%s: NVRAM: None or invalid data.\n", ncr_name(np)); #endif } } #endif /* ** Save setting of some IO registers, so we will ** be able to probe specific implementations. */ ncr_save_initial_setting (np); /* ** Reset the chip now, since it has been reported ** that SCSI clock calibration may not work properly ** if the chip is currently active. */ ncr_chip_reset (np); /* ** Do chip dependent initialization. */ (void) ncr_prepare_setting(np, nvram); /* ** Check the PCI clock frequency if needed. ** ** Must be done after ncr_prepare_setting since it destroys ** STEST1 that is used to probe for the clock multiplier. ** ** The range is currently [22688 - 45375 Khz], given ** the values used by ncr_getclock(). ** This calibration of the frequecy measurement ** algorithm against the PCI clock frequency is only ** performed if the driver has had to measure the SCSI ** clock due to other heuristics not having been enough ** to deduce the SCSI clock frequency. ** ** When the chip has been initialized correctly by the ** SCSI BIOS, the driver deduces the presence of the ** clock multiplier and the value of the SCSI clock from ** initial values of IO registers, and therefore no ** clock measurement is performed. ** Normally the driver should never have to measure any ** clock, unless the controller may use a 80 MHz clock ** or has a clock multiplier and any of the following ** condition is met: ** ** - No SCSI BIOS is present. ** - SCSI BIOS did'nt enable the multiplier for some reason. ** - User has disabled the controller from the SCSI BIOS. ** - User booted the O/S from another O/S that did'nt enable ** the multiplier for some reason. ** ** As a result, the driver may only have to measure some ** frequency in very unusual situations. ** ** For this reality test against the PCI clock to really ** protect against flaws in the udelay() calibration or ** driver problem that affect the clock measurement ** algorithm, the actual PCI clock frequency must be 33 MHz. */ i = np->pciclock_max ? ncr_getpciclock(np) : 0; if (i && (i < np->pciclock_min || i > np->pciclock_max)) { printk(KERN_ERR "%s: PCI clock (%u KHz) is out of range " "[%u KHz - %u KHz].\n", ncr_name(np), i, np->pciclock_min, np->pciclock_max); goto attach_error; } /* ** Patch script to physical addresses */ ncr_script_fill (&script0, &scripth0); np->p_script = vtobus(np->script0); np->p_scripth = vtobus(np->scripth0); np->p_scripth0 = np->p_scripth; if (np->base2_ba) { np->p_script = np->base2_ba; if (np->features & FE_RAM8K) { np->base2_ws = 8192; np->p_scripth = np->p_script + 4096; #if BITS_PER_LONG > 32 np->scr_ram_seg = cpu_to_scr(np->base2_ba >> 32); #endif } else np->base2_ws = 4096; #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED np->base2_va = remap_pci_mem(device->slot.base_2_c, np->base2_ws); if (!np->base2_va) { printk(KERN_ERR "%s: can't map PCI MEMORY region\n", ncr_name(np)); goto attach_error; } #endif } ncr_script_copy_and_bind (np, (ncrcmd *) &script0, (ncrcmd *) np->script0, sizeof(struct script)); ncr_script_copy_and_bind (np, (ncrcmd *) &scripth0, (ncrcmd *) np->scripth0, sizeof(struct scripth)); /* ** Patch some variables in SCRIPTS */ np->scripth0->pm0_data_addr[0] = cpu_to_scr(NCB_SCRIPT_PHYS(np, pm0_data)); np->scripth0->pm1_data_addr[0] = cpu_to_scr(NCB_SCRIPT_PHYS(np, pm1_data)); /* ** Patch if not Ultra 3 - Do not write to scntl4 */ if (np->features & FE_ULTRA3) { np->script0->resel_scntl4[0] = cpu_to_scr(SCR_LOAD_REL (scntl4, 1)); np->script0->resel_scntl4[1] = cpu_to_scr(offsetof(struct tcb, uval)); } #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED np->scripth0->script0_ba[0] = cpu_to_scr(vtobus(np->script0)); np->scripth0->script0_ba64[0] = cpu_to_scr(vtobus(np->script0)); np->scripth0->scripth0_ba64[0] = cpu_to_scr(vtobus(np->scripth0)); np->scripth0->ram_seg64[0] = np->scr_ram_seg; #endif /* ** Prepare the idle and invalid task actions. */ np->idletask.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->idletask.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_idletask = NCB_PHYS(np, idletask); np->notask.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->notask.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_notask = NCB_PHYS(np, notask); np->bad_i_t_l.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->bad_i_t_l.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_bad_i_t_l = NCB_PHYS(np, bad_i_t_l); np->bad_i_t_l_q.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->bad_i_t_l_q.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np,bad_i_t_l_q)); np->p_bad_i_t_l_q = NCB_PHYS(np, bad_i_t_l_q); /* ** Allocate and prepare the bad lun table. */ np->badluntbl = m_calloc_dma(256, "BADLUNTBL"); if (!np->badluntbl) goto attach_error; assert (offsetof(struct lcb, resel_task) == 0); np->resel_badlun = cpu_to_scr(NCB_SCRIPTH_PHYS(np, resel_bad_lun)); for (i = 0 ; i < 64 ; i++) np->badluntbl[i] = cpu_to_scr(NCB_PHYS(np, resel_badlun)); /* ** Prepare the target bus address array. */ np->scripth0->targtbl[0] = cpu_to_scr(vtobus(np->targtbl)); for (i = 0 ; i < MAX_TARGET ; i++) { np->targtbl[i] = cpu_to_scr(NCB_PHYS(np, target[i])); np->target[i].b_luntbl = cpu_to_scr(vtobus(np->badluntbl)); np->target[i].b_lun0 = cpu_to_scr(NCB_PHYS(np, resel_badlun)); } /* ** Patch the script for LED support. */ if (np->features & FE_LED0) { np->script0->idle[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_OR, 0x01)); np->script0->reselected[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_AND, 0xfe)); np->script0->start[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_AND, 0xfe)); } /* ** Patch the script to provide an extra clock cycle on ** data out phase - 53C1010_66MHz part only. ** (Fixed in rev. 1 of the chip) */ if (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 && np->revision_id < 1){ np->script0->datao_phase[0] = cpu_to_scr(SCR_REG_REG(scntl4, SCR_OR, 0x0c)); } #ifdef SCSI_NCR_IARB_SUPPORT /* ** If user does not want to use IMMEDIATE ARBITRATION ** when we are reselected while attempting to arbitrate, ** patch the SCRIPTS accordingly with a SCRIPT NO_OP. */ if (!(driver_setup.iarb & 1)) np->script0->ungetjob[0] = cpu_to_scr(SCR_NO_OP); /* ** If user wants IARB to be set when we win arbitration ** and have other jobs, compute the max number of consecutive ** settings of IARB hint before we leave devices a chance to ** arbitrate for reselection. */ np->iarb_max = (driver_setup.iarb >> 4); #endif /* ** DEL 472 - 53C896 Rev 1 - Part Number 609-0393055 - ITEM 5. */ if (np->device_id == PCI_DEVICE_ID_NCR_53C896 && np->revision_id <= 0x1 && (np->features & FE_NOPM)) { np->scatter = ncr_scatter_896R1; np->script0->datai_phase[0] = cpu_to_scr(SCR_JUMP); np->script0->datai_phase[1] = cpu_to_scr(NCB_SCRIPTH_PHYS (np, tweak_pmj)); np->script0->datao_phase[0] = cpu_to_scr(SCR_JUMP); np->script0->datao_phase[1] = cpu_to_scr(NCB_SCRIPTH_PHYS (np, tweak_pmj)); } else #ifdef DEBUG_896R1 np->scatter = ncr_scatter_896R1; #else np->scatter = ncr_scatter; #endif /* ** Reset chip. ** We should use ncr_soft_reset(), but we donnot want to do ** so, since we may not be safe if ABRT interrupt occurs due ** to the BIOS or previous O/S having enable this interrupt. ** ** For C1010 need to set ABRT bit prior to SRST if SCRIPTs ** are running. Not true in this case. */ ncr_chip_reset(np); /* ** Now check the cache handling of the pci chipset. */ if (ncr_snooptest (np)) { printk (KERN_ERR "CACHE INCORRECTLY CONFIGURED.\n"); goto attach_error; }; /* ** Install the interrupt handler. ** If we synchonize the C code with SCRIPTS on interrupt, ** we donnot want to share the INTR line at all. */ if (request_irq(device->slot.irq, sym53c8xx_intr, #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR ((driver_setup.irqm & 0x20) ? 0 : SA_INTERRUPT), #else ((driver_setup.irqm & 0x10) ? 0 : SA_SHIRQ) | #if LINUX_VERSION_CODE < KERNEL_VERSION(2,2,0) ((driver_setup.irqm & 0x20) ? 0 : SA_INTERRUPT), #else 0, #endif #endif NAME53C8XX, np)) { printk(KERN_ERR "%s: request irq %d failure\n", ncr_name(np), device->slot.irq); goto attach_error; } np->irq = device->slot.irq; /* ** After SCSI devices have been opened, we cannot ** reset the bus safely, so we do it here. ** Interrupt handler does the real work. ** Process the reset exception, ** if interrupts are not enabled yet. ** Then enable disconnects. */ NCR_LOCK_NCB(np, flags); if (ncr_reset_scsi_bus(np, 0, driver_setup.settle_delay) != 0) { printk(KERN_ERR "%s: FATAL ERROR: CHECK SCSI BUS - CABLES, TERMINATION, DEVICE POWER etc.!\n", ncr_name(np)); NCR_UNLOCK_NCB(np, flags); goto attach_error; } ncr_exception (np); /* ** The middle-level SCSI driver does not ** wait for devices to settle. ** Wait synchronously if more than 2 seconds. */ if (driver_setup.settle_delay > 2) { printk(KERN_INFO "%s: waiting %d seconds for scsi devices to settle...\n", ncr_name(np), driver_setup.settle_delay); MDELAY (1000 * driver_setup.settle_delay); } /* ** start the timeout daemon */ np->lasttime=0; ncr_timeout (np); /* ** use SIMPLE TAG messages by default */ #ifdef SCSI_NCR_ALWAYS_SIMPLE_TAG np->order = M_SIMPLE_TAG; #endif /* ** Done. ** Fill Linux host instance structure ** and return success. */ instance->max_channel = 0; instance->this_id = np->myaddr; instance->max_id = np->maxwide ? 16 : 8; instance->max_lun = MAX_LUN; #ifndef SCSI_NCR_IOMAPPED #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,29) instance->base = (unsigned long) np->reg; #else instance->base = (char *) np->reg; #endif #endif instance->irq = np->irq; instance->unique_id = np->base_io; instance->io_port = np->base_io; instance->n_io_port = np->base_ws; instance->dma_channel = 0; instance->cmd_per_lun = MAX_TAGS; instance->can_queue = (MAX_START-4); scsi_set_device(instance, &device->pdev->dev); np->check_integrity = 0; #ifdef SCSI_NCR_INTEGRITY_CHECKING instance->check_integrity = 0; #ifdef SCSI_NCR_ENABLE_INTEGRITY_CHECK if ( !(driver_setup.bus_check & 0x04) ) { np->check_integrity = 1; instance->check_integrity = 1; } #endif #endif NCR_UNLOCK_NCB(np, flags); /* ** Now let the generic SCSI driver ** look for the SCSI devices on the bus .. */ return 0; attach_error: if (!instance) return -1; printk(KERN_INFO "%s: giving up ...\n", ncr_name(np)); if (np) ncr_free_resources(np); scsi_unregister(instance); return -1; } /* ** Free controller resources. */ static void ncr_free_resources(ncb_p np) { ccb_p cp; tcb_p tp; lcb_p lp; int target, lun; if (np->irq) free_irq(np->irq, np); if (np->base_io) release_region(np->base_io, np->base_ws); #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED if (np->base_va) unmap_pci_mem(np->base_va, np->base_ws); if (np->base2_va) unmap_pci_mem(np->base2_va, np->base2_ws); #endif if (np->scripth0) m_free_dma(np->scripth0, sizeof(struct scripth), "SCRIPTH"); if (np->script0) m_free_dma(np->script0, sizeof(struct script), "SCRIPT"); if (np->squeue) m_free_dma(np->squeue, sizeof(ncrcmd)*(MAX_START*2), "SQUEUE"); if (np->dqueue) m_free_dma(np->dqueue, sizeof(ncrcmd)*(MAX_START*2),"DQUEUE"); while ((cp = np->ccbc) != NULL) { np->ccbc = cp->link_ccb; m_free_dma(cp, sizeof(*cp), "CCB"); } if (np->badluntbl) m_free_dma(np->badluntbl, 256,"BADLUNTBL"); for (target = 0; target < MAX_TARGET ; target++) { tp = &np->target[target]; for (lun = 0 ; lun < MAX_LUN ; lun++) { lp = ncr_lp(np, tp, lun); if (!lp) continue; if (lp->tasktbl != &lp->tasktbl_0) m_free_dma(lp->tasktbl, MAX_TASKS*4, "TASKTBL"); if (lp->cb_tags) m_free(lp->cb_tags, MAX_TAGS, "CB_TAGS"); m_free_dma(lp, sizeof(*lp), "LCB"); } #if MAX_LUN > 1 if (tp->lmp) m_free(tp->lmp, MAX_LUN * sizeof(lcb_p), "LMP"); if (tp->luntbl) m_free_dma(tp->luntbl, 256, "LUNTBL"); #endif } if (np->targtbl) m_free_dma(np->targtbl, 256, "TARGTBL"); m_free_dma(np, sizeof(*np), "NCB"); } /*========================================================== ** ** ** Done SCSI commands list management. ** ** We donnot enter the scsi_done() callback immediately ** after a command has been seen as completed but we ** insert it into a list which is flushed outside any kind ** of driver critical section. ** This allows to do minimal stuff under interrupt and ** inside critical sections and to also avoid locking up ** on recursive calls to driver entry points under SMP. ** In fact, the only kernel point which is entered by the ** driver with a driver lock set is get_free_pages(GFP_ATOMIC...) ** that shall not reenter the driver under any circumstance. ** **========================================================== */ static inline void ncr_queue_done_cmd(ncb_p np, Scsi_Cmnd *cmd) { unmap_scsi_data(np, cmd); cmd->host_scribble = (char *) np->done_list; np->done_list = cmd; } static inline void ncr_flush_done_cmds(Scsi_Cmnd *lcmd) { Scsi_Cmnd *cmd; while (lcmd) { cmd = lcmd; lcmd = (Scsi_Cmnd *) cmd->host_scribble; cmd->scsi_done(cmd); } } /*========================================================== ** ** ** Prepare the next negotiation message for integrity check, ** if needed. ** ** Fill in the part of message buffer that contains the ** negotiation and the nego_status field of the CCB. ** Returns the size of the message in bytes. ** ** If tp->ppr_negotiation is 1 and a M_REJECT occurs, then ** we disable ppr_negotiation. If the first ppr_negotiation is ** successful, set this flag to 2. ** **========================================================== */ #ifdef SCSI_NCR_INTEGRITY_CHECKING static int ncr_ic_nego(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd, u_char *msgptr) { tcb_p tp = &np->target[cp->target]; int msglen = 0; int nego = 0; u_char new_width, new_offset, new_period; u_char no_increase; if (tp->ppr_negotiation == 1) /* PPR message successful */ tp->ppr_negotiation = 2; if (tp->inq_done) { if (!tp->ic_maximums_set) { tp->ic_maximums_set = 1; /* * Check against target, host and user limits */ if ( (tp->inq_byte7 & INQ7_WIDE16) && np->maxwide && tp->usrwide) tp->ic_max_width = 1; else tp->ic_max_width = 0; if ((tp->inq_byte7 & INQ7_SYNC) && tp->maxoffs) tp->ic_min_sync = (tp->minsync < np->minsync) ? np->minsync : tp->minsync; else tp->ic_min_sync = 255; tp->period = 1; tp->widedone = 1; /* * Enable PPR negotiation - only if Ultra3 support * is accessible. */ #if 0 if (tp->ic_max_width && (tp->ic_min_sync != 255 )) tp->ppr_negotiation = 1; #endif tp->ppr_negotiation = 0; if (np->features & FE_ULTRA3) { if (tp->ic_max_width && (tp->ic_min_sync == 0x09)) tp->ppr_negotiation = 1; } if (!tp->ppr_negotiation) cmd->ic_nego &= ~NS_PPR; } if (DEBUG_FLAGS & DEBUG_IC) { printk("%s: cmd->ic_nego %d, 1st byte 0x%2X\n", ncr_name(np), cmd->ic_nego, cmd->cmnd[0]); } /* Previous command recorded a parity or an initiator * detected error condition. Force bus to narrow for this * target. Clear flag. Negotation on request sense. * Note: kernel forces 2 bus resets :o( but clears itself out. * Minor bug? in scsi_obsolete.c (ugly) */ if (np->check_integ_par) { printk("%s: Parity Error. Target set to narrow.\n", ncr_name(np)); tp->ic_max_width = 0; tp->widedone = tp->period = 0; } /* Initializing: * If ic_nego == NS_PPR, we are in the initial test for * PPR messaging support. If driver flag is clear, then * either we don't support PPR nego (narrow or async device) * or this is the second TUR and we have had a M. REJECT * or unexpected disconnect on the first PPR negotiation. * Do not negotiate, reset nego flags (in case a reset has * occurred), clear ic_nego and return. * General case: Kernel will clear flag on a fallback. * Do only SDTR or WDTR in the future. */ if (!tp->ppr_negotiation && (cmd->ic_nego == NS_PPR )) { tp->ppr_negotiation = 0; cmd->ic_nego &= ~NS_PPR; tp->widedone = tp->period = 1; return msglen; } else if (( tp->ppr_negotiation && !(cmd->ic_nego & NS_PPR )) || (!tp->ppr_negotiation && (cmd->ic_nego & NS_PPR )) ) { tp->ppr_negotiation = 0; cmd->ic_nego &= ~NS_PPR; } /* * Always check the PPR nego. flag bit if ppr_negotiation * is set. If the ic_nego PPR bit is clear, * there must have been a fallback. Do only * WDTR / SDTR in the future. */ if ((tp->ppr_negotiation) && (!(cmd->ic_nego & NS_PPR))) tp->ppr_negotiation = 0; /* In case of a bus reset, ncr_negotiate will reset * the flags tp->widedone and tp->period to 0, forcing * a new negotiation. Do WDTR then SDTR. If PPR, do both. * Do NOT increase the period. It is possible for the Scsi_Cmnd * flags to be set to increase the period when a bus reset * occurs - we don't want to change anything. */ no_increase = 0; if (tp->ppr_negotiation && (!tp->widedone) && (!tp->period) ) { cmd->ic_nego = NS_PPR; tp->widedone = tp->period = 1; no_increase = 1; } else if (!tp->widedone) { cmd->ic_nego = NS_WIDE; tp->widedone = 1; no_increase = 1; } else if (!tp->period) { cmd->ic_nego = NS_SYNC; tp->period = 1; no_increase = 1; } new_width = cmd->ic_nego_width & tp->ic_max_width; switch (cmd->ic_nego_sync) { case 2: /* increase the period */ if (!no_increase) { if (tp->ic_min_sync <= 0x09) tp->ic_min_sync = 0x0A; else if (tp->ic_min_sync <= 0x0A) tp->ic_min_sync = 0x0C; else if (tp->ic_min_sync <= 0x0C) tp->ic_min_sync = 0x19; else if (tp->ic_min_sync <= 0x19) tp->ic_min_sync *= 2; else { tp->ic_min_sync = 255; cmd->ic_nego_sync = 0; tp->maxoffs = 0; } } new_period = tp->maxoffs?tp->ic_min_sync:0; new_offset = tp->maxoffs; break; case 1: /* nego. to maximum */ new_period = tp->maxoffs?tp->ic_min_sync:0; new_offset = tp->maxoffs; break; case 0: /* nego to async */ default: new_period = 0; new_offset = 0; break; }; nego = NS_NOCHANGE; if (tp->ppr_negotiation) { u_char options_byte = 0; /* ** Must make sure data is consistent. ** If period is 9 and sync, must be wide and DT bit set. ** else period must be larger. If the width is 0, ** reset bus to wide but increase the period to 0x0A. ** Note: The strange else clause is due to the integrity check. ** If fails at 0x09, wide, the I.C. code will redo at the same ** speed but a narrow bus. The driver must take care of slowing ** the bus speed down. ** ** The maximum offset in ST mode is 31, in DT mode 62 (1010/1010_66 only) */ if ( (new_period==0x09) && new_offset) { if (new_width) options_byte = 0x02; else { tp->ic_min_sync = 0x0A; new_period = 0x0A; cmd->ic_nego_width = 1; new_width = 1; } } if (!options_byte && new_offset > np->maxoffs_st) new_offset = np->maxoffs_st; nego = NS_PPR; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 6; msgptr[msglen++] = M_X_PPR_REQ; msgptr[msglen++] = new_period; msgptr[msglen++] = 0; msgptr[msglen++] = new_offset; msgptr[msglen++] = new_width; msgptr[msglen++] = options_byte; } else { switch (cmd->ic_nego & ~NS_PPR) { case NS_WIDE: /* ** WDTR negotiation on if device supports ** wide or if wide device forced narrow ** due to a parity error. */ cmd->ic_nego_width &= tp->ic_max_width; if (tp->ic_max_width | np->check_integ_par) { nego = NS_WIDE; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 2; msgptr[msglen++] = M_X_WIDE_REQ; msgptr[msglen++] = new_width; } break; case NS_SYNC: /* ** negotiate synchronous transfers ** Target must support sync transfers. ** Min. period = 0x0A, maximum offset of 31=0x1f. */ if (tp->inq_byte7 & INQ7_SYNC) { if (new_offset && (new_period < 0x0A)) { tp->ic_min_sync = 0x0A; new_period = 0x0A; } if (new_offset > np->maxoffs_st) new_offset = np->maxoffs_st; nego = NS_SYNC; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 3; msgptr[msglen++] = M_X_SYNC_REQ; msgptr[msglen++] = new_period; msgptr[msglen++] = new_offset; } else cmd->ic_nego_sync = 0; break; case NS_NOCHANGE: break; } } }; cp->nego_status = nego; np->check_integ_par = 0; if (nego) { tp->nego_cp = cp; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, nego == NS_WIDE ? "wide/narrow msgout": (nego == NS_SYNC ? "sync/async msgout" : "ppr msgout"), msgptr); }; }; return msglen; } #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /*========================================================== ** ** ** Prepare the next negotiation message if needed. ** ** Fill in the part of message buffer that contains the ** negotiation and the nego_status field of the CCB. ** Returns the size of the message in bytes. ** ** **========================================================== */ static int ncr_prepare_nego(ncb_p np, ccb_p cp, u_char *msgptr) { tcb_p tp = &np->target[cp->target]; int msglen = 0; int nego = 0; u_char width, offset, factor, last_byte; if (!np->check_integrity) { /* If integrity checking disabled, enable PPR messaging * if device supports wide, sync and ultra 3 */ if (tp->ppr_negotiation == 1) /* PPR message successful */ tp->ppr_negotiation = 2; if ((tp->inq_done) && (!tp->ic_maximums_set)) { tp->ic_maximums_set = 1; /* * Issue PPR only if board is capable * and set-up for Ultra3 transfers. */ tp->ppr_negotiation = 0; if ( (np->features & FE_ULTRA3) && (tp->usrwide) && (tp->maxoffs) && (tp->minsync == 0x09) ) tp->ppr_negotiation = 1; } } if (tp->inq_done) { /* * Get the current width, offset and period */ ncr_get_xfer_info( np, tp, &factor, &offset, &width); /* ** negotiate wide transfers ? */ if (!tp->widedone) { if (tp->inq_byte7 & INQ7_WIDE16) { if (tp->ppr_negotiation) nego = NS_PPR; else nego = NS_WIDE; width = tp->usrwide; #ifdef SCSI_NCR_INTEGRITY_CHECKING if (tp->ic_done) width &= tp->ic_max_width; #endif } else tp->widedone=1; }; /* ** negotiate synchronous transfers? */ if ((nego != NS_WIDE) && !tp->period) { if (tp->inq_byte7 & INQ7_SYNC) { if (tp->ppr_negotiation) nego = NS_PPR; else nego = NS_SYNC; /* Check for async flag */ if (tp->maxoffs == 0) { offset = 0; factor = 0; } else { offset = tp->maxoffs; factor = tp->minsync; #ifdef SCSI_NCR_INTEGRITY_CHECKING if ((tp->ic_done) && (factor < tp->ic_min_sync)) factor = tp->ic_min_sync; #endif } } else { offset = 0; factor = 0; tp->period =0xffff; PRINT_TARGET(np, cp->target); printk ("target did not report SYNC.\n"); }; }; }; switch (nego) { case NS_PPR: /* ** Must make sure data is consistent. ** If period is 9 and sync, must be wide and DT bit set ** else period must be larger. ** Maximum offset is 31=0x1f is ST mode, 62 if DT mode */ last_byte = 0; if ( (factor==9) && offset) { if (!width) { factor = 0x0A; } else last_byte = 0x02; } if (!last_byte && offset > np->maxoffs_st) offset = np->maxoffs_st; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 6; msgptr[msglen++] = M_X_PPR_REQ; msgptr[msglen++] = factor; msgptr[msglen++] = 0; msgptr[msglen++] = offset; msgptr[msglen++] = width; msgptr[msglen++] = last_byte; break; case NS_SYNC: /* ** Never negotiate faster than Ultra 2 (25ns periods) */ if (offset && (factor < 0x0A)) { factor = 0x0A; tp->minsync = 0x0A; } if (offset > np->maxoffs_st) offset = np->maxoffs_st; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 3; msgptr[msglen++] = M_X_SYNC_REQ; msgptr[msglen++] = factor; msgptr[msglen++] = offset; break; case NS_WIDE: msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 2; msgptr[msglen++] = M_X_WIDE_REQ; msgptr[msglen++] = width; break; }; cp->nego_status = nego; if (nego) { tp->nego_cp = cp; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, nego == NS_WIDE ? "wide msgout": (nego == NS_SYNC ? "sync msgout" : "ppr msgout"), msgptr); }; }; return msglen; } /*========================================================== ** ** ** Start execution of a SCSI command. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_queue_command (ncb_p np, Scsi_Cmnd *cmd) { /* Scsi_Device *device = cmd->device; */ tcb_p tp = &np->target[cmd->device->id]; lcb_p lp = ncr_lp(np, tp, cmd->device->lun); ccb_p cp; u_char idmsg, *msgptr; u_int msglen; int direction; u_int32 lastp, goalp; /*--------------------------------------------- ** ** Some shortcuts ... ** **--------------------------------------------- */ if ((cmd->device->id == np->myaddr ) || (cmd->device->id >= MAX_TARGET) || (cmd->device->lun >= MAX_LUN )) { return(DID_BAD_TARGET); } /*--------------------------------------------- ** ** Complete the 1st TEST UNIT READY command ** with error condition if the device is ** flagged NOSCAN, in order to speed up ** the boot. ** **--------------------------------------------- */ if ((cmd->cmnd[0] == 0 || cmd->cmnd[0] == 0x12) && (tp->usrflag & UF_NOSCAN)) { tp->usrflag &= ~UF_NOSCAN; return DID_BAD_TARGET; } if (DEBUG_FLAGS & DEBUG_TINY) { PRINT_ADDR(cmd); printk ("CMD=%x ", cmd->cmnd[0]); } /*--------------------------------------------------- ** ** Assign a ccb / bind cmd. ** If resetting, shorten settle_time if necessary ** in order to avoid spurious timeouts. ** If resetting or no free ccb, ** insert cmd into the waiting list. ** **---------------------------------------------------- */ if (np->settle_time && cmd->timeout_per_command >= HZ) { u_long tlimit = ktime_get(cmd->timeout_per_command - HZ); if (ktime_dif(np->settle_time, tlimit) > 0) np->settle_time = tlimit; } if (np->settle_time || !(cp=ncr_get_ccb (np, cmd->device->id, cmd->device->lun))) { insert_into_waiting_list(np, cmd); return(DID_OK); } cp->cmd = cmd; /*--------------------------------------------------- ** ** Enable tagged queue if asked by scsi ioctl ** **---------------------------------------------------- */ #if 0 /* This stuff was only useful for linux-1.2.13 */ if (lp && !lp->numtags && cmd->device && cmd->device->tagged_queue) { lp->numtags = tp->usrtags; ncr_setup_tags (np, cp->target, cp->lun); } #endif /*---------------------------------------------------- ** ** Build the identify / tag / sdtr message ** **---------------------------------------------------- */ idmsg = M_IDENTIFY | cp->lun; if (cp ->tag != NO_TAG || (lp && !(tp->usrflag & UF_NODISC))) idmsg |= 0x40; msgptr = cp->scsi_smsg; msglen = 0; msgptr[msglen++] = idmsg; if (cp->tag != NO_TAG) { char order = np->order; /* ** Force ordered tag if necessary to avoid timeouts ** and to preserve interactivity. */ if (lp && ktime_exp(lp->tags_stime)) { lp->tags_si = !(lp->tags_si); if (lp->tags_sum[lp->tags_si]) { order = M_ORDERED_TAG; if ((DEBUG_FLAGS & DEBUG_TAGS)||bootverbose>0){ PRINT_ADDR(cmd); printk("ordered tag forced.\n"); } } lp->tags_stime = ktime_get(3*HZ); } if (order == 0) { /* ** Ordered write ops, unordered read ops. */ switch (cmd->cmnd[0]) { case 0x08: /* READ_SMALL (6) */ case 0x28: /* READ_BIG (10) */ case 0xa8: /* READ_HUGE (12) */ order = M_SIMPLE_TAG; break; default: order = M_ORDERED_TAG; } } msgptr[msglen++] = order; /* ** For less than 128 tags, actual tags are numbered ** 1,3,5,..2*MAXTAGS+1,since we may have to deal ** with devices that have problems with #TAG 0 or too ** great #TAG numbers. For more tags (up to 256), ** we use directly our tag number. */ #if MAX_TASKS > (512/4) msgptr[msglen++] = cp->tag; #else msgptr[msglen++] = (cp->tag << 1) + 1; #endif } cp->host_flags = 0; /*---------------------------------------------------- ** ** Build the data descriptors ** **---------------------------------------------------- */ direction = scsi_data_direction(cmd); if (direction != SCSI_DATA_NONE) { cp->segments = np->scatter (np, cp, cp->cmd); if (cp->segments < 0) { ncr_free_ccb(np, cp); return(DID_ERROR); } } else { cp->data_len = 0; cp->segments = 0; } /*--------------------------------------------------- ** ** negotiation required? ** ** (nego_status is filled by ncr_prepare_nego()) ** **--------------------------------------------------- */ cp->nego_status = 0; #ifdef SCSI_NCR_INTEGRITY_CHECKING if ((np->check_integrity && tp->ic_done) || !np->check_integrity) { if ((!tp->widedone || !tp->period) && !tp->nego_cp && lp) { msglen += ncr_prepare_nego (np, cp, msgptr + msglen); } } else if (np->check_integrity && (cmd->ic_in_progress)) { msglen += ncr_ic_nego (np, cp, cmd, msgptr + msglen); } else if (np->check_integrity && cmd->ic_complete) { u_long current_period; u_char current_offset, current_width, current_factor; ncr_get_xfer_info (np, tp, ¤t_factor, ¤t_offset, ¤t_width); tp->ic_max_width = current_width; tp->ic_min_sync = current_factor; if (current_factor == 9) current_period = 125; else if (current_factor == 10) current_period = 250; else if (current_factor == 11) current_period = 303; else if (current_factor == 12) current_period = 500; else current_period = current_factor * 40; /* * Negotiation for this target is complete. Update flags. */ tp->period = current_period; tp->widedone = 1; tp->ic_done = 1; printk("%s: Integrity Check Complete: \n", ncr_name(np)); printk("%s: %s %s SCSI", ncr_name(np), current_offset?"SYNC":"ASYNC", tp->ic_max_width?"WIDE":"NARROW"); if (current_offset) { u_long mbs = 10000 * (tp->ic_max_width + 1); printk(" %d.%d MB/s", (int) (mbs / current_period), (int) (mbs % current_period)); printk(" (%d ns, %d offset)\n", (int) current_period/10, current_offset); } else printk(" %d MB/s. \n ", (tp->ic_max_width+1)*5); } #else if ((!tp->widedone || !tp->period) && !tp->nego_cp && lp) { msglen += ncr_prepare_nego (np, cp, msgptr + msglen); } #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /*---------------------------------------------------- ** ** Determine xfer direction. ** **---------------------------------------------------- */ if (!cp->data_len) direction = SCSI_DATA_NONE; /* ** If data direction is UNKNOWN, speculate DATA_READ ** but prepare alternate pointers for WRITE in case ** of our speculation will be just wrong. ** SCRIPTS will swap values if needed. */ switch(direction) { case SCSI_DATA_UNKNOWN: case SCSI_DATA_WRITE: goalp = NCB_SCRIPT_PHYS (np, data_out2) + 8; lastp = goalp - 8 - (cp->segments * (SCR_SG_SIZE*4)); if (direction != SCSI_DATA_UNKNOWN) break; cp->phys.header.wgoalp = cpu_to_scr(goalp); cp->phys.header.wlastp = cpu_to_scr(lastp); /* fall through */ case SCSI_DATA_READ: cp->host_flags |= HF_DATA_IN; goalp = NCB_SCRIPT_PHYS (np, data_in2) + 8; lastp = goalp - 8 - (cp->segments * (SCR_SG_SIZE*4)); break; default: case SCSI_DATA_NONE: lastp = goalp = NCB_SCRIPTH_PHYS (np, no_data); break; } /* ** Set all pointers values needed by SCRIPTS. ** If direction is unknown, start at data_io. */ cp->phys.header.lastp = cpu_to_scr(lastp); cp->phys.header.goalp = cpu_to_scr(goalp); if (direction == SCSI_DATA_UNKNOWN) cp->phys.header.savep = cpu_to_scr(NCB_SCRIPTH_PHYS (np, data_io)); else cp->phys.header.savep= cpu_to_scr(lastp); /* ** Save the initial data pointer in order to be able ** to redo the command. ** We also have to save the initial lastp, since it ** will be changed to DATA_IO if we don't know the data ** direction and the device completes the command with ** QUEUE FULL status (without entering the data phase). */ cp->startp = cp->phys.header.savep; cp->lastp0 = cp->phys.header.lastp; /*---------------------------------------------------- ** ** fill in ccb ** **---------------------------------------------------- ** ** ** physical -> virtual backlink ** Generic SCSI command */ /* ** Startqueue */ cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np,select)); cp->phys.header.go.restart = cpu_to_scr(NCB_SCRIPT_PHYS (np,resel_dsa)); /* ** select */ cp->phys.select.sel_id = cp->target; cp->phys.select.sel_scntl3 = tp->wval; cp->phys.select.sel_sxfer = tp->sval; cp->phys.select.sel_scntl4 = tp->uval; /* ** message */ cp->phys.smsg.addr = cpu_to_scr(CCB_PHYS (cp, scsi_smsg)); cp->phys.smsg.size = cpu_to_scr(msglen); /* ** command */ memcpy(cp->cdb_buf, cmd->cmnd, MIN(cmd->cmd_len, sizeof(cp->cdb_buf))); cp->phys.cmd.addr = cpu_to_scr(CCB_PHYS (cp, cdb_buf[0])); cp->phys.cmd.size = cpu_to_scr(cmd->cmd_len); /* ** status */ cp->actualquirks = tp->quirks; cp->host_status = cp->nego_status ? HS_NEGOTIATE : HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->xerr_status = 0; cp->extra_bytes = 0; /* ** extreme data pointer. ** shall be positive, so -1 is lower than lowest.:) */ cp->ext_sg = -1; cp->ext_ofs = 0; /*---------------------------------------------------- ** ** Critical region: start this job. ** **---------------------------------------------------- */ /* ** activate this job. */ /* ** insert next CCBs into start queue. ** 2 max at a time is enough to flush the CCB wait queue. */ if (lp) ncr_start_next_ccb(np, lp, 2); else ncr_put_start_queue(np, cp); /* ** Command is successfully queued. */ return(DID_OK); } /*========================================================== ** ** ** Insert a CCB into the start queue and wake up the ** SCRIPTS processor. ** ** **========================================================== */ static void ncr_start_next_ccb(ncb_p np, lcb_p lp, int maxn) { XPT_QUEHEAD *qp; ccb_p cp; while (maxn-- && lp->queuedccbs < lp->queuedepth) { qp = xpt_remque_head(&lp->wait_ccbq); if (!qp) break; ++lp->queuedccbs; cp = xpt_que_entry(qp, struct ccb, link_ccbq); xpt_insque_tail(qp, &lp->busy_ccbq); lp->tasktbl[cp->tag == NO_TAG ? 0 : cp->tag] = cpu_to_scr(cp->p_ccb); ncr_put_start_queue(np, cp); } } static void ncr_put_start_queue(ncb_p np, ccb_p cp) { u_short qidx; #ifdef SCSI_NCR_IARB_SUPPORT /* ** If the previously queued CCB is not yet done, ** set the IARB hint. The SCRIPTS will go with IARB ** for this job when starting the previous one. ** We leave devices a chance to win arbitration by ** not using more than 'iarb_max' consecutive ** immediate arbitrations. */ if (np->last_cp && np->iarb_count < np->iarb_max) { np->last_cp->host_flags |= HF_HINT_IARB; ++np->iarb_count; } else np->iarb_count = 0; np->last_cp = cp; #endif /* ** insert into start queue. */ qidx = np->squeueput + 2; if (qidx >= MAX_START*2) qidx = 0; np->squeue [qidx] = cpu_to_scr(np->p_idletask); MEMORY_BARRIER(); np->squeue [np->squeueput] = cpu_to_scr(cp->p_ccb); np->squeueput = qidx; cp->queued = 1; if (DEBUG_FLAGS & DEBUG_QUEUE) printk ("%s: queuepos=%d.\n", ncr_name (np), np->squeueput); /* ** Script processor may be waiting for reselect. ** Wake it up. */ MEMORY_BARRIER(); OUTB (nc_istat, SIGP|np->istat_sem); } /*========================================================== ** ** Soft reset the chip. ** ** Some 896 and 876 chip revisions may hang-up if we set ** the SRST (soft reset) bit at the wrong time when SCRIPTS ** are running. ** So, we need to abort the current operation prior to ** soft resetting the chip. ** **========================================================== */ static void ncr_chip_reset (ncb_p np) { OUTB (nc_istat, SRST); UDELAY (10); OUTB (nc_istat, 0); } static void ncr_soft_reset(ncb_p np) { u_char istat; int i; if (!(np->features & FE_ISTAT1) || !(INB (nc_istat1) & SRUN)) goto do_chip_reset; OUTB (nc_istat, CABRT); for (i = 100000 ; i ; --i) { istat = INB (nc_istat); if (istat & SIP) { INW (nc_sist); } else if (istat & DIP) { if (INB (nc_dstat) & ABRT) break; } UDELAY(5); } OUTB (nc_istat, 0); if (!i) printk("%s: unable to abort current chip operation, " "ISTAT=0x%02x.\n", ncr_name(np), istat); do_chip_reset: ncr_chip_reset(np); } /*========================================================== ** ** ** Start reset process. ** The interrupt handler will reinitialize the chip. ** The timeout handler will wait for settle_time before ** clearing it and so resuming command processing. ** ** **========================================================== */ static void ncr_start_reset(ncb_p np) { (void) ncr_reset_scsi_bus(np, 1, driver_setup.settle_delay); } static int ncr_reset_scsi_bus(ncb_p np, int enab_int, int settle_delay) { u_int32 term; int retv = 0; np->settle_time = ktime_get(settle_delay * HZ); if (bootverbose > 1) printk("%s: resetting, " "command processing suspended for %d seconds\n", ncr_name(np), settle_delay); ncr_soft_reset(np); /* Soft reset the chip */ UDELAY (2000); /* The 895/6 need time for the bus mode to settle */ if (enab_int) OUTW (nc_sien, RST); /* ** Enable Tolerant, reset IRQD if present and ** properly set IRQ mode, prior to resetting the bus. */ OUTB (nc_stest3, TE); OUTB (nc_dcntl, (np->rv_dcntl & IRQM)); OUTB (nc_scntl1, CRST); UDELAY (200); if (!driver_setup.bus_check) goto out; /* ** Check for no terminators or SCSI bus shorts to ground. ** Read SCSI data bus, data parity bits and control signals. ** We are expecting RESET to be TRUE and other signals to be ** FALSE. */ term = INB(nc_sstat0); term = ((term & 2) << 7) + ((term & 1) << 17); /* rst sdp0 */ term |= ((INB(nc_sstat2) & 0x01) << 26) | /* sdp1 */ ((INW(nc_sbdl) & 0xff) << 9) | /* d7-0 */ ((INW(nc_sbdl) & 0xff00) << 10) | /* d15-8 */ INB(nc_sbcl); /* req ack bsy sel atn msg cd io */ if (!(np->features & FE_WIDE)) term &= 0x3ffff; if (term != (2<<7)) { printk("%s: suspicious SCSI data while resetting the BUS.\n", ncr_name(np)); printk("%s: %sdp0,d7-0,rst,req,ack,bsy,sel,atn,msg,c/d,i/o = " "0x%lx, expecting 0x%lx\n", ncr_name(np), (np->features & FE_WIDE) ? "dp1,d15-8," : "", (u_long)term, (u_long)(2<<7)); if (driver_setup.bus_check == 1) retv = 1; } out: OUTB (nc_scntl1, 0); return retv; } /*========================================================== ** ** ** Reset the SCSI BUS. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_reset_bus (ncb_p np, Scsi_Cmnd *cmd, int sync_reset) { /* Scsi_Device *device = cmd->device; */ ccb_p cp; int found; /* * Return immediately if reset is in progress. */ if (np->settle_time) { return SCSI_RESET_PUNT; } /* * Start the reset process. * The script processor is then assumed to be stopped. * Commands will now be queued in the waiting list until a settle * delay of 2 seconds will be completed. */ ncr_start_reset(np); /* * First, look in the wakeup list */ for (found=0, cp=np->ccbc; cp; cp=cp->link_ccb) { /* ** look for the ccb of this command. */ if (cp->host_status == HS_IDLE) continue; if (cp->cmd == cmd) { found = 1; break; } } /* * Then, look in the waiting list */ if (!found && retrieve_from_waiting_list(0, np, cmd)) found = 1; /* * Wake-up all awaiting commands with DID_RESET. */ reset_waiting_list(np); /* * Wake-up all pending commands with HS_RESET -> DID_RESET. */ ncr_wakeup(np, HS_RESET); /* * If the involved command was not in a driver queue, and the * scsi driver told us reset is synchronous, and the command is not * currently in the waiting list, complete it with DID_RESET status, * in order to keep it alive. */ if (!found && sync_reset && !retrieve_from_waiting_list(0, np, cmd)) { SetScsiResult(cmd, DID_RESET, 0); ncr_queue_done_cmd(np, cmd); } return SCSI_RESET_SUCCESS; } /*========================================================== ** ** ** Abort an SCSI command. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_abort_command (ncb_p np, Scsi_Cmnd *cmd) { /* Scsi_Device *device = cmd->device; */ ccb_p cp; /* * First, look for the scsi command in the waiting list */ if (remove_from_waiting_list(np, cmd)) { SetScsiAbortResult(cmd); ncr_queue_done_cmd(np, cmd); return SCSI_ABORT_SUCCESS; } /* * Then, look in the wakeup list */ for (cp=np->ccbc; cp; cp=cp->link_ccb) { /* ** look for the ccb of this command. */ if (cp->host_status == HS_IDLE) continue; if (cp->cmd == cmd) break; } if (!cp) { return SCSI_ABORT_NOT_RUNNING; } /* ** Keep track we have to abort this job. */ cp->to_abort = 1; /* ** Tell the SCRIPTS processor to stop ** and synchronize with us. */ np->istat_sem = SEM; /* ** If there are no requests, the script ** processor will sleep on SEL_WAIT_RESEL. ** Let's wake it up, since it may have to work. */ OUTB (nc_istat, SIGP|SEM); /* ** Tell user we are working for him. */ return SCSI_ABORT_PENDING; } /*========================================================== ** ** Linux release module stuff. ** ** Called before unloading the module ** Detach the host. ** We have to free resources and halt the NCR chip ** **========================================================== */ static int ncr_detach(ncb_p np) { int i; printk("%s: detaching ...\n", ncr_name(np)); /* ** Stop the ncr_timeout process ** Set release_stage to 1 and wait that ncr_timeout() set it to 2. */ np->release_stage = 1; for (i = 50 ; i && np->release_stage != 2 ; i--) MDELAY (100); if (np->release_stage != 2) printk("%s: the timer seems to be already stopped\n", ncr_name(np)); else np->release_stage = 2; /* ** Reset NCR chip. ** We should use ncr_soft_reset(), but we donnot want to do ** so, since we may not be safe if interrupts occur. */ printk("%s: resetting chip\n", ncr_name(np)); ncr_chip_reset(np); /* ** Restore bios setting for automatic clock detection. */ OUTB(nc_dmode, np->sv_dmode); OUTB(nc_dcntl, np->sv_dcntl); OUTB(nc_ctest3, np->sv_ctest3); OUTB(nc_ctest4, np->sv_ctest4); OUTB(nc_ctest5, np->sv_ctest5); OUTB(nc_gpcntl, np->sv_gpcntl); OUTB(nc_stest2, np->sv_stest2); ncr_selectclock(np, np->sv_scntl3); /* ** Free host resources */ ncr_free_resources(np); return 1; } /*========================================================== ** ** ** Complete execution of a SCSI command. ** Signal completion to the generic SCSI driver. ** ** **========================================================== */ void ncr_complete (ncb_p np, ccb_p cp) { Scsi_Cmnd *cmd; tcb_p tp; lcb_p lp; /* ** Sanity check */ if (!cp || !cp->cmd) return; /* ** Print some debugging info. */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("CCB=%lx STAT=%x/%x\n", (unsigned long)cp, cp->host_status,cp->scsi_status); /* ** Get command, target and lun pointers. */ cmd = cp->cmd; cp->cmd = NULL; tp = &np->target[cp->target]; lp = ncr_lp(np, tp, cp->lun); /* ** We donnot queue more than 1 ccb per target ** with negotiation at any time. If this ccb was ** used for negotiation, clear this info in the tcb. */ if (cp == tp->nego_cp) tp->nego_cp = 0; #ifdef SCSI_NCR_IARB_SUPPORT /* ** We just complete the last queued CCB. ** Clear this info that is no more relevant. */ if (cp == np->last_cp) np->last_cp = 0; #endif /* ** If auto-sense performed, change scsi status, ** Otherwise, compute the residual. */ if (cp->host_flags & HF_AUTO_SENSE) { cp->scsi_status = cp->sv_scsi_status; cp->xerr_status = cp->sv_xerr_status; } else { cp->resid = 0; if (cp->xerr_status || cp->phys.header.lastp != cp->phys.header.goalp) cp->resid = ncr_compute_residual(np, cp); } /* ** Check for extended errors. */ if (cp->xerr_status) { if (cp->xerr_status & XE_PARITY_ERR) { PRINT_ADDR(cmd); printk ("unrecovered SCSI parity error.\n"); } if (cp->xerr_status & XE_EXTRA_DATA) { PRINT_ADDR(cmd); printk ("extraneous data discarded.\n"); } if (cp->xerr_status & XE_BAD_PHASE) { PRINT_ADDR(cmd); printk ("illegal scsi phase (4/5).\n"); } if (cp->xerr_status & XE_SODL_UNRUN) { PRINT_ADDR(cmd); printk ("ODD transfer in DATA OUT phase.\n"); } if (cp->xerr_status & XE_SWIDE_OVRUN){ PRINT_ADDR(cmd); printk ("ODD transfer in DATA IN phase.\n"); } if (cp->host_status==HS_COMPLETE) cp->host_status = HS_FAIL; } /* ** Print out any error for debugging purpose. */ if (DEBUG_FLAGS & (DEBUG_RESULT|DEBUG_TINY)) { if (cp->host_status!=HS_COMPLETE || cp->scsi_status!=S_GOOD || cp->resid) { PRINT_ADDR(cmd); printk ("ERROR: cmd=%x host_status=%x scsi_status=%x " "data_len=%d residual=%d\n", cmd->cmnd[0], cp->host_status, cp->scsi_status, cp->data_len, cp->resid); } } #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,99) /* ** Move residual byte count to user structure. */ cmd->resid = cp->resid; #endif /* ** Check the status. */ if ( (cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_GOOD || cp->scsi_status == S_COND_MET)) { /* ** All went well (GOOD status). ** CONDITION MET status is returned on ** `Pre-Fetch' or `Search data' success. */ SetScsiResult(cmd, DID_OK, cp->scsi_status); /* ** Allocate the lcb if not yet. */ if (!lp) ncr_alloc_lcb (np, cp->target, cp->lun); /* ** On standard INQUIRY response (EVPD and CmDt ** not set), setup logical unit according to ** announced capabilities (we need the 1rst 8 bytes). */ if (cmd->cmnd[0] == 0x12 && !(cmd->cmnd[1] & 0x3) && cmd->request_bufflen - cp->resid > 7 && !cmd->use_sg) { sync_scsi_data(np, cmd); /* SYNC the data */ ncr_setup_lcb (np, cp->target, cp->lun, (char *) cmd->request_buffer); } /* ** If tags was reduced due to queue full, ** increase tags if 1000 good status received. */ if (lp && lp->usetags && lp->numtags < lp->maxtags) { ++lp->num_good; if (lp->num_good >= 1000) { lp->num_good = 0; ++lp->numtags; ncr_setup_tags (np, cp->target, cp->lun); } } } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_CHECK_COND)) { /* ** Check condition code */ SetScsiResult(cmd, DID_OK, S_CHECK_COND); if (DEBUG_FLAGS & (DEBUG_RESULT|DEBUG_TINY)) { PRINT_ADDR(cmd); ncr_printl_hex("sense data:", cmd->sense_buffer, 14); } } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_CONFLICT)) { /* ** Reservation Conflict condition code */ SetScsiResult(cmd, DID_OK, S_CONFLICT); } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_BUSY || cp->scsi_status == S_QUEUE_FULL)) { /* ** Target is busy. */ SetScsiResult(cmd, DID_OK, cp->scsi_status); } else if ((cp->host_status == HS_SEL_TIMEOUT) || (cp->host_status == HS_TIMEOUT)) { /* ** No response */ SetScsiResult(cmd, DID_TIME_OUT, cp->scsi_status); } else if (cp->host_status == HS_RESET) { /* ** SCSI bus reset */ SetScsiResult(cmd, DID_RESET, cp->scsi_status); } else if (cp->host_status == HS_ABORTED) { /* ** Transfer aborted */ SetScsiAbortResult(cmd); } else { int did_status; /* ** Other protocol messes */ PRINT_ADDR(cmd); printk ("COMMAND FAILED (%x %x) @%p.\n", cp->host_status, cp->scsi_status, cp); did_status = DID_ERROR; if (cp->xerr_status & XE_PARITY_ERR) did_status = DID_PARITY; SetScsiResult(cmd, did_status, cp->scsi_status); } /* ** trace output */ if (tp->usrflag & UF_TRACE) { PRINT_ADDR(cmd); printk (" CMD:"); ncr_print_hex(cmd->cmnd, cmd->cmd_len); if (cp->host_status==HS_COMPLETE) { switch (cp->scsi_status) { case S_GOOD: printk (" GOOD"); break; case S_CHECK_COND: printk (" SENSE:"); ncr_print_hex(cmd->sense_buffer, 14); break; default: printk (" STAT: %x\n", cp->scsi_status); break; } } else printk (" HOSTERROR: %x", cp->host_status); printk ("\n"); } /* ** Free this ccb */ ncr_free_ccb (np, cp); /* ** requeue awaiting scsi commands for this lun. */ if (lp && lp->queuedccbs < lp->queuedepth && !xpt_que_empty(&lp->wait_ccbq)) ncr_start_next_ccb(np, lp, 2); /* ** requeue awaiting scsi commands for this controller. */ if (np->waiting_list) requeue_waiting_list(np); /* ** signal completion to generic driver. */ ncr_queue_done_cmd(np, cmd); } /*========================================================== ** ** ** Signal all (or one) control block done. ** ** **========================================================== */ /* ** The NCR has completed CCBs. ** Look at the DONE QUEUE. ** ** On architectures that may reorder LOAD/STORE operations, ** a memory barrier may be needed after the reading of the ** so-called `flag' and prior to dealing with the data. */ int ncr_wakeup_done (ncb_p np) { ccb_p cp; int i, n; u_long dsa; n = 0; i = np->dqueueget; while (1) { dsa = scr_to_cpu(np->dqueue[i]); if (!dsa) break; np->dqueue[i] = 0; if ((i = i+2) >= MAX_START*2) i = 0; cp = ncr_ccb_from_dsa(np, dsa); if (cp) { MEMORY_BARRIER(); ncr_complete (np, cp); ++n; } else printk (KERN_ERR "%s: bad DSA (%lx) in done queue.\n", ncr_name(np), dsa); } np->dqueueget = i; return n; } /* ** Complete all active CCBs. */ void ncr_wakeup (ncb_p np, u_long code) { ccb_p cp = np->ccbc; while (cp) { if (cp->host_status != HS_IDLE) { cp->host_status = code; ncr_complete (np, cp); } cp = cp->link_ccb; } } /*========================================================== ** ** ** Start NCR chip. ** ** **========================================================== */ void ncr_init (ncb_p np, int reset, char * msg, u_long code) { int i; u_long phys; /* ** Reset chip if asked, otherwise just clear fifos. */ if (reset) ncr_soft_reset(np); else { OUTB (nc_stest3, TE|CSF); OUTONB (nc_ctest3, CLF); } /* ** Message. */ if (msg) printk (KERN_INFO "%s: restart (%s).\n", ncr_name (np), msg); /* ** Clear Start Queue */ phys = np->p_squeue; np->queuedepth = MAX_START - 1; /* 1 entry needed as end marker */ for (i = 0; i < MAX_START*2; i += 2) { np->squeue[i] = cpu_to_scr(np->p_idletask); np->squeue[i+1] = cpu_to_scr(phys + (i+2)*4); } np->squeue[MAX_START*2-1] = cpu_to_scr(phys); /* ** Start at first entry. */ np->squeueput = 0; np->scripth0->startpos[0] = cpu_to_scr(phys); /* ** Clear Done Queue */ phys = vtobus(np->dqueue); for (i = 0; i < MAX_START*2; i += 2) { np->dqueue[i] = 0; np->dqueue[i+1] = cpu_to_scr(phys + (i+2)*4); } np->dqueue[MAX_START*2-1] = cpu_to_scr(phys); /* ** Start at first entry. */ np->scripth0->done_pos[0] = cpu_to_scr(phys); np->dqueueget = 0; /* ** Wakeup all pending jobs. */ ncr_wakeup (np, code); /* ** Init chip. */ OUTB (nc_istat, 0x00 ); /* Remove Reset, abort */ UDELAY (2000); /* The 895 needs time for the bus mode to settle */ OUTB (nc_scntl0, np->rv_scntl0 | 0xc0); /* full arb., ena parity, par->ATN */ OUTB (nc_scntl1, 0x00); /* odd parity, and remove CRST!! */ ncr_selectclock(np, np->rv_scntl3); /* Select SCSI clock */ OUTB (nc_scid , RRE|np->myaddr); /* Adapter SCSI address */ OUTW (nc_respid, 1ul<myaddr); /* Id to respond to */ OUTB (nc_istat , SIGP ); /* Signal Process */ OUTB (nc_dmode , np->rv_dmode); /* Burst length, dma mode */ OUTB (nc_ctest5, np->rv_ctest5); /* Large fifo + large burst */ OUTB (nc_dcntl , NOCOM|np->rv_dcntl); /* Protect SFBR */ OUTB (nc_ctest3, np->rv_ctest3); /* Write and invalidate */ OUTB (nc_ctest4, np->rv_ctest4); /* Master parity checking */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)){ OUTB (nc_stest2, EXT|np->rv_stest2); /* Extended Sreq/Sack filtering, not supported in C1010/C1010_66 */ } OUTB (nc_stest3, TE); /* TolerANT enable */ OUTB (nc_stime0, 0x0c); /* HTH disabled STO 0.25 sec */ /* ** DEL 441 - 53C876 Rev 5 - Part Number 609-0392787/2788 - ITEM 2. ** Disable overlapped arbitration for all dual-function ** devices, regardless revision id. ** We may consider it is a post-chip-design feature. ;-) ** ** Errata applies to all 896 and 1010 parts. */ if (np->device_id == PCI_DEVICE_ID_NCR_53C875) OUTB (nc_ctest0, (1<<5)); else if (np->device_id == PCI_DEVICE_ID_NCR_53C896 || np->device_id == PCI_DEVICE_ID_LSI_53C1010 || np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 ) np->rv_ccntl0 |= DPR; /* ** C1010_66MHz rev 0 part requies AIPCNTL1 bit 3 to be set. */ if (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66) OUTB(nc_aipcntl1, (1<<3)); /* ** Write CCNTL0/CCNTL1 for chips capable of 64 bit addressing ** and/or hardware phase mismatch, since only such chips ** seem to support those IO registers. */ if (np->features & (FE_DAC | FE_NOPM)) { OUTB (nc_ccntl0, np->rv_ccntl0); OUTB (nc_ccntl1, np->rv_ccntl1); } /* ** If phase mismatch handled by scripts (53C895A or 53C896 ** or 53C1010 or 53C1010_66), set PM jump addresses. */ if (np->features & FE_NOPM) { printk(KERN_INFO "%s: handling phase mismatch from SCRIPTS.\n", ncr_name(np)); OUTL (nc_pmjad1, NCB_SCRIPTH_PHYS (np, pm_handle)); OUTL (nc_pmjad2, NCB_SCRIPTH_PHYS (np, pm_handle)); } /* ** Enable GPIO0 pin for writing if LED support from SCRIPTS. ** Also set GPIO5 and clear GPIO6 if hardware LED control. */ if (np->features & FE_LED0) OUTB(nc_gpcntl, INB(nc_gpcntl) & ~0x01); else if (np->features & FE_LEDC) OUTB(nc_gpcntl, (INB(nc_gpcntl) & ~0x41) | 0x20); /* ** enable ints */ OUTW (nc_sien , STO|HTH|MA|SGE|UDC|RST|PAR); OUTB (nc_dien , MDPE|BF|SSI|SIR|IID); /* ** For 895/895A/896/c1010 ** Enable SBMC interrupt and save current SCSI bus mode. */ if ( (np->features & FE_ULTRA2) || (np->features & FE_ULTRA3) ) { OUTONW (nc_sien, SBMC); np->scsi_mode = INB (nc_stest4) & SMODE; } /* ** Fill in target structure. ** Reinitialize usrsync. ** Reinitialize usrwide. ** Prepare sync negotiation according to actual SCSI bus mode. */ for (i=0;itarget[i]; tp->to_reset = 0; tp->sval = 0; tp->wval = np->rv_scntl3; tp->uval = np->rv_scntl4; if (tp->usrsync != 255) { if (tp->usrsync <= np->maxsync) { if (tp->usrsync < np->minsync) { tp->usrsync = np->minsync; } } else tp->usrsync = 255; }; if (tp->usrwide > np->maxwide) tp->usrwide = np->maxwide; ncr_negotiate (np, tp); } /* ** Download SCSI SCRIPTS to on-chip RAM if present, ** and start script processor. ** We do the download preferently from the CPU. ** For platforms that may not support PCI memory mapping, ** we use a simple SCRIPTS that performs MEMORY MOVEs. */ if (np->base2_ba) { if (bootverbose) printk ("%s: Downloading SCSI SCRIPTS.\n", ncr_name(np)); #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED if (np->base2_ws == 8192) phys = NCB_SCRIPTH0_PHYS (np, start_ram64); else phys = NCB_SCRIPTH_PHYS (np, start_ram); #else if (np->base2_ws == 8192) { memcpy_to_pci(np->base2_va + 4096, np->scripth0, sizeof(struct scripth)); OUTL (nc_mmws, np->scr_ram_seg); OUTL (nc_mmrs, np->scr_ram_seg); OUTL (nc_sfs, np->scr_ram_seg); phys = NCB_SCRIPTH_PHYS (np, start64); } else phys = NCB_SCRIPT_PHYS (np, init); memcpy_to_pci(np->base2_va, np->script0, sizeof(struct script)); #endif /* SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ } else phys = NCB_SCRIPT_PHYS (np, init); np->istat_sem = 0; OUTL (nc_dsa, np->p_ncb); OUTL_DSP (phys); } /*========================================================== ** ** Prepare the negotiation values for wide and ** synchronous transfers. ** **========================================================== */ static void ncr_negotiate (struct ncb* np, struct tcb* tp) { /* ** minsync unit is 4ns ! */ u_long minsync = tp->usrsync; /* ** SCSI bus mode limit */ if (np->scsi_mode && np->scsi_mode == SMODE_SE) { if (minsync < 12) minsync = 12; } /* ** our limit .. */ if (minsync < np->minsync) minsync = np->minsync; /* ** divider limit */ if (minsync > np->maxsync) minsync = 255; tp->minsync = minsync; tp->maxoffs = (minsync<255 ? np->maxoffs : 0); /* ** period=0: has to negotiate sync transfer */ tp->period=0; /* ** widedone=0: has to negotiate wide transfer */ tp->widedone=0; } /*========================================================== ** ** Get clock factor and sync divisor for a given ** synchronous factor period. ** Returns the clock factor (in sxfer) and scntl3 ** synchronous divisor field. ** **========================================================== */ static void ncr_getsync(ncb_p np, u_char sfac, u_char *fakp, u_char *scntl3p) { u_long clk = np->clock_khz; /* SCSI clock frequency in kHz */ int div = np->clock_divn; /* Number of divisors supported */ u_long fak; /* Sync factor in sxfer */ u_long per; /* Period in tenths of ns */ u_long kpc; /* (per * clk) */ /* ** Compute the synchronous period in tenths of nano-seconds ** from sfac. ** ** Note, if sfac == 9, DT is being used. Double the period of 125 ** to 250. */ if (sfac <= 10) per = 250; else if (sfac == 11) per = 303; else if (sfac == 12) per = 500; else per = 40 * sfac; /* ** Look for the greatest clock divisor that allows an ** input speed faster than the period. */ kpc = per * clk; while (--div >= 0) if (kpc >= (div_10M[div] << 2)) break; /* ** Calculate the lowest clock factor that allows an output ** speed not faster than the period. */ fak = (kpc - 1) / div_10M[div] + 1; #if 0 /* This optimization does not seem very useful */ per = (fak * div_10M[div]) / clk; /* ** Why not to try the immediate lower divisor and to choose ** the one that allows the fastest output speed ? ** We don't want input speed too much greater than output speed. */ if (div >= 1 && fak < 8) { u_long fak2, per2; fak2 = (kpc - 1) / div_10M[div-1] + 1; per2 = (fak2 * div_10M[div-1]) / clk; if (per2 < per && fak2 <= 8) { fak = fak2; per = per2; --div; } } #endif if (fak < 4) fak = 4; /* Should never happen, too bad ... */ /* ** Compute and return sync parameters for the ncr */ *fakp = fak - 4; /* ** If sfac < 25, and 8xx parts, desire that the chip operate at ** least at Ultra speeds. Must set bit 7 of scntl3. ** For C1010, do not set this bit. If operating at Ultra3 speeds, ** set the U3EN bit instead. */ if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { *scntl3p = (div+1) << 4; *fakp = 0; } else { *scntl3p = ((div+1) << 4) + (sfac < 25 ? 0x80 : 0); *fakp = fak - 4; } } /*========================================================== ** ** Utility routine to return the current bus width ** synchronous period and offset. ** Utilizes target sval, wval and uval ** **========================================================== */ static void ncr_get_xfer_info(ncb_p np, tcb_p tp, u_char *factor, u_char *offset, u_char *width) { u_char idiv; u_long period; *width = (tp->wval & EWS) ? 1 : 0; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) *offset = (tp->sval & 0x3f); else *offset = (tp->sval & 0x1f); /* * Midlayer signal to the driver that all of the scsi commands * for the integrity check have completed. Save the negotiated * parameters (extracted from sval, wval and uval). * See ncr_setsync for alg. details. */ idiv = (tp->wval>>4) & 0x07; if ( *offset && idiv ) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)){ if (tp->uval & 0x80) period = (2*div_10M[idiv-1])/np->clock_khz; else period = (4*div_10M[idiv-1])/np->clock_khz; } else period = (((tp->sval>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else period = 0xffff; if (period <= 125) *factor = 9; else if (period <= 250) *factor = 10; else if (period <= 303) *factor = 11; else if (period <= 500) *factor = 12; else *factor = (period + 40 - 1) / 40; } /*========================================================== ** ** Set actual values, sync status and patch all ccbs of ** a target according to new sync/wide agreement. ** **========================================================== */ static void ncr_set_sync_wide_status (ncb_p np, u_char target) { ccb_p cp = np->ccbc; tcb_p tp = &np->target[target]; /* ** set actual value and sync_status ** ** TEMP register contains current scripts address ** which is data type/direction/dependent. */ OUTB (nc_sxfer, tp->sval); OUTB (nc_scntl3, tp->wval); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) OUTB (nc_scntl4, tp->uval); /* ** patch ALL ccbs of this target. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status == HS_IDLE) continue; if (cp->target != target) continue; cp->phys.select.sel_scntl3 = tp->wval; cp->phys.select.sel_sxfer = tp->sval; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) cp->phys.select.sel_scntl4 = tp->uval; }; } /*========================================================== ** ** Switch sync mode for current job and it's target ** **========================================================== */ static void ncr_setsync (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4) { tcb_p tp; u_char target = INB (nc_sdid) & 0x0f; u_char idiv; u_char offset; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { offset = sxfer & 0x3f; /* bits 5-0 */ scntl3 = (scntl3 & 0xf0) | (tp->wval & EWS); scntl4 = (scntl4 & 0x80); } else { offset = sxfer & 0x1f; /* bits 4-0 */ if (!scntl3 || !offset) scntl3 = np->rv_scntl3; scntl3 = (scntl3 & 0xf0) | (tp->wval & EWS) | (np->rv_scntl3 & 0x07); } /* ** Deduce the value of controller sync period from scntl3. ** period is in tenths of nano-seconds. */ idiv = ((scntl3 >> 4) & 0x7); if ( offset && idiv) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { /* Note: If extra data hold clocks are used, * the formulas below must be modified. * When scntl4 == 0, ST mode. */ if (scntl4 & 0x80) tp->period = (2*div_10M[idiv-1])/np->clock_khz; else tp->period = (4*div_10M[idiv-1])/np->clock_khz; } else tp->period = (((sxfer>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else tp->period = 0xffff; /* ** Stop there if sync parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3 && tp->uval == scntl4) return; tp->sval = sxfer; tp->wval = scntl3; tp->uval = scntl4; /* ** Bells and whistles ;-) ** Donnot announce negotiations due to auto-sense, ** unless user really want us to be verbose. :) */ if ( bootverbose < 2 && (cp->host_flags & HF_AUTO_SENSE)) goto next; PRINT_TARGET(np, target); if (offset) { unsigned f10 = 100000 << (tp->widedone ? tp->widedone -1 : 0); unsigned mb10 = (f10 + tp->period/2) / tp->period; char *scsi; /* ** Disable extended Sreq/Sack filtering */ if ((tp->period <= 2000) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) OUTOFFB (nc_stest2, EXT); /* ** Bells and whistles ;-) */ if (tp->period < 250) scsi = "FAST-80"; else if (tp->period < 500) scsi = "FAST-40"; else if (tp->period < 1000) scsi = "FAST-20"; else if (tp->period < 2000) scsi = "FAST-10"; else scsi = "FAST-5"; printk ("%s %sSCSI %d.%d MB/s (%d.%d ns, offset %d)\n", scsi, tp->widedone > 1 ? "WIDE " : "", mb10 / 10, mb10 % 10, tp->period / 10, tp->period % 10, offset); } else printk ("%sasynchronous.\n", tp->widedone > 1 ? "wide " : ""); next: /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch wide mode for current job and it's target ** SCSI specs say: a SCSI device that accepts a WDTR ** message shall reset the synchronous agreement to ** asynchronous mode. ** **========================================================== */ static void ncr_setwide (ncb_p np, ccb_p cp, u_char wide, u_char ack) { u_short target = INB (nc_sdid) & 0x0f; tcb_p tp; u_char scntl3; u_char sxfer; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; tp->widedone = wide+1; scntl3 = (tp->wval & (~EWS)) | (wide ? EWS : 0); sxfer = ack ? 0 : tp->sval; /* ** Stop there if sync/wide parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3) return; tp->sval = sxfer; tp->wval = scntl3; /* ** Bells and whistles ;-) */ if (bootverbose >= 2) { PRINT_TARGET(np, target); if (scntl3 & EWS) printk ("WIDE SCSI (16 bit) enabled.\n"); else printk ("WIDE SCSI disabled.\n"); } /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch sync/wide mode for current job and it's target ** PPR negotiations only ** **========================================================== */ static void ncr_setsyncwide (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4, u_char wide) { tcb_p tp; u_char target = INB (nc_sdid) & 0x0f; u_char idiv; u_char offset; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; tp->widedone = wide+1; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { offset = sxfer & 0x3f; /* bits 5-0 */ scntl3 = (scntl3 & 0xf0) | (wide ? EWS : 0); scntl4 = (scntl4 & 0x80); } else { offset = sxfer & 0x1f; /* bits 4-0 */ if (!scntl3 || !offset) scntl3 = np->rv_scntl3; scntl3 = (scntl3 & 0xf0) | (wide ? EWS : 0) | (np->rv_scntl3 & 0x07); } /* ** Deduce the value of controller sync period from scntl3. ** period is in tenths of nano-seconds. */ idiv = ((scntl3 >> 4) & 0x7); if ( offset && idiv) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { /* Note: If extra data hold clocks are used, * the formulas below must be modified. * When scntl4 == 0, ST mode. */ if (scntl4 & 0x80) tp->period = (2*div_10M[idiv-1])/np->clock_khz; else tp->period = (4*div_10M[idiv-1])/np->clock_khz; } else tp->period = (((sxfer>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else tp->period = 0xffff; /* ** Stop there if sync parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3 && tp->uval == scntl4) return; tp->sval = sxfer; tp->wval = scntl3; tp->uval = scntl4; /* ** Bells and whistles ;-) ** Donnot announce negotiations due to auto-sense, ** unless user really want us to be verbose. :) */ if ( bootverbose < 2 && (cp->host_flags & HF_AUTO_SENSE)) goto next; PRINT_TARGET(np, target); if (offset) { unsigned f10 = 100000 << (tp->widedone ? tp->widedone -1 : 0); unsigned mb10 = (f10 + tp->period/2) / tp->period; char *scsi; /* ** Disable extended Sreq/Sack filtering */ if ((tp->period <= 2000) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) OUTOFFB (nc_stest2, EXT); /* ** Bells and whistles ;-) */ if (tp->period < 250) scsi = "FAST-80"; else if (tp->period < 500) scsi = "FAST-40"; else if (tp->period < 1000) scsi = "FAST-20"; else if (tp->period < 2000) scsi = "FAST-10"; else scsi = "FAST-5"; printk ("%s %sSCSI %d.%d MB/s (%d.%d ns, offset %d)\n", scsi, tp->widedone > 1 ? "WIDE " : "", mb10 / 10, mb10 % 10, tp->period / 10, tp->period % 10, offset); } else printk ("%sasynchronous.\n", tp->widedone > 1 ? "wide " : ""); next: /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch tagged mode for a target. ** **========================================================== */ static void ncr_setup_tags (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_short reqtags, maxdepth; /* ** Just in case ... */ if ((!tp) || (!lp)) return; /* ** If SCSI device queue depth is not yet set, leave here. */ if (!lp->scdev_depth) return; /* ** Donnot allow more tags than the SCSI driver can queue ** for this device. ** Donnot allow more tags than we can handle. */ maxdepth = lp->scdev_depth; if (maxdepth > lp->maxnxs) maxdepth = lp->maxnxs; if (lp->maxtags > maxdepth) lp->maxtags = maxdepth; if (lp->numtags > maxdepth) lp->numtags = maxdepth; /* ** only devices conformant to ANSI Version >= 2 ** only devices capable of tagged commands ** only if enabled by user .. */ if ((lp->inq_byte7 & INQ7_QUEUE) && lp->numtags > 1) { reqtags = lp->numtags; } else { reqtags = 1; }; /* ** Update max number of tags */ lp->numtags = reqtags; if (lp->numtags > lp->maxtags) lp->maxtags = lp->numtags; /* ** If we want to switch tag mode, we must wait ** for no CCB to be active. */ if (reqtags > 1 && lp->usetags) { /* Stay in tagged mode */ if (lp->queuedepth == reqtags) /* Already announced */ return; lp->queuedepth = reqtags; } else if (reqtags <= 1 && !lp->usetags) { /* Stay in untagged mode */ lp->queuedepth = reqtags; return; } else { /* Want to switch tag mode */ if (lp->busyccbs) /* If not yet safe, return */ return; lp->queuedepth = reqtags; lp->usetags = reqtags > 1 ? 1 : 0; } /* ** Patch the lun mini-script, according to tag mode. */ lp->resel_task = lp->usetags? cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_tag)) : cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_notag)); /* ** Announce change to user. */ if (bootverbose) { PRINT_LUN(np, tn, ln); if (lp->usetags) printk("tagged command queue depth set to %d\n", reqtags); else printk("tagged command queueing disabled\n"); } } /*---------------------------------------------------- ** ** handle user commands ** **---------------------------------------------------- */ #ifdef SCSI_NCR_USER_COMMAND_SUPPORT static void ncr_usercmd (ncb_p np) { u_char t; tcb_p tp; int ln; u_long size; switch (np->user.cmd) { case 0: return; case UC_SETDEBUG: #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT ncr_debug = np->user.data; #endif break; case UC_SETORDER: np->order = np->user.data; break; case UC_SETVERBOSE: np->verbose = np->user.data; break; default: /* ** We assume that other commands apply to targets. ** This should always be the case and avoid the below ** 4 lines to be repeated 5 times. */ for (t = 0; t < MAX_TARGET; t++) { if (!((np->user.target >> t) & 1)) continue; tp = &np->target[t]; switch (np->user.cmd) { case UC_SETSYNC: tp->usrsync = np->user.data; ncr_negotiate (np, tp); break; case UC_SETWIDE: size = np->user.data; if (size > np->maxwide) size=np->maxwide; tp->usrwide = size; ncr_negotiate (np, tp); break; case UC_SETTAGS: tp->usrtags = np->user.data; for (ln = 0; ln < MAX_LUN; ln++) { lcb_p lp; lp = ncr_lp(np, tp, ln); if (!lp) continue; lp->numtags = np->user.data; lp->maxtags = lp->numtags; ncr_setup_tags (np, t, ln); } break; case UC_RESETDEV: tp->to_reset = 1; np->istat_sem = SEM; OUTB (nc_istat, SIGP|SEM); break; case UC_CLEARDEV: for (ln = 0; ln < MAX_LUN; ln++) { lcb_p lp; lp = ncr_lp(np, tp, ln); if (lp) lp->to_clear = 1; } np->istat_sem = SEM; OUTB (nc_istat, SIGP|SEM); break; case UC_SETFLAG: tp->usrflag = np->user.data; break; } } break; } np->user.cmd=0; } #endif /*========================================================== ** ** ** ncr timeout handler. ** ** **========================================================== ** ** Misused to keep the driver running when ** interrupts are not configured correctly. ** **---------------------------------------------------------- */ static void ncr_timeout (ncb_p np) { u_long thistime = ktime_get(0); /* ** If release process in progress, let's go ** Set the release stage from 1 to 2 to synchronize ** with the release process. */ if (np->release_stage) { if (np->release_stage == 1) np->release_stage = 2; return; } #ifdef SCSI_NCR_PCIQ_BROKEN_INTR np->timer.expires = ktime_get((HZ+9)/10); #else np->timer.expires = ktime_get(SCSI_NCR_TIMER_INTERVAL); #endif add_timer(&np->timer); /* ** If we are resetting the ncr, wait for settle_time before ** clearing it. Then command processing will be resumed. */ if (np->settle_time) { if (np->settle_time <= thistime) { if (bootverbose > 1) printk("%s: command processing resumed\n", ncr_name(np)); np->settle_time = 0; requeue_waiting_list(np); } return; } /* ** Nothing to do for now, but that may come. */ if (np->lasttime + 4*HZ < thistime) { np->lasttime = thistime; } #ifdef SCSI_NCR_PCIQ_MAY_MISS_COMPLETIONS /* ** Some way-broken PCI bridges may lead to ** completions being lost when the clearing ** of the INTFLY flag by the CPU occurs ** concurrently with the chip raising this flag. ** If this ever happen, lost completions will ** be reaped here. */ ncr_wakeup_done(np); #endif #ifdef SCSI_NCR_PCIQ_BROKEN_INTR if (INB(nc_istat) & (INTF|SIP|DIP)) { /* ** Process pending interrupts. */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("{"); ncr_exception (np); if (DEBUG_FLAGS & DEBUG_TINY) printk ("}"); } #endif /* SCSI_NCR_PCIQ_BROKEN_INTR */ } /*========================================================== ** ** log message for real hard errors ** ** "ncr0 targ 0?: ERROR (ds:si) (so-si-sd) (sxfer/scntl3) @ name (dsp:dbc)." ** " reg: r0 r1 r2 r3 r4 r5 r6 ..... rf." ** ** exception register: ** ds: dstat ** si: sist ** ** SCSI bus lines: ** so: control lines as driver by NCR. ** si: control lines as seen by NCR. ** sd: scsi data lines as seen by NCR. ** ** wide/fastmode: ** sxfer: (see the manual) ** scntl3: (see the manual) ** ** current script command: ** dsp: script address (relative to start of script). ** dbc: first word of script command. ** ** First 24 register of the chip: ** r0..rf ** **========================================================== */ static void ncr_log_hard_error(ncb_p np, u_short sist, u_char dstat) { u_int32 dsp; int script_ofs; int script_size; char *script_name; u_char *script_base; int i; dsp = INL (nc_dsp); if (dsp > np->p_script && dsp <= np->p_script + sizeof(struct script)) { script_ofs = dsp - np->p_script; script_size = sizeof(struct script); script_base = (u_char *) np->script0; script_name = "script"; } else if (np->p_scripth < dsp && dsp <= np->p_scripth + sizeof(struct scripth)) { script_ofs = dsp - np->p_scripth; script_size = sizeof(struct scripth); script_base = (u_char *) np->scripth0; script_name = "scripth"; } else { script_ofs = dsp; script_size = 0; script_base = 0; script_name = "mem"; } printk ("%s:%d: ERROR (%x:%x) (%x-%x-%x) (%x/%x) @ (%s %x:%08x).\n", ncr_name (np), (unsigned)INB (nc_sdid)&0x0f, dstat, sist, (unsigned)INB (nc_socl), (unsigned)INB (nc_sbcl), (unsigned)INB (nc_sbdl), (unsigned)INB (nc_sxfer),(unsigned)INB (nc_scntl3), script_name, script_ofs, (unsigned)INL (nc_dbc)); if (((script_ofs & 3) == 0) && (unsigned)script_ofs < script_size) { printk ("%s: script cmd = %08x\n", ncr_name(np), scr_to_cpu((int) *(ncrcmd *)(script_base + script_ofs))); } printk ("%s: regdump:", ncr_name(np)); for (i=0; i<24;i++) printk (" %02x", (unsigned)INB_OFF(i)); printk (".\n"); } /*============================================================ ** ** ncr chip exception handler. ** **============================================================ ** ** In normal situations, interrupt conditions occur one at ** a time. But when something bad happens on the SCSI BUS, ** the chip may raise several interrupt flags before ** stopping and interrupting the CPU. The additionnal ** interrupt flags are stacked in some extra registers ** after the SIP and/or DIP flag has been raised in the ** ISTAT. After the CPU has read the interrupt condition ** flag from SIST or DSTAT, the chip unstacks the other ** interrupt flags and sets the corresponding bits in ** SIST or DSTAT. Since the chip starts stacking once the ** SIP or DIP flag is set, there is a small window of time ** where the stacking does not occur. ** ** Typically, multiple interrupt conditions may happen in ** the following situations: ** ** - SCSI parity error + Phase mismatch (PAR|MA) ** When an parity error is detected in input phase ** and the device switches to msg-in phase inside a ** block MOV. ** - SCSI parity error + Unexpected disconnect (PAR|UDC) ** When a stupid device does not want to handle the ** recovery of an SCSI parity error. ** - Some combinations of STO, PAR, UDC, ... ** When using non compliant SCSI stuff, when user is ** doing non compliant hot tampering on the BUS, when ** something really bad happens to a device, etc ... ** ** The heuristic suggested by SYMBIOS to handle ** multiple interrupts is to try unstacking all ** interrupts conditions and to handle them on some ** priority based on error severity. ** This will work when the unstacking has been ** successful, but we cannot be 100 % sure of that, ** since the CPU may have been faster to unstack than ** the chip is able to stack. Hmmm ... But it seems that ** such a situation is very unlikely to happen. ** ** If this happen, for example STO catched by the CPU ** then UDC happenning before the CPU have restarted ** the SCRIPTS, the driver may wrongly complete the ** same command on UDC, since the SCRIPTS didn't restart ** and the DSA still points to the same command. ** We avoid this situation by setting the DSA to an ** invalid value when the CCB is completed and before ** restarting the SCRIPTS. ** ** Another issue is that we need some section of our ** recovery procedures to be somehow uninterruptible and ** that the SCRIPTS processor does not provides such a ** feature. For this reason, we handle recovery preferently ** from the C code and check against some SCRIPTS ** critical sections from the C code. ** ** Hopefully, the interrupt handling of the driver is now ** able to resist to weird BUS error conditions, but donnot ** ask me for any guarantee that it will never fail. :-) ** Use at your own decision and risk. ** **============================================================ */ void ncr_exception (ncb_p np) { u_char istat, istatc; u_char dstat; u_short sist; int i; /* ** interrupt on the fly ? ** ** A `dummy read' is needed to ensure that the ** clear of the INTF flag reaches the device ** before the scanning of the DONE queue. */ istat = INB (nc_istat); if (istat & INTF) { OUTB (nc_istat, (istat & SIGP) | INTF | np->istat_sem); istat = INB (nc_istat); /* DUMMY READ */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("F "); (void)ncr_wakeup_done (np); }; if (!(istat & (SIP|DIP))) return; #if 0 /* We should never get this one */ if (istat & CABRT) OUTB (nc_istat, CABRT); #endif /* ** Steinbach's Guideline for Systems Programming: ** Never test for an error condition you don't know how to handle. */ /*======================================================== ** PAR and MA interrupts may occur at the same time, ** and we need to know of both in order to handle ** this situation properly. We try to unstack SCSI ** interrupts for that reason. BTW, I dislike a LOT ** such a loop inside the interrupt routine. ** Even if DMA interrupt stacking is very unlikely to ** happen, we also try unstacking these ones, since ** this has no performance impact. **========================================================= */ sist = 0; dstat = 0; istatc = istat; do { if (istatc & SIP) sist |= INW (nc_sist); if (istatc & DIP) dstat |= INB (nc_dstat); istatc = INB (nc_istat); istat |= istatc; } while (istatc & (SIP|DIP)); if (DEBUG_FLAGS & DEBUG_TINY) printk ("<%d|%x:%x|%x:%x>", (int)INB(nc_scr0), dstat,sist, (unsigned)INL(nc_dsp), (unsigned)INL(nc_dbc)); /* ** On paper, a memory barrier may be needed here. ** And since we are paranoid ... :) */ MEMORY_BARRIER(); /*======================================================== ** First, interrupts we want to service cleanly. ** ** Phase mismatch (MA) is the most frequent interrupt ** for chip earlier than the 896 and so we have to service ** it as quickly as possible. ** A SCSI parity error (PAR) may be combined with a phase ** mismatch condition (MA). ** Programmed interrupts (SIR) are used to call the C code ** from SCRIPTS. ** The single step interrupt (SSI) is not used in this ** driver. **========================================================= */ if (!(sist & (STO|GEN|HTH|SGE|UDC|SBMC|RST)) && !(dstat & (MDPE|BF|ABRT|IID))) { if (sist & PAR) ncr_int_par (np, sist); else if (sist & MA) ncr_int_ma (np); else if (dstat & SIR) ncr_int_sir (np); else if (dstat & SSI) OUTONB_STD (); else goto unknown_int; return; }; /*======================================================== ** Now, interrupts that donnot happen in normal ** situations and that we may need to recover from. ** ** On SCSI RESET (RST), we reset everything. ** On SCSI BUS MODE CHANGE (SBMC), we complete all ** active CCBs with RESET status, prepare all devices ** for negotiating again and restart the SCRIPTS. ** On STO and UDC, we complete the CCB with the corres- ** ponding status and restart the SCRIPTS. **========================================================= */ if (sist & RST) { ncr_init (np, 1, bootverbose ? "scsi reset" : NULL, HS_RESET); return; }; OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* clear dma fifo */ OUTB (nc_stest3, TE|CSF); /* clear scsi fifo */ if (!(sist & (GEN|HTH|SGE)) && !(dstat & (MDPE|BF|ABRT|IID))) { if (sist & SBMC) ncr_int_sbmc (np); else if (sist & STO) ncr_int_sto (np); else if (sist & UDC) ncr_int_udc (np); else goto unknown_int; return; }; /*========================================================= ** Now, interrupts we are not able to recover cleanly. ** ** Do the register dump. ** Log message for hard errors. ** Reset everything. **========================================================= */ if (ktime_exp(np->regtime)) { np->regtime = ktime_get(10*HZ); for (i = 0; iregdump); i++) ((char*)&np->regdump)[i] = INB_OFF(i); np->regdump.nc_dstat = dstat; np->regdump.nc_sist = sist; }; ncr_log_hard_error(np, sist, dstat); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { u_char ctest4_o, ctest4_m; u_char shadow; /* * Get shadow register data * Write 1 to ctest4 */ ctest4_o = INB(nc_ctest4); OUTB(nc_ctest4, ctest4_o | 0x10); ctest4_m = INB(nc_ctest4); shadow = INW_OFF(0x42); OUTB(nc_ctest4, ctest4_o); printk("%s: ctest4/sist original 0x%x/0x%X mod: 0x%X/0x%x\n", ncr_name(np), ctest4_o, sist, ctest4_m, shadow); } if ((sist & (GEN|HTH|SGE)) || (dstat & (MDPE|BF|ABRT|IID))) { ncr_start_reset(np); return; }; unknown_int: /*========================================================= ** We just miss the cause of the interrupt. :( ** Print a message. The timeout will do the real work. **========================================================= */ printk( "%s: unknown interrupt(s) ignored, " "ISTAT=0x%x DSTAT=0x%x SIST=0x%x\n", ncr_name(np), istat, dstat, sist); } /*========================================================== ** ** generic recovery from scsi interrupt ** **========================================================== ** ** The doc says that when the chip gets an SCSI interrupt, ** it tries to stop in an orderly fashion, by completing ** an instruction fetch that had started or by flushing ** the DMA fifo for a write to memory that was executing. ** Such a fashion is not enough to know if the instruction ** that was just before the current DSP value has been ** executed or not. ** ** There are 3 small SCRIPTS sections that deal with the ** start queue and the done queue that may break any ** assomption from the C code if we are interrupted ** inside, so we reset if it happens. Btw, since these ** SCRIPTS sections are executed while the SCRIPTS hasn't ** started SCSI operations, it is very unlikely to happen. ** ** All the driver data structures are supposed to be ** allocated from the same 4 GB memory window, so there ** is a 1 to 1 relationship between DSA and driver data ** structures. Since we are careful :) to invalidate the ** DSA when we complete a command or when the SCRIPTS ** pushes a DSA into a queue, we can trust it when it ** points to a CCB. ** **---------------------------------------------------------- */ static void ncr_recover_scsi_int (ncb_p np, u_char hsts) { u_int32 dsp = INL (nc_dsp); u_int32 dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); /* ** If we haven't been interrupted inside the SCRIPTS ** critical pathes, we can safely restart the SCRIPTS ** and trust the DSA value if it matches a CCB. */ if ((!(dsp > NCB_SCRIPT_PHYS (np, getjob_begin) && dsp < NCB_SCRIPT_PHYS (np, getjob_end) + 1)) && (!(dsp > NCB_SCRIPT_PHYS (np, ungetjob) && dsp < NCB_SCRIPT_PHYS (np, reselect) + 1)) && (!(dsp > NCB_SCRIPTH_PHYS (np, sel_for_abort) && dsp < NCB_SCRIPTH_PHYS (np, sel_for_abort_1) + 1)) && (!(dsp > NCB_SCRIPT_PHYS (np, done) && dsp < NCB_SCRIPT_PHYS (np, done_end) + 1))) { if (cp) { cp->host_status = hsts; ncr_complete (np, cp); } OUTL (nc_dsa, DSA_INVALID); OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* clear dma fifo */ OUTB (nc_stest3, TE|CSF); /* clear scsi fifo */ OUTL_DSP (NCB_SCRIPT_PHYS (np, start)); } else goto reset_all; return; reset_all: ncr_start_reset(np); } /*========================================================== ** ** ncr chip exception handler for selection timeout ** **========================================================== ** ** There seems to be a bug in the 53c810. ** Although a STO-Interrupt is pending, ** it continues executing script commands. ** But it will fail and interrupt (IID) on ** the next instruction where it's looking ** for a valid phase. ** **---------------------------------------------------------- */ void ncr_int_sto (ncb_p np) { u_int32 dsp = INL (nc_dsp); if (DEBUG_FLAGS & DEBUG_TINY) printk ("T"); if (dsp == NCB_SCRIPT_PHYS (np, wf_sel_done) + 8 || !(driver_setup.recovery & 1)) ncr_recover_scsi_int(np, HS_SEL_TIMEOUT); else ncr_start_reset(np); } /*========================================================== ** ** ncr chip exception handler for unexpected disconnect ** **========================================================== ** **---------------------------------------------------------- */ void ncr_int_udc (ncb_p np) { u_int32 dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); /* * Fix Up. Some disks respond to a PPR negotiation with * a bus free instead of a message reject. * Disable ppr negotiation if this is first time * tried ppr negotiation. */ if (cp) { tcb_p tp = &np->target[cp->target]; if (tp->ppr_negotiation == 1) tp->ppr_negotiation = 0; } printk ("%s: unexpected disconnect\n", ncr_name(np)); ncr_recover_scsi_int(np, HS_UNEXPECTED); } /*========================================================== ** ** ncr chip exception handler for SCSI bus mode change ** **========================================================== ** ** spi2-r12 11.2.3 says a transceiver mode change must ** generate a reset event and a device that detects a reset ** event shall initiate a hard reset. It says also that a ** device that detects a mode change shall set data transfer ** mode to eight bit asynchronous, etc... ** So, just resetting should be enough. ** ** **---------------------------------------------------------- */ static void ncr_int_sbmc (ncb_p np) { u_char scsi_mode = INB (nc_stest4) & SMODE; printk("%s: SCSI bus mode change from %x to %x.\n", ncr_name(np), np->scsi_mode, scsi_mode); np->scsi_mode = scsi_mode; /* ** Suspend command processing for 1 second and ** reinitialize all except the chip. */ np->settle_time = ktime_get(1*HZ); ncr_init (np, 0, bootverbose ? "scsi mode change" : NULL, HS_RESET); } /*========================================================== ** ** ncr chip exception handler for SCSI parity error. ** **========================================================== ** ** When the chip detects a SCSI parity error and is ** currently executing a (CH)MOV instruction, it does ** not interrupt immediately, but tries to finish the ** transfer of the current scatter entry before ** interrupting. The following situations may occur: ** ** - The complete scatter entry has been transferred ** without the device having changed phase. ** The chip will then interrupt with the DSP pointing ** to the instruction that follows the MOV. ** ** - A phase mismatch occurs before the MOV finished ** and phase errors are to be handled by the C code. ** The chip will then interrupt with both PAR and MA ** conditions set. ** ** - A phase mismatch occurs before the MOV finished and ** phase errors are to be handled by SCRIPTS (895A or 896). ** The chip will load the DSP with the phase mismatch ** JUMP address and interrupt the host processor. ** **---------------------------------------------------------- */ static void ncr_int_par (ncb_p np, u_short sist) { u_char hsts = INB (HS_PRT); u_int32 dsp = INL (nc_dsp); u_int32 dbc = INL (nc_dbc); u_int32 dsa = INL (nc_dsa); u_char sbcl = INB (nc_sbcl); u_char cmd = dbc >> 24; int phase = cmd & 7; ccb_p cp = ncr_ccb_from_dsa(np, dsa); printk("%s: SCSI parity error detected: SCR1=%d DBC=%x SBCL=%x\n", ncr_name(np), hsts, dbc, sbcl); /* ** Check that the chip is connected to the SCSI BUS. */ if (!(INB (nc_scntl1) & ISCON)) { if (!(driver_setup.recovery & 1)) { ncr_recover_scsi_int(np, HS_FAIL); return; } goto reset_all; } /* ** If the nexus is not clearly identified, reset the bus. ** We will try to do better later. */ if (!cp) goto reset_all; /* ** Check instruction was a MOV, direction was INPUT and ** ATN is asserted. */ if ((cmd & 0xc0) || !(phase & 1) || !(sbcl & 0x8)) goto reset_all; /* ** Keep track of the parity error. */ OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_PARITY_ERR; /* ** Prepare the message to send to the device. */ np->msgout[0] = (phase == 7) ? M_PARITY : M_ID_ERROR; #ifdef SCSI_NCR_INTEGRITY_CHECKING /* ** Save error message. For integrity check use only. */ if (np->check_integrity) np->check_integ_par = np->msgout[0]; #endif /* ** If the old phase was DATA IN or DT DATA IN phase, ** we have to deal with the 3 situations described above. ** For other input phases (MSG IN and STATUS), the device ** must resend the whole thing that failed parity checking ** or signal error. So, jumping to dispatcher should be OK. */ if ((phase == 1) || (phase == 5)) { /* Phase mismatch handled by SCRIPTS */ if (dsp == NCB_SCRIPTH_PHYS (np, pm_handle)) OUTL_DSP (dsp); /* Phase mismatch handled by the C code */ else if (sist & MA) ncr_int_ma (np); /* No phase mismatch occurred */ else { OUTL (nc_temp, dsp); OUTL_DSP (NCB_SCRIPT_PHYS (np, dispatch)); } } else OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; reset_all: ncr_start_reset(np); return; } /*========================================================== ** ** ** ncr chip exception handler for phase errors. ** ** **========================================================== ** ** We have to construct a new transfer descriptor, ** to transfer the rest of the current block. ** **---------------------------------------------------------- */ static void ncr_int_ma (ncb_p np) { u_int32 dbc; u_int32 rest; u_int32 dsp; u_int32 dsa; u_int32 nxtdsp; u_int32 *vdsp; u_int32 oadr, olen; u_int32 *tblp; u_int32 newcmd; u_int delta; u_char cmd; u_char hflags, hflags0; struct pm_ctx *pm; ccb_p cp; dsp = INL (nc_dsp); dbc = INL (nc_dbc); dsa = INL (nc_dsa); cmd = dbc >> 24; rest = dbc & 0xffffff; delta = 0; /* ** locate matching cp. */ cp = ncr_ccb_from_dsa(np, dsa); if (DEBUG_FLAGS & DEBUG_PHASE) printk("CCB = %2x %2x %2x %2x %2x %2x\n", cp->cmd->cmnd[0], cp->cmd->cmnd[1], cp->cmd->cmnd[2], cp->cmd->cmnd[3], cp->cmd->cmnd[4], cp->cmd->cmnd[5]); /* ** Donnot take into account dma fifo and various buffers in ** INPUT phase since the chip flushes everything before ** raising the MA interrupt for interrupted INPUT phases. ** For DATA IN phase, we will check for the SWIDE later. */ if ((cmd & 7) != 1 && (cmd & 7) != 5) { u_int32 dfifo; u_char ss0, ss2; /* ** If C1010, DFBC contains number of bytes in DMA fifo. ** else read DFIFO, CTEST[4-6] using 1 PCI bus ownership. */ if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) delta = INL(nc_dfbc) & 0xffff; else { dfifo = INL(nc_dfifo); /* ** Calculate remaining bytes in DMA fifo. ** C1010 - always large fifo, value in dfbc ** Otherwise, (CTEST5 = dfifo >> 16) */ if (dfifo & (DFS << 16)) delta = ((((dfifo >> 8) & 0x300) | (dfifo & 0xff)) - rest) & 0x3ff; else delta = ((dfifo & 0xff) - rest) & 0x7f; /* ** The data in the dma fifo has not been ** transferred to the target -> add the amount ** to the rest and clear the data. ** Check the sstat2 register in case of wide ** transfer. */ } rest += delta; ss0 = INB (nc_sstat0); if (ss0 & OLF) rest++; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (ss0 & ORF)) rest++; if (cp && (cp->phys.select.sel_scntl3 & EWS)) { ss2 = INB (nc_sstat2); if (ss2 & OLF1) rest++; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (ss2 & ORF)) rest++; }; /* ** Clear fifos. */ OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* dma fifo */ OUTB (nc_stest3, TE|CSF); /* scsi fifo */ } /* ** log the information */ if (DEBUG_FLAGS & (DEBUG_TINY|DEBUG_PHASE)) printk ("P%x%x RL=%d D=%d ", cmd&7, INB(nc_sbcl)&7, (unsigned) rest, (unsigned) delta); /* ** try to find the interrupted script command, ** and the address at which to continue. */ vdsp = 0; nxtdsp = 0; if (dsp > np->p_script && dsp <= np->p_script + sizeof(struct script)) { vdsp = (u_int32 *)((char*)np->script0 + (dsp-np->p_script-8)); nxtdsp = dsp; } else if (dsp > np->p_scripth && dsp <= np->p_scripth + sizeof(struct scripth)) { vdsp = (u_int32 *)((char*)np->scripth0 + (dsp-np->p_scripth-8)); nxtdsp = dsp; } /* ** log the information */ if (DEBUG_FLAGS & DEBUG_PHASE) { printk ("\nCP=%p DSP=%x NXT=%x VDSP=%p CMD=%x ", cp, (unsigned)dsp, (unsigned)nxtdsp, vdsp, cmd); }; if (!vdsp) { printk ("%s: interrupted SCRIPT address not found.\n", ncr_name (np)); goto reset_all; } if (!cp) { printk ("%s: SCSI phase error fixup: CCB already dequeued.\n", ncr_name (np)); goto reset_all; } /* ** get old startaddress and old length. */ oadr = scr_to_cpu(vdsp[1]); if (cmd & 0x10) { /* Table indirect */ tblp = (u_int32 *) ((char*) &cp->phys + oadr); olen = scr_to_cpu(tblp[0]); oadr = scr_to_cpu(tblp[1]); } else { tblp = (u_int32 *) 0; olen = scr_to_cpu(vdsp[0]) & 0xffffff; }; if (DEBUG_FLAGS & DEBUG_PHASE) { printk ("OCMD=%x\nTBLP=%p OLEN=%x OADR=%x\n", (unsigned) (scr_to_cpu(vdsp[0]) >> 24), tblp, (unsigned) olen, (unsigned) oadr); }; /* ** check cmd against assumed interrupted script command. ** If dt data phase, the MOVE instruction hasn't bit 4 of ** the phase. */ if (((cmd & 2) ? cmd : (cmd & ~4)) != (scr_to_cpu(vdsp[0]) >> 24)) { PRINT_ADDR(cp->cmd); printk ("internal error: cmd=%02x != %02x=(vdsp[0] >> 24)\n", (unsigned)cmd, (unsigned)scr_to_cpu(vdsp[0]) >> 24); goto reset_all; }; /* ** if old phase not dataphase, leave here. ** C/D line is low if data. */ if (cmd & 0x02) { PRINT_ADDR(cp->cmd); printk ("phase change %x-%x %d@%08x resid=%d.\n", cmd&7, INB(nc_sbcl)&7, (unsigned)olen, (unsigned)oadr, (unsigned)rest); goto unexpected_phase; }; /* ** Choose the correct PM save area. ** ** Look at the PM_SAVE SCRIPT if you want to understand ** this stuff. The equivalent code is implemented in ** SCRIPTS for the 895A and 896 that are able to handle ** PM from the SCRIPTS processor. */ hflags0 = INB (HF_PRT); hflags = hflags0; if (hflags & (HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED)) { if (hflags & HF_IN_PM0) nxtdsp = scr_to_cpu(cp->phys.pm0.ret); else if (hflags & HF_IN_PM1) nxtdsp = scr_to_cpu(cp->phys.pm1.ret); if (hflags & HF_DP_SAVED) hflags ^= HF_ACT_PM; } if (!(hflags & HF_ACT_PM)) { pm = &cp->phys.pm0; newcmd = NCB_SCRIPT_PHYS(np, pm0_data); } else { pm = &cp->phys.pm1; newcmd = NCB_SCRIPT_PHYS(np, pm1_data); } hflags &= ~(HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED); if (hflags != hflags0) OUTB (HF_PRT, hflags); /* ** fillin the phase mismatch context */ pm->sg.addr = cpu_to_scr(oadr + olen - rest); pm->sg.size = cpu_to_scr(rest); pm->ret = cpu_to_scr(nxtdsp); /* ** If we have a SWIDE, ** - prepare the address to write the SWIDE from SCRIPTS, ** - compute the SCRIPTS address to restart from, ** - move current data pointer context by one byte. */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); if ( ((cmd & 7) == 1 || (cmd & 7) == 5) && cp && (cp->phys.select.sel_scntl3 & EWS) && (INB (nc_scntl2) & WSR)) { u32 tmp; #ifdef SYM_DEBUG_PM_WITH_WSR PRINT_ADDR(cp); printk ("MA interrupt with WSR set - " "pm->sg.addr=%x - pm->sg.size=%d\n", pm->sg.addr, pm->sg.size); #endif /* * Set up the table indirect for the MOVE * of the residual byte and adjust the data * pointer context. */ tmp = scr_to_cpu(pm->sg.addr); cp->phys.wresid.addr = cpu_to_scr(tmp); pm->sg.addr = cpu_to_scr(tmp + 1); tmp = scr_to_cpu(pm->sg.size); cp->phys.wresid.size = cpu_to_scr((tmp&0xff000000) | 1); pm->sg.size = cpu_to_scr(tmp - 1); /* * If only the residual byte is to be moved, * no PM context is needed. */ if ((tmp&0xffffff) == 1) newcmd = pm->ret; /* * Prepare the address of SCRIPTS that will * move the residual byte to memory. */ nxtdsp = NCB_SCRIPTH_PHYS (np, wsr_ma_helper); } if (DEBUG_FLAGS & DEBUG_PHASE) { PRINT_ADDR(cp->cmd); printk ("PM %x %x %x / %x %x %x.\n", hflags0, hflags, newcmd, (unsigned)scr_to_cpu(pm->sg.addr), (unsigned)scr_to_cpu(pm->sg.size), (unsigned)scr_to_cpu(pm->ret)); } /* ** Restart the SCRIPTS processor. */ OUTL (nc_temp, newcmd); OUTL_DSP (nxtdsp); return; /* ** Unexpected phase changes that occurs when the current phase ** is not a DATA IN or DATA OUT phase are due to error conditions. ** Such event may only happen when the SCRIPTS is using a ** multibyte SCSI MOVE. ** ** Phase change Some possible cause ** ** COMMAND --> MSG IN SCSI parity error detected by target. ** COMMAND --> STATUS Bad command or refused by target. ** MSG OUT --> MSG IN Message rejected by target. ** MSG OUT --> COMMAND Bogus target that discards extended ** negotiation messages. ** ** The code below does not care of the new phase and so ** trusts the target. Why to annoy it ? ** If the interrupted phase is COMMAND phase, we restart at ** dispatcher. ** If a target does not get all the messages after selection, ** the code assumes blindly that the target discards extended ** messages and clears the negotiation status. ** If the target does not want all our response to negotiation, ** we force a SIR_NEGO_PROTO interrupt (it is a hack that avoids ** bloat for such a should_not_happen situation). ** In all other situation, we reset the BUS. ** Are these assumptions reasonnable ? (Wait and see ...) */ unexpected_phase: dsp -= 8; nxtdsp = 0; switch (cmd & 7) { case 2: /* COMMAND phase */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); break; #if 0 case 3: /* STATUS phase */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); break; #endif case 6: /* MSG OUT phase */ /* ** If the device may want to use untagged when we want ** tagged, we prepare an IDENTIFY without disc. granted, ** since we will not be able to handle reselect. ** Otherwise, we just don't care. */ if (dsp == NCB_SCRIPT_PHYS (np, send_ident)) { if (cp->tag != NO_TAG && olen - rest <= 3) { cp->host_status = HS_BUSY; np->msgout[0] = M_IDENTIFY | cp->lun; nxtdsp = NCB_SCRIPTH_PHYS (np, ident_break_atn); } else nxtdsp = NCB_SCRIPTH_PHYS (np, ident_break); } else if (dsp == NCB_SCRIPTH_PHYS (np, send_wdtr) || dsp == NCB_SCRIPTH_PHYS (np, send_sdtr) || dsp == NCB_SCRIPTH_PHYS (np, send_ppr)) { nxtdsp = NCB_SCRIPTH_PHYS (np, nego_bad_phase); } break; #if 0 case 7: /* MSG IN phase */ nxtdsp = NCB_SCRIPT_PHYS (np, clrack); break; #endif } if (nxtdsp) { OUTL_DSP (nxtdsp); return; } reset_all: ncr_start_reset(np); } /*========================================================== ** ** ncr chip handler for QUEUE FULL and CHECK CONDITION ** **========================================================== ** ** On QUEUE FULL status, we set the actual tagged command ** queue depth to the number of disconnected CCBs that is ** hopefully a good value to avoid further QUEUE FULL. ** ** On CHECK CONDITION or COMMAND TERMINATED, we use the ** CCB of the failed command for performing a REQUEST ** SENSE SCSI command. ** ** We do not want to change the order commands will be ** actually queued to the device after we received a ** QUEUE FULL status. We also want to properly deal with ** contingent allegiance condition. For these reasons, ** we remove from the start queue all commands for this ** LUN that haven't been yet queued to the device and ** put them back in the correponding LUN queue, then ** requeue the CCB that failed in front of the LUN queue. ** I just hope this not to be performed too often. :) ** ** If we are using IMMEDIATE ARBITRATION, we clear the ** IARB hint for every commands we encounter in order not ** to be stuck with a won arbitration and no job to queue ** to a device. **---------------------------------------------------------- */ static void ncr_sir_to_redo(ncb_p np, int num, ccb_p cp) { Scsi_Cmnd *cmd = cp->cmd; tcb_p tp = &np->target[cp->target]; lcb_p lp = ncr_lp(np, tp, cp->lun); ccb_p cp2; int busyccbs = 1; u_int32 startp; u_char s_status = INB (SS_PRT); int msglen; int i, j; /* ** If the LCB is not yet available, then only ** 1 IO is accepted, so we should have it. */ if (!lp) goto next; /* ** Remove all CCBs queued to the chip for that LUN and put ** them back in the LUN CCB wait queue. */ busyccbs = lp->queuedccbs; i = (INL (nc_scratcha) - np->p_squeue) / 4; j = i; while (i != np->squeueput) { cp2 = ncr_ccb_from_dsa(np, scr_to_cpu(np->squeue[i])); assert(cp2); #ifdef SCSI_NCR_IARB_SUPPORT /* IARB hints may not be relevant any more. Forget them. */ cp2->host_flags &= ~HF_HINT_IARB; #endif if (cp2 && cp2->target == cp->target && cp2->lun == cp->lun) { xpt_remque(&cp2->link_ccbq); xpt_insque_head(&cp2->link_ccbq, &lp->wait_ccbq); --lp->queuedccbs; cp2->queued = 0; } else { if (i != j) np->squeue[j] = np->squeue[i]; if ((j += 2) >= MAX_START*2) j = 0; } if ((i += 2) >= MAX_START*2) i = 0; } if (i != j) /* Copy back the idle task if needed */ np->squeue[j] = np->squeue[i]; np->squeueput = j; /* Update our current start queue pointer */ /* ** Requeue the interrupted CCB in front of the ** LUN CCB wait queue to preserve ordering. */ xpt_remque(&cp->link_ccbq); xpt_insque_head(&cp->link_ccbq, &lp->wait_ccbq); --lp->queuedccbs; cp->queued = 0; next: #ifdef SCSI_NCR_IARB_SUPPORT /* IARB hint may not be relevant any more. Forget it. */ cp->host_flags &= ~HF_HINT_IARB; if (np->last_cp) np->last_cp = 0; #endif /* ** Now we can restart the SCRIPTS processor safely. */ OUTL_DSP (NCB_SCRIPT_PHYS (np, start)); switch(s_status) { default: case S_BUSY: ncr_complete(np, cp); break; case S_QUEUE_FULL: if (!lp || !lp->queuedccbs) { ncr_complete(np, cp); break; } if (bootverbose >= 1) { PRINT_ADDR(cmd); printk ("QUEUE FULL! %d busy, %d disconnected CCBs\n", busyccbs, lp->queuedccbs); } /* ** Decrease number of tags to the number of ** disconnected commands. */ if (lp->queuedccbs < lp->numtags) { lp->numtags = lp->queuedccbs; lp->num_good = 0; ncr_setup_tags (np, cp->target, cp->lun); } /* ** Repair the offending CCB. */ cp->phys.header.savep = cp->startp; cp->phys.header.lastp = cp->lastp0; cp->host_status = HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->xerr_status = 0; cp->extra_bytes = 0; cp->host_flags &= (HF_PM_TO_C|HF_DATA_IN); break; case S_TERMINATED: case S_CHECK_COND: /* ** If we were requesting sense, give up. */ if (cp->host_flags & HF_AUTO_SENSE) { ncr_complete(np, cp); break; } /* ** Save SCSI status and extended error. ** Compute the data residual now. */ cp->sv_scsi_status = cp->scsi_status; cp->sv_xerr_status = cp->xerr_status; cp->resid = ncr_compute_residual(np, cp); /* ** Device returned CHECK CONDITION status. ** Prepare all needed data strutures for getting ** sense data. */ /* ** identify message */ cp->scsi_smsg2[0] = M_IDENTIFY | cp->lun; msglen = 1; /* ** If we are currently using anything different from ** async. 8 bit data transfers with that target, ** start a negotiation, since the device may want ** to report us a UNIT ATTENTION condition due to ** a cause we currently ignore, and we donnot want ** to be stuck with WIDE and/or SYNC data transfer. ** ** cp->nego_status is filled by ncr_prepare_nego(). ** ** Do NOT negotiate if performing integrity check ** or if integrity check has completed, all check ** conditions will have been cleared. */ #ifdef SCSI_NCR_INTEGRITY_CHECKING if (DEBUG_FLAGS & DEBUG_IC) { printk("%s: ncr_sir_to_redo: ic_done %2X, in_progress %2X\n", ncr_name(np), tp->ic_done, cp->cmd->ic_in_progress); } /* ** If parity error during integrity check, ** set the target width to narrow. Otherwise, ** do not negotiate on a request sense. */ if ( np->check_integ_par && np->check_integrity && cp->cmd->ic_in_progress ) { cp->nego_status = 0; msglen += ncr_ic_nego (np, cp, cmd ,&cp->scsi_smsg2[msglen]); } if (!np->check_integrity || (np->check_integrity && (!cp->cmd->ic_in_progress && !tp->ic_done)) ) { ncr_negotiate(np, tp); cp->nego_status = 0; { u_char sync_offset; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) sync_offset = tp->sval & 0x3f; else sync_offset = tp->sval & 0x1f; if ((tp->wval & EWS) || sync_offset) msglen += ncr_prepare_nego (np, cp, &cp->scsi_smsg2[msglen]); } } #else ncr_negotiate(np, tp); cp->nego_status = 0; if ((tp->wval & EWS) || (tp->sval & 0x1f)) msglen += ncr_prepare_nego (np, cp, &cp->scsi_smsg2[msglen]); #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /* ** Message table indirect structure. */ cp->phys.smsg.addr = cpu_to_scr(CCB_PHYS (cp, scsi_smsg2)); cp->phys.smsg.size = cpu_to_scr(msglen); /* ** sense command */ cp->phys.cmd.addr = cpu_to_scr(CCB_PHYS (cp, sensecmd)); cp->phys.cmd.size = cpu_to_scr(6); /* ** patch requested size into sense command */ cp->sensecmd[0] = 0x03; cp->sensecmd[1] = cp->lun << 5; cp->sensecmd[4] = sizeof(cp->sense_buf); /* ** sense data */ bzero(cp->sense_buf, sizeof(cp->sense_buf)); cp->phys.sense.addr = cpu_to_scr(CCB_PHYS(cp,sense_buf[0])); cp->phys.sense.size = cpu_to_scr(sizeof(cp->sense_buf)); /* ** requeue the command. */ startp = NCB_SCRIPTH_PHYS (np, sdata_in); cp->phys.header.savep = cpu_to_scr(startp); cp->phys.header.goalp = cpu_to_scr(startp + 16); cp->phys.header.lastp = cpu_to_scr(startp); cp->phys.header.wgoalp = cpu_to_scr(startp + 16); cp->phys.header.wlastp = cpu_to_scr(startp); cp->host_status = cp->nego_status ? HS_NEGOTIATE : HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->host_flags = (HF_AUTO_SENSE|HF_DATA_IN); cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, select)); /* ** If lp not yet allocated, requeue the command. */ if (!lp) ncr_put_start_queue(np, cp); break; } /* ** requeue awaiting scsi commands for this lun. */ if (lp) ncr_start_next_ccb(np, lp, 1); return; } /*---------------------------------------------------------- ** ** After a device has accepted some management message ** as BUS DEVICE RESET, ABORT TASK, etc ..., or when ** a device signals a UNIT ATTENTION condition, some ** tasks are thrown away by the device. We are required ** to reflect that on our tasks list since the device ** will never complete these tasks. ** ** This function completes all disconnected CCBs for a ** given target that matches the following criteria: ** - lun=-1 means any logical UNIT otherwise a given one. ** - task=-1 means any task, otherwise a given one. **---------------------------------------------------------- */ static int ncr_clear_tasks(ncb_p np, u_char hsts, int target, int lun, int task) { int i = 0; ccb_p cp; for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->target != target) continue; if (lun != -1 && cp->lun != lun) continue; if (task != -1 && cp->tag != NO_TAG && cp->scsi_smsg[2] != task) continue; cp->host_status = hsts; cp->scsi_status = S_ILLEGAL; ncr_complete(np, cp); ++i; } return i; } /*========================================================== ** ** ncr chip handler for TASKS recovery. ** **========================================================== ** ** We cannot safely abort a command, while the SCRIPTS ** processor is running, since we just would be in race ** with it. ** ** As long as we have tasks to abort, we keep the SEM ** bit set in the ISTAT. When this bit is set, the ** SCRIPTS processor interrupts (SIR_SCRIPT_STOPPED) ** each time it enters the scheduler. ** ** If we have to reset a target, clear tasks of a unit, ** or to perform the abort of a disconnected job, we ** restart the SCRIPTS for selecting the target. Once ** selected, the SCRIPTS interrupts (SIR_TARGET_SELECTED). ** If it loses arbitration, the SCRIPTS will interrupt again ** the next time it will enter its scheduler, and so on ... ** ** On SIR_TARGET_SELECTED, we scan for the more ** appropriate thing to do: ** ** - If nothing, we just sent a M_ABORT message to the ** target to get rid of the useless SCSI bus ownership. ** According to the specs, no tasks shall be affected. ** - If the target is to be reset, we send it a M_RESET ** message. ** - If a logical UNIT is to be cleared , we send the ** IDENTIFY(lun) + M_ABORT. ** - If an untagged task is to be aborted, we send the ** IDENTIFY(lun) + M_ABORT. ** - If a tagged task is to be aborted, we send the ** IDENTIFY(lun) + task attributes + M_ABORT_TAG. ** ** Once our 'kiss of death' :) message has been accepted ** by the target, the SCRIPTS interrupts again ** (SIR_ABORT_SENT). On this interrupt, we complete ** all the CCBs that should have been aborted by the ** target according to our message. ** **---------------------------------------------------------- */ static void ncr_sir_task_recovery(ncb_p np, int num) { ccb_p cp; tcb_p tp; int target=-1, lun=-1, task; int i, k; u_char *p; switch(num) { /* ** The SCRIPTS processor stopped before starting ** the next command in order to allow us to perform ** some task recovery. */ case SIR_SCRIPT_STOPPED: /* ** Do we have any target to reset or unit to clear ? */ for (i = 0 ; i < MAX_TARGET ; i++) { tp = &np->target[i]; if (tp->to_reset || (tp->l0p && tp->l0p->to_clear)) { target = i; break; } if (!tp->lmp) continue; for (k = 1 ; k < MAX_LUN ; k++) { if (tp->lmp[k] && tp->lmp[k]->to_clear) { target = i; break; } } if (target != -1) break; } /* ** If not, look at the CCB list for any ** disconnected CCB to be aborted. */ if (target == -1) { for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->to_abort) { target = cp->target; break; } } } /* ** If some target is to be selected, ** prepare and start the selection. */ if (target != -1) { tp = &np->target[target]; np->abrt_sel.sel_id = target; np->abrt_sel.sel_scntl3 = tp->wval; np->abrt_sel.sel_sxfer = tp->sval; np->abrt_sel.sel_scntl4 = tp->uval; OUTL(nc_dsa, np->p_ncb); OUTL_DSP (NCB_SCRIPTH_PHYS (np, sel_for_abort)); return; } /* ** Nothing is to be selected, so we donnot need ** to synchronize with the SCRIPTS anymore. ** Remove the SEM flag from the ISTAT. */ np->istat_sem = 0; OUTB (nc_istat, SIGP); /* ** Now look at CCBs to abort that haven't started yet. ** Remove all those CCBs from the start queue and ** complete them with appropriate status. ** Btw, the SCRIPTS processor is still stopped, so ** we are not in race. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_BUSY && cp->host_status != HS_NEGOTIATE) continue; if (!cp->to_abort) continue; #ifdef SCSI_NCR_IARB_SUPPORT /* ** If we are using IMMEDIATE ARBITRATION, we donnot ** want to cancel the last queued CCB, since the ** SCRIPTS may have anticipated the selection. */ if (cp == np->last_cp) { cp->to_abort = 0; continue; } #endif /* ** Compute index of next position in the start ** queue the SCRIPTS will schedule. */ i = (INL (nc_scratcha) - np->p_squeue) / 4; /* ** Remove the job from the start queue. */ k = -1; while (1) { if (i == np->squeueput) break; if (k == -1) { /* Not found yet */ if (cp == ncr_ccb_from_dsa(np, scr_to_cpu(np->squeue[i]))) k = i; /* Found */ } else { /* ** Once found, we have to move ** back all jobs by 1 position. */ np->squeue[k] = np->squeue[i]; k += 2; if (k >= MAX_START*2) k = 0; } i += 2; if (i >= MAX_START*2) i = 0; } /* ** If job removed, repair the start queue. */ if (k != -1) { np->squeue[k] = np->squeue[i]; /* Idle task */ np->squeueput = k; /* Start queue pointer */ } cp->host_status = HS_ABORTED; cp->scsi_status = S_ILLEGAL; ncr_complete(np, cp); } break; /* ** The SCRIPTS processor has selected a target ** we may have some manual recovery to perform for. */ case SIR_TARGET_SELECTED: target = (INB (nc_sdid) & 0xf); tp = &np->target[target]; np->abrt_tbl.addr = cpu_to_scr(vtobus(np->abrt_msg)); /* ** If the target is to be reset, prepare a ** M_RESET message and clear the to_reset flag ** since we donnot expect this operation to fail. */ if (tp->to_reset) { np->abrt_msg[0] = M_RESET; np->abrt_tbl.size = 1; tp->to_reset = 0; break; } /* ** Otherwise, look for some logical unit to be cleared. */ if (tp->l0p && tp->l0p->to_clear) lun = 0; else if (tp->lmp) { for (k = 1 ; k < MAX_LUN ; k++) { if (tp->lmp[k] && tp->lmp[k]->to_clear) { lun = k; break; } } } /* ** If a logical unit is to be cleared, prepare ** an IDENTIFY(lun) + ABORT MESSAGE. */ if (lun != -1) { lcb_p lp = ncr_lp(np, tp, lun); lp->to_clear = 0; /* We donnot expect to fail here */ np->abrt_msg[0] = M_IDENTIFY | lun; np->abrt_msg[1] = M_ABORT; np->abrt_tbl.size = 2; break; } /* ** Otherwise, look for some disconnected job to ** abort for this target. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->target != target) continue; if (cp->to_abort) break; } /* ** If we have none, probably since the device has ** completed the command before we won abitration, ** send a M_ABORT message without IDENTIFY. ** According to the specs, the device must just ** disconnect the BUS and not abort any task. */ if (!cp) { np->abrt_msg[0] = M_ABORT; np->abrt_tbl.size = 1; break; } /* ** We have some task to abort. ** Set the IDENTIFY(lun) */ np->abrt_msg[0] = M_IDENTIFY | cp->lun; /* ** If we want to abort an untagged command, we ** will send a IDENTIFY + M_ABORT. ** Otherwise (tagged command), we will send ** a IDENTITFY + task attributes + ABORT TAG. */ if (cp->tag == NO_TAG) { np->abrt_msg[1] = M_ABORT; np->abrt_tbl.size = 2; } else { np->abrt_msg[1] = cp->scsi_smsg[1]; np->abrt_msg[2] = cp->scsi_smsg[2]; np->abrt_msg[3] = M_ABORT_TAG; np->abrt_tbl.size = 4; } cp->to_abort = 0; /* We donnot expect to fail here */ break; /* ** The target has accepted our message and switched ** to BUS FREE phase as we expected. */ case SIR_ABORT_SENT: target = (INB (nc_sdid) & 0xf); tp = &np->target[target]; /* ** If we didn't abort anything, leave here. */ if (np->abrt_msg[0] == M_ABORT) break; /* ** If we sent a M_RESET, then a hardware reset has ** been performed by the target. ** - Reset everything to async 8 bit ** - Tell ourself to negotiate next time :-) ** - Prepare to clear all disconnected CCBs for ** this target from our task list (lun=task=-1) */ lun = -1; task = -1; if (np->abrt_msg[0] == M_RESET) { tp->sval = 0; tp->wval = np->rv_scntl3; tp->uval = np->rv_scntl4; ncr_set_sync_wide_status(np, target); ncr_negotiate(np, tp); } /* ** Otherwise, check for the LUN and TASK(s) ** concerned by the cancelation. ** If it is not ABORT_TAG then it is CLEAR_QUEUE ** or an ABORT message :-) */ else { lun = np->abrt_msg[0] & 0x3f; if (np->abrt_msg[1] == M_ABORT_TAG) task = np->abrt_msg[2]; } /* ** Complete all the CCBs the device should have ** aborted due to our 'kiss of death' message. */ (void) ncr_clear_tasks(np, HS_ABORTED, target, lun, task); break; /* ** We have performed a auto-sense that succeeded. ** If the device reports a UNIT ATTENTION condition ** due to a RESET condition, we must complete all ** disconnect CCBs for this unit since the device ** shall have thrown them away. ** Since I haven't time to guess what the specs are ** expecting for other UNIT ATTENTION conditions, I ** decided to only care about RESET conditions. :) */ case SIR_AUTO_SENSE_DONE: cp = ncr_ccb_from_dsa(np, INL (nc_dsa)); if (!cp) break; memcpy(cp->cmd->sense_buffer, cp->sense_buf, sizeof(cp->cmd->sense_buffer)); p = &cp->cmd->sense_buffer[0]; if (p[0] != 0x70 || p[2] != 0x6 || p[12] != 0x29) break; #if 0 (void) ncr_clear_tasks(np, HS_RESET, cp->target, cp->lun, -1); #endif break; } /* ** Print to the log the message we intend to send. */ if (num == SIR_TARGET_SELECTED) { PRINT_TARGET(np, target); ncr_printl_hex("control msgout:", np->abrt_msg, np->abrt_tbl.size); np->abrt_tbl.size = cpu_to_scr(np->abrt_tbl.size); } /* ** Let the SCRIPTS processor continue. */ OUTONB_STD (); } /*========================================================== ** ** Grard's alchemy:) that deals with with the data ** pointer for both MDP and the residual calculation. ** **========================================================== ** ** I didn't want to bloat the code by more than 200 ** lignes for the handling of both MDP and the residual. ** This has been achieved by using a data pointer ** representation consisting in an index in the data ** array (dp_sg) and a negative offset (dp_ofs) that ** have the following meaning: ** ** - dp_sg = MAX_SCATTER ** we are at the end of the data script. ** - dp_sg < MAX_SCATTER ** dp_sg points to the next entry of the scatter array ** we want to transfer. ** - dp_ofs < 0 ** dp_ofs represents the residual of bytes of the ** previous entry scatter entry we will send first. ** - dp_ofs = 0 ** no residual to send first. ** ** The function ncr_evaluate_dp() accepts an arbitray ** offset (basically from the MDP message) and returns ** the corresponding values of dp_sg and dp_ofs. ** **---------------------------------------------------------- */ static int ncr_evaluate_dp(ncb_p np, ccb_p cp, u_int32 scr, int *ofs) { u_int32 dp_scr; int dp_ofs, dp_sg, dp_sgmin; int tmp; struct pm_ctx *pm; /* ** Compute the resulted data pointer in term of a script ** address within some DATA script and a signed byte offset. */ dp_scr = scr; dp_ofs = *ofs; if (dp_scr == NCB_SCRIPT_PHYS (np, pm0_data)) pm = &cp->phys.pm0; else if (dp_scr == NCB_SCRIPT_PHYS (np, pm1_data)) pm = &cp->phys.pm1; else pm = 0; if (pm) { dp_scr = scr_to_cpu(pm->ret); dp_ofs -= scr_to_cpu(pm->sg.size); } /* ** Deduce the index of the sg entry. ** Keep track of the index of the first valid entry. ** If result is dp_sg = MAX_SCATTER, then we are at the ** end of the data and vice-versa. */ tmp = scr_to_cpu(cp->phys.header.goalp); dp_sg = MAX_SCATTER; if (dp_scr != tmp) dp_sg -= (tmp - 8 - (int)dp_scr) / (SCR_SG_SIZE*4); dp_sgmin = MAX_SCATTER - cp->segments; /* ** Move to the sg entry the data pointer belongs to. ** ** If we are inside the data area, we expect result to be: ** ** Either, ** dp_ofs = 0 and dp_sg is the index of the sg entry ** the data pointer belongs to (or the end of the data) ** Or, ** dp_ofs < 0 and dp_sg is the index of the sg entry ** the data pointer belongs to + 1. */ if (dp_ofs < 0) { int n; while (dp_sg > dp_sgmin) { --dp_sg; tmp = scr_to_cpu(cp->phys.data[dp_sg].size); n = dp_ofs + (tmp & 0xffffff); if (n > 0) { ++dp_sg; break; } dp_ofs = n; } } else if (dp_ofs > 0) { while (dp_sg < MAX_SCATTER) { tmp = scr_to_cpu(cp->phys.data[dp_sg].size); dp_ofs -= (tmp & 0xffffff); ++dp_sg; if (dp_ofs <= 0) break; } } /* ** Make sure the data pointer is inside the data area. ** If not, return some error. */ if (dp_sg < dp_sgmin || (dp_sg == dp_sgmin && dp_ofs < 0)) goto out_err; else if (dp_sg > MAX_SCATTER || (dp_sg == MAX_SCATTER && dp_ofs > 0)) goto out_err; /* ** Save the extreme pointer if needed. */ if (dp_sg > cp->ext_sg || (dp_sg == cp->ext_sg && dp_ofs > cp->ext_ofs)) { cp->ext_sg = dp_sg; cp->ext_ofs = dp_ofs; } /* ** Return data. */ *ofs = dp_ofs; return dp_sg; out_err: return -1; } /*========================================================== ** ** ncr chip handler for MODIFY DATA POINTER MESSAGE ** **========================================================== ** ** We also call this function on IGNORE WIDE RESIDUE ** messages that do not match a SWIDE full condition. ** Btw, we assume in that situation that such a message ** is equivalent to a MODIFY DATA POINTER (offset=-1). ** **---------------------------------------------------------- */ static void ncr_modify_dp(ncb_p np, tcb_p tp, ccb_p cp, int ofs) { int dp_ofs = ofs; u_int32 dp_scr = INL (nc_temp); u_int32 dp_ret; u_int32 tmp; u_char hflags; int dp_sg; struct pm_ctx *pm; /* ** Not supported for auto_sense; */ if (cp->host_flags & HF_AUTO_SENSE) goto out_reject; /* ** Apply our alchemy:) (see comments in ncr_evaluate_dp()), ** to the resulted data pointer. */ dp_sg = ncr_evaluate_dp(np, cp, dp_scr, &dp_ofs); if (dp_sg < 0) goto out_reject; /* ** And our alchemy:) allows to easily calculate the data ** script address we want to return for the next data phase. */ dp_ret = cpu_to_scr(cp->phys.header.goalp); dp_ret = dp_ret - 8 - (MAX_SCATTER - dp_sg) * (SCR_SG_SIZE*4); /* ** If offset / scatter entry is zero we donnot need ** a context for the new current data pointer. */ if (dp_ofs == 0) { dp_scr = dp_ret; goto out_ok; } /* ** Get a context for the new current data pointer. */ hflags = INB (HF_PRT); if (hflags & HF_DP_SAVED) hflags ^= HF_ACT_PM; if (!(hflags & HF_ACT_PM)) { pm = &cp->phys.pm0; dp_scr = NCB_SCRIPT_PHYS (np, pm0_data); } else { pm = &cp->phys.pm1; dp_scr = NCB_SCRIPT_PHYS (np, pm1_data); } hflags &= ~(HF_DP_SAVED); OUTB (HF_PRT, hflags); /* ** Set up the new current data pointer. ** ofs < 0 there, and for the next data phase, we ** want to transfer part of the data of the sg entry ** corresponding to index dp_sg-1 prior to returning ** to the main data script. */ pm->ret = cpu_to_scr(dp_ret); tmp = scr_to_cpu(cp->phys.data[dp_sg-1].addr); tmp += scr_to_cpu(cp->phys.data[dp_sg-1].size) + dp_ofs; pm->sg.addr = cpu_to_scr(tmp); pm->sg.size = cpu_to_scr(-dp_ofs); out_ok: OUTL (nc_temp, dp_scr); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; out_reject: OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } /*========================================================== ** ** ncr chip calculation of the data residual. ** **========================================================== ** ** As I used to say, the requirement of data residual ** in SCSI is broken, useless and cannot be achieved ** without huge complexity. ** But most OSes and even the official CAM require it. ** When stupidity happens to be so widely spread inside ** a community, it gets hard to convince. ** ** Anyway, I don't care, since I am not going to use ** any software that considers this data residual as ** a relevant information. :) ** **---------------------------------------------------------- */ static int ncr_compute_residual(ncb_p np, ccb_p cp) { int dp_sg, dp_sgmin, tmp; int resid=0; int dp_ofs = 0; /* * Check for some data lost or just thrown away. * We are not required to be quite accurate in this * situation. Btw, if we are odd for output and the * device claims some more data, it may well happen * than our residual be zero. :-) */ if (cp->xerr_status & (XE_EXTRA_DATA|XE_SODL_UNRUN|XE_SWIDE_OVRUN)) { if (cp->xerr_status & XE_EXTRA_DATA) resid -= cp->extra_bytes; if (cp->xerr_status & XE_SODL_UNRUN) ++resid; if (cp->xerr_status & XE_SWIDE_OVRUN) --resid; } /* ** If SCRIPTS reaches its goal point, then ** there is no additionnal residual. */ if (cp->phys.header.lastp == cp->phys.header.goalp) return resid; /* ** If the last data pointer is data_io (direction ** unknown), then no data transfer should have ** taken place. */ if (cp->phys.header.lastp == NCB_SCRIPTH_PHYS (np, data_io)) return cp->data_len; /* ** If no data transfer occurs, or if the data ** pointer is weird, return full residual. */ if (cp->startp == cp->phys.header.lastp || ncr_evaluate_dp(np, cp, scr_to_cpu(cp->phys.header.lastp), &dp_ofs) < 0) { return cp->data_len; } /* ** We are now full comfortable in the computation ** of the data residual (2's complement). */ dp_sgmin = MAX_SCATTER - cp->segments; resid = -cp->ext_ofs; for (dp_sg = cp->ext_sg; dp_sg < MAX_SCATTER; ++dp_sg) { tmp = scr_to_cpu(cp->phys.data[dp_sg].size); resid += (tmp & 0xffffff); } /* ** Hopefully, the result is not too wrong. */ return resid; } /*========================================================== ** ** Print out the containt of a SCSI message. ** **========================================================== */ static int ncr_show_msg (u_char * msg) { u_char i; printk ("%x",*msg); if (*msg==M_EXTENDED) { for (i=1;i<8;i++) { if (i-1>msg[1]) break; printk ("-%x",msg[i]); }; return (i+1); } else if ((*msg & 0xf0) == 0x20) { printk ("-%x",msg[1]); return (2); }; return (1); } static void ncr_print_msg (ccb_p cp, char *label, u_char *msg) { if (cp) PRINT_ADDR(cp->cmd); if (label) printk ("%s: ", label); (void) ncr_show_msg (msg); printk (".\n"); } /*=================================================================== ** ** Negotiation for WIDE and SYNCHRONOUS DATA TRANSFER. ** **=================================================================== ** ** Was Sie schon immer ueber transfermode negotiation wissen wollten ... ** ** We try to negotiate sync and wide transfer only after ** a successful inquire command. We look at byte 7 of the ** inquire data to determine the capabilities of the target. ** ** When we try to negotiate, we append the negotiation message ** to the identify and (maybe) simple tag message. ** The host status field is set to HS_NEGOTIATE to mark this ** situation. ** ** If the target doesn't answer this message immediately ** (as required by the standard), the SIR_NEGO_FAILED interrupt ** will be raised eventually. ** The handler removes the HS_NEGOTIATE status, and sets the ** negotiated value to the default (async / nowide). ** ** If we receive a matching answer immediately, we check it ** for validity, and set the values. ** ** If we receive a Reject message immediately, we assume the ** negotiation has failed, and fall back to standard values. ** ** If we receive a negotiation message while not in HS_NEGOTIATE ** state, it's a target initiated negotiation. We prepare a ** (hopefully) valid answer, set our parameters, and send back ** this answer to the target. ** ** If the target doesn't fetch the answer (no message out phase), ** we assume the negotiation has failed, and fall back to default ** settings (SIR_NEGO_PROTO interrupt). ** ** When we set the values, we adjust them in all ccbs belonging ** to this target, in the controller's register, and in the "phys" ** field of the controller's struct ncb. ** **--------------------------------------------------------------------- */ /*========================================================== ** ** ncr chip handler for SYNCHRONOUS DATA TRANSFER ** REQUEST (SDTR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_sync_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char scntl3, scntl4; u_char chg, ofs, per, fak; /* ** Synchronous request message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "sync msg in", np->msgin); }; /* ** get requested values. */ chg = 0; per = np->msgin[3]; ofs = np->msgin[4]; if (ofs==0) per=255; /* ** if target sends SDTR message, ** it CAN transfer synch. */ if (ofs) tp->inq_byte7 |= INQ7_SYNC; /* ** check values against driver limits. */ if (per < np->minsync) {chg = 1; per = np->minsync;} if (per < tp->minsync) {chg = 1; per = tp->minsync;} if (ofs > np->maxoffs_st) {chg = 1; ofs = np->maxoffs_st;} if (ofs > tp->maxoffs) {chg = 1; ofs = tp->maxoffs;} /* ** Check against controller limits. */ fak = 7; scntl3 = 0; scntl4 = 0; if (ofs != 0) { ncr_getsync(np, per, &fak, &scntl3); if (fak > 7) { chg = 1; ofs = 0; } } if (ofs == 0) { fak = 7; per = 0; scntl3 = 0; scntl4 = 0; tp->minsync = 0; } if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("sync: per=%d scntl3=0x%x scntl4=0x%x ofs=%d fak=%d chg=%d.\n", per, scntl3, scntl4, ofs, fak, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_SYNC: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ ncr_setsync (np, cp, 0, 0xe0, 0); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsync (np, cp, scntl3, (fak<<5)|ofs,0); else ncr_setsync (np, cp, scntl3, ofs, scntl4); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; }; }; /* ** It was a request. Set value and ** prepare an answer message */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsync (np, cp, scntl3, (fak<<5)|ofs,0); else ncr_setsync (np, cp, scntl3, ofs, scntl4); np->msgout[0] = M_EXTENDED; np->msgout[1] = 3; np->msgout[2] = M_X_SYNC_REQ; np->msgout[3] = per; np->msgout[4] = ofs; cp->nego_status = NS_SYNC; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "sync msgout", np->msgout); } np->msgin [0] = M_NOOP; if (!ofs) OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); else OUTL_DSP (NCB_SCRIPTH_PHYS (np, sdtr_resp)); } /*========================================================== ** ** ncr chip handler for WIDE DATA TRANSFER REQUEST ** (WDTR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_wide_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char chg, wide; /* ** Wide request message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "wide msgin", np->msgin); }; /* ** get requested values. */ chg = 0; wide = np->msgin[3]; /* ** if target sends WDTR message, ** it CAN transfer wide. */ if (wide) tp->inq_byte7 |= INQ7_WIDE16; /* ** check values against driver limits. */ if (wide > tp->usrwide) {chg = 1; wide = tp->usrwide;} if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("wide: wide=%d chg=%d.\n", wide, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_WIDE: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ ncr_setwide (np, cp, 0, 1); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ ncr_setwide (np, cp, wide, 1); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; }; }; /* ** It was a request, set value and ** prepare an answer message */ ncr_setwide (np, cp, wide, 1); np->msgout[0] = M_EXTENDED; np->msgout[1] = 2; np->msgout[2] = M_X_WIDE_REQ; np->msgout[3] = wide; np->msgin [0] = M_NOOP; cp->nego_status = NS_WIDE; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "wide msgout", np->msgout); } OUTL_DSP (NCB_SCRIPTH_PHYS (np, wdtr_resp)); } /*========================================================== ** ** ncr chip handler for PARALLEL PROTOCOL REQUEST ** (PPR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_ppr_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char scntl3, scntl4; u_char chg, ofs, per, fak, wth, dt; /* ** PPR message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "ppr msg in", np->msgin); }; /* ** get requested values. */ chg = 0; per = np->msgin[3]; ofs = np->msgin[5]; wth = np->msgin[6]; dt = np->msgin[7]; if (ofs==0) per=255; /* ** if target sends sync (wide), ** it CAN transfer synch (wide). */ if (ofs) tp->inq_byte7 |= INQ7_SYNC; if (wth) tp->inq_byte7 |= INQ7_WIDE16; /* ** check values against driver limits. */ if (wth > tp->usrwide) {chg = 1; wth = tp->usrwide;} if (per < np->minsync) {chg = 1; per = np->minsync;} if (per < tp->minsync) {chg = 1; per = tp->minsync;} if (ofs > tp->maxoffs) {chg = 1; ofs = tp->maxoffs;} /* ** Check against controller limits. */ fak = 7; scntl3 = 0; scntl4 = 0; if (ofs != 0) { scntl4 = dt ? 0x80 : 0; ncr_getsync(np, per, &fak, &scntl3); if (fak > 7) { chg = 1; ofs = 0; } } if (ofs == 0) { fak = 7; per = 0; scntl3 = 0; scntl4 = 0; tp->minsync = 0; } /* ** If target responds with Ultra 3 speed ** but narrow or not DT, reject. ** If target responds with DT request ** but not Ultra3 speeds, reject message, ** reset min sync for target to 0x0A and ** set flags to re-negotiate. */ if ((per == 0x09) && ofs && (!wth || !dt)) chg = 1; else if (( (per > 0x09) && dt) ) chg = 2; /* Not acceptable since beyond controller limit */ if (!dt && ofs > np->maxoffs_st) {chg = 2; ofs = np->maxoffs_st;} if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("ppr: wth=%d per=%d scntl3=0x%x scntl4=0x%x ofs=%d fak=%d chg=%d.\n", wth, per, scntl3, scntl4, ofs, fak, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_PPR: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ if (chg == 2) { /* Send message reject and reset flags for ** host to re-negotiate with min period 0x0A. */ tp->minsync = 0x0A; tp->period = 0; tp->widedone = 0; } ncr_setsyncwide (np, cp, 0, 0xe0, 0, 0); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsyncwide (np, cp, scntl3, (fak<<5)|ofs,0, wth); else ncr_setsyncwide (np, cp, scntl3, ofs, scntl4, wth); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; }; }; /* ** It was a request. Set value and ** prepare an answer message ** ** If narrow or not DT and requesting Ultra3 ** slow the bus down and force ST. If not ** requesting Ultra3, force ST. ** Max offset is 31=0x1f if ST mode. */ if ((per == 0x09) && ofs && (!wth || !dt)) { per = 0x0A; dt = 0; } else if ( (per > 0x09) && dt) { dt = 0; } if (!dt && ofs > np->maxoffs_st) ofs = np->maxoffs_st; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsyncwide (np, cp, scntl3, (fak<<5)|ofs,0, wth); else ncr_setsyncwide (np, cp, scntl3, ofs, scntl4, wth); np->msgout[0] = M_EXTENDED; np->msgout[1] = 6; np->msgout[2] = M_X_PPR_REQ; np->msgout[3] = per; np->msgout[4] = 0; np->msgout[5] = ofs; np->msgout[6] = wth; np->msgout[7] = dt; cp->nego_status = NS_PPR; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "ppr msgout", np->msgout); } np->msgin [0] = M_NOOP; if (!ofs) OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); else OUTL_DSP (NCB_SCRIPTH_PHYS (np, ppr_resp)); } /* ** Reset SYNC or WIDE to default settings. ** Called when a negotiation does not succeed either ** on rejection or on protocol error. */ static void ncr_nego_default(ncb_p np, tcb_p tp, ccb_p cp) { /* ** any error in negotiation: ** fall back to default mode. */ switch (cp->nego_status) { case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; case NS_PPR: /* * ppr_negotiation is set to 1 on the first ppr nego command. * If ppr is successful, it is reset to 2. * If unsuccessful it is reset to 0. */ if (DEBUG_FLAGS & DEBUG_NEGO) { tcb_p tp=&np->target[cp->target]; u_char factor, offset, width; ncr_get_xfer_info ( np, tp, &factor, &offset, &width); printk("Current factor %d offset %d width %d\n", factor, offset, width); } if (tp->ppr_negotiation == 2) ncr_setsyncwide (np, cp, 0, 0xe0, 0, 0); else if (tp->ppr_negotiation == 1) { /* First ppr command has received a M REJECT. * Do not change the existing wide/sync parameter * values (asyn/narrow if this as the first nego; * may be different if target initiates nego.). */ tp->ppr_negotiation = 0; } else { tp->ppr_negotiation = 0; ncr_setwide (np, cp, 0, 0); } break; }; np->msgin [0] = M_NOOP; np->msgout[0] = M_NOOP; cp->nego_status = 0; } /*========================================================== ** ** ncr chip handler for MESSAGE REJECT received for ** a WIDE or SYNCHRONOUS negotiation. ** ** clear the PPR negotiation flag, all future nego. ** will be SDTR and WDTR ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_nego_rejected(ncb_p np, tcb_p tp, ccb_p cp) { ncr_nego_default(np, tp, cp); OUTB (HS_PRT, HS_BUSY); } /*========================================================== ** ** ** ncr chip exception handler for programmed interrupts. ** ** **========================================================== */ void ncr_int_sir (ncb_p np) { u_char num = INB (nc_dsps); u_long dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); u_char target = INB (nc_sdid) & 0x0f; tcb_p tp = &np->target[target]; int tmp; if (DEBUG_FLAGS & DEBUG_TINY) printk ("I#%d", num); switch (num) { /* ** See comments in the SCRIPTS code. */ #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR case SIR_DUMMY_INTERRUPT: goto out; #endif /* ** The C code is currently trying to recover from something. ** Typically, user want to abort some command. */ case SIR_SCRIPT_STOPPED: case SIR_TARGET_SELECTED: case SIR_ABORT_SENT: case SIR_AUTO_SENSE_DONE: ncr_sir_task_recovery(np, num); return; /* ** The device didn't go to MSG OUT phase after having ** been selected with ATN. We donnot want to handle ** that. */ case SIR_SEL_ATN_NO_MSG_OUT: printk ("%s:%d: No MSG OUT phase after selection with ATN.\n", ncr_name (np), target); goto out_stuck; /* ** The device didn't switch to MSG IN phase after ** having reseleted the initiator. */ case SIR_RESEL_NO_MSG_IN: /* ** After reselection, the device sent a message that wasn't ** an IDENTIFY. */ case SIR_RESEL_NO_IDENTIFY: /* ** If devices reselecting without sending an IDENTIFY ** message still exist, this should help. ** We just assume lun=0, 1 CCB, no tag. */ if (tp->l0p) { OUTL (nc_dsa, scr_to_cpu(tp->l0p->tasktbl[0])); OUTL_DSP (NCB_SCRIPT_PHYS (np, resel_go)); return; } /* ** The device reselected a LUN we donnot know of. */ case SIR_RESEL_BAD_LUN: np->msgout[0] = M_RESET; goto out; /* ** The device reselected for an untagged nexus and we ** haven't any. */ case SIR_RESEL_BAD_I_T_L: np->msgout[0] = M_ABORT; goto out; /* ** The device reselected for a tagged nexus that we donnot ** have. */ case SIR_RESEL_BAD_I_T_L_Q: np->msgout[0] = M_ABORT_TAG; goto out; /* ** The SCRIPTS let us know that the device has grabbed ** our message and will abort the job. */ case SIR_RESEL_ABORTED: np->lastmsg = np->msgout[0]; np->msgout[0] = M_NOOP; printk ("%s:%d: message %x sent on bad reselection.\n", ncr_name (np), target, np->lastmsg); goto out; /* ** The SCRIPTS let us know that a message has been ** successfully sent to the device. */ case SIR_MSG_OUT_DONE: np->lastmsg = np->msgout[0]; np->msgout[0] = M_NOOP; /* Should we really care of that */ if (np->lastmsg == M_PARITY || np->lastmsg == M_ID_ERROR) { if (cp) { cp->xerr_status &= ~XE_PARITY_ERR; if (!cp->xerr_status) OUTOFFB (HF_PRT, HF_EXT_ERR); } } goto out; /* ** The device didn't send a GOOD SCSI status. ** We may have some work to do prior to allow ** the SCRIPTS processor to continue. */ case SIR_BAD_STATUS: if (!cp) goto out; ncr_sir_to_redo(np, num, cp); return; /* ** We are asked by the SCRIPTS to prepare a ** REJECT message. */ case SIR_REJECT_TO_SEND: ncr_print_msg(cp, "M_REJECT to send for ", np->msgin); np->msgout[0] = M_REJECT; goto out; /* ** We have been ODD at the end of a DATA IN ** transfer and the device didn't send a ** IGNORE WIDE RESIDUE message. ** It is a data overrun condition. */ case SIR_SWIDE_OVERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_SWIDE_OVRUN; } goto out; /* ** We have been ODD at the end of a DATA OUT ** transfer. ** It is a data underrun condition. */ case SIR_SODL_UNDERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_SODL_UNRUN; } goto out; /* ** The device wants us to tranfer more data than ** expected or in the wrong direction. ** The number of extra bytes is in scratcha. ** It is a data overrun condition. */ case SIR_DATA_OVERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_EXTRA_DATA; cp->extra_bytes += INL (nc_scratcha); } goto out; /* ** The device switched to an illegal phase (4/5). */ case SIR_BAD_PHASE: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_BAD_PHASE; } goto out; /* ** We received a message. */ case SIR_MSG_RECEIVED: if (!cp) goto out_stuck; switch (np->msgin [0]) { /* ** We received an extended message. ** We handle MODIFY DATA POINTER, SDTR, WDTR ** and reject all other extended messages. */ case M_EXTENDED: switch (np->msgin [2]) { case M_X_MODIFY_DP: if (DEBUG_FLAGS & DEBUG_POINTER) ncr_print_msg(cp,"modify DP",np->msgin); tmp = (np->msgin[3]<<24) + (np->msgin[4]<<16) + (np->msgin[5]<<8) + (np->msgin[6]); ncr_modify_dp(np, tp, cp, tmp); return; case M_X_SYNC_REQ: ncr_sync_nego(np, tp, cp); return; case M_X_WIDE_REQ: ncr_wide_nego(np, tp, cp); return; case M_X_PPR_REQ: ncr_ppr_nego(np, tp, cp); return; default: goto out_reject; } break; /* ** We received a 1/2 byte message not handled from SCRIPTS. ** We are only expecting MESSAGE REJECT and IGNORE WIDE ** RESIDUE messages that haven't been anticipated by ** SCRIPTS on SWIDE full condition. Unanticipated IGNORE ** WIDE RESIDUE messages are aliased as MODIFY DP (-1). */ case M_IGN_RESIDUE: if (DEBUG_FLAGS & DEBUG_POINTER) ncr_print_msg(cp,"ign wide residue", np->msgin); ncr_modify_dp(np, tp, cp, -1); return; case M_REJECT: if (INB (HS_PRT) == HS_NEGOTIATE) ncr_nego_rejected(np, tp, cp); else { PRINT_ADDR(cp->cmd); printk ("M_REJECT received (%x:%x).\n", scr_to_cpu(np->lastmsg), np->msgout[0]); } goto out_clrack; break; default: goto out_reject; } break; /* ** We received an unknown message. ** Ignore all MSG IN phases and reject it. */ case SIR_MSG_WEIRD: ncr_print_msg(cp, "WEIRD message received", np->msgin); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_weird)); return; /* ** Negotiation failed. ** Target does not send us the reply. ** Remove the HS_NEGOTIATE status. */ case SIR_NEGO_FAILED: OUTB (HS_PRT, HS_BUSY); /* ** Negotiation failed. ** Target does not want answer message. */ case SIR_NEGO_PROTO: ncr_nego_default(np, tp, cp); goto out; }; out: OUTONB_STD (); return; out_reject: OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); return; out_clrack: OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; out_stuck: return; } /*========================================================== ** ** ** Acquire a control block ** ** **========================================================== */ static ccb_p ncr_get_ccb (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_short tag = NO_TAG; XPT_QUEHEAD *qp; ccb_p cp = (ccb_p) 0; /* ** Allocate a new CCB if needed. */ if (xpt_que_empty(&np->free_ccbq)) (void) ncr_alloc_ccb(np); /* ** Look for a free CCB */ qp = xpt_remque_head(&np->free_ccbq); if (!qp) goto out; cp = xpt_que_entry(qp, struct ccb, link_ccbq); /* ** If the LCB is not yet available and we already ** have queued a CCB for a LUN without LCB, ** give up. Otherwise all is fine. :-) */ if (!lp) { if (xpt_que_empty(&np->b0_ccbq)) xpt_insque_head(&cp->link_ccbq, &np->b0_ccbq); else goto out_free; } else { /* ** Tune tag mode if asked by user. */ if (lp->queuedepth != lp->numtags) { ncr_setup_tags(np, tn, ln); } /* ** Get a tag for this nexus if required. ** Keep from using more tags than we can handle. */ if (lp->usetags) { if (lp->busyccbs < lp->maxnxs) { tag = lp->cb_tags[lp->ia_tag]; ++lp->ia_tag; if (lp->ia_tag == MAX_TAGS) lp->ia_tag = 0; cp->tags_si = lp->tags_si; ++lp->tags_sum[cp->tags_si]; } else goto out_free; } /* ** Put the CCB in the LUN wait queue and ** count it as busy. */ xpt_insque_tail(&cp->link_ccbq, &lp->wait_ccbq); ++lp->busyccbs; } /* ** Remember all informations needed to free this CCB. */ cp->to_abort = 0; cp->tag = tag; cp->target = tn; cp->lun = ln; if (DEBUG_FLAGS & DEBUG_TAGS) { PRINT_LUN(np, tn, ln); printk ("ccb @%p using tag %d.\n", cp, tag); } out: return cp; out_free: xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); return (ccb_p) 0; } /*========================================================== ** ** ** Release one control block ** ** **========================================================== */ static void ncr_free_ccb (ncb_p np, ccb_p cp) { tcb_p tp = &np->target[cp->target]; lcb_p lp = ncr_lp(np, tp, cp->lun); if (DEBUG_FLAGS & DEBUG_TAGS) { PRINT_LUN(np, cp->target, cp->lun); printk ("ccb @%p freeing tag %d.\n", cp, cp->tag); } /* ** If lun control block available, make available ** the task slot and the tag if any. ** Decrement counters. */ if (lp) { if (cp->tag != NO_TAG) { lp->cb_tags[lp->if_tag++] = cp->tag; if (lp->if_tag == MAX_TAGS) lp->if_tag = 0; --lp->tags_sum[cp->tags_si]; lp->tasktbl[cp->tag] = cpu_to_scr(np->p_bad_i_t_l_q); } else { lp->tasktbl[0] = cpu_to_scr(np->p_bad_i_t_l); } --lp->busyccbs; if (cp->queued) { --lp->queuedccbs; } } /* ** Make this CCB available. */ xpt_remque(&cp->link_ccbq); xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); cp -> host_status = HS_IDLE; cp -> queued = 0; } /*------------------------------------------------------------------------ ** Allocate a CCB and initialize its fixed part. **------------------------------------------------------------------------ **------------------------------------------------------------------------ */ static ccb_p ncr_alloc_ccb(ncb_p np) { ccb_p cp = 0; int hcode; /* ** Allocate memory for this CCB. */ cp = m_calloc_dma(sizeof(struct ccb), "CCB"); if (!cp) return 0; /* ** Count it and initialyze it. */ np->actccbs++; /* ** Remember virtual and bus address of this ccb. */ cp->p_ccb = vtobus(cp); /* ** Insert this ccb into the hashed list. */ hcode = CCB_HASH_CODE(cp->p_ccb); cp->link_ccbh = np->ccbh[hcode]; np->ccbh[hcode] = cp; /* ** Initialyze the start and restart actions. */ cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); cp->phys.header.go.restart = cpu_to_scr(NCB_SCRIPTH_PHYS(np,bad_i_t_l)); /* ** Initilialyze some other fields. */ cp->phys.smsg_ext.addr = cpu_to_scr(NCB_PHYS(np, msgin[2])); /* ** Chain into wakeup list and free ccb queue. */ cp->link_ccb = np->ccbc; np->ccbc = cp; xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); return cp; } /*------------------------------------------------------------------------ ** Look up a CCB from a DSA value. **------------------------------------------------------------------------ **------------------------------------------------------------------------ */ static ccb_p ncr_ccb_from_dsa(ncb_p np, u_long dsa) { int hcode; ccb_p cp; hcode = CCB_HASH_CODE(dsa); cp = np->ccbh[hcode]; while (cp) { if (cp->p_ccb == dsa) break; cp = cp->link_ccbh; } return cp; } /*========================================================== ** ** ** Allocation of resources for Targets/Luns/Tags. ** ** **========================================================== */ /*------------------------------------------------------------------------ ** Target control block initialisation. **------------------------------------------------------------------------ ** This data structure is fully initialized after a SCSI command ** has been successfully completed for this target. **------------------------------------------------------------------------ */ static void ncr_init_tcb (ncb_p np, u_char tn) { /* ** Check some alignments required by the chip. */ assert (( (offsetof(struct ncr_reg, nc_sxfer) ^ offsetof(struct tcb , sval )) &3) == 0); assert (( (offsetof(struct ncr_reg, nc_scntl3) ^ offsetof(struct tcb , wval )) &3) == 0); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)){ assert (( (offsetof(struct ncr_reg, nc_scntl4) ^ offsetof(struct tcb , uval )) &3) == 0); } } /*------------------------------------------------------------------------ ** Lun control block allocation and initialization. **------------------------------------------------------------------------ ** This data structure is allocated and initialized after a SCSI ** command has been successfully completed for this target/lun. **------------------------------------------------------------------------ */ static lcb_p ncr_alloc_lcb (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); /* ** Already done, return. */ if (lp) return lp; /* ** Initialize the target control block if not yet. */ ncr_init_tcb(np, tn); /* ** Allocate the lcb bus address array. ** Compute the bus address of this table. */ if (ln && !tp->luntbl) { int i; tp->luntbl = m_calloc_dma(256, "LUNTBL"); if (!tp->luntbl) goto fail; for (i = 0 ; i < 64 ; i++) tp->luntbl[i] = cpu_to_scr(NCB_PHYS(np, resel_badlun)); tp->b_luntbl = cpu_to_scr(vtobus(tp->luntbl)); } /* ** Allocate the table of pointers for LUN(s) > 0, if needed. */ if (ln && !tp->lmp) { tp->lmp = m_calloc(MAX_LUN * sizeof(lcb_p), "LMP"); if (!tp->lmp) goto fail; } /* ** Allocate the lcb. ** Make it available to the chip. */ lp = m_calloc_dma(sizeof(struct lcb), "LCB"); if (!lp) goto fail; if (ln) { tp->lmp[ln] = lp; tp->luntbl[ln] = cpu_to_scr(vtobus(lp)); } else { tp->l0p = lp; tp->b_lun0 = cpu_to_scr(vtobus(lp)); } /* ** Initialize the CCB queue headers. */ xpt_que_init(&lp->busy_ccbq); xpt_que_init(&lp->wait_ccbq); /* ** Set max CCBs to 1 and use the default task array ** by default. */ lp->maxnxs = 1; lp->tasktbl = &lp->tasktbl_0; lp->b_tasktbl = cpu_to_scr(vtobus(lp->tasktbl)); lp->tasktbl[0] = cpu_to_scr(np->p_notask); lp->resel_task = cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_notag)); /* ** Initialize command queuing control. */ lp->busyccbs = 1; lp->queuedccbs = 1; lp->queuedepth = 1; fail: return lp; } /*------------------------------------------------------------------------ ** Lun control block setup on INQUIRY data received. **------------------------------------------------------------------------ ** We only support WIDE, SYNC for targets and CMDQ for logical units. ** This setup is done on each INQUIRY since we are expecting user ** will play with CHANGE DEFINITION commands. :-) **------------------------------------------------------------------------ */ static lcb_p ncr_setup_lcb (ncb_p np, u_char tn, u_char ln, u_char *inq_data) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_char inq_byte7; int i; /* ** If no lcb, try to allocate it. */ if (!lp && !(lp = ncr_alloc_lcb(np, tn, ln))) goto fail; #if 0 /* No more used. Left here as provision */ /* ** Get device quirks. */ tp->quirks = 0; if (tp->quirks && bootverbose) { PRINT_LUN(np, tn, ln); printk ("quirks=%x.\n", tp->quirks); } #endif /* ** Evaluate trustable target/unit capabilities. ** We only believe device version >= SCSI-2 that ** use appropriate response data format (2). ** But it seems that some CCS devices also ** support SYNC and I donnot want to frustrate ** anybody. ;-) */ inq_byte7 = 0; if ((inq_data[2] & 0x7) >= 2 && (inq_data[3] & 0xf) == 2) inq_byte7 = inq_data[7]; else if ((inq_data[2] & 0x7) == 1 && (inq_data[3] & 0xf) == 1) inq_byte7 = INQ7_SYNC; /* ** Throw away announced LUN capabilities if we are told ** that there is no real device supported by the logical unit. */ if ((inq_data[0] & 0xe0) > 0x20 || (inq_data[0] & 0x1f) == 0x1f) inq_byte7 &= (INQ7_SYNC | INQ7_WIDE16); /* ** If user is wanting SYNC, force this feature. */ if (driver_setup.force_sync_nego) inq_byte7 |= INQ7_SYNC; /* ** Prepare negotiation if SIP capabilities have changed. */ tp->inq_done = 1; if ((inq_byte7 ^ tp->inq_byte7) & (INQ7_SYNC | INQ7_WIDE16)) { tp->inq_byte7 = inq_byte7; ncr_negotiate(np, tp); } /* ** If unit supports tagged commands, allocate and ** initialyze the task table if not yet. */ if ((inq_byte7 & INQ7_QUEUE) && lp->tasktbl == &lp->tasktbl_0) { lp->tasktbl = m_calloc_dma(MAX_TASKS*4, "TASKTBL"); if (!lp->tasktbl) { lp->tasktbl = &lp->tasktbl_0; goto fail; } lp->b_tasktbl = cpu_to_scr(vtobus(lp->tasktbl)); for (i = 0 ; i < MAX_TASKS ; i++) lp->tasktbl[i] = cpu_to_scr(np->p_notask); lp->cb_tags = m_calloc(MAX_TAGS, "CB_TAGS"); if (!lp->cb_tags) goto fail; for (i = 0 ; i < MAX_TAGS ; i++) lp->cb_tags[i] = i; lp->maxnxs = MAX_TAGS; lp->tags_stime = ktime_get(3*HZ); } /* ** Adjust tagged queueing status if needed. */ if ((inq_byte7 ^ lp->inq_byte7) & INQ7_QUEUE) { lp->inq_byte7 = inq_byte7; lp->numtags = lp->maxtags; ncr_setup_tags (np, tn, ln); } fail: return lp; } /*========================================================== ** ** ** Build Scatter Gather Block ** ** **========================================================== ** ** The transfer area may be scattered among ** several non adjacent physical pages. ** ** We may use MAX_SCATTER blocks. ** **---------------------------------------------------------- */ /* ** We try to reduce the number of interrupts caused ** by unexpected phase changes due to disconnects. ** A typical harddisk may disconnect before ANY block. ** If we wanted to avoid unexpected phase changes at all ** we had to use a break point every 512 bytes. ** Of course the number of scatter/gather blocks is ** limited. ** Under Linux, the scatter/gatter blocks are provided by ** the generic driver. We just have to copy addresses and ** sizes to the data segment array. */ /* ** For 64 bit systems, we use the 8 upper bits of the size field ** to provide bus address bits 32-39 to the SCRIPTS processor. ** This allows the 895A and 896 to address up to 1 TB of memory. ** For 32 bit chips on 64 bit systems, we must be provided with ** memory addresses that fit into the first 32 bit bus address ** range and so, this does not matter and we expect an error from ** the chip if this ever happen. ** ** We use a separate function for the case Linux does not provide ** a scatter list in order to allow better code optimization ** for the case we have a scatter list (BTW, for now this just wastes ** about 40 bytes of code for x86, but my guess is that the scatter ** code will get more complex later). */ #define SCATTER_ONE(data, badd, len) \ (data)->addr = cpu_to_scr(badd); \ (data)->size = cpu_to_scr((((badd) >> 8) & 0xff000000) + len); #define CROSS_16MB(p, n) (((((u_long) p) + n - 1) ^ ((u_long) p)) & ~0xffffff) static int ncr_scatter_no_sglist(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { struct scr_tblmove *data = &cp->phys.data[MAX_SCATTER-1]; int segment; cp->data_len = cmd->request_bufflen; if (cmd->request_bufflen) { dma_addr_t baddr = map_scsi_single_data(np, cmd); SCATTER_ONE(data, baddr, cmd->request_bufflen); if (CROSS_16MB(baddr, cmd->request_bufflen)) { cp->host_flags |= HF_PM_TO_C; #ifdef DEBUG_896R1 printk("He! we are crossing a 16 MB boundary (0x%lx, 0x%x)\n", baddr, cmd->request_bufflen); #endif } segment = 1; } else segment = 0; return segment; } /* ** DEL 472 - 53C896 Rev 1 - Part Number 609-0393055 - ITEM 5. ** ** We disable data phase mismatch handling from SCRIPTS for data ** transfers that contains scatter/gather entries that cross ** a 16 MB boundary. ** We use a different scatter function for 896 rev. 1 that needs ** such a work-around. Doing so, we do not affect performance for ** other chips. ** This problem should not be triggered for disk IOs under Linux, ** since such IOs are performed using pages and buffers that are ** nicely power-of-two sized and aligned. But, since this may change ** at any time, a work-around was required. */ static int ncr_scatter_896R1(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { int segn; int use_sg = (int) cmd->use_sg; cp->data_len = 0; if (!use_sg) segn = ncr_scatter_no_sglist(np, cp, cmd); else { struct scatterlist *scatter = (struct scatterlist *)cmd->buffer; struct scr_tblmove *data; use_sg = map_scsi_sg_data(np, cmd); if (use_sg > MAX_SCATTER) { unmap_scsi_data(np, cmd); return -1; } data = &cp->phys.data[MAX_SCATTER - use_sg]; for (segn = 0; segn < use_sg; segn++) { dma_addr_t baddr = scsi_sg_dma_address(&scatter[segn]); unsigned int len = scsi_sg_dma_len(&scatter[segn]); SCATTER_ONE(&data[segn], baddr, len); if (CROSS_16MB(baddr, scatter[segn].length)) { cp->host_flags |= HF_PM_TO_C; #ifdef DEBUG_896R1 printk("He! we are crossing a 16 MB boundary (0x%lx, 0x%x)\n", baddr, scatter[segn].length); #endif } cp->data_len += len; } } return segn; } static int ncr_scatter(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { int segment; int use_sg = (int) cmd->use_sg; cp->data_len = 0; if (!use_sg) segment = ncr_scatter_no_sglist(np, cp, cmd); else { struct scatterlist *scatter = (struct scatterlist *)cmd->buffer; struct scr_tblmove *data; use_sg = map_scsi_sg_data(np, cmd); if (use_sg > MAX_SCATTER) { unmap_scsi_data(np, cmd); return -1; } data = &cp->phys.data[MAX_SCATTER - use_sg]; for (segment = 0; segment < use_sg; segment++) { dma_addr_t baddr = scsi_sg_dma_address(&scatter[segment]); unsigned int len = scsi_sg_dma_len(&scatter[segment]); SCATTER_ONE(&data[segment], baddr, len); cp->data_len += len; } } return segment; } /*========================================================== ** ** ** Test the pci bus snoop logic :-( ** ** Has to be called with interrupts disabled. ** ** **========================================================== */ #ifndef SCSI_NCR_IOMAPPED static int __init ncr_regtest (struct ncb* np) { register volatile u_int32 data; /* ** ncr registers may NOT be cached. ** write 0xffffffff to a read only register area, ** and try to read it back. */ data = 0xffffffff; OUTL_OFF(offsetof(struct ncr_reg, nc_dstat), data); data = INL_OFF(offsetof(struct ncr_reg, nc_dstat)); #if 1 if (data == 0xffffffff) { #else if ((data & 0xe2f0fffd) != 0x02000080) { #endif printk ("CACHE TEST FAILED: reg dstat-sstat2 readback %x.\n", (unsigned) data); return (0x10); }; return (0); } #endif static int __init ncr_snooptest (struct ncb* np) { u_int32 ncr_rd, ncr_wr, ncr_bk, host_rd, host_wr, pc; u_char dstat; int i, err=0; #ifndef SCSI_NCR_IOMAPPED if (np->reg) { err |= ncr_regtest (np); if (err) return (err); } #endif restart_test: /* ** Enable Master Parity Checking as we intend ** to enable it for normal operations. */ OUTB (nc_ctest4, (np->rv_ctest4 & MPEE)); /* ** init */ pc = NCB_SCRIPTH0_PHYS (np, snooptest); host_wr = 1; ncr_wr = 2; /* ** Set memory and register. */ np->ncr_cache = cpu_to_scr(host_wr); OUTL (nc_temp, ncr_wr); /* ** Start script (exchange values) */ OUTL (nc_dsa, np->p_ncb); OUTL_DSP (pc); /* ** Wait 'til done (with timeout) */ for (i=0; i=NCR_SNOOP_TIMEOUT) { printk ("CACHE TEST FAILED: timeout.\n"); return (0x20); }; /* ** Check for fatal DMA errors. */ dstat = INB (nc_dstat); #if 1 /* Band aiding for broken hardwares that fail PCI parity */ if ((dstat & MDPE) && (np->rv_ctest4 & MPEE)) { printk ("%s: PCI DATA PARITY ERROR DETECTED - " "DISABLING MASTER DATA PARITY CHECKING.\n", ncr_name(np)); np->rv_ctest4 &= ~MPEE; goto restart_test; } #endif if (dstat & (MDPE|BF|IID)) { printk ("CACHE TEST FAILED: DMA error (dstat=0x%02x).", dstat); return (0x80); } /* ** Save termination position. */ pc = INL (nc_dsp); /* ** Read memory and register. */ host_rd = scr_to_cpu(np->ncr_cache); ncr_rd = INL (nc_scratcha); ncr_bk = INL (nc_temp); /* ** Check termination position. */ if (pc != NCB_SCRIPTH0_PHYS (np, snoopend)+8) { printk ("CACHE TEST FAILED: script execution failed.\n"); printk ("start=%08lx, pc=%08lx, end=%08lx\n", (u_long) NCB_SCRIPTH0_PHYS (np, snooptest), (u_long) pc, (u_long) NCB_SCRIPTH0_PHYS (np, snoopend) +8); return (0x40); }; /* ** Show results. */ if (host_wr != ncr_rd) { printk ("CACHE TEST FAILED: host wrote %d, ncr read %d.\n", (int) host_wr, (int) ncr_rd); err |= 1; }; if (host_rd != ncr_wr) { printk ("CACHE TEST FAILED: ncr wrote %d, host read %d.\n", (int) ncr_wr, (int) host_rd); err |= 2; }; if (ncr_bk != ncr_wr) { printk ("CACHE TEST FAILED: ncr wrote %d, read back %d.\n", (int) ncr_wr, (int) ncr_bk); err |= 4; }; return (err); } /*========================================================== ** ** Determine the ncr's clock frequency. ** This is essential for the negotiation ** of the synchronous transfer rate. ** **========================================================== ** ** Note: we have to return the correct value. ** THERE IS NO SAFE DEFAULT VALUE. ** ** Most NCR/SYMBIOS boards are delivered with a 40 Mhz clock. ** 53C860 and 53C875 rev. 1 support fast20 transfers but ** do not have a clock doubler and so are provided with a ** 80 MHz clock. All other fast20 boards incorporate a doubler ** and so should be delivered with a 40 MHz clock. ** The recent fast40 chips (895/896/895A) and the ** fast80 chip (C1010) use a 40 Mhz base clock ** and provide a clock quadrupler (160 Mhz). The code below ** tries to deal as cleverly as possible with all this stuff. ** **---------------------------------------------------------- */ /* * Select NCR SCSI clock frequency */ static void ncr_selectclock(ncb_p np, u_char scntl3) { if (np->multiplier < 2) { OUTB(nc_scntl3, scntl3); return; } if (bootverbose >= 2) printk ("%s: enabling clock multiplier\n", ncr_name(np)); OUTB(nc_stest1, DBLEN); /* Enable clock multiplier */ if ( (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (np->multiplier > 2)) { int i = 20; /* Poll bit 5 of stest4 for quadrupler */ while (!(INB(nc_stest4) & LCKFRQ) && --i > 0) UDELAY (20); if (!i) printk("%s: the chip cannot lock the frequency\n", ncr_name(np)); } else /* Wait 120 micro-seconds for multiplier*/ UDELAY (120); OUTB(nc_stest3, HSC); /* Halt the scsi clock */ OUTB(nc_scntl3, scntl3); OUTB(nc_stest1, (DBLEN|DBLSEL));/* Select clock multiplier */ OUTB(nc_stest3, 0x00); /* Restart scsi clock */ } /* * calculate NCR SCSI clock frequency (in KHz) */ static unsigned __init ncrgetfreq (ncb_p np, int gen) { unsigned int ms = 0; unsigned int f; int count; /* * Measure GEN timer delay in order * to calculate SCSI clock frequency * * This code will never execute too * many loop iterations (if DELAY is * reasonably correct). It could get * too low a delay (too high a freq.) * if the CPU is slow executing the * loop for some reason (an NMI, for * example). For this reason we will * if multiple measurements are to be * performed trust the higher delay * (lower frequency returned). */ OUTW (nc_sien , 0x0);/* mask all scsi interrupts */ /* enable general purpose timer */ (void) INW (nc_sist); /* clear pending scsi interrupt */ OUTB (nc_dien , 0); /* mask all dma interrupts */ (void) INW (nc_sist); /* another one, just to be sure :) */ OUTB (nc_scntl3, 4); /* set pre-scaler to divide by 3 */ OUTB (nc_stime1, 0); /* disable general purpose timer */ OUTB (nc_stime1, gen); /* set to nominal delay of 1<= 2) printk ("%s: Delay (GEN=%d): %u msec, %u KHz\n", ncr_name(np), gen, ms, f); return f; } static unsigned __init ncr_getfreq (ncb_p np) { u_int f1, f2; int gen = 11; (void) ncrgetfreq (np, gen); /* throw away first result */ f1 = ncrgetfreq (np, gen); f2 = ncrgetfreq (np, gen); if (f1 > f2) f1 = f2; /* trust lower result */ return f1; } /* * Get/probe NCR SCSI clock frequency */ static void __init ncr_getclock (ncb_p np, int mult) { unsigned char scntl3 = np->sv_scntl3; unsigned char stest1 = np->sv_stest1; unsigned f1; np->multiplier = 1; f1 = 40000; /* ** True with 875/895/896/895A with clock multiplier selected */ if (mult > 1 && (stest1 & (DBLEN+DBLSEL)) == DBLEN+DBLSEL) { if (bootverbose >= 2) printk ("%s: clock multiplier found\n", ncr_name(np)); np->multiplier = mult; } /* ** If multiplier not found or scntl3 not 7,5,3, ** reset chip and get frequency from general purpose timer. ** Otherwise trust scntl3 BIOS setting. */ if (np->multiplier != mult || (scntl3 & 7) < 3 || !(scntl3 & 1)) { OUTB (nc_stest1, 0); /* make sure doubler is OFF */ f1 = ncr_getfreq (np); if (bootverbose) printk ("%s: NCR clock is %uKHz\n", ncr_name(np), f1); if (f1 < 55000) f1 = 40000; else f1 = 80000; /* ** Suggest to also check the PCI clock frequency ** to make sure our frequency calculation algorithm ** is not too biased. */ if (np->features & FE_66MHZ) { np->pciclock_min = (66000*55+80-1)/80; np->pciclock_max = (66000*55)/40; } else { np->pciclock_min = (33000*55+80-1)/80; np->pciclock_max = (33000*55)/40; } if (f1 == 40000 && mult > 1) { if (bootverbose >= 2) printk ("%s: clock multiplier assumed\n", ncr_name(np)); np->multiplier = mult; } } else { if ((scntl3 & 7) == 3) f1 = 40000; else if ((scntl3 & 7) == 5) f1 = 80000; else f1 = 160000; f1 /= np->multiplier; } /* ** Compute controller synchronous parameters. */ f1 *= np->multiplier; np->clock_khz = f1; } /* * Get/probe PCI clock frequency */ static u_int __init ncr_getpciclock (ncb_p np) { static u_int f; OUTB (nc_stest1, SCLK); /* Use the PCI clock as SCSI clock */ f = ncr_getfreq (np); OUTB (nc_stest1, 0); return f; } /*===================== LINUX ENTRY POINTS SECTION ==========================*/ #ifndef uchar #define uchar unsigned char #endif #ifndef ushort #define ushort unsigned short #endif #ifndef ulong #define ulong unsigned long #endif /* --------------------------------------------------------------------- ** ** Driver setup from the boot command line ** ** --------------------------------------------------------------------- */ #ifdef MODULE #define ARG_SEP ' ' #else #define ARG_SEP ',' #endif #define OPT_TAGS 1 #define OPT_MASTER_PARITY 2 #define OPT_SCSI_PARITY 3 #define OPT_DISCONNECTION 4 #define OPT_SPECIAL_FEATURES 5 #define OPT_RESERVED_1 6 #define OPT_FORCE_SYNC_NEGO 7 #define OPT_REVERSE_PROBE 8 #define OPT_DEFAULT_SYNC 9 #define OPT_VERBOSE 10 #define OPT_DEBUG 11 #define OPT_BURST_MAX 12 #define OPT_LED_PIN 13 #define OPT_MAX_WIDE 14 #define OPT_SETTLE_DELAY 15 #define OPT_DIFF_SUPPORT 16 #define OPT_IRQM 17 #define OPT_PCI_FIX_UP 18 #define OPT_BUS_CHECK 19 #define OPT_OPTIMIZE 20 #define OPT_RECOVERY 21 #define OPT_SAFE_SETUP 22 #define OPT_USE_NVRAM 23 #define OPT_EXCLUDE 24 #define OPT_HOST_ID 25 #ifdef SCSI_NCR_IARB_SUPPORT #define OPT_IARB 26 #endif static char setup_token[] __initdata = "tags:" "mpar:" "spar:" "disc:" "specf:" "_rsvd1:" "fsn:" "revprob:" "sync:" "verb:" "debug:" "burst:" "led:" "wide:" "settle:" "diff:" "irqm:" "pcifix:" "buschk:" "optim:" "recovery:" "safe:" "nvram:" "excl:" "hostid:" #ifdef SCSI_NCR_IARB_SUPPORT "iarb:" #endif ; /* DONNOT REMOVE THIS ';' */ #ifdef MODULE #define ARG_SEP ' ' #else #define ARG_SEP ',' #endif static int __init get_setup_token(char *p) { char *cur = setup_token; char *pc; int i = 0; while (cur != NULL && (pc = strchr(cur, ':')) != NULL) { ++pc; ++i; if (!strncmp(p, cur, pc - cur)) return i; cur = pc; } return 0; } int __init sym53c8xx_setup(char *str) { #ifdef SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT char *cur = str; char *pc, *pv; unsigned long val; int i, c; int xi = 0; while (cur != NULL && (pc = strchr(cur, ':')) != NULL) { char *pe; val = 0; pv = pc; c = *++pv; if (c == 'n') val = 0; else if (c == 'y') val = 1; else val = (int) simple_strtoul(pv, &pe, 0); switch (get_setup_token(cur)) { case OPT_TAGS: driver_setup.default_tags = val; if (pe && *pe == '/') { i = 0; while (*pe && *pe != ARG_SEP && i < sizeof(driver_setup.tag_ctrl)-1) { driver_setup.tag_ctrl[i++] = *pe++; } driver_setup.tag_ctrl[i] = '\0'; } break; case OPT_MASTER_PARITY: driver_setup.master_parity = val; break; case OPT_SCSI_PARITY: driver_setup.scsi_parity = val; break; case OPT_DISCONNECTION: driver_setup.disconnection = val; break; case OPT_SPECIAL_FEATURES: driver_setup.special_features = val; break; case OPT_FORCE_SYNC_NEGO: driver_setup.force_sync_nego = val; break; case OPT_REVERSE_PROBE: driver_setup.reverse_probe = val; break; case OPT_DEFAULT_SYNC: driver_setup.default_sync = val; break; case OPT_VERBOSE: driver_setup.verbose = val; break; case OPT_DEBUG: driver_setup.debug = val; break; case OPT_BURST_MAX: driver_setup.burst_max = val; break; case OPT_LED_PIN: driver_setup.led_pin = val; break; case OPT_MAX_WIDE: driver_setup.max_wide = val? 1:0; break; case OPT_SETTLE_DELAY: driver_setup.settle_delay = val; break; case OPT_DIFF_SUPPORT: driver_setup.diff_support = val; break; case OPT_IRQM: driver_setup.irqm = val; break; case OPT_PCI_FIX_UP: driver_setup.pci_fix_up = val; break; case OPT_BUS_CHECK: driver_setup.bus_check = val; break; case OPT_OPTIMIZE: driver_setup.optimize = val; break; case OPT_RECOVERY: driver_setup.recovery = val; break; case OPT_USE_NVRAM: driver_setup.use_nvram = val; break; case OPT_SAFE_SETUP: memcpy(&driver_setup, &driver_safe_setup, sizeof(driver_setup)); break; case OPT_EXCLUDE: if (xi < SCSI_NCR_MAX_EXCLUDES) driver_setup.excludes[xi++] = val; break; case OPT_HOST_ID: driver_setup.host_id = val; break; #ifdef SCSI_NCR_IARB_SUPPORT case OPT_IARB: driver_setup.iarb = val; break; #endif default: printk("sym53c8xx_setup: unexpected boot option '%.*s' ignored\n", (int)(pc-cur+1), cur); break; } if ((cur = strchr(cur, ARG_SEP)) != NULL) ++cur; } #endif /* SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT */ return 1; } #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,13) #ifndef MODULE __setup("sym53c8xx=", sym53c8xx_setup); #endif #endif static int sym53c8xx_pci_init(Scsi_Host_Template *tpnt, pcidev_t pdev, ncr_device *device); /* ** Linux entry point for SYM53C8XX devices detection routine. ** ** Called by the middle-level scsi drivers at initialization time, ** or at module installation. ** ** Read the PCI configuration and try to attach each ** detected NCR board. ** ** If NVRAM is present, try to attach boards according to ** the used defined boot order. ** ** Returns the number of boards successfully attached. */ static void __init ncr_print_driver_setup(void) { #define YesNo(y) y ? 'y' : 'n' printk (NAME53C8XX ": setup=disc:%c,specf:%d,tags:%d,sync:%d," "burst:%d,wide:%c,diff:%d,revprob:%c,buschk:0x%x\n", YesNo(driver_setup.disconnection), driver_setup.special_features, driver_setup.default_tags, driver_setup.default_sync, driver_setup.burst_max, YesNo(driver_setup.max_wide), driver_setup.diff_support, YesNo(driver_setup.reverse_probe), driver_setup.bus_check); printk (NAME53C8XX ": setup=mpar:%c,spar:%c,fsn=%c,verb:%d,debug:0x%x," "led:%c,settle:%d,irqm:0x%x,nvram:0x%x,pcifix:0x%x\n", YesNo(driver_setup.master_parity), YesNo(driver_setup.scsi_parity), YesNo(driver_setup.force_sync_nego), driver_setup.verbose, driver_setup.debug, YesNo(driver_setup.led_pin), driver_setup.settle_delay, driver_setup.irqm, driver_setup.use_nvram, driver_setup.pci_fix_up); #undef YesNo } /*=================================================================== ** SYM53C8XX devices description table and chip ids list. **=================================================================== */ static ncr_chip ncr_chip_table[] __initdata = SCSI_NCR_CHIP_TABLE; static ushort ncr_chip_ids[] __initdata = SCSI_NCR_CHIP_IDS; #ifdef SCSI_NCR_PQS_PDS_SUPPORT /*=================================================================== ** Detect all NCR PQS/PDS boards and keep track of their bus nr. ** ** The NCR PQS or PDS card is constructed as a DEC bridge ** behind which sit a proprietary NCR memory controller and ** four or two 53c875s as separate devices. In its usual mode ** of operation, the 875s are slaved to the memory controller ** for all transfers. We can tell if an 875 is part of a ** PQS/PDS or not since if it is, it will be on the same bus ** as the memory controller. To operate with the Linux ** driver, the memory controller is disabled and the 875s ** freed to function independently. The only wrinkle is that ** the preset SCSI ID (which may be zero) must be read in from ** a special configuration space register of the 875 **=================================================================== */ #define SCSI_NCR_MAX_PQS_BUS 16 static int pqs_bus[SCSI_NCR_MAX_PQS_BUS] __initdata = { 0 }; static void __init ncr_detect_pqs_pds(void) { short index; pcidev_t dev = PCIDEV_NULL; for(index=0; index < SCSI_NCR_MAX_PQS_BUS; index++) { u_char tmp; dev = pci_find_device(0x101a, 0x0009, dev); if (dev == PCIDEV_NULL) { pqs_bus[index] = -1; break; } printk(KERN_INFO NAME53C8XX ": NCR PQS/PDS memory controller detected on bus %d\n", PciBusNumber(dev)); pci_read_config_byte(dev, 0x44, &tmp); /* bit 1: allow individual 875 configuration */ tmp |= 0x2; pci_write_config_byte(dev, 0x44, tmp); pci_read_config_byte(dev, 0x45, &tmp); /* bit 2: drive individual 875 interrupts to the bus */ tmp |= 0x4; pci_write_config_byte(dev, 0x45, tmp); pqs_bus[index] = PciBusNumber(dev); } } #endif /* SCSI_NCR_PQS_PDS_SUPPORT */ /*=================================================================== ** Detect all 53c8xx hosts and then attach them. ** ** If we are using NVRAM, once all hosts are detected, we need to ** check any NVRAM for boot order in case detect and boot order ** differ and attach them using the order in the NVRAM. ** ** If no NVRAM is found or data appears invalid attach boards in ** the order they are detected. **=================================================================== */ int __init sym53c8xx_detect(Scsi_Host_Template *tpnt) { pcidev_t pcidev; int i, j, chips, hosts, count; int attach_count = 0; ncr_device *devtbl, *devp; #ifdef SCSI_NCR_NVRAM_SUPPORT ncr_nvram nvram0, nvram, *nvp; #endif /* ** PCI is required. */ if (!pci_present()) return 0; /* ** Initialize driver general stuff. */ #ifdef SCSI_NCR_PROC_INFO_SUPPORT #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,27) tpnt->proc_dir = &proc_scsi_sym53c8xx; #else tpnt->proc_name = NAME53C8XX; #endif tpnt->proc_info = sym53c8xx_proc_info; #endif #if defined(SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT) && defined(MODULE) if (sym53c8xx) sym53c8xx_setup(sym53c8xx); #endif #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT ncr_debug = driver_setup.debug; #endif if (initverbose >= 2) ncr_print_driver_setup(); /* ** Allocate the device table since we donnot want to ** overflow the kernel stack. ** 1 x 4K PAGE is enough for more than 40 devices for i386. */ devtbl = m_calloc(PAGE_SIZE, "devtbl"); if (!devtbl) return 0; /* ** Detect all NCR PQS/PDS memory controllers. */ #ifdef SCSI_NCR_PQS_PDS_SUPPORT ncr_detect_pqs_pds(); #endif /* ** Detect all 53c8xx hosts. ** Save the first Symbios NVRAM content if any ** for the boot order. */ chips = sizeof(ncr_chip_ids) / sizeof(ncr_chip_ids[0]); hosts = PAGE_SIZE / sizeof(*devtbl); #ifdef SCSI_NCR_NVRAM_SUPPORT nvp = (driver_setup.use_nvram & 0x1) ? &nvram0 : 0; #endif j = 0; count = 0; pcidev = PCIDEV_NULL; while (1) { char *msg = ""; if (count >= hosts) break; if (j >= chips) break; i = driver_setup.reverse_probe ? chips - 1 - j : j; pcidev = pci_find_device(PCI_VENDOR_ID_NCR, ncr_chip_ids[i], pcidev); if (pcidev == PCIDEV_NULL) { ++j; continue; } if (pci_enable_device(pcidev)) /* @!*!$&*!%-*#;! */ continue; /* Some HW as the HP LH4 may report twice PCI devices */ for (i = 0; i < count ; i++) { if (devtbl[i].slot.bus == PciBusNumber(pcidev) && devtbl[i].slot.device_fn == PciDeviceFn(pcidev)) break; } if (i != count) /* Ignore this device if we already have it */ continue; pci_set_master(pcidev); devp = &devtbl[count]; devp->host_id = driver_setup.host_id; devp->attach_done = 0; if (sym53c8xx_pci_init(tpnt, pcidev, devp)) { continue; } ++count; #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvp) { ncr_get_nvram(devp, nvp); switch(nvp->type) { case SCSI_NCR_SYMBIOS_NVRAM: /* * Switch to the other nvram buffer, so that * nvram0 will contain the first Symbios * format NVRAM content with boot order. */ nvp = &nvram; msg = "with Symbios NVRAM"; break; case SCSI_NCR_TEKRAM_NVRAM: msg = "with Tekram NVRAM"; break; } } #endif #ifdef SCSI_NCR_PQS_PDS_SUPPORT if (devp->pqs_pds) msg = "(NCR PQS/PDS)"; #endif printk(KERN_INFO NAME53C8XX ": 53c%s detected %s\n", devp->chip.name, msg); } /* ** If we have found a SYMBIOS NVRAM, use first the NVRAM boot ** sequence as device boot order. ** check devices in the boot record against devices detected. ** attach devices if we find a match. boot table records that ** do not match any detected devices will be ignored. ** devices that do not match any boot table will not be attached ** here but will attempt to be attached during the device table ** rescan. */ #ifdef SCSI_NCR_NVRAM_SUPPORT if (!nvp || nvram0.type != SCSI_NCR_SYMBIOS_NVRAM) goto next; for (i = 0; i < 4; i++) { Symbios_host *h = &nvram0.data.Symbios.host[i]; for (j = 0 ; j < count ; j++) { devp = &devtbl[j]; if (h->device_fn != devp->slot.device_fn || h->bus_nr != devp->slot.bus || h->device_id != devp->chip.device_id) continue; if (devp->attach_done) continue; if (h->flags & SYMBIOS_INIT_SCAN_AT_BOOT) { ncr_get_nvram(devp, nvp); if (!ncr_attach (tpnt, attach_count, devp)) attach_count++; } else if (!(driver_setup.use_nvram & 0x80)) printk(KERN_INFO NAME53C8XX ": 53c%s state OFF thus not attached\n", devp->chip.name); else continue; devp->attach_done = 1; break; } } next: #endif /* ** Rescan device list to make sure all boards attached. ** Devices without boot records will not be attached yet ** so try to attach them here. */ for (i= 0; i < count; i++) { devp = &devtbl[i]; if (!devp->attach_done) { #ifdef SCSI_NCR_NVRAM_SUPPORT ncr_get_nvram(devp, nvp); #endif if (!ncr_attach (tpnt, attach_count, devp)) attach_count++; } } m_free(devtbl, PAGE_SIZE, "devtbl"); return attach_count; } /*=================================================================== ** Read and check the PCI configuration for any detected NCR ** boards and save data for attaching after all boards have ** been detected. **=================================================================== */ static int __init sym53c8xx_pci_init(Scsi_Host_Template *tpnt, pcidev_t pdev, ncr_device *device) { u_short vendor_id, device_id, command, status_reg; u_char cache_line_size, latency_timer; u_char suggested_cache_line_size = 0; u_char pci_fix_up = driver_setup.pci_fix_up; u_char revision; u_int irq; u_long base, base_c, base_2, base_2_c, io_port; int i; ncr_chip *chip; printk(KERN_INFO NAME53C8XX ": at PCI bus %d, device %d, function %d\n", PciBusNumber(pdev), (int) (PciDeviceFn(pdev) & 0xf8) >> 3, (int) (PciDeviceFn(pdev) & 7)); /* ** Read info from the PCI config space. ** pci_read_config_xxx() functions are assumed to be used for ** successfully detected PCI devices. */ vendor_id = PciVendorId(pdev); device_id = PciDeviceId(pdev); irq = PciIrqLine(pdev); i = pci_get_base_address(pdev, 0, &io_port); io_port = pci_get_base_cookie(pdev, 0); base_c = pci_get_base_cookie(pdev, i); i = pci_get_base_address(pdev, i, &base); base_2_c = pci_get_base_cookie(pdev, i); (void) pci_get_base_address(pdev, i, &base_2); pci_read_config_word(pdev, PCI_COMMAND, &command); pci_read_config_byte(pdev, PCI_CLASS_REVISION, &revision); pci_read_config_byte(pdev, PCI_CACHE_LINE_SIZE, &cache_line_size); pci_read_config_byte(pdev, PCI_LATENCY_TIMER, &latency_timer); pci_read_config_word(pdev, PCI_STATUS, &status_reg); #ifdef SCSI_NCR_PQS_PDS_SUPPORT /* ** Match the BUS number for PQS/PDS devices. ** Read the SCSI ID from a special register mapped ** into the configuration space of the individual ** 875s. This register is set up by the PQS bios */ for(i = 0; i < SCSI_NCR_MAX_PQS_BUS && pqs_bus[i] != -1; i++) { u_char tmp; if (pqs_bus[i] == PciBusNumber(pdev)) { pci_read_config_byte(pdev, 0x84, &tmp); device->pqs_pds = 1; device->host_id = tmp; break; } } #endif /* SCSI_NCR_PQS_PDS_SUPPORT */ /* ** If user excludes this chip, donnot initialize it. */ for (i = 0 ; i < SCSI_NCR_MAX_EXCLUDES ; i++) { if (driver_setup.excludes[i] == (io_port & PCI_BASE_ADDRESS_IO_MASK)) return -1; } /* ** Check if the chip is supported */ chip = 0; for (i = 0; i < sizeof(ncr_chip_table)/sizeof(ncr_chip_table[0]); i++) { if (device_id != ncr_chip_table[i].device_id) continue; if (revision > ncr_chip_table[i].revision_id) continue; if (!(ncr_chip_table[i].features & FE_LDSTR)) break; chip = &device->chip; memcpy(chip, &ncr_chip_table[i], sizeof(*chip)); chip->revision_id = revision; break; } #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Configure DMA attributes. For DAC capable boards, we can encode ** 32+8 bits for SCSI DMA data addresses with the extra bits used ** in the size field. We use normal 32-bit PCI addresses for ** descriptors. */ if (chip && (chip->features & FE_DAC)) { if (pci_set_dma_mask(pdev, (u64) 0xffffffffff)) chip->features &= ~FE_DAC_IN_USE; else chip->features |= FE_DAC_IN_USE; } if (chip && !(chip->features & FE_DAC_IN_USE)) { if (pci_set_dma_mask(pdev, (u64) 0xffffffff)) { printk(KERN_WARNING NAME53C8XX "32 BIT PCI BUS DMA ADDRESSING NOT SUPPORTED\n"); return -1; } } #endif /* ** Ignore Symbios chips controlled by SISL RAID controller. ** This controller sets value 0x52414944 at RAM end - 16. */ #if defined(__i386__) && !defined(SCSI_NCR_PCI_MEM_NOT_SUPPORTED) if (chip && (base_2_c & PCI_BASE_ADDRESS_MEM_MASK)) { unsigned int ram_size, ram_val; u_long ram_ptr; if (chip->features & FE_RAM8K) ram_size = 8192; else ram_size = 4096; ram_ptr = remap_pci_mem(base_2_c & PCI_BASE_ADDRESS_MEM_MASK, ram_size); if (ram_ptr) { ram_val = readl_raw(ram_ptr + ram_size - 16); unmap_pci_mem(ram_ptr, ram_size); if (ram_val == 0x52414944) { printk(NAME53C8XX": not initializing, " "driven by SISL RAID controller.\n"); return -1; } } } #endif /* i386 and PCI MEMORY accessible */ if (!chip) { printk(NAME53C8XX ": not initializing, device not supported\n"); return -1; } #if defined(__powerpc__) || defined(__hppa__) /* ** Fix-up for power/pc and hppa. ** Should not be performed by the driver. */ if ((command & (PCI_COMMAND_IO | PCI_COMMAND_MEMORY)) != (PCI_COMMAND_IO | PCI_COMMAND_MEMORY)) { printk(NAME53C8XX ": setting%s%s...\n", (command & PCI_COMMAND_IO) ? "" : " PCI_COMMAND_IO", (command & PCI_COMMAND_MEMORY) ? "" : " PCI_COMMAND_MEMORY"); command |= (PCI_COMMAND_IO | PCI_COMMAND_MEMORY); pci_write_config_word(pdev, PCI_COMMAND, command); } #if LINUX_VERSION_CODE < KERNEL_VERSION(2,2,0) if ( is_prep ) { if (io_port >= 0x10000000) { printk(NAME53C8XX ": reallocating io_port (Wacky IBM)"); io_port = (io_port & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_0, io_port); } if (base >= 0x10000000) { printk(NAME53C8XX ": reallocating base (Wacky IBM)"); base = (base & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_1, base); } if (base_2 >= 0x10000000) { printk(NAME53C8XX ": reallocating base2 (Wacky IBM)"); base_2 = (base_2 & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_2, base_2); } } #endif #endif /* __powerpc__ */ #if defined(__i386__) && !defined(MODULE) if (!cache_line_size) { #if LINUX_VERSION_CODE < KERNEL_VERSION(2,1,75) extern char x86; switch(x86) { #else switch(boot_cpu_data.x86) { #endif case 4: suggested_cache_line_size = 4; break; case 6: case 5: suggested_cache_line_size = 8; break; } } #endif /* __i386__ */ /* ** Check availability of IO space, memory space. ** Enable master capability if not yet. ** ** We shouldn't have to care about the IO region when ** we are using MMIO. But calling check_region() from ** both the ncr53c8xx and the sym53c8xx drivers prevents ** from attaching devices from the both drivers. ** If you have a better idea, let me know. */ /* #ifdef SCSI_NCR_IOMAPPED */ #if 1 if (!(command & PCI_COMMAND_IO)) { printk(NAME53C8XX ": I/O base address (0x%lx) disabled.\n", (long) io_port); io_port = 0; } #endif if (!(command & PCI_COMMAND_MEMORY)) { printk(NAME53C8XX ": PCI_COMMAND_MEMORY not set.\n"); base = 0; base_2 = 0; } io_port &= PCI_BASE_ADDRESS_IO_MASK; base &= PCI_BASE_ADDRESS_MEM_MASK; base_2 &= PCI_BASE_ADDRESS_MEM_MASK; /* #ifdef SCSI_NCR_IOMAPPED */ #if 1 if (io_port && check_region (io_port, 128)) { printk(NAME53C8XX ": IO region 0x%lx[0..127] is in use\n", (long) io_port); io_port = 0; } if (!io_port) return -1; #endif #ifndef SCSI_NCR_IOMAPPED if (!base) { printk(NAME53C8XX ": MMIO base address disabled.\n"); return -1; } #endif /* ** Set MASTER capable and PARITY bit, if not yet. */ if ((command & (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY)) != (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY)) { printk(NAME53C8XX ": setting%s%s...(fix-up)\n", (command & PCI_COMMAND_MASTER) ? "" : " PCI_COMMAND_MASTER", (command & PCI_COMMAND_PARITY) ? "" : " PCI_COMMAND_PARITY"); command |= (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY); pci_write_config_word(pdev, PCI_COMMAND, command); } /* ** Fix some features according to driver setup. */ if (!(driver_setup.special_features & 1)) chip->features &= ~FE_SPECIAL_SET; else { if (driver_setup.special_features & 2) chip->features &= ~FE_WRIE; if (driver_setup.special_features & 4) chip->features &= ~FE_NOPM; } /* ** Work around for errant bit in 895A. The 66Mhz ** capable bit is set erroneously. Clear this bit. ** (Item 1 DEL 533) ** ** Make sure Config space and Features agree. ** ** Recall: writes are not normal to status register - ** write a 1 to clear and a 0 to leave unchanged. ** Can only reset bits. */ if (chip->features & FE_66MHZ) { if (!(status_reg & PCI_STATUS_66MHZ)) chip->features &= ~FE_66MHZ; } else { if (status_reg & PCI_STATUS_66MHZ) { status_reg = PCI_STATUS_66MHZ; pci_write_config_word(pdev, PCI_STATUS, status_reg); pci_read_config_word(pdev, PCI_STATUS, &status_reg); } } /* ** Some features are required to be enabled in order to ** work around some chip problems. :) ;) ** (ITEM 12 of a DEL about the 896 I haven't yet). ** We must ensure the chip will use WRITE AND INVALIDATE. ** The revision number limit is for now arbitrary. */ if (device_id == PCI_DEVICE_ID_NCR_53C896 && revision <= 0x10) { chip->features |= (FE_WRIE | FE_CLSE); pci_fix_up |= 3; /* Force appropriate PCI fix-up */ } #ifdef SCSI_NCR_PCI_FIX_UP_SUPPORT /* ** Try to fix up PCI config according to wished features. */ if ((pci_fix_up & 1) && (chip->features & FE_CLSE) && !cache_line_size && suggested_cache_line_size) { cache_line_size = suggested_cache_line_size; pci_write_config_byte(pdev, PCI_CACHE_LINE_SIZE, cache_line_size); printk(NAME53C8XX ": PCI_CACHE_LINE_SIZE set to %d (fix-up).\n", cache_line_size); } if ((pci_fix_up & 2) && cache_line_size && (chip->features & FE_WRIE) && !(command & PCI_COMMAND_INVALIDATE)) { printk(NAME53C8XX": setting PCI_COMMAND_INVALIDATE (fix-up)\n"); command |= PCI_COMMAND_INVALIDATE; pci_write_config_word(pdev, PCI_COMMAND, command); } /* ** Tune PCI LATENCY TIMER according to burst max length transfer. ** (latency timer >= burst length + 6, we add 10 to be quite sure) */ if (chip->burst_max && (latency_timer == 0 || (pci_fix_up & 4))) { uchar lt = (1 << chip->burst_max) + 6 + 10; if (latency_timer < lt) { printk(NAME53C8XX ": changing PCI_LATENCY_TIMER from %d to %d.\n", (int) latency_timer, (int) lt); latency_timer = lt; pci_write_config_byte(pdev, PCI_LATENCY_TIMER, latency_timer); } } #endif /* SCSI_NCR_PCI_FIX_UP_SUPPORT */ /* ** Initialise ncr_device structure with items required by ncr_attach. */ device->pdev = pdev; device->slot.bus = PciBusNumber(pdev); device->slot.device_fn = PciDeviceFn(pdev); device->slot.base = base; device->slot.base_2 = base_2; device->slot.base_c = base_c; device->slot.base_2_c = base_2_c; device->slot.io_port = io_port; device->slot.irq = irq; device->attach_done = 0; return 0; } /*=================================================================== ** Detect and try to read SYMBIOS and TEKRAM NVRAM. ** ** Data can be used to order booting of boards. ** ** Data is saved in ncr_device structure if NVRAM found. This ** is then used to find drive boot order for ncr_attach(). ** ** NVRAM data is passed to Scsi_Host_Template later during ** ncr_attach() for any device set up. *=================================================================== */ #ifdef SCSI_NCR_NVRAM_SUPPORT static void __init ncr_get_nvram(ncr_device *devp, ncr_nvram *nvp) { devp->nvram = nvp; if (!nvp) return; /* ** Get access to chip IO registers */ #ifdef SCSI_NCR_IOMAPPED request_region(devp->slot.io_port, 128, NAME53C8XX); devp->slot.base_io = devp->slot.io_port; #else devp->slot.reg = (struct ncr_reg *) remap_pci_mem(devp->slot.base_c, 128); if (!devp->slot.reg) return; #endif /* ** Try to read SYMBIOS nvram. ** Try to read TEKRAM nvram if Symbios nvram not found. */ if (!sym_read_Symbios_nvram(&devp->slot, &nvp->data.Symbios)) nvp->type = SCSI_NCR_SYMBIOS_NVRAM; else if (!sym_read_Tekram_nvram(&devp->slot, devp->chip.device_id, &nvp->data.Tekram)) nvp->type = SCSI_NCR_TEKRAM_NVRAM; else { nvp->type = 0; devp->nvram = 0; } /* ** Release access to chip IO registers */ #ifdef SCSI_NCR_IOMAPPED release_region(devp->slot.base_io, 128); #else unmap_pci_mem((u_long) devp->slot.reg, 128ul); #endif } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Linux select queue depths function */ #define DEF_DEPTH (driver_setup.default_tags) #define ALL_TARGETS -2 #define NO_TARGET -1 #define ALL_LUNS -2 #define NO_LUN -1 static int device_queue_depth(ncb_p np, int target, int lun) { int c, h, t, u, v; char *p = driver_setup.tag_ctrl; char *ep; h = -1; t = NO_TARGET; u = NO_LUN; while ((c = *p++) != 0) { v = simple_strtoul(p, &ep, 0); switch(c) { case '/': ++h; t = ALL_TARGETS; u = ALL_LUNS; break; case 't': if (t != target) t = (target == v) ? v : NO_TARGET; u = ALL_LUNS; break; case 'u': if (u != lun) u = (lun == v) ? v : NO_LUN; break; case 'q': if (h == np->unit && (t == ALL_TARGETS || t == target) && (u == ALL_LUNS || u == lun)) return v; break; case '-': t = ALL_TARGETS; u = ALL_LUNS; break; default: break; } p = ep; } return DEF_DEPTH; } int sym53c8xx_slave_configure(Scsi_Device *device) { struct Scsi_Host *host = device->host; ncb_p np; tcb_p tp; lcb_p lp; int numtags, depth_to_use; np = ((struct host_data *) host->hostdata)->ncb; tp = &np->target[device->id]; lp = ncr_lp(np, tp, device->lun); /* ** Select queue depth from driver setup. ** Donnot use more than configured by user. ** Use at least 2. ** Donnot use more than our maximum. */ numtags = device_queue_depth(np, device->id, device->lun); if (numtags > tp->usrtags) numtags = tp->usrtags; if (!device->tagged_supported) numtags = 1; depth_to_use = numtags; if (depth_to_use < 2) depth_to_use = 2; if (depth_to_use > MAX_TAGS) depth_to_use = MAX_TAGS; scsi_adjust_queue_depth(device, (device->tagged_supported ? MSG_SIMPLE_TAG : 0), depth_to_use); /* ** Since the queue depth is not tunable under Linux, ** we need to know this value in order not to ** announce stupid things to user. */ if (lp) { lp->numtags = lp->maxtags = numtags; lp->scdev_depth = depth_to_use; } ncr_setup_tags (np, device->id, device->lun); #ifdef DEBUG_SYM53C8XX printk("sym53c8xx_select_queue_depth: host=%d, id=%d, lun=%d, depth=%d\n", np->unit, device->id, device->lun, depth_to_use); #endif return 0; } /* ** Linux entry point for info() function */ const char *sym53c8xx_info (struct Scsi_Host *host) { return SCSI_NCR_DRIVER_NAME; } /* ** Linux entry point of queuecommand() function */ int sym53c8xx_queue_command (Scsi_Cmnd *cmd, void (* done)(Scsi_Cmnd *)) { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; unsigned long flags; int sts; #ifdef DEBUG_SYM53C8XX printk("sym53c8xx_queue_command\n"); #endif cmd->scsi_done = done; cmd->host_scribble = NULL; cmd->SCp.ptr = NULL; cmd->SCp.buffer = NULL; #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING __data_mapped(cmd) = 0; __data_mapping(cmd) = 0; #endif NCR_LOCK_NCB(np, flags); if ((sts = ncr_queue_command(np, cmd)) != DID_OK) { SetScsiResult(cmd, sts, 0); #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : command not queued - result=%d\n", sts); #endif } #ifdef DEBUG_SYM53C8XX else printk("sym53c8xx : command successfully queued\n"); #endif NCR_UNLOCK_NCB(np, flags); if (sts != DID_OK) { unmap_scsi_data(np, cmd); done(cmd); } return sts; } /* ** Linux entry point of the interrupt handler. ** Since linux versions > 1.3.70, we trust the kernel for ** passing the internal host descriptor as 'dev_id'. ** Otherwise, we scan the host list and call the interrupt ** routine for each host that uses this IRQ. */ static void sym53c8xx_intr(int irq, void *dev_id, struct pt_regs * regs) { unsigned long flags; ncb_p np = (ncb_p) dev_id; Scsi_Cmnd *done_list; #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : interrupt received\n"); #endif if (DEBUG_FLAGS & DEBUG_TINY) printk ("["); NCR_LOCK_NCB(np, flags); ncr_exception(np); done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); if (DEBUG_FLAGS & DEBUG_TINY) printk ("]\n"); if (done_list) { NCR_LOCK_SCSI_DONE(done_list->device->host, flags); ncr_flush_done_cmds(done_list); NCR_UNLOCK_SCSI_DONE(done_list->device->host, flags); } } /* ** Linux entry point of the timer handler */ static void sym53c8xx_timeout(unsigned long npref) { ncb_p np = (ncb_p) npref; unsigned long flags; Scsi_Cmnd *done_list; NCR_LOCK_NCB(np, flags); ncr_timeout((ncb_p) np); done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); if (done_list) { NCR_LOCK_SCSI_DONE(done_list->device->host, flags); ncr_flush_done_cmds(done_list); NCR_UNLOCK_SCSI_DONE(done_list->device->host, flags); } } /* ** Linux entry point of reset() function */ #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS int sym53c8xx_reset(Scsi_Cmnd *cmd, unsigned int reset_flags) #else int sym53c8xx_reset(Scsi_Cmnd *cmd) #endif { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; int sts; unsigned long flags; Scsi_Cmnd *done_list; #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS printk("sym53c8xx_reset: pid=%lu reset_flags=%x serial_number=%ld serial_number_at_timeout=%ld\n", cmd->pid, reset_flags, cmd->serial_number, cmd->serial_number_at_timeout); #else printk("sym53c8xx_reset: command pid %lu\n", cmd->pid); #endif NCR_LOCK_NCB(np, flags); /* * We have to just ignore reset requests in some situations. */ #if defined SCSI_RESET_NOT_RUNNING if (cmd->serial_number != cmd->serial_number_at_timeout) { sts = SCSI_RESET_NOT_RUNNING; goto out; } #endif /* * If the mid-level driver told us reset is synchronous, it seems * that we must call the done() callback for the involved command, * even if this command was not queued to the low-level driver, * before returning SCSI_RESET_SUCCESS. */ #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS sts = ncr_reset_bus(np, cmd, (reset_flags & (SCSI_RESET_SYNCHRONOUS | SCSI_RESET_ASYNCHRONOUS)) == SCSI_RESET_SYNCHRONOUS); #else sts = ncr_reset_bus(np, cmd, 0); #endif /* * Since we always reset the controller, when we return success, * we add this information to the return code. */ #if defined SCSI_RESET_HOST_RESET if (sts == SCSI_RESET_SUCCESS) sts |= SCSI_RESET_HOST_RESET; #endif out: done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); ncr_flush_done_cmds(done_list); return sts; } /* ** Linux entry point of abort() function */ int sym53c8xx_abort(Scsi_Cmnd *cmd) { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; int sts; unsigned long flags; Scsi_Cmnd *done_list; #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS printk("sym53c8xx_abort: pid=%lu serial_number=%ld serial_number_at_timeout=%ld\n", cmd->pid, cmd->serial_number, cmd->serial_number_at_timeout); #else printk("sym53c8xx_abort: command pid %lu\n", cmd->pid); #endif NCR_LOCK_NCB(np, flags); #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS /* * We have to just ignore abort requests in some situations. */ if (cmd->serial_number != cmd->serial_number_at_timeout) { sts = SCSI_ABORT_NOT_RUNNING; goto out; } #endif sts = ncr_abort_command(np, cmd); out: done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); ncr_flush_done_cmds(done_list); return sts; } int sym53c8xx_release(struct Scsi_Host *host) { #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : release\n"); #endif ncr_detach(((struct host_data *) host->hostdata)->ncb); return 1; } /* ** Scsi command waiting list management. ** ** It may happen that we cannot insert a scsi command into the start queue, ** in the following circumstances. ** Too few preallocated ccb(s), ** maxtags < cmd_per_lun of the Linux host control block, ** etc... ** Such scsi commands are inserted into a waiting list. ** When a scsi command complete, we try to requeue the commands of the ** waiting list. */ #define next_wcmd host_scribble static void insert_into_waiting_list(ncb_p np, Scsi_Cmnd *cmd) { Scsi_Cmnd *wcmd; #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx inserted into waiting list\n", ncr_name(np), (u_long) cmd); #endif cmd->next_wcmd = 0; if (!(wcmd = np->waiting_list)) np->waiting_list = cmd; else { while ((wcmd->next_wcmd) != 0) wcmd = (Scsi_Cmnd *) wcmd->next_wcmd; wcmd->next_wcmd = (char *) cmd; } } static Scsi_Cmnd *retrieve_from_waiting_list(int to_remove, ncb_p np, Scsi_Cmnd *cmd) { Scsi_Cmnd **pcmd = &np->waiting_list; while (*pcmd) { if (cmd == *pcmd) { if (to_remove) { *pcmd = (Scsi_Cmnd *) cmd->next_wcmd; cmd->next_wcmd = 0; } #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx retrieved from waiting list\n", ncr_name(np), (u_long) cmd); #endif return cmd; } pcmd = (Scsi_Cmnd **) &(*pcmd)->next_wcmd; } return 0; } static void process_waiting_list(ncb_p np, int sts) { Scsi_Cmnd *waiting_list, *wcmd; waiting_list = np->waiting_list; np->waiting_list = 0; #ifdef DEBUG_WAITING_LIST if (waiting_list) printk("%s: waiting_list=%lx processing sts=%d\n", ncr_name(np), (u_long) waiting_list, sts); #endif while ((wcmd = waiting_list) != 0) { waiting_list = (Scsi_Cmnd *) wcmd->next_wcmd; wcmd->next_wcmd = 0; if (sts == DID_OK) { #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx trying to requeue\n", ncr_name(np), (u_long) wcmd); #endif sts = ncr_queue_command(np, wcmd); } if (sts != DID_OK) { #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx done forced sts=%d\n", ncr_name(np), (u_long) wcmd, sts); #endif SetScsiResult(wcmd, sts, 0); ncr_queue_done_cmd(np, wcmd); } } } #undef next_wcmd #ifdef SCSI_NCR_PROC_INFO_SUPPORT /*========================================================================= ** Proc file system stuff ** ** A read operation returns adapter information. ** A write operation is a control command. ** The string is parsed in the driver code and the command is passed ** to the ncr_usercmd() function. **========================================================================= */ #ifdef SCSI_NCR_USER_COMMAND_SUPPORT #define is_digit(c) ((c) >= '0' && (c) <= '9') #define digit_to_bin(c) ((c) - '0') #define is_space(c) ((c) == ' ' || (c) == '\t') static int skip_spaces(char *ptr, int len) { int cnt, c; for (cnt = len; cnt > 0 && (c = *ptr++) && is_space(c); cnt--); return (len - cnt); } static int get_int_arg(char *ptr, int len, u_long *pv) { int cnt, c; u_long v; for (v = 0, cnt = len; cnt > 0 && (c = *ptr++) && is_digit(c); cnt--) { v = (v * 10) + digit_to_bin(c); } if (pv) *pv = v; return (len - cnt); } static int is_keyword(char *ptr, int len, char *verb) { int verb_len = strlen(verb); if (len >= strlen(verb) && !memcmp(verb, ptr, verb_len)) return verb_len; else return 0; } #define SKIP_SPACES(min_spaces) \ if ((arg_len = skip_spaces(ptr, len)) < (min_spaces)) \ return -EINVAL; \ ptr += arg_len; len -= arg_len; #define GET_INT_ARG(v) \ if (!(arg_len = get_int_arg(ptr, len, &(v)))) \ return -EINVAL; \ ptr += arg_len; len -= arg_len; /* ** Parse a control command */ static int ncr_user_command(ncb_p np, char *buffer, int length) { char *ptr = buffer; int len = length; struct usrcmd *uc = &np->user; int arg_len; u_long target; bzero(uc, sizeof(*uc)); if (len > 0 && ptr[len-1] == '\n') --len; if ((arg_len = is_keyword(ptr, len, "setsync")) != 0) uc->cmd = UC_SETSYNC; else if ((arg_len = is_keyword(ptr, len, "settags")) != 0) uc->cmd = UC_SETTAGS; else if ((arg_len = is_keyword(ptr, len, "setorder")) != 0) uc->cmd = UC_SETORDER; else if ((arg_len = is_keyword(ptr, len, "setverbose")) != 0) uc->cmd = UC_SETVERBOSE; else if ((arg_len = is_keyword(ptr, len, "setwide")) != 0) uc->cmd = UC_SETWIDE; else if ((arg_len = is_keyword(ptr, len, "setdebug")) != 0) uc->cmd = UC_SETDEBUG; else if ((arg_len = is_keyword(ptr, len, "setflag")) != 0) uc->cmd = UC_SETFLAG; else if ((arg_len = is_keyword(ptr, len, "resetdev")) != 0) uc->cmd = UC_RESETDEV; else if ((arg_len = is_keyword(ptr, len, "cleardev")) != 0) uc->cmd = UC_CLEARDEV; else arg_len = 0; #ifdef DEBUG_PROC_INFO printk("ncr_user_command: arg_len=%d, cmd=%ld\n", arg_len, uc->cmd); #endif if (!arg_len) return -EINVAL; ptr += arg_len; len -= arg_len; switch(uc->cmd) { case UC_SETSYNC: case UC_SETTAGS: case UC_SETWIDE: case UC_SETFLAG: case UC_RESETDEV: case UC_CLEARDEV: SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "all")) != 0) { ptr += arg_len; len -= arg_len; uc->target = ~0; } else { GET_INT_ARG(target); uc->target = (1<cmd) { case UC_SETVERBOSE: case UC_SETSYNC: case UC_SETTAGS: case UC_SETWIDE: SKIP_SPACES(1); GET_INT_ARG(uc->data); #ifdef DEBUG_PROC_INFO printk("ncr_user_command: data=%ld\n", uc->data); #endif break; case UC_SETORDER: SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "simple"))) uc->data = M_SIMPLE_TAG; else if ((arg_len = is_keyword(ptr, len, "ordered"))) uc->data = M_ORDERED_TAG; else if ((arg_len = is_keyword(ptr, len, "default"))) uc->data = 0; else return -EINVAL; break; case UC_SETDEBUG: while (len > 0) { SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "alloc"))) uc->data |= DEBUG_ALLOC; else if ((arg_len = is_keyword(ptr, len, "phase"))) uc->data |= DEBUG_PHASE; else if ((arg_len = is_keyword(ptr, len, "queue"))) uc->data |= DEBUG_QUEUE; else if ((arg_len = is_keyword(ptr, len, "result"))) uc->data |= DEBUG_RESULT; else if ((arg_len = is_keyword(ptr, len, "pointer"))) uc->data |= DEBUG_POINTER; else if ((arg_len = is_keyword(ptr, len, "script"))) uc->data |= DEBUG_SCRIPT; else if ((arg_len = is_keyword(ptr, len, "tiny"))) uc->data |= DEBUG_TINY; else if ((arg_len = is_keyword(ptr, len, "timing"))) uc->data |= DEBUG_TIMING; else if ((arg_len = is_keyword(ptr, len, "nego"))) uc->data |= DEBUG_NEGO; else if ((arg_len = is_keyword(ptr, len, "tags"))) uc->data |= DEBUG_TAGS; else return -EINVAL; ptr += arg_len; len -= arg_len; } #ifdef DEBUG_PROC_INFO printk("ncr_user_command: data=%ld\n", uc->data); #endif break; case UC_SETFLAG: while (len > 0) { SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "trace"))) uc->data |= UF_TRACE; else if ((arg_len = is_keyword(ptr, len, "no_disc"))) uc->data |= UF_NODISC; else return -EINVAL; ptr += arg_len; len -= arg_len; } break; default: break; } if (len) return -EINVAL; else { unsigned long flags; NCR_LOCK_NCB(np, flags); ncr_usercmd (np); NCR_UNLOCK_NCB(np, flags); } return length; } #endif /* SCSI_NCR_USER_COMMAND_SUPPORT */ #ifdef SCSI_NCR_USER_INFO_SUPPORT struct info_str { char *buffer; int length; int offset; int pos; }; static void copy_mem_info(struct info_str *info, char *data, int len) { if (info->pos + len > info->length) len = info->length - info->pos; if (info->pos + len < info->offset) { info->pos += len; return; } if (info->pos < info->offset) { data += (info->offset - info->pos); len -= (info->offset - info->pos); } if (len > 0) { memcpy(info->buffer + info->pos, data, len); info->pos += len; } } static int copy_info(struct info_str *info, char *fmt, ...) { va_list args; char buf[81]; int len; va_start(args, fmt); len = vsprintf(buf, fmt, args); va_end(args); copy_mem_info(info, buf, len); return len; } /* ** Copy formatted information into the input buffer. */ static int ncr_host_info(ncb_p np, char *ptr, off_t offset, int len) { struct info_str info; info.buffer = ptr; info.length = len; info.offset = offset; info.pos = 0; copy_info(&info, "General information:\n"); copy_info(&info, " Chip " NAME53C "%s, device id 0x%x, " "revision id 0x%x\n", np->chip_name, np->device_id, np->revision_id); copy_info(&info, " On PCI bus %d, device %d, function %d, " #ifdef __sparc__ "IRQ %s\n", #else "IRQ %d\n", #endif np->bus, (np->device_fn & 0xf8) >> 3, np->device_fn & 7, #ifdef __sparc__ __irq_itoa(np->irq)); #else (int) np->irq); #endif copy_info(&info, " Synchronous period factor %d, " "max commands per lun %d\n", (int) np->minsync, MAX_TAGS); if (driver_setup.debug || driver_setup.verbose > 1) { copy_info(&info, " Debug flags 0x%x, verbosity level %d\n", driver_setup.debug, driver_setup.verbose); } return info.pos > info.offset? info.pos - info.offset : 0; } #endif /* SCSI_NCR_USER_INFO_SUPPORT */ /* ** Entry point of the scsi proc fs of the driver. ** - func = 0 means read (returns adapter infos) ** - func = 1 means write (parse user control command) */ static int sym53c8xx_proc_info(struct Scsi_Host *host, char *buffer, char **start, off_t offset, int length, int func) { struct host_data *host_data; ncb_p ncb = 0; int retv; #ifdef DEBUG_PROC_INFO printk("sym53c8xx_proc_info: hostno=%d, func=%d\n", host->host_no, func); #endif host_data = (struct host_data *) host->hostdata; ncb = host_data->ncb; retv = -EINVAL; if (!ncb) goto out; if (func) { #ifdef SCSI_NCR_USER_COMMAND_SUPPORT retv = ncr_user_command(ncb, buffer, length); #endif } else { if (start) *start = buffer; #ifdef SCSI_NCR_USER_INFO_SUPPORT retv = ncr_host_info(ncb, buffer, offset, length); #endif } out: return retv; } /*========================================================================= ** End of proc file system stuff **========================================================================= */ #endif #ifdef SCSI_NCR_NVRAM_SUPPORT /* * 24C16 EEPROM reading. * * GPOI0 - data in/data out * GPIO1 - clock * Symbios NVRAM wiring now also used by Tekram. */ #define SET_BIT 0 #define CLR_BIT 1 #define SET_CLK 2 #define CLR_CLK 3 /* * Set/clear data/clock bit in GPIO0 */ static void __init S24C16_set_bit(ncr_slot *np, u_char write_bit, u_char *gpreg, int bit_mode) { UDELAY (5); switch (bit_mode){ case SET_BIT: *gpreg |= write_bit; break; case CLR_BIT: *gpreg &= 0xfe; break; case SET_CLK: *gpreg |= 0x02; break; case CLR_CLK: *gpreg &= 0xfd; break; } OUTB (nc_gpreg, *gpreg); UDELAY (5); } /* * Send START condition to NVRAM to wake it up. */ static void __init S24C16_start(ncr_slot *np, u_char *gpreg) { S24C16_set_bit(np, 1, gpreg, SET_BIT); S24C16_set_bit(np, 0, gpreg, SET_CLK); S24C16_set_bit(np, 0, gpreg, CLR_BIT); S24C16_set_bit(np, 0, gpreg, CLR_CLK); } /* * Send STOP condition to NVRAM - puts NVRAM to sleep... ZZzzzz!! */ static void __init S24C16_stop(ncr_slot *np, u_char *gpreg) { S24C16_set_bit(np, 0, gpreg, SET_CLK); S24C16_set_bit(np, 1, gpreg, SET_BIT); } /* * Read or write a bit to the NVRAM, * read if GPIO0 input else write if GPIO0 output */ static void __init S24C16_do_bit(ncr_slot *np, u_char *read_bit, u_char write_bit, u_char *gpreg) { S24C16_set_bit(np, write_bit, gpreg, SET_BIT); S24C16_set_bit(np, 0, gpreg, SET_CLK); if (read_bit) *read_bit = INB (nc_gpreg); S24C16_set_bit(np, 0, gpreg, CLR_CLK); S24C16_set_bit(np, 0, gpreg, CLR_BIT); } /* * Output an ACK to the NVRAM after reading, * change GPIO0 to output and when done back to an input */ static void __init S24C16_write_ack(ncr_slot *np, u_char write_bit, u_char *gpreg, u_char *gpcntl) { OUTB (nc_gpcntl, *gpcntl & 0xfe); S24C16_do_bit(np, 0, write_bit, gpreg); OUTB (nc_gpcntl, *gpcntl); } /* * Input an ACK from NVRAM after writing, * change GPIO0 to input and when done back to an output */ static void __init S24C16_read_ack(ncr_slot *np, u_char *read_bit, u_char *gpreg, u_char *gpcntl) { OUTB (nc_gpcntl, *gpcntl | 0x01); S24C16_do_bit(np, read_bit, 1, gpreg); OUTB (nc_gpcntl, *gpcntl); } /* * WRITE a byte to the NVRAM and then get an ACK to see it was accepted OK, * GPIO0 must already be set as an output */ static void __init S24C16_write_byte(ncr_slot *np, u_char *ack_data, u_char write_data, u_char *gpreg, u_char *gpcntl) { int x; for (x = 0; x < 8; x++) S24C16_do_bit(np, 0, (write_data >> (7 - x)) & 0x01, gpreg); S24C16_read_ack(np, ack_data, gpreg, gpcntl); } /* * READ a byte from the NVRAM and then send an ACK to say we have got it, * GPIO0 must already be set as an input */ static void __init S24C16_read_byte(ncr_slot *np, u_char *read_data, u_char ack_data, u_char *gpreg, u_char *gpcntl) { int x; u_char read_bit; *read_data = 0; for (x = 0; x < 8; x++) { S24C16_do_bit(np, &read_bit, 1, gpreg); *read_data |= ((read_bit & 0x01) << (7 - x)); } S24C16_write_ack(np, ack_data, gpreg, gpcntl); } /* * Read 'len' bytes starting at 'offset'. */ static int __init sym_read_S24C16_nvram (ncr_slot *np, int offset, u_char *data, int len) { u_char gpcntl, gpreg; u_char old_gpcntl, old_gpreg; u_char ack_data; int retv = 1; int x; /* save current state of GPCNTL and GPREG */ old_gpreg = INB (nc_gpreg); old_gpcntl = INB (nc_gpcntl); gpcntl = old_gpcntl & 0x1c; /* set up GPREG & GPCNTL to set GPIO0 and GPIO1 in to known state */ OUTB (nc_gpreg, old_gpreg); OUTB (nc_gpcntl, gpcntl); /* this is to set NVRAM into a known state with GPIO0/1 both low */ gpreg = old_gpreg; S24C16_set_bit(np, 0, &gpreg, CLR_CLK); S24C16_set_bit(np, 0, &gpreg, CLR_BIT); /* now set NVRAM inactive with GPIO0/1 both high */ S24C16_stop(np, &gpreg); /* activate NVRAM */ S24C16_start(np, &gpreg); /* write device code and random address MSB */ S24C16_write_byte(np, &ack_data, 0xa0 | ((offset >> 7) & 0x0e), &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* write random address LSB */ S24C16_write_byte(np, &ack_data, offset & 0xff, &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* regenerate START state to set up for reading */ S24C16_start(np, &gpreg); /* rewrite device code and address MSB with read bit set (lsb = 0x01) */ S24C16_write_byte(np, &ack_data, 0xa1 | ((offset >> 7) & 0x0e), &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* now set up GPIO0 for inputting data */ gpcntl |= 0x01; OUTB (nc_gpcntl, gpcntl); /* input all requested data - only part of total NVRAM */ for (x = 0; x < len; x++) S24C16_read_byte(np, &data[x], (x == (len-1)), &gpreg, &gpcntl); /* finally put NVRAM back in inactive mode */ gpcntl &= 0xfe; OUTB (nc_gpcntl, gpcntl); S24C16_stop(np, &gpreg); retv = 0; out: /* return GPIO0/1 to original states after having accessed NVRAM */ OUTB (nc_gpcntl, old_gpcntl); OUTB (nc_gpreg, old_gpreg); return retv; } #undef SET_BIT #undef CLR_BIT #undef SET_CLK #undef CLR_CLK /* * Try reading Symbios NVRAM. * Return 0 if OK. */ static int __init sym_read_Symbios_nvram (ncr_slot *np, Symbios_nvram *nvram) { static u_char Symbios_trailer[6] = {0xfe, 0xfe, 0, 0, 0, 0}; u_char *data = (u_char *) nvram; int len = sizeof(*nvram); u_short csum; int x; /* probe the 24c16 and read the SYMBIOS 24c16 area */ if (sym_read_S24C16_nvram (np, SYMBIOS_NVRAM_ADDRESS, data, len)) return 1; /* check valid NVRAM signature, verify byte count and checksum */ if (nvram->type != 0 || memcmp(nvram->trailer, Symbios_trailer, 6) || nvram->byte_count != len - 12) return 1; /* verify checksum */ for (x = 6, csum = 0; x < len - 6; x++) csum += data[x]; if (csum != nvram->checksum) return 1; return 0; } /* * 93C46 EEPROM reading. * * GPOI0 - data in * GPIO1 - data out * GPIO2 - clock * GPIO4 - chip select * * Used by Tekram. */ /* * Pulse clock bit in GPIO0 */ static void __init T93C46_Clk(ncr_slot *np, u_char *gpreg) { OUTB (nc_gpreg, *gpreg | 0x04); UDELAY (2); OUTB (nc_gpreg, *gpreg); } /* * Read bit from NVRAM */ static void __init T93C46_Read_Bit(ncr_slot *np, u_char *read_bit, u_char *gpreg) { UDELAY (2); T93C46_Clk(np, gpreg); *read_bit = INB (nc_gpreg); } /* * Write bit to GPIO0 */ static void __init T93C46_Write_Bit(ncr_slot *np, u_char write_bit, u_char *gpreg) { if (write_bit & 0x01) *gpreg |= 0x02; else *gpreg &= 0xfd; *gpreg |= 0x10; OUTB (nc_gpreg, *gpreg); UDELAY (2); T93C46_Clk(np, gpreg); } /* * Send STOP condition to NVRAM - puts NVRAM to sleep... ZZZzzz!! */ static void __init T93C46_Stop(ncr_slot *np, u_char *gpreg) { *gpreg &= 0xef; OUTB (nc_gpreg, *gpreg); UDELAY (2); T93C46_Clk(np, gpreg); } /* * Send read command and address to NVRAM */ static void __init T93C46_Send_Command(ncr_slot *np, u_short write_data, u_char *read_bit, u_char *gpreg) { int x; /* send 9 bits, start bit (1), command (2), address (6) */ for (x = 0; x < 9; x++) T93C46_Write_Bit(np, (u_char) (write_data >> (8 - x)), gpreg); *read_bit = INB (nc_gpreg); } /* * READ 2 bytes from the NVRAM */ static void __init T93C46_Read_Word(ncr_slot *np, u_short *nvram_data, u_char *gpreg) { int x; u_char read_bit; *nvram_data = 0; for (x = 0; x < 16; x++) { T93C46_Read_Bit(np, &read_bit, gpreg); if (read_bit & 0x01) *nvram_data |= (0x01 << (15 - x)); else *nvram_data &= ~(0x01 << (15 - x)); } } /* * Read Tekram NvRAM data. */ static int __init T93C46_Read_Data(ncr_slot *np, u_short *data,int len,u_char *gpreg) { u_char read_bit; int x; for (x = 0; x < len; x++) { /* output read command and address */ T93C46_Send_Command(np, 0x180 | x, &read_bit, gpreg); if (read_bit & 0x01) return 1; /* Bad */ T93C46_Read_Word(np, &data[x], gpreg); T93C46_Stop(np, gpreg); } return 0; } /* * Try reading 93C46 Tekram NVRAM. */ static int __init sym_read_T93C46_nvram (ncr_slot *np, Tekram_nvram *nvram) { u_char gpcntl, gpreg; u_char old_gpcntl, old_gpreg; int retv = 1; /* save current state of GPCNTL and GPREG */ old_gpreg = INB (nc_gpreg); old_gpcntl = INB (nc_gpcntl); /* set up GPREG & GPCNTL to set GPIO0/1/2/4 in to known state, 0 in, 1/2/4 out */ gpreg = old_gpreg & 0xe9; OUTB (nc_gpreg, gpreg); gpcntl = (old_gpcntl & 0xe9) | 0x09; OUTB (nc_gpcntl, gpcntl); /* input all of NVRAM, 64 words */ retv = T93C46_Read_Data(np, (u_short *) nvram, sizeof(*nvram) / sizeof(short), &gpreg); /* return GPIO0/1/2/4 to original states after having accessed NVRAM */ OUTB (nc_gpcntl, old_gpcntl); OUTB (nc_gpreg, old_gpreg); return retv; } /* * Try reading Tekram NVRAM. * Return 0 if OK. */ static int __init sym_read_Tekram_nvram (ncr_slot *np, u_short device_id, Tekram_nvram *nvram) { u_char *data = (u_char *) nvram; int len = sizeof(*nvram); u_short csum; int x; switch (device_id) { case PCI_DEVICE_ID_NCR_53C885: case PCI_DEVICE_ID_NCR_53C895: case PCI_DEVICE_ID_NCR_53C896: x = sym_read_S24C16_nvram(np, TEKRAM_24C16_NVRAM_ADDRESS, data, len); break; case PCI_DEVICE_ID_NCR_53C875: x = sym_read_S24C16_nvram(np, TEKRAM_24C16_NVRAM_ADDRESS, data, len); if (!x) break; default: x = sym_read_T93C46_nvram(np, nvram); break; } if (x) return 1; /* verify checksum */ for (x = 0, csum = 0; x < len - 1; x += 2) csum += data[x] + (data[x+1] << 8); if (csum != 0x1234) return 1; return 0; } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Module stuff */ MODULE_LICENSE("GPL"); static Scsi_Host_Template driver_template = { .name = "sym53c8xx", .detect = sym53c8xx_detect, .release = sym53c8xx_release, .info = sym53c8xx_info, .queuecommand = sym53c8xx_queue_command, .slave_configure = sym53c8xx_slave_configure, .abort = sym53c8xx_abort, .reset = sym53c8xx_reset, .can_queue = SCSI_NCR_CAN_QUEUE, .this_id = 7, .sg_tablesize = SCSI_NCR_SG_TABLESIZE, .cmd_per_lun = SCSI_NCR_CMD_PER_LUN, .max_sectors = MAX_HW_SEGMENTS*8, .use_clustering = DISABLE_CLUSTERING, .highmem_io = 1 }; #include "scsi_module.c" coccinelle-1.0.0-rc19/demos/demo_rule9/sym53c8xx.c0000644000175000017500000134115112247437436020510 0ustar eugeneugen/****************************************************************************** ** High Performance device driver for the Symbios 53C896 controller. ** ** Copyright (C) 1998-2001 Gerard Roudier ** ** This driver also supports all the Symbios 53C8XX controller family, ** except 53C810 revisions < 16, 53C825 revisions < 16 and all ** revisions of 53C815 controllers. ** ** This driver is based on the Linux port of the FreeBSD ncr driver. ** ** Copyright (C) 1994 Wolfgang Stanglmeier ** **----------------------------------------------------------------------------- ** ** This program is free software; you can redistribute it and/or modify ** it under the terms of the GNU General Public License as published by ** the Free Software Foundation; either version 2 of the License, or ** (at your option) any later version. ** ** This program is distributed in the hope that it will be useful, ** but WITHOUT ANY WARRANTY; without even the implied warranty of ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ** GNU General Public License for more details. ** ** You should have received a copy of the GNU General Public License ** along with this program; if not, write to the Free Software ** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ** **----------------------------------------------------------------------------- ** ** The Linux port of the FreeBSD ncr driver has been achieved in ** november 1995 by: ** ** Gerard Roudier ** ** Being given that this driver originates from the FreeBSD version, and ** in order to keep synergy on both, any suggested enhancements and corrections ** received on Linux are automatically a potential candidate for the FreeBSD ** version. ** ** The original driver has been written for 386bsd and FreeBSD by ** Wolfgang Stanglmeier ** Stefan Esser ** **----------------------------------------------------------------------------- ** ** Major contributions: ** -------------------- ** ** NVRAM detection and reading. ** Copyright (C) 1997 Richard Waltham ** ******************************************************************************* */ /* ** Supported SCSI features: ** Synchronous data transfers ** Wide16 SCSI BUS ** Disconnection/Reselection ** Tagged command queuing ** SCSI Parity checking ** ** Supported NCR/SYMBIOS chips: ** 53C810A (8 bits, Fast 10, no rom BIOS) ** 53C825A (Wide, Fast 10, on-board rom BIOS) ** 53C860 (8 bits, Fast 20, no rom BIOS) ** 53C875 (Wide, Fast 20, on-board rom BIOS) ** 53C876 (Wide, Fast 20 Dual, on-board rom BIOS) ** 53C895 (Wide, Fast 40, on-board rom BIOS) ** 53C895A (Wide, Fast 40, on-board rom BIOS) ** 53C896 (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C897 (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C1510D (Wide, Fast 40 Dual, on-board rom BIOS) ** 53C1010 (Wide, Fast 80 Dual, on-board rom BIOS) ** 53C1010_66(Wide, Fast 80 Dual, on-board rom BIOS, 33/66MHz PCI) ** ** Other features: ** Memory mapped IO ** Module ** Shared IRQ */ /* ** Name and version of the driver */ #define SCSI_NCR_DRIVER_NAME "sym53c8xx-1.7.3c-20010512" #define SCSI_NCR_DEBUG_FLAGS (0) #define NAME53C "sym53c" #define NAME53C8XX "sym53c8xx" /*========================================================== ** ** Include files ** **========================================================== */ #include #include #include #include #include #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,17) #include #elif LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,35) #include #endif #ifndef __init #define __init #endif #ifndef __initdata #define __initdata #endif #if LINUX_VERSION_CODE <= KERNEL_VERSION(2,1,92) #include #endif #include "scsi.h" #include "hosts.h" #include /* ** Define BITS_PER_LONG for earlier linux versions. */ #ifndef BITS_PER_LONG #if (~0UL) == 0xffffffffUL #define BITS_PER_LONG 32 #else #define BITS_PER_LONG 64 #endif #endif /* ** Define the BSD style u_int32 and u_int64 type. ** Are in fact u_int32_t and u_int64_t :-) */ typedef u32 u_int32; typedef u64 u_int64; #include "sym53c8xx.h" /* ** Donnot compile integrity checking code for Linux-2.3.0 ** and above since SCSI data structures are not ready yet. */ /* #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,0) */ #if 0 #define SCSI_NCR_INTEGRITY_CHECKING #endif #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #define MAX(a,b) (((a) > (b)) ? (a) : (b)) /* ** Hmmm... What complex some PCI-HOST bridges actually are, ** despite the fact that the PCI specifications are looking ** so smart and simple! ;-) */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,47) #define SCSI_NCR_DYNAMIC_DMA_MAPPING #endif /*========================================================== ** ** A la VMS/CAM-3 queue management. ** Implemented from linux list management. ** **========================================================== */ typedef struct xpt_quehead { struct xpt_quehead *flink; /* Forward pointer */ struct xpt_quehead *blink; /* Backward pointer */ } XPT_QUEHEAD; #define xpt_que_init(ptr) do { \ (ptr)->flink = (ptr); (ptr)->blink = (ptr); \ } while (0) static inline void __xpt_que_add(struct xpt_quehead * new, struct xpt_quehead * blink, struct xpt_quehead * flink) { flink->blink = new; new->flink = flink; new->blink = blink; blink->flink = new; } static inline void __xpt_que_del(struct xpt_quehead * blink, struct xpt_quehead * flink) { flink->blink = blink; blink->flink = flink; } static inline int xpt_que_empty(struct xpt_quehead *head) { return head->flink == head; } static inline void xpt_que_splice(struct xpt_quehead *list, struct xpt_quehead *head) { struct xpt_quehead *first = list->flink; if (first != list) { struct xpt_quehead *last = list->blink; struct xpt_quehead *at = head->flink; first->blink = head; head->flink = first; last->flink = at; at->blink = last; } } #define xpt_que_entry(ptr, type, member) \ ((type *)((char *)(ptr)-(unsigned long)(&((type *)0)->member))) #define xpt_insque(new, pos) __xpt_que_add(new, pos, (pos)->flink) #define xpt_remque(el) __xpt_que_del((el)->blink, (el)->flink) #define xpt_insque_head(new, head) __xpt_que_add(new, head, (head)->flink) static inline struct xpt_quehead *xpt_remque_head(struct xpt_quehead *head) { struct xpt_quehead *elem = head->flink; if (elem != head) __xpt_que_del(head, elem->flink); else elem = 0; return elem; } #define xpt_insque_tail(new, head) __xpt_que_add(new, (head)->blink, head) static inline struct xpt_quehead *xpt_remque_tail(struct xpt_quehead *head) { struct xpt_quehead *elem = head->blink; if (elem != head) __xpt_que_del(elem->blink, head); else elem = 0; return elem; } /*========================================================== ** ** Configuration and Debugging ** **========================================================== */ /* ** SCSI address of this device. ** The boot routines should have set it. ** If not, use this. */ #ifndef SCSI_NCR_MYADDR #define SCSI_NCR_MYADDR (7) #endif /* ** The maximum number of tags per logic unit. ** Used only for devices that support tags. */ #ifndef SCSI_NCR_MAX_TAGS #define SCSI_NCR_MAX_TAGS (8) #endif /* ** TAGS are actually unlimited (256 tags/lun). ** But Linux only supports 255. :) */ #if SCSI_NCR_MAX_TAGS > 255 #define MAX_TAGS 255 #else #define MAX_TAGS SCSI_NCR_MAX_TAGS #endif /* ** Since the ncr chips only have a 8 bit ALU, we try to be clever ** about offset calculation in the TASK TABLE per LUN that is an ** array of DWORDS = 4 bytes. */ #if MAX_TAGS > (512/4) #define MAX_TASKS (1024/4) #elif MAX_TAGS > (256/4) #define MAX_TASKS (512/4) #else #define MAX_TASKS (256/4) #endif /* ** This one means 'NO TAG for this job' */ #define NO_TAG (256) /* ** Number of targets supported by the driver. ** n permits target numbers 0..n-1. ** Default is 16, meaning targets #0..#15. ** #7 .. is myself. */ #ifdef SCSI_NCR_MAX_TARGET #define MAX_TARGET (SCSI_NCR_MAX_TARGET) #else #define MAX_TARGET (16) #endif /* ** Number of logic units supported by the driver. ** n enables logic unit numbers 0..n-1. ** The common SCSI devices require only ** one lun, so take 1 as the default. */ #ifdef SCSI_NCR_MAX_LUN #define MAX_LUN 64 #else #define MAX_LUN (1) #endif /* ** Asynchronous pre-scaler (ns). Shall be 40 for ** the SCSI timings to be compliant. */ #ifndef SCSI_NCR_MIN_ASYNC #define SCSI_NCR_MIN_ASYNC (40) #endif /* ** The maximum number of jobs scheduled for starting. ** We allocate 4 entries more than the value we announce ** to the SCSI upper layer. Guess why ! :-) */ #ifdef SCSI_NCR_CAN_QUEUE #define MAX_START (SCSI_NCR_CAN_QUEUE + 4) #else #define MAX_START (MAX_TARGET + 7 * MAX_TAGS) #endif /* ** We donnot want to allocate more than 1 PAGE for the ** the start queue and the done queue. We hard-code entry ** size to 8 in order to let cpp do the checking. ** Allows 512-4=508 pending IOs for i386 but Linux seems for ** now not able to provide the driver with this amount of IOs. */ #if MAX_START > PAGE_SIZE/8 #undef MAX_START #define MAX_START (PAGE_SIZE/8) #endif /* ** The maximum number of segments a transfer is split into. ** We support up to 127 segments for both read and write. */ #define MAX_SCATTER (SCSI_NCR_MAX_SCATTER) #define SCR_SG_SIZE (2) /* ** other */ #define NCR_SNOOP_TIMEOUT (1000000) /*========================================================== ** ** Miscallaneous BSDish defines. ** **========================================================== */ #define u_char unsigned char #define u_short unsigned short #define u_int unsigned int #define u_long unsigned long #ifndef bcopy #define bcopy(s, d, n) memcpy((d), (s), (n)) #endif #ifndef bzero #define bzero(d, n) memset((d), 0, (n)) #endif #ifndef offsetof #define offsetof(t, m) ((size_t) (&((t *)0)->m)) #endif /* ** Simple Wrapper to kernel PCI bus interface. ** ** This wrapper allows to get rid of old kernel PCI interface ** and still allows to preserve linux-2.0 compatibility. ** In fact, it is mostly an incomplete emulation of the new ** PCI code for pre-2.2 kernels. When kernel-2.0 support ** will be dropped, we will just have to remove most of this ** code. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,2,0) typedef struct pci_dev *pcidev_t; #define PCIDEV_NULL (0) #define PciBusNumber(d) (d)->bus->number #define PciDeviceFn(d) (d)->devfn #define PciVendorId(d) (d)->vendor #define PciDeviceId(d) (d)->device #define PciIrqLine(d) (d)->irq static u_long __init pci_get_base_cookie(struct pci_dev *pdev, int index) { u_long base; #if LINUX_VERSION_CODE > KERNEL_VERSION(2,3,12) base = pdev->resource[index].start; #else base = pdev->base_address[index]; #if BITS_PER_LONG > 32 if ((base & 0x7) == 0x4) *base |= (((u_long)pdev->base_address[++index]) << 32); #endif #endif return (base & ~0x7ul); } static int __init pci_get_base_address(struct pci_dev *pdev, int index, u_long *base) { u32 tmp; #define PCI_BAR_OFFSET(index) (PCI_BASE_ADDRESS_0 + (index<<2)) pci_read_config_dword(pdev, PCI_BAR_OFFSET(index), &tmp); *base = tmp; ++index; if ((tmp & 0x7) == 0x4) { #if BITS_PER_LONG > 32 pci_read_config_dword(pdev, PCI_BAR_OFFSET(index), &tmp); *base |= (((u_long)tmp) << 32); #endif ++index; } return index; #undef PCI_BAR_OFFSET } #else /* Incomplete emulation of current PCI code for pre-2.2 kernels */ typedef unsigned int pcidev_t; #define PCIDEV_NULL (~0u) #define PciBusNumber(d) ((d)>>8) #define PciDeviceFn(d) ((d)&0xff) #define __PciDev(busn, devfn) (((busn)<<8)+(devfn)) #define pci_present pcibios_present #define pci_read_config_byte(d, w, v) \ pcibios_read_config_byte(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_read_config_word(d, w, v) \ pcibios_read_config_word(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_read_config_dword(d, w, v) \ pcibios_read_config_dword(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_byte(d, w, v) \ pcibios_write_config_byte(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_word(d, w, v) \ pcibios_write_config_word(PciBusNumber(d), PciDeviceFn(d), w, v) #define pci_write_config_dword(d, w, v) \ pcibios_write_config_dword(PciBusNumber(d), PciDeviceFn(d), w, v) static pcidev_t __init pci_find_device(unsigned int vendor, unsigned int device, pcidev_t prev) { static unsigned short pci_index; int retv; unsigned char bus_number, device_fn; if (prev == PCIDEV_NULL) pci_index = 0; else ++pci_index; retv = pcibios_find_device (vendor, device, pci_index, &bus_number, &device_fn); return retv ? PCIDEV_NULL : __PciDev(bus_number, device_fn); } static u_short __init PciVendorId(pcidev_t dev) { u_short vendor_id; pci_read_config_word(dev, PCI_VENDOR_ID, &vendor_id); return vendor_id; } static u_short __init PciDeviceId(pcidev_t dev) { u_short device_id; pci_read_config_word(dev, PCI_DEVICE_ID, &device_id); return device_id; } static u_int __init PciIrqLine(pcidev_t dev) { u_char irq; pci_read_config_byte(dev, PCI_INTERRUPT_LINE, &irq); return irq; } static int __init pci_get_base_address(pcidev_t dev, int offset, u_long *base) { u_int32 tmp; pci_read_config_dword(dev, PCI_BASE_ADDRESS_0 + offset, &tmp); *base = tmp; offset += sizeof(u_int32); if ((tmp & 0x7) == 0x4) { #if BITS_PER_LONG > 32 pci_read_config_dword(dev, PCI_BASE_ADDRESS_0 + offset, &tmp); *base |= (((u_long)tmp) << 32); #endif offset += sizeof(u_int32); } return offset; } static u_long __init pci_get_base_cookie(struct pci_dev *pdev, int offset) { u_long base; (void) pci_get_base_address(dev, offset, &base); return base; } #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(2,2,0) */ /* Does not make sense in earlier kernels */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,4,0) #define pci_enable_device(pdev) (0) #endif #if LINUX_VERSION_CODE < KERNEL_VERSION(2,4,4) #define scsi_set_pci_device(inst, pdev) (0) #endif /*========================================================== ** ** Debugging tags ** **========================================================== */ #define DEBUG_ALLOC (0x0001) #define DEBUG_PHASE (0x0002) #define DEBUG_QUEUE (0x0008) #define DEBUG_RESULT (0x0010) #define DEBUG_POINTER (0x0020) #define DEBUG_SCRIPT (0x0040) #define DEBUG_TINY (0x0080) #define DEBUG_TIMING (0x0100) #define DEBUG_NEGO (0x0200) #define DEBUG_TAGS (0x0400) #define DEBUG_IC (0x0800) /* ** Enable/Disable debug messages. ** Can be changed at runtime too. */ #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT static int ncr_debug = SCSI_NCR_DEBUG_FLAGS; #define DEBUG_FLAGS ncr_debug #else #define DEBUG_FLAGS SCSI_NCR_DEBUG_FLAGS #endif /* ** SMP threading. ** ** Assuming that SMP systems are generally high end systems and may ** use several SCSI adapters, we are using one lock per controller ** instead of some global one. For the moment (linux-2.1.95), driver's ** entry points are called with the 'io_request_lock' lock held, so: ** - We are uselessly losing a couple of micro-seconds to lock the ** controller data structure. ** - But the driver is not broken by design for SMP and so can be ** more resistant to bugs or bad changes in the IO sub-system code. ** - A small advantage could be that the interrupt code is grained as ** wished (e.g.: threaded by controller). */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) spinlock_t sym53c8xx_lock = SPIN_LOCK_UNLOCKED; #define NCR_LOCK_DRIVER(flags) spin_lock_irqsave(&sym53c8xx_lock, flags) #define NCR_UNLOCK_DRIVER(flags) spin_unlock_irqrestore(&sym53c8xx_lock,flags) #define NCR_INIT_LOCK_NCB(np) spin_lock_init(&np->smp_lock); #define NCR_LOCK_NCB(np, flags) spin_lock_irqsave(&np->smp_lock, flags) #define NCR_UNLOCK_NCB(np, flags) spin_unlock_irqrestore(&np->smp_lock, flags) #define NCR_LOCK_SCSI_DONE(host, flags) \ spin_lock_irqsave(((host)->host_lock), flags) #define NCR_UNLOCK_SCSI_DONE(host, flags) \ spin_unlock_irqrestore(((host)->host_lock), flags) #else #define NCR_LOCK_DRIVER(flags) do { save_flags(flags); cli(); } while (0) #define NCR_UNLOCK_DRIVER(flags) do { restore_flags(flags); } while (0) #define NCR_INIT_LOCK_NCB(np) do { } while (0) #define NCR_LOCK_NCB(np, flags) do { save_flags(flags); cli(); } while (0) #define NCR_UNLOCK_NCB(np, flags) do { restore_flags(flags); } while (0) #define NCR_LOCK_SCSI_DONE(host, flags) do {;} while (0) #define NCR_UNLOCK_SCSI_DONE(host, flags) do {;} while (0) #endif /* ** Memory mapped IO ** ** Since linux-2.1, we must use ioremap() to map the io memory space. ** iounmap() to unmap it. That allows portability. ** Linux 1.3.X and 2.0.X allow to remap physical pages addresses greater ** than the highest physical memory address to kernel virtual pages with ** vremap() / vfree(). That was not portable but worked with i386 ** architecture. */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,1,0) #define ioremap vremap #define iounmap vfree #endif #ifdef __sparc__ # include # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #elif defined(__alpha__) # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #else /* others */ # define memcpy_to_pci(a, b, c) memcpy_toio((a), (b), (c)) #endif #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED static u_long __init remap_pci_mem(u_long base, u_long size) { u_long page_base = ((u_long) base) & PAGE_MASK; u_long page_offs = ((u_long) base) - page_base; u_long page_remapped = (u_long) ioremap(page_base, page_offs+size); return page_remapped? (page_remapped + page_offs) : 0UL; } static void __init unmap_pci_mem(u_long vaddr, u_long size) { if (vaddr) iounmap((void *) (vaddr & PAGE_MASK)); } #endif /* not def SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ /* ** Insert a delay in micro-seconds and milli-seconds. ** ------------------------------------------------- ** Under Linux, udelay() is restricted to delay < 1 milli-second. ** In fact, it generally works for up to 1 second delay. ** Since 2.1.105, the mdelay() function is provided for delays ** in milli-seconds. ** Under 2.0 kernels, udelay() is an inline function that is very ** inaccurate on Pentium processors. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,105) #define UDELAY udelay #define MDELAY mdelay #else static void UDELAY(long us) { udelay(us); } static void MDELAY(long ms) { while (ms--) UDELAY(1000); } #endif /* ** Simple power of two buddy-like allocator ** ---------------------------------------- ** This simple code is not intended to be fast, but to provide ** power of 2 aligned memory allocations. ** Since the SCRIPTS processor only supplies 8 bit arithmetic, ** this allocator allows simple and fast address calculations ** from the SCRIPTS code. In addition, cache line alignment ** is guaranteed for power of 2 cache line size. ** Enhanced in linux-2.3.44 to provide a memory pool per pcidev ** to support dynamic dma mapping. (I would have preferred a ** real bus abstraction, btw). */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,0) #define __GetFreePages(flags, order) __get_free_pages(flags, order) #else #define __GetFreePages(flags, order) __get_free_pages(flags, order, 0) #endif #define MEMO_SHIFT 4 /* 16 bytes minimum memory chunk */ #if PAGE_SIZE >= 8192 #define MEMO_PAGE_ORDER 0 /* 1 PAGE maximum */ #else #define MEMO_PAGE_ORDER 1 /* 2 PAGES maximum */ #endif #define MEMO_FREE_UNUSED /* Free unused pages immediately */ #define MEMO_WARN 1 #define MEMO_GFP_FLAGS GFP_ATOMIC #define MEMO_CLUSTER_SHIFT (PAGE_SHIFT+MEMO_PAGE_ORDER) #define MEMO_CLUSTER_SIZE (1UL << MEMO_CLUSTER_SHIFT) #define MEMO_CLUSTER_MASK (MEMO_CLUSTER_SIZE-1) typedef u_long m_addr_t; /* Enough bits to bit-hack addresses */ typedef pcidev_t m_bush_t; /* Something that addresses DMAable */ typedef struct m_link { /* Link between free memory chunks */ struct m_link *next; } m_link_s; #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING typedef struct m_vtob { /* Virtual to Bus address translation */ struct m_vtob *next; m_addr_t vaddr; m_addr_t baddr; } m_vtob_s; #define VTOB_HASH_SHIFT 5 #define VTOB_HASH_SIZE (1UL << VTOB_HASH_SHIFT) #define VTOB_HASH_MASK (VTOB_HASH_SIZE-1) #define VTOB_HASH_CODE(m) \ ((((m_addr_t) (m)) >> MEMO_CLUSTER_SHIFT) & VTOB_HASH_MASK) #endif typedef struct m_pool { /* Memory pool of a given kind */ #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING m_bush_t bush; m_addr_t (*getp)(struct m_pool *); void (*freep)(struct m_pool *, m_addr_t); #define M_GETP() mp->getp(mp) #define M_FREEP(p) mp->freep(mp, p) #define GetPages() __GetFreePages(MEMO_GFP_FLAGS, MEMO_PAGE_ORDER) #define FreePages(p) free_pages(p, MEMO_PAGE_ORDER) int nump; m_vtob_s *(vtob[VTOB_HASH_SIZE]); struct m_pool *next; #else #define M_GETP() __GetFreePages(MEMO_GFP_FLAGS, MEMO_PAGE_ORDER) #define M_FREEP(p) free_pages(p, MEMO_PAGE_ORDER) #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ struct m_link h[PAGE_SHIFT-MEMO_SHIFT+MEMO_PAGE_ORDER+1]; } m_pool_s; static void *___m_alloc(m_pool_s *mp, int size) { int i = 0; int s = (1 << MEMO_SHIFT); int j; m_addr_t a; m_link_s *h = mp->h; if (size > (PAGE_SIZE << MEMO_PAGE_ORDER)) return 0; while (size > s) { s <<= 1; ++i; } j = i; while (!h[j].next) { if (s == (PAGE_SIZE << MEMO_PAGE_ORDER)) { h[j].next = (m_link_s *) M_GETP(); if (h[j].next) h[j].next->next = 0; break; } ++j; s <<= 1; } a = (m_addr_t) h[j].next; if (a) { h[j].next = h[j].next->next; while (j > i) { j -= 1; s >>= 1; h[j].next = (m_link_s *) (a+s); h[j].next->next = 0; } } #ifdef DEBUG printk("___m_alloc(%d) = %p\n", size, (void *) a); #endif return (void *) a; } static void ___m_free(m_pool_s *mp, void *ptr, int size) { int i = 0; int s = (1 << MEMO_SHIFT); m_link_s *q; m_addr_t a, b; m_link_s *h = mp->h; #ifdef DEBUG printk("___m_free(%p, %d)\n", ptr, size); #endif if (size > (PAGE_SIZE << MEMO_PAGE_ORDER)) return; while (size > s) { s <<= 1; ++i; } a = (m_addr_t) ptr; while (1) { #ifdef MEMO_FREE_UNUSED if (s == (PAGE_SIZE << MEMO_PAGE_ORDER)) { M_FREEP(a); break; } #endif b = a ^ s; q = &h[i]; while (q->next && q->next != (m_link_s *) b) { q = q->next; } if (!q->next) { ((m_link_s *) a)->next = h[i].next; h[i].next = (m_link_s *) a; break; } q->next = q->next->next; a = a & b; s <<= 1; ++i; } } static void *__m_calloc2(m_pool_s *mp, int size, char *name, int uflags) { void *p; p = ___m_alloc(mp, size); if (DEBUG_FLAGS & DEBUG_ALLOC) printk ("new %-10s[%4d] @%p.\n", name, size, p); if (p) bzero(p, size); else if (uflags & MEMO_WARN) printk (NAME53C8XX ": failed to allocate %s[%d]\n", name, size); return p; } #define __m_calloc(mp, s, n) __m_calloc2(mp, s, n, MEMO_WARN) static void __m_free(m_pool_s *mp, void *ptr, int size, char *name) { if (DEBUG_FLAGS & DEBUG_ALLOC) printk ("freeing %-10s[%4d] @%p.\n", name, size, ptr); ___m_free(mp, ptr, size); } /* * With pci bus iommu support, we use a default pool of unmapped memory * for memory we donnot need to DMA from/to and one pool per pcidev for * memory accessed by the PCI chip. `mp0' is the default not DMAable pool. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING static m_pool_s mp0; #else static m_addr_t ___mp0_getp(m_pool_s *mp) { m_addr_t m = GetPages(); if (m) ++mp->nump; return m; } static void ___mp0_freep(m_pool_s *mp, m_addr_t m) { FreePages(m); --mp->nump; } static m_pool_s mp0 = {0, ___mp0_getp, ___mp0_freep}; #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ static void *m_calloc(int size, char *name) { u_long flags; void *m; NCR_LOCK_DRIVER(flags); m = __m_calloc(&mp0, size, name); NCR_UNLOCK_DRIVER(flags); return m; } static void m_free(void *ptr, int size, char *name) { u_long flags; NCR_LOCK_DRIVER(flags); __m_free(&mp0, ptr, size, name); NCR_UNLOCK_DRIVER(flags); } /* * DMAable pools. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Without pci bus iommu support, all the memory is assumed DMAable */ #define __m_calloc_dma(b, s, n) m_calloc(s, n) #define __m_free_dma(b, p, s, n) m_free(p, s, n) #define __vtobus(b, p) virt_to_bus(p) #else /* * With pci bus iommu support, we maintain one pool per pcidev and a * hashed reverse table for virtual to bus physical address translations. */ static m_addr_t ___dma_getp(m_pool_s *mp) { m_addr_t vp; m_vtob_s *vbp; vbp = __m_calloc(&mp0, sizeof(*vbp), "VTOB"); if (vbp) { dma_addr_t daddr; vp = (m_addr_t) pci_alloc_consistent(mp->bush, PAGE_SIZE<vaddr = vp; vbp->baddr = daddr; vbp->next = mp->vtob[hc]; mp->vtob[hc] = vbp; ++mp->nump; return vp; } else __m_free(&mp0, vbp, sizeof(*vbp), "VTOB"); } return 0; } static void ___dma_freep(m_pool_s *mp, m_addr_t m) { m_vtob_s **vbpp, *vbp; int hc = VTOB_HASH_CODE(m); vbpp = &mp->vtob[hc]; while (*vbpp && (*vbpp)->vaddr != m) vbpp = &(*vbpp)->next; if (*vbpp) { vbp = *vbpp; *vbpp = (*vbpp)->next; pci_free_consistent(mp->bush, PAGE_SIZE<vaddr, (dma_addr_t)vbp->baddr); __m_free(&mp0, vbp, sizeof(*vbp), "VTOB"); --mp->nump; } } static inline m_pool_s *___get_dma_pool(m_bush_t bush) { m_pool_s *mp; for (mp = mp0.next; mp && mp->bush != bush; mp = mp->next); return mp; } static m_pool_s *___cre_dma_pool(m_bush_t bush) { m_pool_s *mp; mp = __m_calloc(&mp0, sizeof(*mp), "MPOOL"); if (mp) { bzero(mp, sizeof(*mp)); mp->bush = bush; mp->getp = ___dma_getp; mp->freep = ___dma_freep; mp->next = mp0.next; mp0.next = mp; } return mp; } static void ___del_dma_pool(m_pool_s *p) { struct m_pool **pp = &mp0.next; while (*pp && *pp != p) pp = &(*pp)->next; if (*pp) { *pp = (*pp)->next; __m_free(&mp0, p, sizeof(*p), "MPOOL"); } } static void *__m_calloc_dma(m_bush_t bush, int size, char *name) { u_long flags; struct m_pool *mp; void *m = 0; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (!mp) mp = ___cre_dma_pool(bush); if (mp) m = __m_calloc(mp, size, name); if (mp && !mp->nump) ___del_dma_pool(mp); NCR_UNLOCK_DRIVER(flags); return m; } static void __m_free_dma(m_bush_t bush, void *m, int size, char *name) { u_long flags; struct m_pool *mp; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (mp) __m_free(mp, m, size, name); if (mp && !mp->nump) ___del_dma_pool(mp); NCR_UNLOCK_DRIVER(flags); } static m_addr_t __vtobus(m_bush_t bush, void *m) { u_long flags; m_pool_s *mp; int hc = VTOB_HASH_CODE(m); m_vtob_s *vp = 0; m_addr_t a = ((m_addr_t) m) & ~MEMO_CLUSTER_MASK; NCR_LOCK_DRIVER(flags); mp = ___get_dma_pool(bush); if (mp) { vp = mp->vtob[hc]; while (vp && (m_addr_t) vp->vaddr != a) vp = vp->next; } NCR_UNLOCK_DRIVER(flags); return vp ? vp->baddr + (((m_addr_t) m) - a) : 0; } #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ #define _m_calloc_dma(np, s, n) __m_calloc_dma(np->pdev, s, n) #define _m_free_dma(np, p, s, n) __m_free_dma(np->pdev, p, s, n) #define m_calloc_dma(s, n) _m_calloc_dma(np, s, n) #define m_free_dma(p, s, n) _m_free_dma(np, p, s, n) #define _vtobus(np, p) __vtobus(np->pdev, p) #define vtobus(p) _vtobus(np, p) /* * Deal with DMA mapping/unmapping. */ #ifndef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Linux versions prior to pci bus iommu kernel interface */ #define __unmap_scsi_data(pdev, cmd) do {; } while (0) #define __map_scsi_single_data(pdev, cmd) (__vtobus(pdev,(cmd)->request_buffer)) #define __map_scsi_sg_data(pdev, cmd) ((cmd)->use_sg) #define __sync_scsi_data(pdev, cmd) do {; } while (0) #define scsi_sg_dma_address(sc) vtobus((sc)->address) #define scsi_sg_dma_len(sc) ((sc)->length) #else /* Linux version with pci bus iommu kernel interface */ /* To keep track of the dma mapping (sg/single) that has been set */ #define __data_mapped(cmd) (cmd)->SCp.phase #define __data_mapping(cmd) (cmd)->SCp.dma_handle static void __unmap_scsi_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); switch(__data_mapped(cmd)) { case 2: pci_unmap_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); break; case 1: pci_unmap_page(pdev, __data_mapping(cmd), cmd->request_bufflen, dma_dir); break; } __data_mapped(cmd) = 0; } static dma_addr_t __map_scsi_single_data(pcidev_t pdev, Scsi_Cmnd *cmd) { dma_addr_t mapping; int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); if (cmd->request_bufflen == 0) return 0; mapping = pci_map_page(pdev, virt_to_page(cmd->request_buffer), ((unsigned long)cmd->request_buffer & ~PAGE_MASK), cmd->request_bufflen, dma_dir); __data_mapped(cmd) = 1; __data_mapping(cmd) = mapping; return mapping; } static int __map_scsi_sg_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int use_sg; int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); if (cmd->use_sg == 0) return 0; use_sg = pci_map_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); __data_mapped(cmd) = 2; __data_mapping(cmd) = use_sg; return use_sg; } static void __sync_scsi_data(pcidev_t pdev, Scsi_Cmnd *cmd) { int dma_dir = scsi_to_pci_dma_dir(cmd->sc_data_direction); switch(__data_mapped(cmd)) { case 2: pci_dma_sync_sg(pdev, cmd->buffer, cmd->use_sg, dma_dir); break; case 1: pci_dma_sync_single(pdev, __data_mapping(cmd), cmd->request_bufflen, dma_dir); break; } } #define scsi_sg_dma_address(sc) sg_dma_address(sc) #define scsi_sg_dma_len(sc) sg_dma_len(sc) #endif /* SCSI_NCR_DYNAMIC_DMA_MAPPING */ #define unmap_scsi_data(np, cmd) __unmap_scsi_data(np->pdev, cmd) #define map_scsi_single_data(np, cmd) __map_scsi_single_data(np->pdev, cmd) #define map_scsi_sg_data(np, cmd) __map_scsi_sg_data(np->pdev, cmd) #define sync_scsi_data(np, cmd) __sync_scsi_data(np->pdev, cmd) /* * Print out some buffer. */ static void ncr_print_hex(u_char *p, int n) { while (n-- > 0) printk (" %x", *p++); } static void ncr_printl_hex(char *label, u_char *p, int n) { printk("%s", label); ncr_print_hex(p, n); printk (".\n"); } /* ** Transfer direction ** ** Until some linux kernel version near 2.3.40, low-level scsi ** drivers were not told about data transfer direction. ** We check the existence of this feature that has been expected ** for a _long_ time by all SCSI driver developers by just ** testing against the definition of SCSI_DATA_UNKNOWN. Indeed ** this is a hack, but testing against a kernel version would ** have been a shame. ;-) */ #ifdef SCSI_DATA_UNKNOWN #define scsi_data_direction(cmd) (cmd->sc_data_direction) #else #define SCSI_DATA_UNKNOWN 0 #define SCSI_DATA_WRITE 1 #define SCSI_DATA_READ 2 #define SCSI_DATA_NONE 3 static __inline__ int scsi_data_direction(Scsi_Cmnd *cmd) { int direction; switch((int) cmd->cmnd[0]) { case 0x08: /* READ(6) 08 */ case 0x28: /* READ(10) 28 */ case 0xA8: /* READ(12) A8 */ direction = SCSI_DATA_READ; break; case 0x0A: /* WRITE(6) 0A */ case 0x2A: /* WRITE(10) 2A */ case 0xAA: /* WRITE(12) AA */ direction = SCSI_DATA_WRITE; break; default: direction = SCSI_DATA_UNKNOWN; break; } return direction; } #endif /* SCSI_DATA_UNKNOWN */ /* ** /proc directory entry and proc_info function */ #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,27) static struct proc_dir_entry proc_scsi_sym53c8xx = { PROC_SCSI_SYM53C8XX, 9, NAME53C8XX, S_IFDIR | S_IRUGO | S_IXUGO, 2 }; #endif #ifdef SCSI_NCR_PROC_INFO_SUPPORT static int sym53c8xx_proc_info(char *buffer, char **start, off_t offset, int length, int hostno, int func); #endif /* ** Driver setup. ** ** This structure is initialized from linux config options. ** It can be overridden at boot-up by the boot command line. */ static struct ncr_driver_setup driver_setup = SCSI_NCR_DRIVER_SETUP; #ifdef SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT static struct ncr_driver_setup driver_safe_setup __initdata = SCSI_NCR_DRIVER_SAFE_SETUP; # ifdef MODULE char *sym53c8xx = 0; /* command line passed by insmod */ # if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,30) MODULE_PARM(sym53c8xx, "s"); # endif # endif #endif /* ** Other Linux definitions */ #define SetScsiResult(cmd, h_sts, s_sts) \ cmd->result = (((h_sts) << 16) + ((s_sts) & 0x7f)) /* We may have to remind our amnesiac SCSI layer of the reason of the abort */ #if 0 #define SetScsiAbortResult(cmd) \ SetScsiResult( \ cmd, \ (cmd)->abort_reason == DID_TIME_OUT ? DID_TIME_OUT : DID_ABORT, \ 0xff) #else #define SetScsiAbortResult(cmd) SetScsiResult(cmd, DID_ABORT, 0xff) #endif static void sym53c8xx_intr(int irq, void *dev_id, struct pt_regs * regs); static void sym53c8xx_timeout(unsigned long np); #define initverbose (driver_setup.verbose) #define bootverbose (np->verbose) #ifdef SCSI_NCR_NVRAM_SUPPORT static u_char Tekram_sync[16] __initdata = {25,31,37,43, 50,62,75,125, 12,15,18,21, 6,7,9,10}; #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Structures used by sym53c8xx_detect/sym53c8xx_pci_init to ** transmit device configuration to the ncr_attach() function. */ typedef struct { int bus; u_char device_fn; u_long base; u_long base_2; u_long io_port; u_long base_c; u_long base_2_c; int irq; /* port and reg fields to use INB, OUTB macros */ u_long base_io; volatile struct ncr_reg *reg; } ncr_slot; typedef struct { int type; #define SCSI_NCR_SYMBIOS_NVRAM (1) #define SCSI_NCR_TEKRAM_NVRAM (2) #ifdef SCSI_NCR_NVRAM_SUPPORT union { Symbios_nvram Symbios; Tekram_nvram Tekram; } data; #endif } ncr_nvram; /* ** Structure used by sym53c8xx_detect/sym53c8xx_pci_init ** to save data on each detected board for ncr_attach(). */ typedef struct { pcidev_t pdev; ncr_slot slot; ncr_chip chip; ncr_nvram *nvram; u_char host_id; #ifdef SCSI_NCR_PQS_PDS_SUPPORT u_char pqs_pds; #endif int attach_done; } ncr_device; /*========================================================== ** ** assert () ** **========================================================== ** ** modified copy from 386bsd:/usr/include/sys/assert.h ** **---------------------------------------------------------- */ #define assert(expression) { \ if (!(expression)) { \ (void)panic( \ "assertion \"%s\" failed: file \"%s\", line %d\n", \ #expression, \ __FILE__, __LINE__); \ } \ } /*========================================================== ** ** Command control block states. ** **========================================================== */ #define HS_IDLE (0) #define HS_BUSY (1) #define HS_NEGOTIATE (2) /* sync/wide data transfer*/ #define HS_DISCONNECT (3) /* Disconnected by target */ #define HS_DONEMASK (0x80) #define HS_COMPLETE (4|HS_DONEMASK) #define HS_SEL_TIMEOUT (5|HS_DONEMASK) /* Selection timeout */ #define HS_RESET (6|HS_DONEMASK) /* SCSI reset */ #define HS_ABORTED (7|HS_DONEMASK) /* Transfer aborted */ #define HS_TIMEOUT (8|HS_DONEMASK) /* Software timeout */ #define HS_FAIL (9|HS_DONEMASK) /* SCSI or PCI bus errors */ #define HS_UNEXPECTED (10|HS_DONEMASK)/* Unexpected disconnect */ #define DSA_INVALID 0xffffffff /*========================================================== ** ** Software Interrupt Codes ** **========================================================== */ #define SIR_BAD_STATUS (1) #define SIR_SEL_ATN_NO_MSG_OUT (2) #define SIR_MSG_RECEIVED (3) #define SIR_MSG_WEIRD (4) #define SIR_NEGO_FAILED (5) #define SIR_NEGO_PROTO (6) #define SIR_SCRIPT_STOPPED (7) #define SIR_REJECT_TO_SEND (8) #define SIR_SWIDE_OVERRUN (9) #define SIR_SODL_UNDERRUN (10) #define SIR_RESEL_NO_MSG_IN (11) #define SIR_RESEL_NO_IDENTIFY (12) #define SIR_RESEL_BAD_LUN (13) #define SIR_TARGET_SELECTED (14) #define SIR_RESEL_BAD_I_T_L (15) #define SIR_RESEL_BAD_I_T_L_Q (16) #define SIR_ABORT_SENT (17) #define SIR_RESEL_ABORTED (18) #define SIR_MSG_OUT_DONE (19) #define SIR_AUTO_SENSE_DONE (20) #define SIR_DUMMY_INTERRUPT (21) #define SIR_DATA_OVERRUN (22) #define SIR_BAD_PHASE (23) #define SIR_MAX (23) /*========================================================== ** ** Extended error bits. ** xerr_status field of struct ccb. ** **========================================================== */ #define XE_EXTRA_DATA (1) /* unexpected data phase */ #define XE_BAD_PHASE (2) /* illegal phase (4/5) */ #define XE_PARITY_ERR (4) /* unrecovered SCSI parity error */ #define XE_SODL_UNRUN (1<<3) #define XE_SWIDE_OVRUN (1<<4) /*========================================================== ** ** Negotiation status. ** nego_status field of struct ccb. ** **========================================================== */ #define NS_NOCHANGE (0) #define NS_SYNC (1) #define NS_WIDE (2) #define NS_PPR (4) /*========================================================== ** ** "Special features" of targets. ** quirks field of struct tcb. ** actualquirks field of struct ccb. ** **========================================================== */ #define QUIRK_AUTOSAVE (0x01) /*========================================================== ** ** Capability bits in Inquire response byte 7. ** **========================================================== */ #define INQ7_QUEUE (0x02) #define INQ7_SYNC (0x10) #define INQ7_WIDE16 (0x20) /*========================================================== ** ** A CCB hashed table is used to retrieve CCB address ** from DSA value. ** **========================================================== */ #define CCB_HASH_SHIFT 8 #define CCB_HASH_SIZE (1UL << CCB_HASH_SHIFT) #define CCB_HASH_MASK (CCB_HASH_SIZE-1) #define CCB_HASH_CODE(dsa) (((dsa) >> 11) & CCB_HASH_MASK) /*========================================================== ** ** Declaration of structs. ** **========================================================== */ struct tcb; struct lcb; struct ccb; struct ncb; struct script; typedef struct ncb * ncb_p; typedef struct tcb * tcb_p; typedef struct lcb * lcb_p; typedef struct ccb * ccb_p; struct link { ncrcmd l_cmd; ncrcmd l_paddr; }; struct usrcmd { u_long target; u_long lun; u_long data; u_long cmd; }; #define UC_SETSYNC 10 #define UC_SETTAGS 11 #define UC_SETDEBUG 12 #define UC_SETORDER 13 #define UC_SETWIDE 14 #define UC_SETFLAG 15 #define UC_SETVERBOSE 17 #define UC_RESETDEV 18 #define UC_CLEARDEV 19 #define UF_TRACE (0x01) #define UF_NODISC (0x02) #define UF_NOSCAN (0x04) /*======================================================================== ** ** Declaration of structs: target control block ** **======================================================================== */ struct tcb { /*---------------------------------------------------------------- ** LUN tables. ** An array of bus addresses is used on reselection by ** the SCRIPT. **---------------------------------------------------------------- */ u_int32 *luntbl; /* lcbs bus address table */ u_int32 b_luntbl; /* bus address of this table */ u_int32 b_lun0; /* bus address of lun0 */ lcb_p l0p; /* lcb of LUN #0 (normal case) */ #if MAX_LUN > 1 lcb_p *lmp; /* Other lcb's [1..MAX_LUN] */ #endif /*---------------------------------------------------------------- ** Target capabilities. **---------------------------------------------------------------- */ u_char inq_done; /* Target capabilities received */ u_char inq_byte7; /* Contains these capabilities */ /*---------------------------------------------------------------- ** Some flags. **---------------------------------------------------------------- */ u_char to_reset; /* This target is to be reset */ /*---------------------------------------------------------------- ** Pointer to the ccb used for negotiation. ** Prevent from starting a negotiation for all queued commands ** when tagged command queuing is enabled. **---------------------------------------------------------------- */ ccb_p nego_cp; /*---------------------------------------------------------------- ** negotiation of wide and sync transfer and device quirks. ** sval, wval and uval are read from SCRIPTS and so have alignment ** constraints. **---------------------------------------------------------------- */ /*0*/ u_char uval; /*1*/ u_char sval; /*2*/ u_char filler2; /*3*/ u_char wval; u_short period; u_char minsync; u_char maxoffs; u_char quirks; u_char widedone; #ifdef SCSI_NCR_INTEGRITY_CHECKING u_char ic_min_sync; u_char ic_max_width; u_char ic_done; #endif u_char ic_maximums_set; u_char ppr_negotiation; /*---------------------------------------------------------------- ** User settable limits and options. ** These limits are read from the NVRAM if present. **---------------------------------------------------------------- */ u_char usrsync; u_char usrwide; u_short usrtags; u_char usrflag; }; /*======================================================================== ** ** Declaration of structs: lun control block ** **======================================================================== */ struct lcb { /*---------------------------------------------------------------- ** On reselection, SCRIPTS use this value as a JUMP address ** after the IDENTIFY has been successfully received. ** This field is set to 'resel_tag' if TCQ is enabled and ** to 'resel_notag' if TCQ is disabled. ** (Must be at zero due to bad lun handling on reselection) **---------------------------------------------------------------- */ /*0*/ u_int32 resel_task; /*---------------------------------------------------------------- ** Task table used by the script processor to retrieve the ** task corresponding to a reselected nexus. The TAG is used ** as offset to determine the corresponding entry. ** Each entry contains the associated CCB bus address. **---------------------------------------------------------------- */ u_int32 tasktbl_0; /* Used if TCQ not enabled */ u_int32 *tasktbl; u_int32 b_tasktbl; /*---------------------------------------------------------------- ** CCB queue management. **---------------------------------------------------------------- */ XPT_QUEHEAD busy_ccbq; /* Queue of busy CCBs */ XPT_QUEHEAD wait_ccbq; /* Queue of waiting for IO CCBs */ u_short busyccbs; /* CCBs busy for this lun */ u_short queuedccbs; /* CCBs queued to the controller*/ u_short queuedepth; /* Queue depth for this lun */ u_short scdev_depth; /* SCSI device queue depth */ u_short maxnxs; /* Max possible nexuses */ /*---------------------------------------------------------------- ** Control of tagged command queuing. ** Tags allocation is performed using a circular buffer. ** This avoids using a loop for tag allocation. **---------------------------------------------------------------- */ u_short ia_tag; /* Tag allocation index */ u_short if_tag; /* Tag release index */ u_char *cb_tags; /* Circular tags buffer */ u_char inq_byte7; /* Store unit CmdQ capability */ u_char usetags; /* Command queuing is active */ u_char to_clear; /* User wants to clear all tasks*/ u_short maxtags; /* Max NR of tags asked by user */ u_short numtags; /* Current number of tags */ /*---------------------------------------------------------------- ** QUEUE FULL and ORDERED tag control. **---------------------------------------------------------------- */ u_short num_good; /* Nr of GOOD since QUEUE FULL */ u_short tags_sum[2]; /* Tags sum counters */ u_char tags_si; /* Current index to tags sum */ u_long tags_stime; /* Last time we switch tags_sum */ }; /*======================================================================== ** ** Declaration of structs: actions for a task. ** **======================================================================== ** ** It is part of the CCB and is called by the scripts processor to ** start or restart the data structure (nexus). ** **------------------------------------------------------------------------ */ struct action { u_int32 start; u_int32 restart; }; /*======================================================================== ** ** Declaration of structs: Phase mismatch context. ** **======================================================================== ** ** It is part of the CCB and is used as parameters for the DATA ** pointer. We need two contexts to handle correctly the SAVED ** DATA POINTER. ** **------------------------------------------------------------------------ */ struct pm_ctx { struct scr_tblmove sg; /* Updated interrupted SG block */ u_int32 ret; /* SCRIPT return address */ }; /*======================================================================== ** ** Declaration of structs: global HEADER. ** **======================================================================== ** ** In earlier driver versions, this substructure was copied from the ** ccb to a global address after selection (or reselection) and copied ** back before disconnect. Since we are now using LOAD/STORE DSA ** RELATIVE instructions, the script is able to access directly these ** fields, and so, this header is no more copied. ** **------------------------------------------------------------------------ */ struct head { /*---------------------------------------------------------------- ** Start and restart SCRIPTS addresses (must be at 0). **---------------------------------------------------------------- */ struct action go; /*---------------------------------------------------------------- ** Saved data pointer. ** Points to the position in the script responsible for the ** actual transfer of data. ** It's written after reception of a SAVE_DATA_POINTER message. ** The goalpointer points after the last transfer command. **---------------------------------------------------------------- */ u_int32 savep; u_int32 lastp; u_int32 goalp; /*---------------------------------------------------------------- ** Alternate data pointer. ** They are copied back to savep/lastp/goalp by the SCRIPTS ** when the direction is unknown and the device claims data out. **---------------------------------------------------------------- */ u_int32 wlastp; u_int32 wgoalp; /*---------------------------------------------------------------- ** Status fields. **---------------------------------------------------------------- */ u_char status[4]; /* host status */ }; /* ** LUN control block lookup. ** We use a direct pointer for LUN #0, and a table of pointers ** which is only allocated for devices that support LUN(s) > 0. */ #if MAX_LUN <= 1 #define ncr_lp(np, tp, lun) (!lun) ? (tp)->l0p : 0 #else #define ncr_lp(np, tp, lun) \ (!lun) ? (tp)->l0p : (tp)->lmp ? (tp)->lmp[(lun)] : 0 #endif /* ** The status bytes are used by the host and the script processor. ** ** The four bytes (status[4]) are copied to the scratchb register ** (declared as scr0..scr3 in ncr_reg.h) just after the select/reselect, ** and copied back just after disconnecting. ** Inside the script the XX_REG are used. */ /* ** Last four bytes (script) */ #define QU_REG scr0 #define HS_REG scr1 #define HS_PRT nc_scr1 #define SS_REG scr2 #define SS_PRT nc_scr2 #define HF_REG scr3 #define HF_PRT nc_scr3 /* ** Last four bytes (host) */ #define actualquirks phys.header.status[0] #define host_status phys.header.status[1] #define scsi_status phys.header.status[2] #define host_flags phys.header.status[3] /* ** Host flags */ #define HF_IN_PM0 1u #define HF_IN_PM1 (1u<<1) #define HF_ACT_PM (1u<<2) #define HF_DP_SAVED (1u<<3) #define HF_AUTO_SENSE (1u<<4) #define HF_DATA_IN (1u<<5) #define HF_PM_TO_C (1u<<6) #define HF_EXT_ERR (1u<<7) #ifdef SCSI_NCR_IARB_SUPPORT #define HF_HINT_IARB (1u<<7) #endif /* ** This one is stolen from QU_REG.:) */ #define HF_DATA_ST (1u<<7) /*========================================================== ** ** Declaration of structs: Data structure block ** **========================================================== ** ** During execution of a ccb by the script processor, ** the DSA (data structure address) register points ** to this substructure of the ccb. ** This substructure contains the header with ** the script-processor-changable data and ** data blocks for the indirect move commands. ** **---------------------------------------------------------- */ struct dsb { /* ** Header. */ struct head header; /* ** Table data for Script */ struct scr_tblsel select; struct scr_tblmove smsg ; struct scr_tblmove smsg_ext ; struct scr_tblmove cmd ; struct scr_tblmove sense ; struct scr_tblmove wresid; struct scr_tblmove data [MAX_SCATTER]; /* ** Phase mismatch contexts. ** We need two to handle correctly the ** SAVED DATA POINTER. */ struct pm_ctx pm0; struct pm_ctx pm1; }; /*======================================================================== ** ** Declaration of structs: Command control block. ** **======================================================================== */ struct ccb { /*---------------------------------------------------------------- ** This is the data structure which is pointed by the DSA ** register when it is executed by the script processor. ** It must be the first entry. **---------------------------------------------------------------- */ struct dsb phys; /*---------------------------------------------------------------- ** The general SCSI driver provides a ** pointer to a control block. **---------------------------------------------------------------- */ Scsi_Cmnd *cmd; /* SCSI command */ u_char cdb_buf[16]; /* Copy of CDB */ u_char sense_buf[64]; int data_len; /* Total data length */ int segments; /* Number of SG segments */ /*---------------------------------------------------------------- ** Message areas. ** We prepare a message to be sent after selection. ** We may use a second one if the command is rescheduled ** due to CHECK_CONDITION or QUEUE FULL status. ** Contents are IDENTIFY and SIMPLE_TAG. ** While negotiating sync or wide transfer, ** a SDTR or WDTR message is appended. **---------------------------------------------------------------- */ u_char scsi_smsg [12]; u_char scsi_smsg2[12]; /*---------------------------------------------------------------- ** Miscellaneous status'. **---------------------------------------------------------------- */ u_char nego_status; /* Negotiation status */ u_char xerr_status; /* Extended error flags */ u_int32 extra_bytes; /* Extraneous bytes transferred */ /*---------------------------------------------------------------- ** Saved info for auto-sense **---------------------------------------------------------------- */ u_char sv_scsi_status; u_char sv_xerr_status; /*---------------------------------------------------------------- ** Other fields. **---------------------------------------------------------------- */ u_long p_ccb; /* BUS address of this CCB */ u_char sensecmd[6]; /* Sense command */ u_char to_abort; /* This CCB is to be aborted */ u_short tag; /* Tag for this transfer */ /* NO_TAG means no tag */ u_char tags_si; /* Lun tags sum index (0,1) */ u_char target; u_char lun; u_short queued; ccb_p link_ccb; /* Host adapter CCB chain */ ccb_p link_ccbh; /* Host adapter CCB hash chain */ XPT_QUEHEAD link_ccbq; /* Link to unit CCB queue */ u_int32 startp; /* Initial data pointer */ u_int32 lastp0; /* Initial 'lastp' */ int ext_sg; /* Extreme data pointer, used */ int ext_ofs; /* to calculate the residual. */ int resid; }; #define CCB_PHYS(cp,lbl) (cp->p_ccb + offsetof(struct ccb, lbl)) /*======================================================================== ** ** Declaration of structs: NCR device descriptor ** **======================================================================== */ struct ncb { /*---------------------------------------------------------------- ** Idle task and invalid task actions and their bus ** addresses. **---------------------------------------------------------------- */ struct action idletask; struct action notask; struct action bad_i_t_l; struct action bad_i_t_l_q; u_long p_idletask; u_long p_notask; u_long p_bad_i_t_l; u_long p_bad_i_t_l_q; /*---------------------------------------------------------------- ** Dummy lun table to protect us against target returning bad ** lun number on reselection. **---------------------------------------------------------------- */ u_int32 *badluntbl; /* Table physical address */ u_int32 resel_badlun; /* SCRIPT handler BUS address */ /*---------------------------------------------------------------- ** Bit 32-63 of the on-chip RAM bus address in LE format. ** The START_RAM64 script loads the MMRS and MMWS from this ** field. **---------------------------------------------------------------- */ u_int32 scr_ram_seg; /*---------------------------------------------------------------- ** CCBs management queues. **---------------------------------------------------------------- */ Scsi_Cmnd *waiting_list; /* Commands waiting for a CCB */ /* when lcb is not allocated. */ Scsi_Cmnd *done_list; /* Commands waiting for done() */ /* callback to be invoked. */ #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,1,93) spinlock_t smp_lock; /* Lock for SMP threading */ #endif /*---------------------------------------------------------------- ** Chip and controller indentification. **---------------------------------------------------------------- */ int unit; /* Unit number */ char chip_name[8]; /* Chip name */ char inst_name[16]; /* ncb instance name */ /*---------------------------------------------------------------- ** Initial value of some IO register bits. ** These values are assumed to have been set by BIOS, and may ** be used for probing adapter implementation differences. **---------------------------------------------------------------- */ u_char sv_scntl0, sv_scntl3, sv_dmode, sv_dcntl, sv_ctest3, sv_ctest4, sv_ctest5, sv_gpcntl, sv_stest2, sv_stest4, sv_stest1, sv_scntl4; /*---------------------------------------------------------------- ** Actual initial value of IO register bits used by the ** driver. They are loaded at initialisation according to ** features that are to be enabled. **---------------------------------------------------------------- */ u_char rv_scntl0, rv_scntl3, rv_dmode, rv_dcntl, rv_ctest3, rv_ctest4, rv_ctest5, rv_stest2, rv_ccntl0, rv_ccntl1, rv_scntl4; /*---------------------------------------------------------------- ** Target data. ** Target control block bus address array used by the SCRIPT ** on reselection. **---------------------------------------------------------------- */ struct tcb target[MAX_TARGET]; u_int32 *targtbl; /*---------------------------------------------------------------- ** Virtual and physical bus addresses of the chip. **---------------------------------------------------------------- */ #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED u_long base_va; /* MMIO base virtual address */ u_long base2_va; /* On-chip RAM virtual address */ #endif u_long base_ba; /* MMIO base bus address */ u_long base_io; /* IO space base address */ u_long base_ws; /* (MM)IO window size */ u_long base2_ba; /* On-chip RAM bus address */ u_long base2_ws; /* On-chip RAM window size */ u_int irq; /* IRQ number */ volatile /* Pointer to volatile for */ struct ncr_reg *reg; /* memory mapped IO. */ /*---------------------------------------------------------------- ** SCRIPTS virtual and physical bus addresses. ** 'script' is loaded in the on-chip RAM if present. ** 'scripth' stays in main memory for all chips except the ** 53C895A and 53C896 that provide 8K on-chip RAM. **---------------------------------------------------------------- */ struct script *script0; /* Copies of script and scripth */ struct scripth *scripth0; /* relocated for this ncb. */ u_long p_script; /* Actual script and scripth */ u_long p_scripth; /* bus addresses. */ u_long p_scripth0; /*---------------------------------------------------------------- ** General controller parameters and configuration. **---------------------------------------------------------------- */ pcidev_t pdev; u_short device_id; /* PCI device id */ u_char revision_id; /* PCI device revision id */ u_char bus; /* PCI BUS number */ u_char device_fn; /* PCI BUS device and function */ u_char myaddr; /* SCSI id of the adapter */ u_char maxburst; /* log base 2 of dwords burst */ u_char maxwide; /* Maximum transfer width */ u_char minsync; /* Minimum sync period factor */ u_char maxsync; /* Maximum sync period factor */ u_char maxoffs; /* Max scsi offset */ u_char maxoffs_st; /* Max scsi offset in ST mode */ u_char multiplier; /* Clock multiplier (1,2,4) */ u_char clock_divn; /* Number of clock divisors */ u_long clock_khz; /* SCSI clock frequency in KHz */ u_int features; /* Chip features map */ /*---------------------------------------------------------------- ** Range for the PCI clock frequency measurement result ** that ensures the algorithm used by the driver can be ** trusted for the SCSI clock frequency measurement. ** (Assuming a PCI clock frequency of 33 MHz). **---------------------------------------------------------------- */ u_int pciclock_min; u_int pciclock_max; /*---------------------------------------------------------------- ** Start queue management. ** It is filled up by the host processor and accessed by the ** SCRIPTS processor in order to start SCSI commands. **---------------------------------------------------------------- */ u_long p_squeue; /* Start queue BUS address */ u_int32 *squeue; /* Start queue virtual address */ u_short squeueput; /* Next free slot of the queue */ u_short actccbs; /* Number of allocated CCBs */ u_short queuedepth; /* Start queue depth */ /*---------------------------------------------------------------- ** Command completion queue. ** It is the same size as the start queue to avoid overflow. **---------------------------------------------------------------- */ u_short dqueueget; /* Next position to scan */ u_int32 *dqueue; /* Completion (done) queue */ /*---------------------------------------------------------------- ** Timeout handler. **---------------------------------------------------------------- */ struct timer_list timer; /* Timer handler link header */ u_long lasttime; u_long settle_time; /* Resetting the SCSI BUS */ /*---------------------------------------------------------------- ** Debugging and profiling. **---------------------------------------------------------------- */ struct ncr_reg regdump; /* Register dump */ u_long regtime; /* Time it has been done */ /*---------------------------------------------------------------- ** Miscellaneous buffers accessed by the scripts-processor. ** They shall be DWORD aligned, because they may be read or ** written with a script command. **---------------------------------------------------------------- */ u_char msgout[12]; /* Buffer for MESSAGE OUT */ u_char msgin [12]; /* Buffer for MESSAGE IN */ u_int32 lastmsg; /* Last SCSI message sent */ u_char scratch; /* Scratch for SCSI receive */ /*---------------------------------------------------------------- ** Miscellaneous configuration and status parameters. **---------------------------------------------------------------- */ u_char scsi_mode; /* Current SCSI BUS mode */ u_char order; /* Tag order to use */ u_char verbose; /* Verbosity for this controller*/ u_int32 ncr_cache; /* Used for cache test at init. */ u_long p_ncb; /* BUS address of this NCB */ /*---------------------------------------------------------------- ** CCB lists and queue. **---------------------------------------------------------------- */ ccb_p ccbh[CCB_HASH_SIZE]; /* CCB hashed by DSA value */ struct ccb *ccbc; /* CCB chain */ XPT_QUEHEAD free_ccbq; /* Queue of available CCBs */ /*---------------------------------------------------------------- ** IMMEDIATE ARBITRATION (IARB) control. ** We keep track in 'last_cp' of the last CCB that has been ** queued to the SCRIPTS processor and clear 'last_cp' when ** this CCB completes. If last_cp is not zero at the moment ** we queue a new CCB, we set a flag in 'last_cp' that is ** used by the SCRIPTS as a hint for setting IARB. ** We donnot set more than 'iarb_max' consecutive hints for ** IARB in order to leave devices a chance to reselect. ** By the way, any non zero value of 'iarb_max' is unfair. :) **---------------------------------------------------------------- */ #ifdef SCSI_NCR_IARB_SUPPORT struct ccb *last_cp; /* Last queud CCB used for IARB */ u_short iarb_max; /* Max. # consecutive IARB hints*/ u_short iarb_count; /* Actual # of these hints */ #endif /*---------------------------------------------------------------- ** We need the LCB in order to handle disconnections and ** to count active CCBs for task management. So, we use ** a unique CCB for LUNs we donnot have the LCB yet. ** This queue normally should have at most 1 element. **---------------------------------------------------------------- */ XPT_QUEHEAD b0_ccbq; /*---------------------------------------------------------------- ** We use a different scatter function for 896 rev 1. **---------------------------------------------------------------- */ int (*scatter) (ncb_p, ccb_p, Scsi_Cmnd *); /*---------------------------------------------------------------- ** Command abort handling. ** We need to synchronize tightly with the SCRIPTS ** processor in order to handle things correctly. **---------------------------------------------------------------- */ u_char abrt_msg[4]; /* Message to send buffer */ struct scr_tblmove abrt_tbl; /* Table for the MOV of it */ struct scr_tblsel abrt_sel; /* Sync params for selection */ u_char istat_sem; /* Tells the chip to stop (SEM) */ /*---------------------------------------------------------------- ** Fields that should be removed or changed. **---------------------------------------------------------------- */ struct usrcmd user; /* Command from user */ volatile u_char release_stage; /* Synchronisation stage on release */ /*---------------------------------------------------------------- ** Fields that are used (primarily) for integrity check **---------------------------------------------------------------- */ unsigned char check_integrity; /* Enable midlayer integ. check on * bus scan. */ #ifdef SCSI_NCR_INTEGRITY_CHECKING unsigned char check_integ_par; /* Set if par or Init. Det. error * used only during integ check */ #endif }; #define NCB_PHYS(np, lbl) (np->p_ncb + offsetof(struct ncb, lbl)) #define NCB_SCRIPT_PHYS(np,lbl) (np->p_script + offsetof (struct script, lbl)) #define NCB_SCRIPTH_PHYS(np,lbl) (np->p_scripth + offsetof (struct scripth,lbl)) #define NCB_SCRIPTH0_PHYS(np,lbl) (np->p_scripth0+offsetof (struct scripth,lbl)) /*========================================================== ** ** ** Script for NCR-Processor. ** ** Use ncr_script_fill() to create the variable parts. ** Use ncr_script_copy_and_bind() to make a copy and ** bind to physical addresses. ** ** **========================================================== ** ** We have to know the offsets of all labels before ** we reach them (for forward jumps). ** Therefore we declare a struct here. ** If you make changes inside the script, ** DONT FORGET TO CHANGE THE LENGTHS HERE! ** **---------------------------------------------------------- */ /* ** Script fragments which are loaded into the on-chip RAM ** of 825A, 875, 876, 895, 895A and 896 chips. */ struct script { ncrcmd start [ 14]; ncrcmd getjob_begin [ 4]; ncrcmd getjob_end [ 4]; ncrcmd select [ 8]; ncrcmd wf_sel_done [ 2]; ncrcmd send_ident [ 2]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd select2 [ 8]; #else ncrcmd select2 [ 2]; #endif ncrcmd command [ 2]; ncrcmd dispatch [ 28]; ncrcmd sel_no_cmd [ 10]; ncrcmd init [ 6]; ncrcmd clrack [ 4]; ncrcmd disp_status [ 4]; ncrcmd datai_done [ 26]; ncrcmd datao_done [ 12]; ncrcmd ign_i_w_r_msg [ 4]; ncrcmd datai_phase [ 2]; ncrcmd datao_phase [ 4]; ncrcmd msg_in [ 2]; ncrcmd msg_in2 [ 10]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd status [ 14]; #else ncrcmd status [ 10]; #endif ncrcmd complete [ 8]; #ifdef SCSI_NCR_PCIQ_MAY_REORDER_WRITES ncrcmd complete2 [ 12]; #else ncrcmd complete2 [ 10]; #endif #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR ncrcmd done [ 18]; #else ncrcmd done [ 14]; #endif ncrcmd done_end [ 2]; ncrcmd save_dp [ 8]; ncrcmd restore_dp [ 4]; ncrcmd disconnect [ 20]; #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd idle [ 4]; #else ncrcmd idle [ 2]; #endif #ifdef SCSI_NCR_IARB_SUPPORT ncrcmd ungetjob [ 6]; #else ncrcmd ungetjob [ 4]; #endif ncrcmd reselect [ 4]; ncrcmd reselected [ 20]; ncrcmd resel_scntl4 [ 30]; #if MAX_TASKS*4 > 512 ncrcmd resel_tag [ 18]; #elif MAX_TASKS*4 > 256 ncrcmd resel_tag [ 12]; #else ncrcmd resel_tag [ 8]; #endif ncrcmd resel_go [ 6]; ncrcmd resel_notag [ 2]; ncrcmd resel_dsa [ 8]; ncrcmd data_in [MAX_SCATTER * SCR_SG_SIZE]; ncrcmd data_in2 [ 4]; ncrcmd data_out [MAX_SCATTER * SCR_SG_SIZE]; ncrcmd data_out2 [ 4]; ncrcmd pm0_data [ 12]; ncrcmd pm0_data_out [ 6]; ncrcmd pm0_data_end [ 6]; ncrcmd pm1_data [ 12]; ncrcmd pm1_data_out [ 6]; ncrcmd pm1_data_end [ 6]; }; /* ** Script fragments which stay in main memory for all chips ** except for the 895A and 896 that support 8K on-chip RAM. */ struct scripth { ncrcmd start64 [ 2]; ncrcmd no_data [ 2]; ncrcmd sel_for_abort [ 18]; ncrcmd sel_for_abort_1 [ 2]; ncrcmd select_no_atn [ 8]; ncrcmd wf_sel_done_no_atn [ 4]; ncrcmd msg_in_etc [ 14]; ncrcmd msg_received [ 4]; ncrcmd msg_weird_seen [ 4]; ncrcmd msg_extended [ 20]; ncrcmd msg_bad [ 6]; ncrcmd msg_weird [ 4]; ncrcmd msg_weird1 [ 8]; ncrcmd wdtr_resp [ 6]; ncrcmd send_wdtr [ 4]; ncrcmd sdtr_resp [ 6]; ncrcmd send_sdtr [ 4]; ncrcmd ppr_resp [ 6]; ncrcmd send_ppr [ 4]; ncrcmd nego_bad_phase [ 4]; ncrcmd msg_out [ 4]; ncrcmd msg_out_done [ 4]; ncrcmd data_ovrun [ 2]; ncrcmd data_ovrun1 [ 22]; ncrcmd data_ovrun2 [ 8]; ncrcmd abort_resel [ 16]; ncrcmd resend_ident [ 4]; ncrcmd ident_break [ 4]; ncrcmd ident_break_atn [ 4]; ncrcmd sdata_in [ 6]; ncrcmd data_io [ 2]; ncrcmd data_io_com [ 8]; ncrcmd data_io_out [ 12]; ncrcmd resel_bad_lun [ 4]; ncrcmd bad_i_t_l [ 4]; ncrcmd bad_i_t_l_q [ 4]; ncrcmd bad_status [ 6]; ncrcmd tweak_pmj [ 12]; ncrcmd pm_handle [ 20]; ncrcmd pm_handle1 [ 4]; ncrcmd pm_save [ 4]; ncrcmd pm0_save [ 14]; ncrcmd pm1_save [ 14]; /* WSR handling */ #ifdef SYM_DEBUG_PM_WITH_WSR ncrcmd pm_wsr_handle [ 44]; #else ncrcmd pm_wsr_handle [ 42]; #endif ncrcmd wsr_ma_helper [ 4]; /* Data area */ ncrcmd zero [ 1]; ncrcmd scratch [ 1]; ncrcmd scratch1 [ 1]; ncrcmd pm0_data_addr [ 1]; ncrcmd pm1_data_addr [ 1]; ncrcmd saved_dsa [ 1]; ncrcmd saved_drs [ 1]; ncrcmd done_pos [ 1]; ncrcmd startpos [ 1]; ncrcmd targtbl [ 1]; /* End of data area */ #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED ncrcmd start_ram [ 1]; ncrcmd script0_ba [ 4]; ncrcmd start_ram64 [ 3]; ncrcmd script0_ba64 [ 3]; ncrcmd scripth0_ba64 [ 6]; ncrcmd ram_seg64 [ 1]; #endif ncrcmd snooptest [ 6]; ncrcmd snoopend [ 2]; }; /*========================================================== ** ** ** Function headers. ** ** **========================================================== */ static ccb_p ncr_alloc_ccb (ncb_p np); static void ncr_complete (ncb_p np, ccb_p cp); static void ncr_exception (ncb_p np); static void ncr_free_ccb (ncb_p np, ccb_p cp); static ccb_p ncr_ccb_from_dsa(ncb_p np, u_long dsa); static void ncr_init_tcb (ncb_p np, u_char tn); static lcb_p ncr_alloc_lcb (ncb_p np, u_char tn, u_char ln); static lcb_p ncr_setup_lcb (ncb_p np, u_char tn, u_char ln, u_char *inq_data); static void ncr_getclock (ncb_p np, int mult); static u_int ncr_getpciclock (ncb_p np); static void ncr_selectclock (ncb_p np, u_char scntl3); static ccb_p ncr_get_ccb (ncb_p np, u_char tn, u_char ln); static void ncr_init (ncb_p np, int reset, char * msg, u_long code); static void ncr_int_sbmc (ncb_p np); static void ncr_int_par (ncb_p np, u_short sist); static void ncr_int_ma (ncb_p np); static void ncr_int_sir (ncb_p np); static void ncr_int_sto (ncb_p np); static void ncr_int_udc (ncb_p np); static void ncr_negotiate (ncb_p np, tcb_p tp); static int ncr_prepare_nego(ncb_p np, ccb_p cp, u_char *msgptr); #ifdef SCSI_NCR_INTEGRITY_CHECKING static int ncr_ic_nego(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd, u_char *msgptr); #endif static void ncr_script_copy_and_bind (ncb_p np, ncrcmd *src, ncrcmd *dst, int len); static void ncr_script_fill (struct script * scr, struct scripth * scripth); static int ncr_scatter_896R1 (ncb_p np, ccb_p cp, Scsi_Cmnd *cmd); static int ncr_scatter (ncb_p np, ccb_p cp, Scsi_Cmnd *cmd); static void ncr_getsync (ncb_p np, u_char sfac, u_char *fakp, u_char *scntl3p); static void ncr_get_xfer_info(ncb_p np, tcb_p tp, u_char *factor, u_char *offset, u_char *width); static void ncr_setsync (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4); static void ncr_set_sync_wide_status (ncb_p np, u_char target); static void ncr_setup_tags (ncb_p np, u_char tn, u_char ln); static void ncr_setwide (ncb_p np, ccb_p cp, u_char wide, u_char ack); static void ncr_setsyncwide (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4, u_char wide); static int ncr_show_msg (u_char * msg); static void ncr_print_msg (ccb_p cp, char *label, u_char * msg); static int ncr_snooptest (ncb_p np); static void ncr_timeout (ncb_p np); static void ncr_wakeup (ncb_p np, u_long code); static int ncr_wakeup_done (ncb_p np); static void ncr_start_next_ccb (ncb_p np, lcb_p lp, int maxn); static void ncr_put_start_queue(ncb_p np, ccb_p cp); static void ncr_chip_reset (ncb_p np); static void ncr_soft_reset (ncb_p np); static void ncr_start_reset (ncb_p np); static int ncr_reset_scsi_bus (ncb_p np, int enab_int, int settle_delay); static int ncr_compute_residual (ncb_p np, ccb_p cp); #ifdef SCSI_NCR_USER_COMMAND_SUPPORT static void ncr_usercmd (ncb_p np); #endif static int ncr_attach (Scsi_Host_Template *tpnt, int unit, ncr_device *device); static void ncr_free_resources(ncb_p np); static void insert_into_waiting_list(ncb_p np, Scsi_Cmnd *cmd); static Scsi_Cmnd *retrieve_from_waiting_list(int to_remove, ncb_p np, Scsi_Cmnd *cmd); static void process_waiting_list(ncb_p np, int sts); #define remove_from_waiting_list(np, cmd) \ retrieve_from_waiting_list(1, (np), (cmd)) #define requeue_waiting_list(np) process_waiting_list((np), DID_OK) #define reset_waiting_list(np) process_waiting_list((np), DID_RESET) #ifdef SCSI_NCR_NVRAM_SUPPORT static void ncr_get_nvram (ncr_device *devp, ncr_nvram *nvp); static int sym_read_Tekram_nvram (ncr_slot *np, u_short device_id, Tekram_nvram *nvram); static int sym_read_Symbios_nvram (ncr_slot *np, Symbios_nvram *nvram); #endif /*========================================================== ** ** ** Global static data. ** ** **========================================================== */ static inline char *ncr_name (ncb_p np) { return np->inst_name; } /*========================================================== ** ** ** Scripts for NCR-Processor. ** ** Use ncr_script_bind for binding to physical addresses. ** ** **========================================================== ** ** NADDR generates a reference to a field of the controller data. ** PADDR generates a reference to another part of the script. ** RADDR generates a reference to a script processor register. ** FADDR generates a reference to a script processor register ** with offset. ** **---------------------------------------------------------- */ #define RELOC_SOFTC 0x40000000 #define RELOC_LABEL 0x50000000 #define RELOC_REGISTER 0x60000000 #if 0 #define RELOC_KVAR 0x70000000 #endif #define RELOC_LABELH 0x80000000 #define RELOC_MASK 0xf0000000 #define NADDR(label) (RELOC_SOFTC | offsetof(struct ncb, label)) #define PADDR(label) (RELOC_LABEL | offsetof(struct script, label)) #define PADDRH(label) (RELOC_LABELH | offsetof(struct scripth, label)) #define RADDR(label) (RELOC_REGISTER | REG(label)) #define FADDR(label,ofs)(RELOC_REGISTER | ((REG(label))+(ofs))) #define KVAR(which) (RELOC_KVAR | (which)) #define SCR_DATA_ZERO 0xf00ff00f #ifdef RELOC_KVAR #define SCRIPT_KVAR_JIFFIES (0) #define SCRIPT_KVAR_FIRST SCRIPT_KVAR_JIFFIES #define SCRIPT_KVAR_LAST SCRIPT_KVAR_JIFFIES /* * Kernel variables referenced in the scripts. * THESE MUST ALL BE ALIGNED TO A 4-BYTE BOUNDARY. */ static void *script_kvars[] __initdata = { (void *)&jiffies }; #endif static struct script script0 __initdata = { /*--------------------------< START >-----------------------*/ { /* ** This NOP will be patched with LED ON ** SCR_REG_REG (gpreg, SCR_AND, 0xfe) */ SCR_NO_OP, 0, /* ** Clear SIGP. */ SCR_FROM_REG (ctest2), 0, /* ** Stop here if the C code wants to perform ** some error recovery procedure manually. ** (Indicate this by setting SEM in ISTAT) */ SCR_FROM_REG (istat), 0, /* ** Report to the C code the next position in ** the start queue the SCRIPTS will schedule. ** The C code must not change SCRATCHA. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (startpos), SCR_INT ^ IFTRUE (MASK (SEM, SEM)), SIR_SCRIPT_STOPPED, /* ** Start the next job. ** ** @DSA = start point for this job. ** SCRATCHA = address of this job in the start queue. ** ** We will restore startpos with SCRATCHA if we fails the ** arbitration or if it is the idle job. ** ** The below GETJOB_BEGIN to GETJOB_END section of SCRIPTS ** is a critical path. If it is partially executed, it then ** may happen that the job address is not yet in the DSA ** and the next queue position points to the next JOB. */ SCR_LOAD_ABS (dsa, 4), PADDRH (startpos), SCR_LOAD_REL (temp, 4), 4, }/*-------------------------< GETJOB_BEGIN >------------------*/,{ SCR_STORE_ABS (temp, 4), PADDRH (startpos), SCR_LOAD_REL (dsa, 4), 0, }/*-------------------------< GETJOB_END >--------------------*/,{ SCR_LOAD_REL (temp, 4), 0, SCR_RETURN, 0, }/*-------------------------< SELECT >----------------------*/,{ /* ** DSA contains the address of a scheduled ** data structure. ** ** SCRATCHA contains the address of the start queue ** entry which points to the next job. ** ** Set Initiator mode. ** ** (Target mode is left as an exercise for the reader) */ SCR_CLR (SCR_TRG), 0, /* ** And try to select this target. */ SCR_SEL_TBL_ATN ^ offsetof (struct dsb, select), PADDR (ungetjob), /* ** Now there are 4 possibilities: ** ** (1) The ncr loses arbitration. ** This is ok, because it will try again, ** when the bus becomes idle. ** (But beware of the timeout function!) ** ** (2) The ncr is reselected. ** Then the script processor takes the jump ** to the RESELECT label. ** ** (3) The ncr wins arbitration. ** Then it will execute SCRIPTS instruction until ** the next instruction that checks SCSI phase. ** Then will stop and wait for selection to be ** complete or selection time-out to occur. ** ** After having won arbitration, the ncr SCRIPTS ** processor is able to execute instructions while ** the SCSI core is performing SCSI selection. But ** some script instruction that is not waiting for ** a valid phase (or selection timeout) to occur ** breaks the selection procedure, by probably ** affecting timing requirements. ** So we have to wait immediately for the next phase ** or the selection to complete or time-out. */ /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), }/*-------------------------< WF_SEL_DONE >----------------------*/,{ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_OUT)), SIR_SEL_ATN_NO_MSG_OUT, }/*-------------------------< SEND_IDENT >----------------------*/,{ /* ** Selection complete. ** Send the IDENTIFY and SIMPLE_TAG messages ** (and the M_X_SYNC_REQ / M_X_WIDE_REQ message) */ SCR_MOVE_TBL ^ SCR_MSG_OUT, offsetof (struct dsb, smsg), }/*-------------------------< SELECT2 >----------------------*/,{ #ifdef SCSI_NCR_IARB_SUPPORT /* ** Set IMMEDIATE ARBITRATION if we have been given ** a hint to do so. (Some job to do after this one). */ SCR_FROM_REG (HF_REG), 0, SCR_JUMPR ^ IFFALSE (MASK (HF_HINT_IARB, HF_HINT_IARB)), 8, SCR_REG_REG (scntl1, SCR_OR, IARB), 0, #endif /* ** Anticipate the COMMAND phase. ** This is the PHASE we expect at this point. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_COMMAND)), PADDR (sel_no_cmd), }/*-------------------------< COMMAND >--------------------*/,{ /* ** ... and send the command */ SCR_MOVE_TBL ^ SCR_COMMAND, offsetof (struct dsb, cmd), }/*-----------------------< DISPATCH >----------------------*/,{ /* ** MSG_IN is the only phase that shall be ** entered at least once for each (re)selection. ** So we test it first. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (msg_in), SCR_JUMP ^ IFTRUE (IF (SCR_DATA_OUT)), PADDR (datao_phase), SCR_JUMP ^ IFTRUE (IF (SCR_DATA_IN)), PADDR (datai_phase), SCR_JUMP ^ IFTRUE (IF (SCR_STATUS)), PADDR (status), SCR_JUMP ^ IFTRUE (IF (SCR_COMMAND)), PADDR (command), SCR_JUMP ^ IFTRUE (IF (SCR_MSG_OUT)), PADDRH (msg_out), /* * Discard as many illegal phases as * required and tell the C code about. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_ILG_OUT)), 16, SCR_MOVE_ABS (1) ^ SCR_ILG_OUT, NADDR (scratch), SCR_JUMPR ^ IFTRUE (WHEN (SCR_ILG_OUT)), -16, SCR_JUMPR ^ IFFALSE (WHEN (SCR_ILG_IN)), 16, SCR_MOVE_ABS (1) ^ SCR_ILG_IN, NADDR (scratch), SCR_JUMPR ^ IFTRUE (WHEN (SCR_ILG_IN)), -16, SCR_INT, SIR_BAD_PHASE, SCR_JUMP, PADDR (dispatch), }/*---------------------< SEL_NO_CMD >----------------------*/,{ /* ** The target does not switch to command ** phase after IDENTIFY has been sent. ** ** If it stays in MSG OUT phase send it ** the IDENTIFY again. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_OUT)), PADDRH (resend_ident), /* ** If target does not switch to MSG IN phase ** and we sent a negotiation, assert the ** failure immediately. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (dispatch), SCR_FROM_REG (HS_REG), 0, SCR_INT ^ IFTRUE (DATA (HS_NEGOTIATE)), SIR_NEGO_FAILED, /* ** Jump to dispatcher. */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< INIT >------------------------*/,{ /* ** Wait for the SCSI RESET signal to be ** inactive before restarting operations, ** since the chip may hang on SEL_ATN ** if SCSI RESET is active. */ SCR_FROM_REG (sstat0), 0, SCR_JUMPR ^ IFTRUE (MASK (IRST, IRST)), -16, SCR_JUMP, PADDR (start), }/*-------------------------< CLRACK >----------------------*/,{ /* ** Terminate possible pending message phase. */ SCR_CLR (SCR_ACK), 0, SCR_JUMP, PADDR (dispatch), }/*-------------------------< DISP_STATUS >----------------------*/,{ /* ** Anticipate STATUS phase. ** ** Does spare 3 SCRIPTS instructions when we have ** completed the INPUT of the data. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_STATUS)), PADDR (status), SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATAI_DONE >-------------------*/,{ /* * If the device wants us to send more data, * we must count the extra bytes. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_IN)), PADDRH (data_ovrun), /* ** If the SWIDE is not full, jump to dispatcher. ** We anticipate a STATUS phase. ** If we get later an IGNORE WIDE RESIDUE, we ** will alias it as a MODIFY DP (-1). */ SCR_FROM_REG (scntl2), 0, SCR_JUMP ^ IFFALSE (MASK (WSR, WSR)), PADDR (disp_status), /* ** The SWIDE is full. ** Clear this condition. */ SCR_REG_REG (scntl2, SCR_OR, WSR), 0, /* * We are expecting an IGNORE RESIDUE message * from the device, otherwise we are in data * overrun condition. Check against MSG_IN phase. */ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_IN)), SIR_SWIDE_OVERRUN, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_IN)), PADDR (disp_status), /* * We are in MSG_IN phase, * Read the first byte of the message. * If it is not an IGNORE RESIDUE message, * signal overrun and jump to message * processing. */ SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[0]), SCR_INT ^ IFFALSE (DATA (M_IGN_RESIDUE)), SIR_SWIDE_OVERRUN, SCR_JUMP ^ IFFALSE (DATA (M_IGN_RESIDUE)), PADDR (msg_in2), /* * We got the message we expected. * Read the 2nd byte, and jump to dispatcher. */ SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), SCR_CLR (SCR_ACK), 0, SCR_JUMP, PADDR (disp_status), }/*-------------------------< DATAO_DONE >-------------------*/,{ /* * If the device wants us to send more data, * we must count the extra bytes. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_OUT)), PADDRH (data_ovrun), /* ** If the SODL is not full jump to dispatcher. ** We anticipate a MSG IN phase or a STATUS phase. */ SCR_FROM_REG (scntl2), 0, SCR_JUMP ^ IFFALSE (MASK (WSS, WSS)), PADDR (disp_status), /* ** The SODL is full, clear this condition. */ SCR_REG_REG (scntl2, SCR_OR, WSS), 0, /* ** And signal a DATA UNDERRUN condition ** to the C code. */ SCR_INT, SIR_SODL_UNDERRUN, SCR_JUMP, PADDR (dispatch), }/*-------------------------< IGN_I_W_R_MSG >--------------*/,{ /* ** We jump here from the phase mismatch interrupt, ** When we have a SWIDE and the device has presented ** a IGNORE WIDE RESIDUE message on the BUS. ** We just have to throw away this message and then ** to jump to dispatcher. */ SCR_MOVE_ABS (2) ^ SCR_MSG_IN, NADDR (scratch), /* ** Clear ACK and jump to dispatcher. */ SCR_JUMP, PADDR (clrack), }/*-------------------------< DATAI_PHASE >------------------*/,{ SCR_RETURN, 0, }/*-------------------------< DATAO_PHASE >------------------*/,{ /* ** Patch for 53c1010_66 only - to allow A0 part ** to operate properly in a 33MHz PCI bus. ** ** SCR_REG_REG(scntl4, SCR_OR, 0x0c), ** 0, */ SCR_NO_OP, 0, SCR_RETURN, 0, }/*-------------------------< MSG_IN >--------------------*/,{ /* ** Get the first byte of the message. ** ** The script processor doesn't negate the ** ACK signal after this transfer. */ SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[0]), }/*-------------------------< MSG_IN2 >--------------------*/,{ /* ** Check first against 1 byte messages ** that we handle from SCRIPTS. */ SCR_JUMP ^ IFTRUE (DATA (M_COMPLETE)), PADDR (complete), SCR_JUMP ^ IFTRUE (DATA (M_DISCONNECT)), PADDR (disconnect), SCR_JUMP ^ IFTRUE (DATA (M_SAVE_DP)), PADDR (save_dp), SCR_JUMP ^ IFTRUE (DATA (M_RESTORE_DP)), PADDR (restore_dp), /* ** We handle all other messages from the ** C code, so no need to waste on-chip RAM ** for those ones. */ SCR_JUMP, PADDRH (msg_in_etc), }/*-------------------------< STATUS >--------------------*/,{ /* ** get the status */ SCR_MOVE_ABS (1) ^ SCR_STATUS, NADDR (scratch), #ifdef SCSI_NCR_IARB_SUPPORT /* ** If STATUS is not GOOD, clear IMMEDIATE ARBITRATION, ** since we may have to tamper the start queue from ** the C code. */ SCR_JUMPR ^ IFTRUE (DATA (S_GOOD)), 8, SCR_REG_REG (scntl1, SCR_AND, ~IARB), 0, #endif /* ** save status to scsi_status. ** mark as complete. */ SCR_TO_REG (SS_REG), 0, SCR_LOAD_REG (HS_REG, HS_COMPLETE), 0, /* ** Anticipate the MESSAGE PHASE for ** the TASK COMPLETE message. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_IN)), PADDR (msg_in), SCR_JUMP, PADDR (dispatch), }/*-------------------------< COMPLETE >-----------------*/,{ /* ** Complete message. ** ** Copy the data pointer to LASTP in header. */ SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.lastp), /* ** When we terminate the cycle by clearing ACK, ** the target may disconnect immediately. ** ** We don't want to be told of an ** "unexpected disconnect", ** so we disable this feature. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, /* ** Terminate cycle ... */ SCR_CLR (SCR_ACK|SCR_ATN), 0, /* ** ... and wait for the disconnect. */ SCR_WAIT_DISC, 0, }/*-------------------------< COMPLETE2 >-----------------*/,{ /* ** Save host status to header. */ SCR_STORE_REL (scr0, 4), offsetof (struct ccb, phys.header.status), #ifdef SCSI_NCR_PCIQ_MAY_REORDER_WRITES /* ** Some bridges may reorder DMA writes to memory. ** We donnot want the CPU to deal with completions ** without all the posted write having been flushed ** to memory. This DUMMY READ should flush posted ** buffers prior to the CPU having to deal with ** completions. */ SCR_LOAD_REL (scr0, 4), /* DUMMY READ */ offsetof (struct ccb, phys.header.status), #endif /* ** If command resulted in not GOOD status, ** call the C code if needed. */ SCR_FROM_REG (SS_REG), 0, SCR_CALL ^ IFFALSE (DATA (S_GOOD)), PADDRH (bad_status), /* ** If we performed an auto-sense, call ** the C code to synchronyze task aborts ** with UNIT ATTENTION conditions. */ SCR_FROM_REG (HF_REG), 0, SCR_INT ^ IFTRUE (MASK (HF_AUTO_SENSE, HF_AUTO_SENSE)), SIR_AUTO_SENSE_DONE, }/*------------------------< DONE >-----------------*/,{ #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR /* ** It seems that some bridges flush everything ** when the INTR line is raised. For these ones, ** we can just ensure that the INTR line will be ** raised before each completion. So, if it happens ** that we have been faster that the CPU, we just ** have to synchronize with it. A dummy programmed ** interrupt will do the trick. ** Note that we overlap at most 1 IO with the CPU ** in this situation and that the IRQ line must not ** be shared. */ SCR_FROM_REG (istat), 0, SCR_INT ^ IFTRUE (MASK (INTF, INTF)), SIR_DUMMY_INTERRUPT, #endif /* ** Copy the DSA to the DONE QUEUE and ** signal completion to the host. ** If we are interrupted between DONE ** and DONE_END, we must reset, otherwise ** the completed CCB will be lost. */ SCR_STORE_ABS (dsa, 4), PADDRH (saved_dsa), SCR_LOAD_ABS (dsa, 4), PADDRH (done_pos), SCR_LOAD_ABS (scratcha, 4), PADDRH (saved_dsa), SCR_STORE_REL (scratcha, 4), 0, /* ** The instruction below reads the DONE QUEUE next ** free position from memory. ** In addition it ensures that all PCI posted writes ** are flushed and so the DSA value of the done ** CCB is visible by the CPU before INTFLY is raised. */ SCR_LOAD_REL (temp, 4), 4, SCR_INT_FLY, 0, SCR_STORE_ABS (temp, 4), PADDRH (done_pos), }/*------------------------< DONE_END >-----------------*/,{ SCR_JUMP, PADDR (start), }/*-------------------------< SAVE_DP >------------------*/,{ /* ** Clear ACK immediately. ** No need to delay it. */ SCR_CLR (SCR_ACK), 0, /* ** Keep track we received a SAVE DP, so ** we will switch to the other PM context ** on the next PM since the DP may point ** to the current PM context. */ SCR_REG_REG (HF_REG, SCR_OR, HF_DP_SAVED), 0, /* ** SAVE_DP message: ** Copy the data pointer to SAVEP in header. */ SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (dispatch), }/*-------------------------< RESTORE_DP >---------------*/,{ /* ** RESTORE_DP message: ** Copy SAVEP in header to actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (clrack), }/*-------------------------< DISCONNECT >---------------*/,{ /* ** DISCONNECTing ... ** ** disable the "unexpected disconnect" feature, ** and remove the ACK signal. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_CLR (SCR_ACK|SCR_ATN), 0, /* ** Wait for the disconnect. */ SCR_WAIT_DISC, 0, /* ** Status is: DISCONNECTED. */ SCR_LOAD_REG (HS_REG, HS_DISCONNECT), 0, /* ** Save host status to header. */ SCR_STORE_REL (scr0, 4), offsetof (struct ccb, phys.header.status), /* ** If QUIRK_AUTOSAVE is set, ** do an "save pointer" operation. */ SCR_FROM_REG (QU_REG), 0, SCR_JUMP ^ IFFALSE (MASK (QUIRK_AUTOSAVE, QUIRK_AUTOSAVE)), PADDR (start), /* ** like SAVE_DP message: ** Remember we saved the data pointer. ** Copy data pointer to SAVEP in header. */ SCR_REG_REG (HF_REG, SCR_OR, HF_DP_SAVED), 0, SCR_STORE_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_JUMP, PADDR (start), }/*-------------------------< IDLE >------------------------*/,{ /* ** Nothing to do? ** Wait for reselect. ** This NOP will be patched with LED OFF ** SCR_REG_REG (gpreg, SCR_OR, 0x01) */ SCR_NO_OP, 0, #ifdef SCSI_NCR_IARB_SUPPORT SCR_JUMPR, 8, #endif }/*-------------------------< UNGETJOB >-----------------*/,{ #ifdef SCSI_NCR_IARB_SUPPORT /* ** Set IMMEDIATE ARBITRATION, for the next time. ** This will give us better chance to win arbitration ** for the job we just wanted to do. */ SCR_REG_REG (scntl1, SCR_OR, IARB), 0, #endif /* ** We are not able to restart the SCRIPTS if we are ** interrupted and these instruction haven't been ** all executed. BTW, this is very unlikely to ** happen, but we check that from the C code. */ SCR_LOAD_REG (dsa, 0xff), 0, SCR_STORE_ABS (scratcha, 4), PADDRH (startpos), }/*-------------------------< RESELECT >--------------------*/,{ /* ** make the host status invalid. */ SCR_CLR (SCR_TRG), 0, /* ** Sleep waiting for a reselection. ** If SIGP is set, special treatment. ** ** Zu allem bereit .. */ SCR_WAIT_RESEL, PADDR(start), }/*-------------------------< RESELECTED >------------------*/,{ /* ** This NOP will be patched with LED ON ** SCR_REG_REG (gpreg, SCR_AND, 0xfe) */ SCR_NO_OP, 0, /* ** load the target id into the sdid */ SCR_REG_SFBR (ssid, SCR_AND, 0x8F), 0, SCR_TO_REG (sdid), 0, /* ** load the target control block address */ SCR_LOAD_ABS (dsa, 4), PADDRH (targtbl), SCR_SFBR_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_AND, 0x3c), 0, SCR_LOAD_REL (dsa, 4), 0, /* ** Load the synchronous transfer registers. */ SCR_LOAD_REL (scntl3, 1), offsetof(struct tcb, wval), SCR_LOAD_REL (sxfer, 1), offsetof(struct tcb, sval), }/*-------------------------< RESEL_SCNTL4 >------------------*/,{ /* ** Write with uval value. Patch if device ** does not support Ultra3. ** ** SCR_LOAD_REL (scntl4, 1), ** offsetof(struct tcb, uval), */ SCR_NO_OP, 0, /* * We expect MESSAGE IN phase. * If not, get help from the C code. */ SCR_INT ^ IFFALSE (WHEN (SCR_MSG_IN)), SIR_RESEL_NO_MSG_IN, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin), /* * If IDENTIFY LUN #0, use a faster path * to find the LCB structure. */ SCR_JUMPR ^ IFTRUE (MASK (0x80, 0xbf)), 56, /* * If message isn't an IDENTIFY, * tell the C code about. */ SCR_INT ^ IFFALSE (MASK (0x80, 0x80)), SIR_RESEL_NO_IDENTIFY, /* * It is an IDENTIFY message, * Load the LUN control block address. */ SCR_LOAD_REL (dsa, 4), offsetof(struct tcb, b_luntbl), SCR_SFBR_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_SHL, 0), 0, SCR_REG_REG (dsa, SCR_AND, 0xfc), 0, SCR_LOAD_REL (dsa, 4), 0, SCR_JUMPR, 8, /* ** LUN 0 special case (but usual one :)) */ SCR_LOAD_REL (dsa, 4), offsetof(struct tcb, b_lun0), /* ** Load the reselect task action for this LUN. ** Load the tasks DSA array for this LUN. ** Call the action. */ SCR_LOAD_REL (temp, 4), offsetof(struct lcb, resel_task), SCR_LOAD_REL (dsa, 4), offsetof(struct lcb, b_tasktbl), SCR_RETURN, 0, }/*-------------------------< RESEL_TAG >-------------------*/,{ /* ** ACK the IDENTIFY or TAG previously received */ SCR_CLR (SCR_ACK), 0, /* ** Read IDENTIFY + SIMPLE + TAG using a single MOVE. ** Aggressive optimization, is'nt it? ** No need to test the SIMPLE TAG message, since the ** driver only supports conformant devices for tags. ;-) */ SCR_MOVE_ABS (2) ^ SCR_MSG_IN, NADDR (msgin), /* ** Read the TAG from the SIDL. ** Still an aggressive optimization. ;-) ** Compute the CCB indirect jump address which ** is (#TAG*2 & 0xfc) due to tag numbering using ** 1,3,5..MAXTAGS*2+1 actual values. */ SCR_REG_SFBR (sidl, SCR_SHL, 0), 0, #if MAX_TASKS*4 > 512 SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 2), 0, SCR_REG_REG (sfbr, SCR_SHL, 0), 0, SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 1), 0, #elif MAX_TASKS*4 > 256 SCR_JUMPR ^ IFFALSE (CARRYSET), 8, SCR_REG_REG (dsa1, SCR_OR, 1), 0, #endif /* ** Retrieve the DSA of this task. ** JUMP indirectly to the restart point of the CCB. */ SCR_SFBR_REG (dsa, SCR_AND, 0xfc), 0, }/*-------------------------< RESEL_GO >-------------------*/,{ SCR_LOAD_REL (dsa, 4), 0, SCR_LOAD_REL (temp, 4), offsetof(struct ccb, phys.header.go.restart), SCR_RETURN, 0, /* In normal situations we branch to RESEL_DSA */ }/*-------------------------< RESEL_NOTAG >-------------------*/,{ /* ** JUMP indirectly to the restart point of the CCB. */ SCR_JUMP, PADDR (resel_go), }/*-------------------------< RESEL_DSA >-------------------*/,{ /* ** Ack the IDENTIFY or TAG previously received. */ SCR_CLR (SCR_ACK), 0, /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), /* ** Jump to dispatcher. */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATA_IN >--------------------*/,{ /* ** Because the size depends on the ** #define MAX_SCATTER parameter, ** it is filled in at runtime. ** ** ##===========< i=0; i========= ** || SCR_CHMOV_TBL ^ SCR_DATA_IN, ** || offsetof (struct dsb, data[ i]), ** ##========================================== ** **--------------------------------------------------------- */ 0 }/*-------------------------< DATA_IN2 >-------------------*/,{ SCR_CALL, PADDR (datai_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< DATA_OUT >--------------------*/,{ /* ** Because the size depends on the ** #define MAX_SCATTER parameter, ** it is filled in at runtime. ** ** ##===========< i=0; i========= ** || SCR_CHMOV_TBL ^ SCR_DATA_OUT, ** || offsetof (struct dsb, data[ i]), ** ##========================================== ** **--------------------------------------------------------- */ 0 }/*-------------------------< DATA_OUT2 >-------------------*/,{ SCR_CALL, PADDR (datao_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< PM0_DATA >--------------------*/,{ /* ** Read our host flags to SFBR, so we will be able ** to check against the data direction we expect. */ SCR_FROM_REG (HF_REG), 0, /* ** Check against actual DATA PHASE. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_DATA_IN)), PADDR (pm0_data_out), /* ** Actual phase is DATA IN. ** Check against expected direction. */ SCR_JUMP ^ IFFALSE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM0), 0, /* ** Move the data to memory. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.pm0.sg), SCR_JUMP, PADDR (pm0_data_end), }/*-------------------------< PM0_DATA_OUT >----------------*/,{ /* ** Actual phase is DATA OUT. ** Check against expected direction. */ SCR_JUMP ^ IFTRUE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM0), 0, /* ** Move the data from memory. */ SCR_CHMOV_TBL ^ SCR_DATA_OUT, offsetof (struct ccb, phys.pm0.sg), }/*-------------------------< PM0_DATA_END >----------------*/,{ /* ** Clear the flag that told we were moving ** data from the PM0 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_IN_PM0)), 0, /* ** Return to the previous DATA script which ** is guaranteed by design (if no bug) to be ** the main DATA script for this transfer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.pm0.ret), SCR_RETURN, 0, }/*-------------------------< PM1_DATA >--------------------*/,{ /* ** Read our host flags to SFBR, so we will be able ** to check against the data direction we expect. */ SCR_FROM_REG (HF_REG), 0, /* ** Check against actual DATA PHASE. */ SCR_JUMP ^ IFFALSE (WHEN (SCR_DATA_IN)), PADDR (pm1_data_out), /* ** Actual phase is DATA IN. ** Check against expected direction. */ SCR_JUMP ^ IFFALSE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM1), 0, /* ** Move the data to memory. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.pm1.sg), SCR_JUMP, PADDR (pm1_data_end), }/*-------------------------< PM1_DATA_OUT >----------------*/,{ /* ** Actual phase is DATA OUT. ** Check against expected direction. */ SCR_JUMP ^ IFTRUE (MASK (HF_DATA_IN, HF_DATA_IN)), PADDRH (data_ovrun), /* ** Keep track we are moving data from the ** PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_OR, HF_IN_PM1), 0, /* ** Move the data from memory. */ SCR_CHMOV_TBL ^ SCR_DATA_OUT, offsetof (struct ccb, phys.pm1.sg), }/*-------------------------< PM1_DATA_END >----------------*/,{ /* ** Clear the flag that told we were moving ** data from the PM1 DATA mini-script. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_IN_PM1)), 0, /* ** Return to the previous DATA script which ** is guaranteed by design (if no bug) to be ** the main DATA script for this transfer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.pm1.ret), SCR_RETURN, 0, }/*---------------------------------------------------------*/ }; static struct scripth scripth0 __initdata = { /*------------------------< START64 >-----------------------*/{ /* ** SCRIPT entry point for the 895A and the 896. ** For now, there is no specific stuff for that ** chip at this point, but this may come. */ SCR_JUMP, PADDR (init), }/*-------------------------< NO_DATA >-------------------*/,{ SCR_JUMP, PADDRH (data_ovrun), }/*-----------------------< SEL_FOR_ABORT >------------------*/,{ /* ** We are jumped here by the C code, if we have ** some target to reset or some disconnected ** job to abort. Since error recovery is a serious ** busyness, we will really reset the SCSI BUS, if ** case of a SCSI interrupt occurring in this path. */ /* ** Set initiator mode. */ SCR_CLR (SCR_TRG), 0, /* ** And try to select this target. */ SCR_SEL_TBL_ATN ^ offsetof (struct ncb, abrt_sel), PADDR (reselect), /* ** Wait for the selection to complete or ** the selection to time out. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_MSG_OUT)), -8, /* ** Call the C code. */ SCR_INT, SIR_TARGET_SELECTED, /* ** The C code should let us continue here. ** Send the 'kiss of death' message. ** We expect an immediate disconnect once ** the target has eaten the message. */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_MOVE_TBL ^ SCR_MSG_OUT, offsetof (struct ncb, abrt_tbl), SCR_CLR (SCR_ACK|SCR_ATN), 0, SCR_WAIT_DISC, 0, /* ** Tell the C code that we are done. */ SCR_INT, SIR_ABORT_SENT, }/*-----------------------< SEL_FOR_ABORT_1 >--------------*/,{ /* ** Jump at scheduler. */ SCR_JUMP, PADDR (start), }/*------------------------< SELECT_NO_ATN >-----------------*/,{ /* ** Set Initiator mode. ** And try to select this target without ATN. */ SCR_CLR (SCR_TRG), 0, SCR_SEL_TBL ^ offsetof (struct dsb, select), PADDR (ungetjob), /* ** load the savep (saved pointer) into ** the actual data pointer. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), /* ** Initialize the status registers */ SCR_LOAD_REL (scr0, 4), offsetof (struct ccb, phys.header.status), }/*------------------------< WF_SEL_DONE_NO_ATN >-----------------*/,{ /* ** Wait immediately for the next phase or ** the selection to complete or time-out. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_MSG_OUT)), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< MSG_IN_ETC >--------------------*/,{ /* ** If it is an EXTENDED (variable size message) ** Handle it. */ SCR_JUMP ^ IFTRUE (DATA (M_EXTENDED)), PADDRH (msg_extended), /* ** Let the C code handle any other ** 1 byte message. */ SCR_JUMP ^ IFTRUE (MASK (0x00, 0xf0)), PADDRH (msg_received), SCR_JUMP ^ IFTRUE (MASK (0x10, 0xf0)), PADDRH (msg_received), /* ** We donnot handle 2 bytes messages from SCRIPTS. ** So, let the C code deal with these ones too. */ SCR_JUMP ^ IFFALSE (MASK (0x20, 0xf0)), PADDRH (msg_weird_seen), SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), SCR_JUMP, PADDRH (msg_received), }/*-------------------------< MSG_RECEIVED >--------------------*/,{ SCR_LOAD_REL (scratcha, 4), /* DUMMY READ */ 0, SCR_INT, SIR_MSG_RECEIVED, }/*-------------------------< MSG_WEIRD_SEEN >------------------*/,{ SCR_LOAD_REL (scratcha, 4), /* DUMMY READ */ 0, SCR_INT, SIR_MSG_WEIRD, }/*-------------------------< MSG_EXTENDED >--------------------*/,{ /* ** Clear ACK and get the next byte ** assumed to be the message length. */ SCR_CLR (SCR_ACK), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (msgin[1]), /* ** Try to catch some unlikely situations as 0 length ** or too large the length. */ SCR_JUMP ^ IFTRUE (DATA (0)), PADDRH (msg_weird_seen), SCR_TO_REG (scratcha), 0, SCR_REG_REG (sfbr, SCR_ADD, (256-8)), 0, SCR_JUMP ^ IFTRUE (CARRYSET), PADDRH (msg_weird_seen), /* ** We donnot handle extended messages from SCRIPTS. ** Read the amount of data corresponding to the ** message length and call the C code. */ SCR_STORE_REL (scratcha, 1), offsetof (struct dsb, smsg_ext.size), SCR_CLR (SCR_ACK), 0, SCR_MOVE_TBL ^ SCR_MSG_IN, offsetof (struct dsb, smsg_ext), SCR_JUMP, PADDRH (msg_received), }/*-------------------------< MSG_BAD >------------------*/,{ /* ** unimplemented message - reject it. */ SCR_INT, SIR_REJECT_TO_SEND, SCR_SET (SCR_ATN), 0, SCR_JUMP, PADDR (clrack), }/*-------------------------< MSG_WEIRD >--------------------*/,{ /* ** weird message received ** ignore all MSG IN phases and reject it. */ SCR_INT, SIR_REJECT_TO_SEND, SCR_SET (SCR_ATN), 0, }/*-------------------------< MSG_WEIRD1 >--------------------*/,{ SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_IN)), PADDR (dispatch), SCR_MOVE_ABS (1) ^ SCR_MSG_IN, NADDR (scratch), SCR_JUMP, PADDRH (msg_weird1), }/*-------------------------< WDTR_RESP >----------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_WDTR >----------------*/,{ /* ** Send the M_X_WIDE_REQ */ SCR_MOVE_ABS (4) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< SDTR_RESP >-------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_SDTR >-------------*/,{ /* ** Send the M_X_SYNC_REQ */ SCR_MOVE_ABS (5) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< PPR_RESP >-------------*/,{ /* ** let the target fetch our answer. */ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, SCR_JUMP ^ IFFALSE (WHEN (SCR_MSG_OUT)), PADDRH (nego_bad_phase), }/*-------------------------< SEND_PPR >-------------*/,{ /* ** Send the M_X_PPR_REQ */ SCR_MOVE_ABS (8) ^ SCR_MSG_OUT, NADDR (msgout), SCR_JUMP, PADDRH (msg_out_done), }/*-------------------------< NEGO_BAD_PHASE >------------*/,{ SCR_INT, SIR_NEGO_PROTO, SCR_JUMP, PADDR (dispatch), }/*-------------------------< MSG_OUT >-------------------*/,{ /* ** The target requests a message. */ SCR_MOVE_ABS (1) ^ SCR_MSG_OUT, NADDR (msgout), /* ** ... wait for the next phase ** if it's a message out, send it again, ... */ SCR_JUMP ^ IFTRUE (WHEN (SCR_MSG_OUT)), PADDRH (msg_out), }/*-------------------------< MSG_OUT_DONE >--------------*/,{ /* ** ... else clear the message ... */ SCR_INT, SIR_MSG_OUT_DONE, /* ** ... and process the next phase */ SCR_JUMP, PADDR (dispatch), }/*-------------------------< DATA_OVRUN >-----------------------*/,{ /* * Use scratcha to count the extra bytes. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (zero), }/*-------------------------< DATA_OVRUN1 >----------------------*/,{ /* * The target may want to transfer too much data. * * If phase is DATA OUT write 1 byte and count it. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_DATA_OUT)), 16, SCR_CHMOV_ABS (1) ^ SCR_DATA_OUT, NADDR (scratch), SCR_JUMP, PADDRH (data_ovrun2), /* * If WSR is set, clear this condition, and * count this byte. */ SCR_FROM_REG (scntl2), 0, SCR_JUMPR ^ IFFALSE (MASK (WSR, WSR)), 16, SCR_REG_REG (scntl2, SCR_OR, WSR), 0, SCR_JUMP, PADDRH (data_ovrun2), /* * Finally check against DATA IN phase. * Signal data overrun to the C code * and jump to dispatcher if not so. * Read 1 byte otherwise and count it. */ SCR_JUMPR ^ IFTRUE (WHEN (SCR_DATA_IN)), 16, SCR_INT, SIR_DATA_OVERRUN, SCR_JUMP, PADDR (dispatch), SCR_CHMOV_ABS (1) ^ SCR_DATA_IN, NADDR (scratch), }/*-------------------------< DATA_OVRUN2 >----------------------*/,{ /* * Count this byte. * This will allow to return a negative * residual to user. */ SCR_REG_REG (scratcha, SCR_ADD, 0x01), 0, SCR_REG_REG (scratcha1, SCR_ADDC, 0), 0, SCR_REG_REG (scratcha2, SCR_ADDC, 0), 0, /* * .. and repeat as required. */ SCR_JUMP, PADDRH (data_ovrun1), }/*-------------------------< ABORT_RESEL >----------------*/,{ SCR_SET (SCR_ATN), 0, SCR_CLR (SCR_ACK), 0, /* ** send the abort/abortag/reset message ** we expect an immediate disconnect */ SCR_REG_REG (scntl2, SCR_AND, 0x7f), 0, SCR_MOVE_ABS (1) ^ SCR_MSG_OUT, NADDR (msgout), SCR_CLR (SCR_ACK|SCR_ATN), 0, SCR_WAIT_DISC, 0, SCR_INT, SIR_RESEL_ABORTED, SCR_JUMP, PADDR (start), }/*-------------------------< RESEND_IDENT >-------------------*/,{ /* ** The target stays in MSG OUT phase after having acked ** Identify [+ Tag [+ Extended message ]]. Targets shall ** behave this way on parity error. ** We must send it again all the messages. */ SCR_SET (SCR_ATN), /* Shall be asserted 2 deskew delays before the */ 0, /* 1rst ACK = 90 ns. Hope the NCR is'nt too fast */ SCR_JUMP, PADDR (send_ident), }/*-------------------------< IDENT_BREAK >-------------------*/,{ SCR_CLR (SCR_ATN), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< IDENT_BREAK_ATN >----------------*/,{ SCR_SET (SCR_ATN), 0, SCR_JUMP, PADDR (select2), }/*-------------------------< SDATA_IN >-------------------*/,{ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct dsb, sense), SCR_CALL, PADDR (datai_done), SCR_JUMP, PADDRH (data_ovrun), }/*-------------------------< DATA_IO >--------------------*/,{ /* ** We jump here if the data direction was unknown at the ** time we had to queue the command to the scripts processor. ** Pointers had been set as follow in this situation: ** savep --> DATA_IO ** lastp --> start pointer when DATA_IN ** goalp --> goal pointer when DATA_IN ** wlastp --> start pointer when DATA_OUT ** wgoalp --> goal pointer when DATA_OUT ** This script sets savep/lastp/goalp according to the ** direction chosen by the target. */ SCR_JUMP ^ IFTRUE (WHEN (SCR_DATA_OUT)), PADDRH(data_io_out), }/*-------------------------< DATA_IO_COM >-----------------*/,{ /* ** Direction is DATA IN. ** Warning: we jump here, even when phase is DATA OUT. */ SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.lastp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.savep), /* ** Jump to the SCRIPTS according to actual direction. */ SCR_LOAD_REL (temp, 4), offsetof (struct ccb, phys.header.savep), SCR_RETURN, 0, }/*-------------------------< DATA_IO_OUT >-----------------*/,{ /* ** Direction is DATA OUT. */ SCR_REG_REG (HF_REG, SCR_AND, (~HF_DATA_IN)), 0, SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.wlastp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.lastp), SCR_LOAD_REL (scratcha, 4), offsetof (struct ccb, phys.header.wgoalp), SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.header.goalp), SCR_JUMP, PADDRH(data_io_com), }/*-------------------------< RESEL_BAD_LUN >---------------*/,{ /* ** Message is an IDENTIFY, but lun is unknown. ** Signal problem to C code for logging the event. ** Send a M_ABORT to clear all pending tasks. */ SCR_INT, SIR_RESEL_BAD_LUN, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_I_T_L >------------------*/,{ /* ** We donnot have a task for that I_T_L. ** Signal problem to C code for logging the event. ** Send a M_ABORT message. */ SCR_INT, SIR_RESEL_BAD_I_T_L, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_I_T_L_Q >----------------*/,{ /* ** We donnot have a task that matches the tag. ** Signal problem to C code for logging the event. ** Send a M_ABORTTAG message. */ SCR_INT, SIR_RESEL_BAD_I_T_L_Q, SCR_JUMP, PADDRH (abort_resel), }/*-------------------------< BAD_STATUS >-----------------*/,{ /* ** Anything different from INTERMEDIATE ** CONDITION MET should be a bad SCSI status, ** given that GOOD status has already been tested. ** Call the C code. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (startpos), SCR_INT ^ IFFALSE (DATA (S_COND_MET)), SIR_BAD_STATUS, SCR_RETURN, 0, }/*-------------------------< TWEAK_PMJ >------------------*/,{ /* ** Disable PM handling from SCRIPTS for the data phase ** and so force PM to be handled from C code if HF_PM_TO_C ** flag is set. */ SCR_FROM_REG(HF_REG), 0, SCR_JUMPR ^ IFTRUE (MASK (HF_PM_TO_C, HF_PM_TO_C)), 16, SCR_REG_REG (ccntl0, SCR_OR, ENPMJ), 0, SCR_RETURN, 0, SCR_REG_REG (ccntl0, SCR_AND, (~ENPMJ)), 0, SCR_RETURN, 0, }/*-------------------------< PM_HANDLE >------------------*/,{ /* ** Phase mismatch handling. ** ** Since we have to deal with 2 SCSI data pointers ** (current and saved), we need at least 2 contexts. ** Each context (pm0 and pm1) has a saved area, a ** SAVE mini-script and a DATA phase mini-script. */ /* ** Get the PM handling flags. */ SCR_FROM_REG (HF_REG), 0, /* ** If no flags (1rst PM for example), avoid ** all the below heavy flags testing. ** This makes the normal case a bit faster. */ SCR_JUMP ^ IFTRUE (MASK (0, (HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED))), PADDRH (pm_handle1), /* ** If we received a SAVE DP, switch to the ** other PM context since the savep may point ** to the current PM context. */ SCR_JUMPR ^ IFFALSE (MASK (HF_DP_SAVED, HF_DP_SAVED)), 8, SCR_REG_REG (sfbr, SCR_XOR, HF_ACT_PM), 0, /* ** If we have been interrupt in a PM DATA mini-script, ** we take the return address from the corresponding ** saved area. ** This ensure the return address always points to the ** main DATA script for this transfer. */ SCR_JUMP ^ IFTRUE (MASK (0, (HF_IN_PM0 | HF_IN_PM1))), PADDRH (pm_handle1), SCR_JUMPR ^ IFFALSE (MASK (HF_IN_PM0, HF_IN_PM0)), 16, SCR_LOAD_REL (ia, 4), offsetof(struct ccb, phys.pm0.ret), SCR_JUMP, PADDRH (pm_save), SCR_LOAD_REL (ia, 4), offsetof(struct ccb, phys.pm1.ret), SCR_JUMP, PADDRH (pm_save), }/*-------------------------< PM_HANDLE1 >-----------------*/,{ /* ** Normal case. ** Update the return address so that it ** will point after the interrupted MOVE. */ SCR_REG_REG (ia, SCR_ADD, 8), 0, SCR_REG_REG (ia1, SCR_ADDC, 0), 0, }/*-------------------------< PM_SAVE >--------------------*/,{ /* ** Clear all the flags that told us if we were ** interrupted in a PM DATA mini-script and/or ** we received a SAVE DP. */ SCR_SFBR_REG (HF_REG, SCR_AND, (~(HF_IN_PM0|HF_IN_PM1|HF_DP_SAVED))), 0, /* ** Choose the current PM context. */ SCR_JUMP ^ IFTRUE (MASK (HF_ACT_PM, HF_ACT_PM)), PADDRH (pm1_save), }/*-------------------------< PM0_SAVE >-------------------*/,{ SCR_STORE_REL (ia, 4), offsetof(struct ccb, phys.pm0.ret), /* ** If WSR bit is set, either UA and RBC may ** have to be changed whatever the device wants ** to ignore this residue ot not. */ SCR_FROM_REG (scntl2), 0, SCR_CALL ^ IFTRUE (MASK (WSR, WSR)), PADDRH (pm_wsr_handle), /* ** Save the remaining byte count, the updated ** address and the return address. */ SCR_STORE_REL (rbc, 4), offsetof(struct ccb, phys.pm0.sg.size), SCR_STORE_REL (ua, 4), offsetof(struct ccb, phys.pm0.sg.addr), /* ** Set the current pointer at the PM0 DATA mini-script. */ SCR_LOAD_ABS (temp, 4), PADDRH (pm0_data_addr), SCR_JUMP, PADDR (dispatch), }/*-------------------------< PM1_SAVE >-------------------*/,{ SCR_STORE_REL (ia, 4), offsetof(struct ccb, phys.pm1.ret), /* ** If WSR bit is set, either UA and RBC may ** have been changed whatever the device wants ** to ignore this residue or not. */ SCR_FROM_REG (scntl2), 0, SCR_CALL ^ IFTRUE (MASK (WSR, WSR)), PADDRH (pm_wsr_handle), /* ** Save the remaining byte count, the updated ** address and the return address. */ SCR_STORE_REL (rbc, 4), offsetof(struct ccb, phys.pm1.sg.size), SCR_STORE_REL (ua, 4), offsetof(struct ccb, phys.pm1.sg.addr), /* ** Set the current pointer at the PM1 DATA mini-script. */ SCR_LOAD_ABS (temp, 4), PADDRH (pm1_data_addr), SCR_JUMP, PADDR (dispatch), }/*--------------------------< PM_WSR_HANDLE >-----------------------*/,{ /* * Phase mismatch handling from SCRIPT with WSR set. * Such a condition can occur if the chip wants to * execute a CHMOV(size > 1) when the WSR bit is * set and the target changes PHASE. */ #ifdef SYM_DEBUG_PM_WITH_WSR /* * Some debugging may still be needed.:) */ SCR_INT, SIR_PM_WITH_WSR, #endif /* * We must move the residual byte to memory. * * UA contains bit 0..31 of the address to * move the residual byte. * Move it to the table indirect. */ SCR_STORE_REL (ua, 4), offsetof (struct ccb, phys.wresid.addr), /* * Increment UA (move address to next position). */ SCR_REG_REG (ua, SCR_ADD, 1), 0, SCR_REG_REG (ua1, SCR_ADDC, 0), 0, SCR_REG_REG (ua2, SCR_ADDC, 0), 0, SCR_REG_REG (ua3, SCR_ADDC, 0), 0, /* * Compute SCRATCHA as: * - size to transfer = 1 byte. * - bit 24..31 = high address bit [32...39]. */ SCR_LOAD_ABS (scratcha, 4), PADDRH (zero), SCR_REG_REG (scratcha, SCR_OR, 1), 0, SCR_FROM_REG (rbc3), 0, SCR_TO_REG (scratcha3), 0, /* * Move this value to the table indirect. */ SCR_STORE_REL (scratcha, 4), offsetof (struct ccb, phys.wresid.size), /* * Wait for a valid phase. * While testing with bogus QUANTUM drives, the C1010 * sometimes raised a spurious phase mismatch with * WSR and the CHMOV(1) triggered another PM. * Waiting explicitely for the PHASE seemed to avoid * the nested phase mismatch. Btw, this didn't happen * using my IBM drives. */ SCR_JUMPR ^ IFFALSE (WHEN (SCR_DATA_IN)), 0, /* * Perform the move of the residual byte. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.wresid), /* * We can now handle the phase mismatch with UA fixed. * RBC[0..23]=0 is a special case that does not require * a PM context. The C code also checks against this. */ SCR_FROM_REG (rbc), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, SCR_FROM_REG (rbc1), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, SCR_FROM_REG (rbc2), 0, SCR_RETURN ^ IFFALSE (DATA (0)), 0, /* * RBC[0..23]=0. * Not only we donnot need a PM context, but this would * lead to a bogus CHMOV(0). This condition means that * the residual was the last byte to move from this CHMOV. * So, we just have to move the current data script pointer * (i.e. TEMP) to the SCRIPTS address following the * interrupted CHMOV and jump to dispatcher. */ SCR_STORE_ABS (ia, 4), PADDRH (scratch), SCR_LOAD_ABS (temp, 4), PADDRH (scratch), SCR_JUMP, PADDR (dispatch), }/*--------------------------< WSR_MA_HELPER >-----------------------*/,{ /* * Helper for the C code when WSR bit is set. * Perform the move of the residual byte. */ SCR_CHMOV_TBL ^ SCR_DATA_IN, offsetof (struct ccb, phys.wresid), SCR_JUMP, PADDR (dispatch), }/*-------------------------< ZERO >------------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SCRATCH >---------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SCRATCH1 >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< PM0_DATA_ADDR >---------------*/,{ SCR_DATA_ZERO, }/*-------------------------< PM1_DATA_ADDR >---------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SAVED_DSA >-------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< SAVED_DRS >-------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< DONE_POS >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< STARTPOS >--------------------*/,{ SCR_DATA_ZERO, }/*-------------------------< TARGTBL >---------------------*/,{ SCR_DATA_ZERO, /* ** We may use MEMORY MOVE instructions to load the on chip-RAM, ** if it happens that mapping PCI memory is not possible. ** But writing the RAM from the CPU is the preferred method, ** since PCI 2.2 seems to disallow PCI self-mastering. */ #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED }/*-------------------------< START_RAM >-------------------*/,{ /* ** Load the script into on-chip RAM, ** and jump to start point. */ SCR_COPY (sizeof (struct script)), }/*-------------------------< SCRIPT0_BA >--------------------*/,{ 0, PADDR (start), SCR_JUMP, PADDR (init), }/*-------------------------< START_RAM64 >--------------------*/,{ /* ** Load the RAM and start for 64 bit PCI (895A,896). ** Both scripts (script and scripth) are loaded into ** the RAM which is 8K (4K for 825A/875/895). ** We also need to load some 32-63 bit segments ** address of the SCRIPTS processor. ** LOAD/STORE ABSOLUTE always refers to on-chip RAM ** in our implementation. The main memory is ** accessed using LOAD/STORE DSA RELATIVE. */ SCR_LOAD_REL (mmws, 4), offsetof (struct ncb, scr_ram_seg), SCR_COPY (sizeof(struct script)), }/*-------------------------< SCRIPT0_BA64 >--------------------*/,{ 0, PADDR (start), SCR_COPY (sizeof(struct scripth)), }/*-------------------------< SCRIPTH0_BA64 >--------------------*/,{ 0, PADDRH (start64), SCR_LOAD_REL (mmrs, 4), offsetof (struct ncb, scr_ram_seg), SCR_JUMP64, PADDRH (start64), }/*-------------------------< RAM_SEG64 >--------------------*/,{ 0, #endif /* SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ }/*-------------------------< SNOOPTEST >-------------------*/,{ /* ** Read the variable. */ SCR_LOAD_REL (scratcha, 4), offsetof(struct ncb, ncr_cache), SCR_STORE_REL (temp, 4), offsetof(struct ncb, ncr_cache), SCR_LOAD_REL (temp, 4), offsetof(struct ncb, ncr_cache), }/*-------------------------< SNOOPEND >-------------------*/,{ /* ** And stop. */ SCR_INT, 99, }/*--------------------------------------------------------*/ }; /*========================================================== ** ** ** Fill in #define dependent parts of the script ** ** **========================================================== */ void __init ncr_script_fill (struct script * scr, struct scripth * scrh) { int i; ncrcmd *p; p = scr->data_in; for (i=0; idata_in + sizeof (scr->data_in)); p = scr->data_out; for (i=0; idata_out + sizeof (scr->data_out)); } /*========================================================== ** ** ** Copy and rebind a script. ** ** **========================================================== */ static void __init ncr_script_copy_and_bind (ncb_p np,ncrcmd *src,ncrcmd *dst,int len) { ncrcmd opcode, new, old, tmp1, tmp2; ncrcmd *start, *end; int relocs; int opchanged = 0; start = src; end = src + len/4; while (src < end) { opcode = *src++; *dst++ = cpu_to_scr(opcode); /* ** If we forget to change the length ** in struct script, a field will be ** padded with 0. This is an illegal ** command. */ if (opcode == 0) { printk (KERN_INFO "%s: ERROR0 IN SCRIPT at %d.\n", ncr_name(np), (int) (src-start-1)); MDELAY (10000); continue; }; /* ** We use the bogus value 0xf00ff00f ;-) ** to reserve data area in SCRIPTS. */ if (opcode == SCR_DATA_ZERO) { dst[-1] = 0; continue; } if (DEBUG_FLAGS & DEBUG_SCRIPT) printk (KERN_INFO "%p: <%x>\n", (src-1), (unsigned)opcode); /* ** We don't have to decode ALL commands */ switch (opcode >> 28) { case 0xf: /* ** LOAD / STORE DSA relative, don't relocate. */ relocs = 0; break; case 0xe: /* ** LOAD / STORE absolute. */ relocs = 1; break; case 0xc: /* ** COPY has TWO arguments. */ relocs = 2; tmp1 = src[0]; tmp2 = src[1]; #ifdef RELOC_KVAR if ((tmp1 & RELOC_MASK) == RELOC_KVAR) tmp1 = 0; if ((tmp2 & RELOC_MASK) == RELOC_KVAR) tmp2 = 0; #endif if ((tmp1 ^ tmp2) & 3) { printk (KERN_ERR"%s: ERROR1 IN SCRIPT at %d.\n", ncr_name(np), (int) (src-start-1)); MDELAY (1000); } /* ** If PREFETCH feature not enabled, remove ** the NO FLUSH bit if present. */ if ((opcode & SCR_NO_FLUSH) && !(np->features & FE_PFEN)) { dst[-1] = cpu_to_scr(opcode & ~SCR_NO_FLUSH); ++opchanged; } break; case 0x0: /* ** MOVE/CHMOV (absolute address) */ if (!(np->features & FE_WIDE)) dst[-1] = cpu_to_scr(opcode | OPC_MOVE); relocs = 1; break; case 0x1: /* ** MOVE/CHMOV (table indirect) */ if (!(np->features & FE_WIDE)) dst[-1] = cpu_to_scr(opcode | OPC_MOVE); relocs = 0; break; case 0x8: /* ** JUMP / CALL ** don't relocate if relative :-) */ if (opcode & 0x00800000) relocs = 0; else if ((opcode & 0xf8400000) == 0x80400000)/*JUMP64*/ relocs = 2; else relocs = 1; break; case 0x4: case 0x5: case 0x6: case 0x7: relocs = 1; break; default: relocs = 0; break; }; if (!relocs) { *dst++ = cpu_to_scr(*src++); continue; } while (relocs--) { old = *src++; switch (old & RELOC_MASK) { case RELOC_REGISTER: new = (old & ~RELOC_MASK) + np->base_ba; break; case RELOC_LABEL: new = (old & ~RELOC_MASK) + np->p_script; break; case RELOC_LABELH: new = (old & ~RELOC_MASK) + np->p_scripth; break; case RELOC_SOFTC: new = (old & ~RELOC_MASK) + np->p_ncb; break; #ifdef RELOC_KVAR case RELOC_KVAR: new=0; if (((old & ~RELOC_MASK) < SCRIPT_KVAR_FIRST) || ((old & ~RELOC_MASK) > SCRIPT_KVAR_LAST)) panic("ncr KVAR out of range"); new = vtobus(script_kvars[old & ~RELOC_MASK]); #endif break; case 0: /* Don't relocate a 0 address. */ if (old == 0) { new = old; break; } /* fall through */ default: new = 0; /* For 'cc' not to complain */ panic("ncr_script_copy_and_bind: " "weird relocation %x\n", old); break; } *dst++ = cpu_to_scr(new); } }; } /*========================================================== ** ** ** Auto configuration: attach and init a host adapter. ** ** **========================================================== */ /* ** Linux host data structure. */ struct host_data { struct ncb *ncb; }; /* ** Print something which allows to retrieve the controller type, unit, ** target, lun concerned by a kernel message. */ static void PRINT_TARGET(ncb_p np, int target) { printk(KERN_INFO "%s-<%d,*>: ", ncr_name(np), target); } static void PRINT_LUN(ncb_p np, int target, int lun) { printk(KERN_INFO "%s-<%d,%d>: ", ncr_name(np), target, lun); } static void PRINT_ADDR(Scsi_Cmnd *cmd) { struct host_data *host_data = (struct host_data *) cmd->device->host->hostdata; PRINT_LUN(host_data->ncb, cmd->device->id, cmd->device->lun); } /*========================================================== ** ** NCR chip clock divisor table. ** Divisors are multiplied by 10,000,000 in order to make ** calculations more simple. ** **========================================================== */ #define _5M 5000000 static u_long div_10M[] = {2*_5M, 3*_5M, 4*_5M, 6*_5M, 8*_5M, 12*_5M, 16*_5M}; /*=============================================================== ** ** Prepare io register values used by ncr_init() according ** to selected and supported features. ** ** NCR/SYMBIOS chips allow burst lengths of 2, 4, 8, 16, 32, 64, ** 128 transfers. All chips support at least 16 transfers bursts. ** The 825A, 875 and 895 chips support bursts of up to 128 ** transfers and the 895A and 896 support bursts of up to 64 ** transfers. All other chips support up to 16 transfers bursts. ** ** For PCI 32 bit data transfers each transfer is a DWORD (4 bytes). ** It is a QUADWORD (8 bytes) for PCI 64 bit data transfers. ** Only the 896 is able to perform 64 bit data transfers. ** ** We use log base 2 (burst length) as internal code, with ** value 0 meaning "burst disabled". ** **=============================================================== */ /* * Burst length from burst code. */ #define burst_length(bc) (!(bc))? 0 : 1 << (bc) /* * Burst code from io register bits. */ #define burst_code(dmode, ctest4, ctest5) \ (ctest4) & 0x80? 0 : (((dmode) & 0xc0) >> 6) + ((ctest5) & 0x04) + 1 /* * Set initial io register bits from burst code. */ static inline void ncr_init_burst(ncb_p np, u_char bc) { np->rv_ctest4 &= ~0x80; np->rv_dmode &= ~(0x3 << 6); np->rv_ctest5 &= ~0x4; if (!bc) { np->rv_ctest4 |= 0x80; } else { --bc; np->rv_dmode |= ((bc & 0x3) << 6); np->rv_ctest5 |= (bc & 0x4); } } #ifdef SCSI_NCR_NVRAM_SUPPORT /* ** Get target set-up from Symbios format NVRAM. */ static void __init ncr_Symbios_setup_target(ncb_p np, int target, Symbios_nvram *nvram) { tcb_p tp = &np->target[target]; Symbios_target *tn = &nvram->target[target]; tp->usrsync = tn->sync_period ? (tn->sync_period + 3) / 4 : 255; tp->usrwide = tn->bus_width == 0x10 ? 1 : 0; tp->usrtags = (tn->flags & SYMBIOS_QUEUE_TAGS_ENABLED)? MAX_TAGS : 0; if (!(tn->flags & SYMBIOS_DISCONNECT_ENABLE)) tp->usrflag |= UF_NODISC; if (!(tn->flags & SYMBIOS_SCAN_AT_BOOT_TIME)) tp->usrflag |= UF_NOSCAN; } /* ** Get target set-up from Tekram format NVRAM. */ static void __init ncr_Tekram_setup_target(ncb_p np, int target, Tekram_nvram *nvram) { tcb_p tp = &np->target[target]; struct Tekram_target *tn = &nvram->target[target]; int i; if (tn->flags & TEKRAM_SYNC_NEGO) { i = tn->sync_index & 0xf; tp->usrsync = Tekram_sync[i]; } tp->usrwide = (tn->flags & TEKRAM_WIDE_NEGO) ? 1 : 0; if (tn->flags & TEKRAM_TAGGED_COMMANDS) { tp->usrtags = 2 << nvram->max_tags_index; } if (!(tn->flags & TEKRAM_DISCONNECT_ENABLE)) tp->usrflag = UF_NODISC; /* If any device does not support parity, we will not use this option */ if (!(tn->flags & TEKRAM_PARITY_CHECK)) np->rv_scntl0 &= ~0x0a; /* SCSI parity checking disabled */ } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Save initial settings of some IO registers. ** Assumed to have been set by BIOS. */ static void __init ncr_save_initial_setting(ncb_p np) { np->sv_scntl0 = INB(nc_scntl0) & 0x0a; np->sv_dmode = INB(nc_dmode) & 0xce; np->sv_dcntl = INB(nc_dcntl) & 0xa8; np->sv_ctest3 = INB(nc_ctest3) & 0x01; np->sv_ctest4 = INB(nc_ctest4) & 0x80; np->sv_gpcntl = INB(nc_gpcntl); np->sv_stest2 = INB(nc_stest2) & 0x20; np->sv_stest4 = INB(nc_stest4); np->sv_stest1 = INB(nc_stest1); np->sv_scntl3 = INB(nc_scntl3) & 0x07; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66) ){ /* ** C1010 always uses large fifo, bit 5 rsvd ** scntl4 used ONLY with C1010 */ np->sv_ctest5 = INB(nc_ctest5) & 0x04 ; np->sv_scntl4 = INB(nc_scntl4); } else { np->sv_ctest5 = INB(nc_ctest5) & 0x24 ; np->sv_scntl4 = 0; } } /* ** Prepare io register values used by ncr_init() ** according to selected and supported features. */ static int __init ncr_prepare_setting(ncb_p np, ncr_nvram *nvram) { u_char burst_max; u_long period; int i; #ifdef CONFIG_PARISC char scsi_mode = -1; struct hardware_path hwpath; #endif /* ** Wide ? */ np->maxwide = (np->features & FE_WIDE)? 1 : 0; /* * Guess the frequency of the chip's clock. */ if (np->features & (FE_ULTRA3 | FE_ULTRA2)) np->clock_khz = 160000; else if (np->features & FE_ULTRA) np->clock_khz = 80000; else np->clock_khz = 40000; /* * Get the clock multiplier factor. */ if (np->features & FE_QUAD) np->multiplier = 4; else if (np->features & FE_DBLR) np->multiplier = 2; else np->multiplier = 1; /* * Measure SCSI clock frequency for chips * it may vary from assumed one. */ if (np->features & FE_VARCLK) ncr_getclock(np, np->multiplier); /* * Divisor to be used for async (timer pre-scaler). * * Note: For C1010 the async divisor is 2(8) if he * quadrupler is disabled (enabled). */ if ( (np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { np->rv_scntl3 = 0; } else { i = np->clock_divn - 1; while (--i >= 0) { if (10ul * SCSI_NCR_MIN_ASYNC * np->clock_khz > div_10M[i]) { ++i; break; } } np->rv_scntl3 = i+1; } /* * Save the ultra3 register for the C1010/C1010_66 */ np->rv_scntl4 = np->sv_scntl4; /* * Minimum synchronous period factor supported by the chip. * Btw, 'period' is in tenths of nanoseconds. */ period = (4 * div_10M[0] + np->clock_khz - 1) / np->clock_khz; #ifdef CONFIG_PARISC /* Host firmware (PDC) keeps a table for crippling SCSI capabilities. * Many newer machines export one channel of 53c896 chip * as SE, 50-pin HD. Also used for Multi-initiator SCSI clusters * to set the SCSI Initiator ID. */ get_pci_node_path(np->pdev, &hwpath); if (pdc_get_initiator(&hwpath, &np->myaddr, &period, &np->maxwide, &scsi_mode)) { if (np->maxwide) np->features |= FE_WIDE; if (scsi_mode >= 0) { /* C3000 PDC reports period/mode */ driver_setup.diff_support = 0; switch(scsi_mode) { case 0: np->scsi_mode = SMODE_SE; break; case 1: np->scsi_mode = SMODE_HVD; break; case 2: np->scsi_mode = SMODE_LVD; break; default: break; } } } #endif if (period <= 250) np->minsync = 10; else if (period <= 303) np->minsync = 11; else if (period <= 500) np->minsync = 12; else np->minsync = (period + 40 - 1) / 40; /* * Fix up. If sync. factor is 10 (160000Khz clock) and chip * supports ultra3, then min. sync. period 12.5ns and the factor is 9 * Also keep track of the maximum offset in ST mode which may differ * from the maximum offset in DT mode. For now hardcoded to 31. */ if (np->features & FE_ULTRA3) { if (np->minsync == 10) np->minsync = 9; np->maxoffs_st = 31; } else np->maxoffs_st = np->maxoffs; /* * Check against chip SCSI standard support (SCSI-2,ULTRA,ULTRA2). * * Transfer period minimums: SCSI-1 200 (50); Fast 100 (25) * Ultra 50 (12); Ultra2 (6); Ultra3 (3) */ if (np->minsync < 25 && !(np->features & (FE_ULTRA|FE_ULTRA2|FE_ULTRA3))) np->minsync = 25; else if (np->minsync < 12 && (np->features & FE_ULTRA)) np->minsync = 12; else if (np->minsync < 10 && (np->features & FE_ULTRA2)) np->minsync = 10; else if (np->minsync < 9 && (np->features & FE_ULTRA3)) np->minsync = 9; /* * Maximum synchronous period factor supported by the chip. */ period = (11 * div_10M[np->clock_divn - 1]) / (4 * np->clock_khz); np->maxsync = period > 2540 ? 254 : period / 10; /* ** 64 bit (53C895A or 53C896) ? */ if (np->features & FE_DAC) { if (np->features & FE_DAC_IN_USE) np->rv_ccntl1 |= (XTIMOD | EXTIBMV); else np->rv_ccntl1 |= (DDAC); } /* ** Phase mismatch handled by SCRIPTS (53C895A, 53C896 or C1010) ? */ if (np->features & FE_NOPM) np->rv_ccntl0 |= (ENPMJ); /* ** Prepare initial value of other IO registers */ #if defined SCSI_NCR_TRUST_BIOS_SETTING np->rv_scntl0 = np->sv_scntl0; np->rv_dmode = np->sv_dmode; np->rv_dcntl = np->sv_dcntl; np->rv_ctest3 = np->sv_ctest3; np->rv_ctest4 = np->sv_ctest4; np->rv_ctest5 = np->sv_ctest5; burst_max = burst_code(np->sv_dmode, np->sv_ctest4, np->sv_ctest5); #else /* ** Select burst length (dwords) */ burst_max = driver_setup.burst_max; if (burst_max == 255) burst_max = burst_code(np->sv_dmode, np->sv_ctest4, np->sv_ctest5); if (burst_max > 7) burst_max = 7; if (burst_max > np->maxburst) burst_max = np->maxburst; /* ** DEL 352 - 53C810 Rev x11 - Part Number 609-0392140 - ITEM 2. ** This chip and the 860 Rev 1 may wrongly use PCI cache line ** based transactions on LOAD/STORE instructions. So we have ** to prevent these chips from using such PCI transactions in ** this driver. The generic sym53c8xx driver that does not use ** LOAD/STORE instructions does not need this work-around. */ if ((np->device_id == PCI_DEVICE_ID_NCR_53C810 && np->revision_id >= 0x10 && np->revision_id <= 0x11) || (np->device_id == PCI_DEVICE_ID_NCR_53C860 && np->revision_id <= 0x1)) np->features &= ~(FE_WRIE|FE_ERL|FE_ERMP); /* ** DEL ? - 53C1010 Rev 1 - Part Number 609-0393638 ** 64-bit Slave Cycles must be disabled. */ if ( ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) && (np->revision_id < 0x02) ) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 ) ) np->rv_ccntl1 |= 0x10; /* ** Select all supported special features. ** If we are using on-board RAM for scripts, prefetch (PFEN) ** does not help, but burst op fetch (BOF) does. ** Disabling PFEN makes sure BOF will be used. */ if (np->features & FE_ERL) np->rv_dmode |= ERL; /* Enable Read Line */ if (np->features & FE_BOF) np->rv_dmode |= BOF; /* Burst Opcode Fetch */ if (np->features & FE_ERMP) np->rv_dmode |= ERMP; /* Enable Read Multiple */ #if 1 if ((np->features & FE_PFEN) && !np->base2_ba) #else if (np->features & FE_PFEN) #endif np->rv_dcntl |= PFEN; /* Prefetch Enable */ if (np->features & FE_CLSE) np->rv_dcntl |= CLSE; /* Cache Line Size Enable */ if (np->features & FE_WRIE) np->rv_ctest3 |= WRIE; /* Write and Invalidate */ if ( (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (np->features & FE_DFS)) np->rv_ctest5 |= DFS; /* Dma Fifo Size */ /* C1010/C1010_66 always large fifo */ /* ** Select some other */ if (driver_setup.master_parity) np->rv_ctest4 |= MPEE; /* Master parity checking */ if (driver_setup.scsi_parity) np->rv_scntl0 |= 0x0a; /* full arb., ena parity, par->ATN */ #ifdef SCSI_NCR_NVRAM_SUPPORT /* ** Get parity checking, host ID and verbose mode from NVRAM **/ if (nvram) { switch(nvram->type) { case SCSI_NCR_TEKRAM_NVRAM: np->myaddr = nvram->data.Tekram.host_id & 0x0f; break; case SCSI_NCR_SYMBIOS_NVRAM: if (!(nvram->data.Symbios.flags & SYMBIOS_PARITY_ENABLE)) np->rv_scntl0 &= ~0x0a; np->myaddr = nvram->data.Symbios.host_id & 0x0f; if (nvram->data.Symbios.flags & SYMBIOS_VERBOSE_MSGS) np->verbose += 1; break; } } #endif /* ** Get SCSI addr of host adapter (set by bios?). */ if (np->myaddr == 255) { np->myaddr = INB(nc_scid) & 0x07; if (!np->myaddr) np->myaddr = SCSI_NCR_MYADDR; } #endif /* SCSI_NCR_TRUST_BIOS_SETTING */ /* * Prepare initial io register bits for burst length */ ncr_init_burst(np, burst_max); /* ** Set SCSI BUS mode. ** ** - ULTRA2 chips (895/895A/896) ** and ULTRA 3 chips (1010) report the current ** BUS mode through the STEST4 IO register. ** - For previous generation chips (825/825A/875), ** user has to tell us how to check against HVD, ** since a 100% safe algorithm is not possible. */ np->scsi_mode = SMODE_SE; if (np->features & (FE_ULTRA2 | FE_ULTRA3)) np->scsi_mode = (np->sv_stest4 & SMODE); else if (np->features & FE_DIFF) { switch(driver_setup.diff_support) { case 4: /* Trust previous settings if present, then GPIO3 */ if (np->sv_scntl3) { if (np->sv_stest2 & 0x20) np->scsi_mode = SMODE_HVD; break; } case 3: /* SYMBIOS controllers report HVD through GPIO3 */ if (nvram && nvram->type != SCSI_NCR_SYMBIOS_NVRAM) break; if (INB(nc_gpreg) & 0x08) break; case 2: /* Set HVD unconditionally */ np->scsi_mode = SMODE_HVD; case 1: /* Trust previous settings for HVD */ if (np->sv_stest2 & 0x20) np->scsi_mode = SMODE_HVD; break; default:/* Don't care about HVD */ break; } } if (np->scsi_mode == SMODE_HVD) np->rv_stest2 |= 0x20; /* ** Set LED support from SCRIPTS. ** Ignore this feature for boards known to use a ** specific GPIO wiring and for the 895A or 896 ** that drive the LED directly. ** Also probe initial setting of GPIO0 as output. */ if ((driver_setup.led_pin || (nvram && nvram->type == SCSI_NCR_SYMBIOS_NVRAM)) && !(np->features & FE_LEDC) && !(np->sv_gpcntl & 0x01)) np->features |= FE_LED0; /* ** Set irq mode. */ switch(driver_setup.irqm & 3) { case 2: np->rv_dcntl |= IRQM; break; case 1: np->rv_dcntl |= (np->sv_dcntl & IRQM); break; default: break; } /* ** Configure targets according to driver setup. ** If NVRAM present get targets setup from NVRAM. ** Allow to override sync, wide and NOSCAN from ** boot command line. */ for (i = 0 ; i < MAX_TARGET ; i++) { tcb_p tp = &np->target[i]; tp->usrsync = 255; #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvram) { switch(nvram->type) { case SCSI_NCR_TEKRAM_NVRAM: ncr_Tekram_setup_target(np, i, &nvram->data.Tekram); break; case SCSI_NCR_SYMBIOS_NVRAM: ncr_Symbios_setup_target(np, i, &nvram->data.Symbios); break; } if (driver_setup.use_nvram & 0x2) tp->usrsync = driver_setup.default_sync; if (driver_setup.use_nvram & 0x4) tp->usrwide = driver_setup.max_wide; if (driver_setup.use_nvram & 0x8) tp->usrflag &= ~UF_NOSCAN; } else { #else if (1) { #endif tp->usrsync = driver_setup.default_sync; tp->usrwide = driver_setup.max_wide; tp->usrtags = MAX_TAGS; if (!driver_setup.disconnection) np->target[i].usrflag = UF_NODISC; } } /* ** Announce all that stuff to user. */ i = nvram ? nvram->type : 0; printk(KERN_INFO "%s: %sID %d, Fast-%d%s%s\n", ncr_name(np), i == SCSI_NCR_SYMBIOS_NVRAM ? "Symbios format NVRAM, " : (i == SCSI_NCR_TEKRAM_NVRAM ? "Tekram format NVRAM, " : ""), np->myaddr, np->minsync < 10 ? 80 : (np->minsync < 12 ? 40 : (np->minsync < 25 ? 20 : 10) ), (np->rv_scntl0 & 0xa) ? ", Parity Checking" : ", NO Parity", (np->rv_stest2 & 0x20) ? ", Differential" : ""); if (bootverbose > 1) { printk (KERN_INFO "%s: initial SCNTL3/DMODE/DCNTL/CTEST3/4/5 = " "(hex) %02x/%02x/%02x/%02x/%02x/%02x\n", ncr_name(np), np->sv_scntl3, np->sv_dmode, np->sv_dcntl, np->sv_ctest3, np->sv_ctest4, np->sv_ctest5); printk (KERN_INFO "%s: final SCNTL3/DMODE/DCNTL/CTEST3/4/5 = " "(hex) %02x/%02x/%02x/%02x/%02x/%02x\n", ncr_name(np), np->rv_scntl3, np->rv_dmode, np->rv_dcntl, np->rv_ctest3, np->rv_ctest4, np->rv_ctest5); } if (bootverbose && np->base2_ba) printk (KERN_INFO "%s: on-chip RAM at 0x%lx\n", ncr_name(np), np->base2_ba); return 0; } #ifdef SCSI_NCR_DEBUG_NVRAM void __init ncr_display_Symbios_nvram(ncb_p np, Symbios_nvram *nvram) { int i; /* display Symbios nvram host data */ printk(KERN_DEBUG "%s: HOST ID=%d%s%s%s%s%s\n", ncr_name(np), nvram->host_id & 0x0f, (nvram->flags & SYMBIOS_SCAM_ENABLE) ? " SCAM" :"", (nvram->flags & SYMBIOS_PARITY_ENABLE) ? " PARITY" :"", (nvram->flags & SYMBIOS_VERBOSE_MSGS) ? " VERBOSE" :"", (nvram->flags & SYMBIOS_CHS_MAPPING) ? " CHS_ALT" :"", (nvram->flags1 & SYMBIOS_SCAN_HI_LO) ? " HI_LO" :""); /* display Symbios nvram drive data */ for (i = 0 ; i < 15 ; i++) { struct Symbios_target *tn = &nvram->target[i]; printk(KERN_DEBUG "%s-%d:%s%s%s%s WIDTH=%d SYNC=%d TMO=%d\n", ncr_name(np), i, (tn->flags & SYMBIOS_DISCONNECT_ENABLE) ? " DISC" : "", (tn->flags & SYMBIOS_SCAN_AT_BOOT_TIME) ? " SCAN_BOOT" : "", (tn->flags & SYMBIOS_SCAN_LUNS) ? " SCAN_LUNS" : "", (tn->flags & SYMBIOS_QUEUE_TAGS_ENABLED)? " TCQ" : "", tn->bus_width, tn->sync_period / 4, tn->timeout); } } static u_char Tekram_boot_delay[7] __initdata = {3, 5, 10, 20, 30, 60, 120}; void __init ncr_display_Tekram_nvram(ncb_p np, Tekram_nvram *nvram) { int i, tags, boot_delay; char *rem; /* display Tekram nvram host data */ tags = 2 << nvram->max_tags_index; boot_delay = 0; if (nvram->boot_delay_index < 6) boot_delay = Tekram_boot_delay[nvram->boot_delay_index]; switch((nvram->flags & TEKRAM_REMOVABLE_FLAGS) >> 6) { default: case 0: rem = ""; break; case 1: rem = " REMOVABLE=boot device"; break; case 2: rem = " REMOVABLE=all"; break; } printk(KERN_DEBUG "%s: HOST ID=%d%s%s%s%s%s%s%s%s%s BOOT DELAY=%d tags=%d\n", ncr_name(np), nvram->host_id & 0x0f, (nvram->flags1 & SYMBIOS_SCAM_ENABLE) ? " SCAM" :"", (nvram->flags & TEKRAM_MORE_THAN_2_DRIVES) ? " >2DRIVES" :"", (nvram->flags & TEKRAM_DRIVES_SUP_1GB) ? " >1GB" :"", (nvram->flags & TEKRAM_RESET_ON_POWER_ON) ? " RESET" :"", (nvram->flags & TEKRAM_ACTIVE_NEGATION) ? " ACT_NEG" :"", (nvram->flags & TEKRAM_IMMEDIATE_SEEK) ? " IMM_SEEK" :"", (nvram->flags & TEKRAM_SCAN_LUNS) ? " SCAN_LUNS" :"", (nvram->flags1 & TEKRAM_F2_F6_ENABLED) ? " F2_F6" :"", rem, boot_delay, tags); /* display Tekram nvram drive data */ for (i = 0; i <= 15; i++) { int sync, j; struct Tekram_target *tn = &nvram->target[i]; j = tn->sync_index & 0xf; sync = Tekram_sync[j]; printk(KERN_DEBUG "%s-%d:%s%s%s%s%s%s PERIOD=%d\n", ncr_name(np), i, (tn->flags & TEKRAM_PARITY_CHECK) ? " PARITY" : "", (tn->flags & TEKRAM_SYNC_NEGO) ? " SYNC" : "", (tn->flags & TEKRAM_DISCONNECT_ENABLE) ? " DISC" : "", (tn->flags & TEKRAM_START_CMD) ? " START" : "", (tn->flags & TEKRAM_TAGGED_COMMANDS) ? " TCQ" : "", (tn->flags & TEKRAM_WIDE_NEGO) ? " WIDE" : "", sync); } } #endif /* SCSI_NCR_DEBUG_NVRAM */ /* ** Host attach and initialisations. ** ** Allocate host data and ncb structure. ** Request IO region and remap MMIO region. ** Do chip initialization. ** If all is OK, install interrupt handling and ** start the timer daemon. */ static int __init ncr_attach (Scsi_Host_Template *tpnt, int unit, ncr_device *device) { struct host_data *host_data; ncb_p np = 0; struct Scsi_Host *instance = 0; u_long flags = 0; ncr_nvram *nvram = device->nvram; int i; printk(KERN_INFO NAME53C "%s-%d: rev 0x%x on pci bus %d device %d function %d " #ifdef __sparc__ "irq %s\n", #else "irq %d\n", #endif device->chip.name, unit, device->chip.revision_id, device->slot.bus, (device->slot.device_fn & 0xf8) >> 3, device->slot.device_fn & 7, #ifdef __sparc__ __irq_itoa(device->slot.irq)); #else device->slot.irq); #endif /* ** Allocate host_data structure */ if (!(instance = scsi_register(tpnt, sizeof(*host_data)))) goto attach_error; host_data = (struct host_data *) instance->hostdata; /* ** Allocate the host control block. */ np = __m_calloc_dma(device->pdev, sizeof(struct ncb), "NCB"); if (!np) goto attach_error; NCR_INIT_LOCK_NCB(np); np->pdev = device->pdev; np->p_ncb = vtobus(np); host_data->ncb = np; /* ** Store input informations in the host data structure. */ strncpy(np->chip_name, device->chip.name, sizeof(np->chip_name) - 1); np->unit = unit; np->verbose = driver_setup.verbose; sprintf(np->inst_name, NAME53C "%s-%d", np->chip_name, np->unit); np->device_id = device->chip.device_id; np->revision_id = device->chip.revision_id; np->bus = device->slot.bus; np->device_fn = device->slot.device_fn; np->features = device->chip.features; np->clock_divn = device->chip.nr_divisor; np->maxoffs = device->chip.offset_max; np->maxburst = device->chip.burst_max; np->myaddr = device->host_id; /* ** Allocate the start queue. */ np->squeue = (ncrcmd *) m_calloc_dma(sizeof(ncrcmd)*(MAX_START*2), "SQUEUE"); if (!np->squeue) goto attach_error; np->p_squeue = vtobus(np->squeue); /* ** Allocate the done queue. */ np->dqueue = (ncrcmd *) m_calloc_dma(sizeof(ncrcmd)*(MAX_START*2), "DQUEUE"); if (!np->dqueue) goto attach_error; /* ** Allocate the target bus address array. */ np->targtbl = (u_int32 *) m_calloc_dma(256, "TARGTBL"); if (!np->targtbl) goto attach_error; /* ** Allocate SCRIPTS areas */ np->script0 = (struct script *) m_calloc_dma(sizeof(struct script), "SCRIPT"); if (!np->script0) goto attach_error; np->scripth0 = (struct scripth *) m_calloc_dma(sizeof(struct scripth), "SCRIPTH"); if (!np->scripth0) goto attach_error; /* ** Initialize the CCB free queue and, ** allocate some CCB. We need at least ONE. */ xpt_que_init(&np->free_ccbq); xpt_que_init(&np->b0_ccbq); if (!ncr_alloc_ccb(np)) goto attach_error; /* ** Initialize timer structure ** */ init_timer(&np->timer); np->timer.data = (unsigned long) np; np->timer.function = sym53c8xx_timeout; /* ** Try to map the controller chip to ** virtual and physical memory. */ np->base_ba = device->slot.base; np->base_ws = (np->features & FE_IO256)? 256 : 128; np->base2_ba = (np->features & FE_RAM)? device->slot.base_2 : 0; #ifndef SCSI_NCR_IOMAPPED np->base_va = remap_pci_mem(device->slot.base_c, np->base_ws); if (!np->base_va) { printk(KERN_ERR "%s: can't map PCI MMIO region\n",ncr_name(np)); goto attach_error; } else if (bootverbose > 1) printk(KERN_INFO "%s: using memory mapped IO\n", ncr_name(np)); /* ** Make the controller's registers available. ** Now the INB INW INL OUTB OUTW OUTL macros ** can be used safely. */ np->reg = (struct ncr_reg *) np->base_va; #endif /* !defined SCSI_NCR_IOMAPPED */ /* ** If on-chip RAM is used, make sure SCRIPTS isn't too large. */ if (np->base2_ba && sizeof(struct script) > 4096) { printk(KERN_ERR "%s: script too large.\n", ncr_name(np)); goto attach_error; } /* ** Try to map the controller chip into iospace. */ if (device->slot.io_port) { request_region(device->slot.io_port, np->base_ws, NAME53C8XX); np->base_io = device->slot.io_port; } #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvram) { switch(nvram->type) { case SCSI_NCR_SYMBIOS_NVRAM: #ifdef SCSI_NCR_DEBUG_NVRAM ncr_display_Symbios_nvram(np, &nvram->data.Symbios); #endif break; case SCSI_NCR_TEKRAM_NVRAM: #ifdef SCSI_NCR_DEBUG_NVRAM ncr_display_Tekram_nvram(np, &nvram->data.Tekram); #endif break; default: nvram = 0; #ifdef SCSI_NCR_DEBUG_NVRAM printk(KERN_DEBUG "%s: NVRAM: None or invalid data.\n", ncr_name(np)); #endif } } #endif /* ** Save setting of some IO registers, so we will ** be able to probe specific implementations. */ ncr_save_initial_setting (np); /* ** Reset the chip now, since it has been reported ** that SCSI clock calibration may not work properly ** if the chip is currently active. */ ncr_chip_reset (np); /* ** Do chip dependent initialization. */ (void) ncr_prepare_setting(np, nvram); /* ** Check the PCI clock frequency if needed. ** ** Must be done after ncr_prepare_setting since it destroys ** STEST1 that is used to probe for the clock multiplier. ** ** The range is currently [22688 - 45375 Khz], given ** the values used by ncr_getclock(). ** This calibration of the frequecy measurement ** algorithm against the PCI clock frequency is only ** performed if the driver has had to measure the SCSI ** clock due to other heuristics not having been enough ** to deduce the SCSI clock frequency. ** ** When the chip has been initialized correctly by the ** SCSI BIOS, the driver deduces the presence of the ** clock multiplier and the value of the SCSI clock from ** initial values of IO registers, and therefore no ** clock measurement is performed. ** Normally the driver should never have to measure any ** clock, unless the controller may use a 80 MHz clock ** or has a clock multiplier and any of the following ** condition is met: ** ** - No SCSI BIOS is present. ** - SCSI BIOS didn't enable the multiplier for some reason. ** - User has disabled the controller from the SCSI BIOS. ** - User booted the O/S from another O/S that didn't enable ** the multiplier for some reason. ** ** As a result, the driver may only have to measure some ** frequency in very unusual situations. ** ** For this reality test against the PCI clock to really ** protect against flaws in the udelay() calibration or ** driver problem that affect the clock measurement ** algorithm, the actual PCI clock frequency must be 33 MHz. */ i = np->pciclock_max ? ncr_getpciclock(np) : 0; if (i && (i < np->pciclock_min || i > np->pciclock_max)) { printk(KERN_ERR "%s: PCI clock (%u KHz) is out of range " "[%u KHz - %u KHz].\n", ncr_name(np), i, np->pciclock_min, np->pciclock_max); goto attach_error; } /* ** Patch script to physical addresses */ ncr_script_fill (&script0, &scripth0); np->p_script = vtobus(np->script0); np->p_scripth = vtobus(np->scripth0); np->p_scripth0 = np->p_scripth; if (np->base2_ba) { np->p_script = np->base2_ba; if (np->features & FE_RAM8K) { np->base2_ws = 8192; np->p_scripth = np->p_script + 4096; #if BITS_PER_LONG > 32 np->scr_ram_seg = cpu_to_scr(np->base2_ba >> 32); #endif } else np->base2_ws = 4096; #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED np->base2_va = remap_pci_mem(device->slot.base_2_c, np->base2_ws); if (!np->base2_va) { printk(KERN_ERR "%s: can't map PCI MEMORY region\n", ncr_name(np)); goto attach_error; } #endif } ncr_script_copy_and_bind (np, (ncrcmd *) &script0, (ncrcmd *) np->script0, sizeof(struct script)); ncr_script_copy_and_bind (np, (ncrcmd *) &scripth0, (ncrcmd *) np->scripth0, sizeof(struct scripth)); /* ** Patch some variables in SCRIPTS */ np->scripth0->pm0_data_addr[0] = cpu_to_scr(NCB_SCRIPT_PHYS(np, pm0_data)); np->scripth0->pm1_data_addr[0] = cpu_to_scr(NCB_SCRIPT_PHYS(np, pm1_data)); /* ** Patch if not Ultra 3 - Do not write to scntl4 */ if (np->features & FE_ULTRA3) { np->script0->resel_scntl4[0] = cpu_to_scr(SCR_LOAD_REL (scntl4, 1)); np->script0->resel_scntl4[1] = cpu_to_scr(offsetof(struct tcb, uval)); } #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED np->scripth0->script0_ba[0] = cpu_to_scr(vtobus(np->script0)); np->scripth0->script0_ba64[0] = cpu_to_scr(vtobus(np->script0)); np->scripth0->scripth0_ba64[0] = cpu_to_scr(vtobus(np->scripth0)); np->scripth0->ram_seg64[0] = np->scr_ram_seg; #endif /* ** Prepare the idle and invalid task actions. */ np->idletask.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->idletask.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_idletask = NCB_PHYS(np, idletask); np->notask.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->notask.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_notask = NCB_PHYS(np, notask); np->bad_i_t_l.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->bad_i_t_l.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np, bad_i_t_l)); np->p_bad_i_t_l = NCB_PHYS(np, bad_i_t_l); np->bad_i_t_l_q.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); np->bad_i_t_l_q.restart = cpu_to_scr(NCB_SCRIPTH_PHYS (np,bad_i_t_l_q)); np->p_bad_i_t_l_q = NCB_PHYS(np, bad_i_t_l_q); /* ** Allocate and prepare the bad lun table. */ np->badluntbl = m_calloc_dma(256, "BADLUNTBL"); if (!np->badluntbl) goto attach_error; assert (offsetof(struct lcb, resel_task) == 0); np->resel_badlun = cpu_to_scr(NCB_SCRIPTH_PHYS(np, resel_bad_lun)); for (i = 0 ; i < 64 ; i++) np->badluntbl[i] = cpu_to_scr(NCB_PHYS(np, resel_badlun)); /* ** Prepare the target bus address array. */ np->scripth0->targtbl[0] = cpu_to_scr(vtobus(np->targtbl)); for (i = 0 ; i < MAX_TARGET ; i++) { np->targtbl[i] = cpu_to_scr(NCB_PHYS(np, target[i])); np->target[i].b_luntbl = cpu_to_scr(vtobus(np->badluntbl)); np->target[i].b_lun0 = cpu_to_scr(NCB_PHYS(np, resel_badlun)); } /* ** Patch the script for LED support. */ if (np->features & FE_LED0) { np->script0->idle[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_OR, 0x01)); np->script0->reselected[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_AND, 0xfe)); np->script0->start[0] = cpu_to_scr(SCR_REG_REG(gpreg, SCR_AND, 0xfe)); } /* ** Patch the script to provide an extra clock cycle on ** data out phase - 53C1010_66MHz part only. ** (Fixed in rev. 1 of the chip) */ if (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 && np->revision_id < 1){ np->script0->datao_phase[0] = cpu_to_scr(SCR_REG_REG(scntl4, SCR_OR, 0x0c)); } #ifdef SCSI_NCR_IARB_SUPPORT /* ** If user does not want to use IMMEDIATE ARBITRATION ** when we are reselected while attempting to arbitrate, ** patch the SCRIPTS accordingly with a SCRIPT NO_OP. */ if (!(driver_setup.iarb & 1)) np->script0->ungetjob[0] = cpu_to_scr(SCR_NO_OP); /* ** If user wants IARB to be set when we win arbitration ** and have other jobs, compute the max number of consecutive ** settings of IARB hint before we leave devices a chance to ** arbitrate for reselection. */ np->iarb_max = (driver_setup.iarb >> 4); #endif /* ** DEL 472 - 53C896 Rev 1 - Part Number 609-0393055 - ITEM 5. */ if (np->device_id == PCI_DEVICE_ID_NCR_53C896 && np->revision_id <= 0x1 && (np->features & FE_NOPM)) { np->scatter = ncr_scatter_896R1; np->script0->datai_phase[0] = cpu_to_scr(SCR_JUMP); np->script0->datai_phase[1] = cpu_to_scr(NCB_SCRIPTH_PHYS (np, tweak_pmj)); np->script0->datao_phase[0] = cpu_to_scr(SCR_JUMP); np->script0->datao_phase[1] = cpu_to_scr(NCB_SCRIPTH_PHYS (np, tweak_pmj)); } else #ifdef DEBUG_896R1 np->scatter = ncr_scatter_896R1; #else np->scatter = ncr_scatter; #endif /* ** Reset chip. ** We should use ncr_soft_reset(), but we donnot want to do ** so, since we may not be safe if ABRT interrupt occurs due ** to the BIOS or previous O/S having enable this interrupt. ** ** For C1010 need to set ABRT bit prior to SRST if SCRIPTs ** are running. Not true in this case. */ ncr_chip_reset(np); /* ** Now check the cache handling of the pci chipset. */ if (ncr_snooptest (np)) { printk (KERN_ERR "CACHE INCORRECTLY CONFIGURED.\n"); goto attach_error; }; /* ** Install the interrupt handler. ** If we support the C code with SCRIPTS on interrupt, ** we donnot want to share the INTR line at all. */ if (request_irq(device->slot.irq, sym53c8xx_intr, #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR ((driver_setup.irqm & 0x20) ? 0 : SA_INTERRUPT), #else ((driver_setup.irqm & 0x10) ? 0 : SA_SHIRQ) | #if LINUX_VERSION_CODE < KERNEL_VERSION(2,2,0) ((driver_setup.irqm & 0x20) ? 0 : SA_INTERRUPT), #else 0, #endif #endif NAME53C8XX, np)) { printk(KERN_ERR "%s: request irq %d failure\n", ncr_name(np), device->slot.irq); goto attach_error; } np->irq = device->slot.irq; /* ** After SCSI devices have been opened, we cannot ** reset the bus safely, so we do it here. ** Interrupt handler does the real work. ** Process the reset exception, ** if interrupts are not enabled yet. ** Then enable disconnects. */ NCR_LOCK_NCB(np, flags); if (ncr_reset_scsi_bus(np, 0, driver_setup.settle_delay) != 0) { printk(KERN_ERR "%s: FATAL ERROR: CHECK SCSI BUS - CABLES, TERMINATION, DEVICE POWER etc.!\n", ncr_name(np)); NCR_UNLOCK_NCB(np, flags); goto attach_error; } ncr_exception (np); /* ** The middle-level SCSI driver does not ** wait for devices to settle. ** Wait synchronously if more than 2 seconds. */ if (driver_setup.settle_delay > 2) { printk(KERN_INFO "%s: waiting %d seconds for scsi devices to settle...\n", ncr_name(np), driver_setup.settle_delay); MDELAY (1000 * driver_setup.settle_delay); } /* ** start the timeout daemon */ np->lasttime=0; ncr_timeout (np); /* ** use SIMPLE TAG messages by default */ #ifdef SCSI_NCR_ALWAYS_SIMPLE_TAG np->order = M_SIMPLE_TAG; #endif /* ** Done. ** Fill Linux host instance structure ** and return success. */ instance->max_channel = 0; instance->this_id = np->myaddr; instance->max_id = np->maxwide ? 16 : 8; instance->max_lun = MAX_LUN; #ifndef SCSI_NCR_IOMAPPED #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,29) instance->base = (unsigned long) np->reg; #else instance->base = (char *) np->reg; #endif #endif instance->irq = np->irq; instance->unique_id = np->base_io; instance->io_port = np->base_io; instance->n_io_port = np->base_ws; instance->dma_channel = 0; instance->cmd_per_lun = MAX_TAGS; instance->can_queue = (MAX_START-4); scsi_set_device(instance, &device->pdev->dev); np->check_integrity = 0; #ifdef SCSI_NCR_INTEGRITY_CHECKING instance->check_integrity = 0; #ifdef SCSI_NCR_ENABLE_INTEGRITY_CHECK if ( !(driver_setup.bus_check & 0x04) ) { np->check_integrity = 1; instance->check_integrity = 1; } #endif #endif NCR_UNLOCK_NCB(np, flags); /* ** Now let the generic SCSI driver ** look for the SCSI devices on the bus .. */ return 0; attach_error: if (!instance) return -1; printk(KERN_INFO "%s: giving up ...\n", ncr_name(np)); if (np) ncr_free_resources(np); scsi_unregister(instance); return -1; } /* ** Free controller resources. */ static void ncr_free_resources(ncb_p np) { ccb_p cp; tcb_p tp; lcb_p lp; int target, lun; if (np->irq) free_irq(np->irq, np); if (np->base_io) release_region(np->base_io, np->base_ws); #ifndef SCSI_NCR_PCI_MEM_NOT_SUPPORTED if (np->base_va) unmap_pci_mem(np->base_va, np->base_ws); if (np->base2_va) unmap_pci_mem(np->base2_va, np->base2_ws); #endif if (np->scripth0) m_free_dma(np->scripth0, sizeof(struct scripth), "SCRIPTH"); if (np->script0) m_free_dma(np->script0, sizeof(struct script), "SCRIPT"); if (np->squeue) m_free_dma(np->squeue, sizeof(ncrcmd)*(MAX_START*2), "SQUEUE"); if (np->dqueue) m_free_dma(np->dqueue, sizeof(ncrcmd)*(MAX_START*2),"DQUEUE"); while ((cp = np->ccbc) != NULL) { np->ccbc = cp->link_ccb; m_free_dma(cp, sizeof(*cp), "CCB"); } if (np->badluntbl) m_free_dma(np->badluntbl, 256,"BADLUNTBL"); for (target = 0; target < MAX_TARGET ; target++) { tp = &np->target[target]; for (lun = 0 ; lun < MAX_LUN ; lun++) { lp = ncr_lp(np, tp, lun); if (!lp) continue; if (lp->tasktbl != &lp->tasktbl_0) m_free_dma(lp->tasktbl, MAX_TASKS*4, "TASKTBL"); if (lp->cb_tags) m_free(lp->cb_tags, MAX_TAGS, "CB_TAGS"); m_free_dma(lp, sizeof(*lp), "LCB"); } #if MAX_LUN > 1 if (tp->lmp) m_free(tp->lmp, MAX_LUN * sizeof(lcb_p), "LMP"); if (tp->luntbl) m_free_dma(tp->luntbl, 256, "LUNTBL"); #endif } if (np->targtbl) m_free_dma(np->targtbl, 256, "TARGTBL"); m_free_dma(np, sizeof(*np), "NCB"); } /*========================================================== ** ** ** Done SCSI commands list management. ** ** We donnot enter the scsi_done() callback immediately ** after a command has been seen as completed but we ** insert it into a list which is flushed outside any kind ** of driver critical section. ** This allows to do minimal stuff under interrupt and ** inside critical sections and to also avoid locking up ** on recursive calls to driver entry points under SMP. ** In fact, the only kernel point which is entered by the ** driver with a driver lock set is get_free_pages(GFP_ATOMIC...) ** that shall not reenter the driver under any circumstance. ** **========================================================== */ static inline void ncr_queue_done_cmd(ncb_p np, Scsi_Cmnd *cmd) { unmap_scsi_data(np, cmd); cmd->host_scribble = (char *) np->done_list; np->done_list = cmd; } static inline void ncr_flush_done_cmds(Scsi_Cmnd *lcmd) { Scsi_Cmnd *cmd; while (lcmd) { cmd = lcmd; lcmd = (Scsi_Cmnd *) cmd->host_scribble; cmd->scsi_done(cmd); } } /*========================================================== ** ** ** Prepare the next negotiation message for integrity check, ** if needed. ** ** Fill in the part of message buffer that contains the ** negotiation and the nego_status field of the CCB. ** Returns the size of the message in bytes. ** ** If tp->ppr_negotiation is 1 and a M_REJECT occurs, then ** we disable ppr_negotiation. If the first ppr_negotiation is ** successful, set this flag to 2. ** **========================================================== */ #ifdef SCSI_NCR_INTEGRITY_CHECKING static int ncr_ic_nego(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd, u_char *msgptr) { tcb_p tp = &np->target[cp->target]; int msglen = 0; int nego = 0; u_char new_width, new_offset, new_period; u_char no_increase; if (tp->ppr_negotiation == 1) /* PPR message successful */ tp->ppr_negotiation = 2; if (tp->inq_done) { if (!tp->ic_maximums_set) { tp->ic_maximums_set = 1; /* * Check against target, host and user limits */ if ( (tp->inq_byte7 & INQ7_WIDE16) && np->maxwide && tp->usrwide) tp->ic_max_width = 1; else tp->ic_max_width = 0; if ((tp->inq_byte7 & INQ7_SYNC) && tp->maxoffs) tp->ic_min_sync = (tp->minsync < np->minsync) ? np->minsync : tp->minsync; else tp->ic_min_sync = 255; tp->period = 1; tp->widedone = 1; /* * Enable PPR negotiation - only if Ultra3 support * is accessible. */ #if 0 if (tp->ic_max_width && (tp->ic_min_sync != 255 )) tp->ppr_negotiation = 1; #endif tp->ppr_negotiation = 0; if (np->features & FE_ULTRA3) { if (tp->ic_max_width && (tp->ic_min_sync == 0x09)) tp->ppr_negotiation = 1; } if (!tp->ppr_negotiation) cmd->ic_nego &= ~NS_PPR; } if (DEBUG_FLAGS & DEBUG_IC) { printk("%s: cmd->ic_nego %d, 1st byte 0x%2X\n", ncr_name(np), cmd->ic_nego, cmd->cmnd[0]); } /* Previous command recorded a parity or an initiator * detected error condition. Force bus to narrow for this * target. Clear flag. Negotiation on request sense. * Note: kernel forces 2 bus resets :o( but clears itself out. * Minor bug? in scsi_obsolete.c (ugly) */ if (np->check_integ_par) { printk("%s: Parity Error. Target set to narrow.\n", ncr_name(np)); tp->ic_max_width = 0; tp->widedone = tp->period = 0; } /* Initializing: * If ic_nego == NS_PPR, we are in the initial test for * PPR messaging support. If driver flag is clear, then * either we don't support PPR nego (narrow or async device) * or this is the second TUR and we have had a M. REJECT * or unexpected disconnect on the first PPR negotiation. * Do not negotiate, reset nego flags (in case a reset has * occurred), clear ic_nego and return. * General case: Kernel will clear flag on a fallback. * Do only SDTR or WDTR in the future. */ if (!tp->ppr_negotiation && (cmd->ic_nego == NS_PPR )) { tp->ppr_negotiation = 0; cmd->ic_nego &= ~NS_PPR; tp->widedone = tp->period = 1; return msglen; } else if (( tp->ppr_negotiation && !(cmd->ic_nego & NS_PPR )) || (!tp->ppr_negotiation && (cmd->ic_nego & NS_PPR )) ) { tp->ppr_negotiation = 0; cmd->ic_nego &= ~NS_PPR; } /* * Always check the PPR nego. flag bit if ppr_negotiation * is set. If the ic_nego PPR bit is clear, * there must have been a fallback. Do only * WDTR / SDTR in the future. */ if ((tp->ppr_negotiation) && (!(cmd->ic_nego & NS_PPR))) tp->ppr_negotiation = 0; /* In case of a bus reset, ncr_negotiate will reset * the flags tp->widedone and tp->period to 0, forcing * a new negotiation. Do WDTR then SDTR. If PPR, do both. * Do NOT increase the period. It is possible for the Scsi_Cmnd * flags to be set to increase the period when a bus reset * occurs - we don't want to change anything. */ no_increase = 0; if (tp->ppr_negotiation && (!tp->widedone) && (!tp->period) ) { cmd->ic_nego = NS_PPR; tp->widedone = tp->period = 1; no_increase = 1; } else if (!tp->widedone) { cmd->ic_nego = NS_WIDE; tp->widedone = 1; no_increase = 1; } else if (!tp->period) { cmd->ic_nego = NS_SYNC; tp->period = 1; no_increase = 1; } new_width = cmd->ic_nego_width & tp->ic_max_width; switch (cmd->ic_nego_sync) { case 2: /* increase the period */ if (!no_increase) { if (tp->ic_min_sync <= 0x09) tp->ic_min_sync = 0x0A; else if (tp->ic_min_sync <= 0x0A) tp->ic_min_sync = 0x0C; else if (tp->ic_min_sync <= 0x0C) tp->ic_min_sync = 0x19; else if (tp->ic_min_sync <= 0x19) tp->ic_min_sync *= 2; else { tp->ic_min_sync = 255; cmd->ic_nego_sync = 0; tp->maxoffs = 0; } } new_period = tp->maxoffs?tp->ic_min_sync:0; new_offset = tp->maxoffs; break; case 1: /* nego. to maximum */ new_period = tp->maxoffs?tp->ic_min_sync:0; new_offset = tp->maxoffs; break; case 0: /* nego to async */ default: new_period = 0; new_offset = 0; break; }; nego = NS_NOCHANGE; if (tp->ppr_negotiation) { u_char options_byte = 0; /* ** Must make sure data is consistent. ** If period is 9 and sync, must be wide and DT bit set. ** else period must be larger. If the width is 0, ** reset bus to wide but increase the period to 0x0A. ** Note: The strange else clause is due to the integrity check. ** If fails at 0x09, wide, the I.C. code will redo at the same ** speed but a narrow bus. The driver must take care of slowing ** the bus speed down. ** ** The maximum offset in ST mode is 31, in DT mode 62 (1010/1010_66 only) */ if ( (new_period==0x09) && new_offset) { if (new_width) options_byte = 0x02; else { tp->ic_min_sync = 0x0A; new_period = 0x0A; cmd->ic_nego_width = 1; new_width = 1; } } if (!options_byte && new_offset > np->maxoffs_st) new_offset = np->maxoffs_st; nego = NS_PPR; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 6; msgptr[msglen++] = M_X_PPR_REQ; msgptr[msglen++] = new_period; msgptr[msglen++] = 0; msgptr[msglen++] = new_offset; msgptr[msglen++] = new_width; msgptr[msglen++] = options_byte; } else { switch (cmd->ic_nego & ~NS_PPR) { case NS_WIDE: /* ** WDTR negotiation on if device supports ** wide or if wide device forced narrow ** due to a parity error. */ cmd->ic_nego_width &= tp->ic_max_width; if (tp->ic_max_width | np->check_integ_par) { nego = NS_WIDE; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 2; msgptr[msglen++] = M_X_WIDE_REQ; msgptr[msglen++] = new_width; } break; case NS_SYNC: /* ** negotiate synchronous transfers ** Target must support sync transfers. ** Min. period = 0x0A, maximum offset of 31=0x1f. */ if (tp->inq_byte7 & INQ7_SYNC) { if (new_offset && (new_period < 0x0A)) { tp->ic_min_sync = 0x0A; new_period = 0x0A; } if (new_offset > np->maxoffs_st) new_offset = np->maxoffs_st; nego = NS_SYNC; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 3; msgptr[msglen++] = M_X_SYNC_REQ; msgptr[msglen++] = new_period; msgptr[msglen++] = new_offset; } else cmd->ic_nego_sync = 0; break; case NS_NOCHANGE: break; } } }; cp->nego_status = nego; np->check_integ_par = 0; if (nego) { tp->nego_cp = cp; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, nego == NS_WIDE ? "wide/narrow msgout": (nego == NS_SYNC ? "sync/async msgout" : "ppr msgout"), msgptr); }; }; return msglen; } #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /*========================================================== ** ** ** Prepare the next negotiation message if needed. ** ** Fill in the part of message buffer that contains the ** negotiation and the nego_status field of the CCB. ** Returns the size of the message in bytes. ** ** **========================================================== */ static int ncr_prepare_nego(ncb_p np, ccb_p cp, u_char *msgptr) { tcb_p tp = &np->target[cp->target]; int msglen = 0; int nego = 0; u_char width, offset, factor, last_byte; if (!np->check_integrity) { /* If integrity checking disabled, enable PPR messaging * if device supports wide, sync and ultra 3 */ if (tp->ppr_negotiation == 1) /* PPR message successful */ tp->ppr_negotiation = 2; if ((tp->inq_done) && (!tp->ic_maximums_set)) { tp->ic_maximums_set = 1; /* * Issue PPR only if board is capable * and set-up for Ultra3 transfers. */ tp->ppr_negotiation = 0; if ( (np->features & FE_ULTRA3) && (tp->usrwide) && (tp->maxoffs) && (tp->minsync == 0x09) ) tp->ppr_negotiation = 1; } } if (tp->inq_done) { /* * Get the current width, offset and period */ ncr_get_xfer_info( np, tp, &factor, &offset, &width); /* ** negotiate wide transfers ? */ if (!tp->widedone) { if (tp->inq_byte7 & INQ7_WIDE16) { if (tp->ppr_negotiation) nego = NS_PPR; else nego = NS_WIDE; width = tp->usrwide; #ifdef SCSI_NCR_INTEGRITY_CHECKING if (tp->ic_done) width &= tp->ic_max_width; #endif } else tp->widedone=1; }; /* ** negotiate synchronous transfers? */ if ((nego != NS_WIDE) && !tp->period) { if (tp->inq_byte7 & INQ7_SYNC) { if (tp->ppr_negotiation) nego = NS_PPR; else nego = NS_SYNC; /* Check for async flag */ if (tp->maxoffs == 0) { offset = 0; factor = 0; } else { offset = tp->maxoffs; factor = tp->minsync; #ifdef SCSI_NCR_INTEGRITY_CHECKING if ((tp->ic_done) && (factor < tp->ic_min_sync)) factor = tp->ic_min_sync; #endif } } else { offset = 0; factor = 0; tp->period =0xffff; PRINT_TARGET(np, cp->target); printk ("target did not report SYNC.\n"); }; }; }; switch (nego) { case NS_PPR: /* ** Must make sure data is consistent. ** If period is 9 and sync, must be wide and DT bit set ** else period must be larger. ** Maximum offset is 31=0x1f is ST mode, 62 if DT mode */ last_byte = 0; if ( (factor==9) && offset) { if (!width) { factor = 0x0A; } else last_byte = 0x02; } if (!last_byte && offset > np->maxoffs_st) offset = np->maxoffs_st; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 6; msgptr[msglen++] = M_X_PPR_REQ; msgptr[msglen++] = factor; msgptr[msglen++] = 0; msgptr[msglen++] = offset; msgptr[msglen++] = width; msgptr[msglen++] = last_byte; break; case NS_SYNC: /* ** Never negotiate faster than Ultra 2 (25ns periods) */ if (offset && (factor < 0x0A)) { factor = 0x0A; tp->minsync = 0x0A; } if (offset > np->maxoffs_st) offset = np->maxoffs_st; msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 3; msgptr[msglen++] = M_X_SYNC_REQ; msgptr[msglen++] = factor; msgptr[msglen++] = offset; break; case NS_WIDE: msgptr[msglen++] = M_EXTENDED; msgptr[msglen++] = 2; msgptr[msglen++] = M_X_WIDE_REQ; msgptr[msglen++] = width; break; }; cp->nego_status = nego; if (nego) { tp->nego_cp = cp; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, nego == NS_WIDE ? "wide msgout": (nego == NS_SYNC ? "sync msgout" : "ppr msgout"), msgptr); }; }; return msglen; } /*========================================================== ** ** ** Start execution of a SCSI command. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_queue_command (ncb_p np, Scsi_Cmnd *cmd) { /* Scsi_Device *device = cmd->device; */ tcb_p tp = &np->target[cmd->device->id]; lcb_p lp = ncr_lp(np, tp, cmd->device->lun); ccb_p cp; u_char idmsg, *msgptr; u_int msglen; int direction; u_int32 lastp, goalp; /*--------------------------------------------- ** ** Some shortcuts ... ** **--------------------------------------------- */ if ((cmd->device->id == np->myaddr ) || (cmd->device->id >= MAX_TARGET) || (cmd->device->lun >= MAX_LUN )) { return(DID_BAD_TARGET); } /*--------------------------------------------- ** ** Complete the 1st TEST UNIT READY command ** with error condition if the device is ** flagged NOSCAN, in order to speed up ** the boot. ** **--------------------------------------------- */ if ((cmd->cmnd[0] == 0 || cmd->cmnd[0] == 0x12) && (tp->usrflag & UF_NOSCAN)) { tp->usrflag &= ~UF_NOSCAN; return DID_BAD_TARGET; } if (DEBUG_FLAGS & DEBUG_TINY) { PRINT_ADDR(cmd); printk ("CMD=%x ", cmd->cmnd[0]); } /*--------------------------------------------------- ** ** Assign a ccb / bind cmd. ** If resetting, shorten settle_time if necessary ** in order to avoid spurious timeouts. ** If resetting or no free ccb, ** insert cmd into the waiting list. ** **---------------------------------------------------- */ if (np->settle_time && cmd->timeout_per_command >= HZ) { u_long tlimit = ktime_get(cmd->timeout_per_command - HZ); if (ktime_dif(np->settle_time, tlimit) > 0) np->settle_time = tlimit; } if (np->settle_time || !(cp=ncr_get_ccb (np, cmd->device->id, cmd->device->lun))) { insert_into_waiting_list(np, cmd); return(DID_OK); } cp->cmd = cmd; /*--------------------------------------------------- ** ** Enable tagged queue if asked by scsi ioctl ** **---------------------------------------------------- */ #if 0 /* This stuff was only useful for linux-1.2.13 */ if (lp && !lp->numtags && cmd->device && cmd->device->tagged_queue) { lp->numtags = tp->usrtags; ncr_setup_tags (np, cp->target, cp->lun); } #endif /*---------------------------------------------------- ** ** Build the identify / tag / sdtr message ** **---------------------------------------------------- */ idmsg = M_IDENTIFY | cp->lun; if (cp ->tag != NO_TAG || (lp && !(tp->usrflag & UF_NODISC))) idmsg |= 0x40; msgptr = cp->scsi_smsg; msglen = 0; msgptr[msglen++] = idmsg; if (cp->tag != NO_TAG) { char order = np->order; /* ** Force ordered tag if necessary to avoid timeouts ** and to preserve interactivity. */ if (lp && ktime_exp(lp->tags_stime)) { lp->tags_si = !(lp->tags_si); if (lp->tags_sum[lp->tags_si]) { order = M_ORDERED_TAG; if ((DEBUG_FLAGS & DEBUG_TAGS)||bootverbose>0){ PRINT_ADDR(cmd); printk("ordered tag forced.\n"); } } lp->tags_stime = ktime_get(3*HZ); } if (order == 0) { /* ** Ordered write ops, unordered read ops. */ switch (cmd->cmnd[0]) { case 0x08: /* READ_SMALL (6) */ case 0x28: /* READ_BIG (10) */ case 0xa8: /* READ_HUGE (12) */ order = M_SIMPLE_TAG; break; default: order = M_ORDERED_TAG; } } msgptr[msglen++] = order; /* ** For less than 128 tags, actual tags are numbered ** 1,3,5,..2*MAXTAGS+1,since we may have to deal ** with devices that have problems with #TAG 0 or too ** great #TAG numbers. For more tags (up to 256), ** we use directly our tag number. */ #if MAX_TASKS > (512/4) msgptr[msglen++] = cp->tag; #else msgptr[msglen++] = (cp->tag << 1) + 1; #endif } cp->host_flags = 0; /*---------------------------------------------------- ** ** Build the data descriptors ** **---------------------------------------------------- */ direction = scsi_data_direction(cmd); if (direction != SCSI_DATA_NONE) { cp->segments = np->scatter (np, cp, cp->cmd); if (cp->segments < 0) { ncr_free_ccb(np, cp); return(DID_ERROR); } } else { cp->data_len = 0; cp->segments = 0; } /*--------------------------------------------------- ** ** negotiation required? ** ** (nego_status is filled by ncr_prepare_nego()) ** **--------------------------------------------------- */ cp->nego_status = 0; #ifdef SCSI_NCR_INTEGRITY_CHECKING if ((np->check_integrity && tp->ic_done) || !np->check_integrity) { if ((!tp->widedone || !tp->period) && !tp->nego_cp && lp) { msglen += ncr_prepare_nego (np, cp, msgptr + msglen); } } else if (np->check_integrity && (cmd->ic_in_progress)) { msglen += ncr_ic_nego (np, cp, cmd, msgptr + msglen); } else if (np->check_integrity && cmd->ic_complete) { u_long current_period; u_char current_offset, current_width, current_factor; ncr_get_xfer_info (np, tp, ¤t_factor, ¤t_offset, ¤t_width); tp->ic_max_width = current_width; tp->ic_min_sync = current_factor; if (current_factor == 9) current_period = 125; else if (current_factor == 10) current_period = 250; else if (current_factor == 11) current_period = 303; else if (current_factor == 12) current_period = 500; else current_period = current_factor * 40; /* * Negotiation for this target is complete. Update flags. */ tp->period = current_period; tp->widedone = 1; tp->ic_done = 1; printk("%s: Integrity Check Complete: \n", ncr_name(np)); printk("%s: %s %s SCSI", ncr_name(np), current_offset?"SYNC":"ASYNC", tp->ic_max_width?"WIDE":"NARROW"); if (current_offset) { u_long mbs = 10000 * (tp->ic_max_width + 1); printk(" %d.%d MB/s", (int) (mbs / current_period), (int) (mbs % current_period)); printk(" (%d ns, %d offset)\n", (int) current_period/10, current_offset); } else printk(" %d MB/s. \n ", (tp->ic_max_width+1)*5); } #else if ((!tp->widedone || !tp->period) && !tp->nego_cp && lp) { msglen += ncr_prepare_nego (np, cp, msgptr + msglen); } #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /*---------------------------------------------------- ** ** Determine xfer direction. ** **---------------------------------------------------- */ if (!cp->data_len) direction = SCSI_DATA_NONE; /* ** If data direction is UNKNOWN, speculate DATA_READ ** but prepare alternate pointers for WRITE in case ** of our speculation will be just wrong. ** SCRIPTS will swap values if needed. */ switch(direction) { case SCSI_DATA_UNKNOWN: case SCSI_DATA_WRITE: goalp = NCB_SCRIPT_PHYS (np, data_out2) + 8; lastp = goalp - 8 - (cp->segments * (SCR_SG_SIZE*4)); if (direction != SCSI_DATA_UNKNOWN) break; cp->phys.header.wgoalp = cpu_to_scr(goalp); cp->phys.header.wlastp = cpu_to_scr(lastp); /* fall through */ case SCSI_DATA_READ: cp->host_flags |= HF_DATA_IN; goalp = NCB_SCRIPT_PHYS (np, data_in2) + 8; lastp = goalp - 8 - (cp->segments * (SCR_SG_SIZE*4)); break; default: case SCSI_DATA_NONE: lastp = goalp = NCB_SCRIPTH_PHYS (np, no_data); break; } /* ** Set all pointers values needed by SCRIPTS. ** If direction is unknown, start at data_io. */ cp->phys.header.lastp = cpu_to_scr(lastp); cp->phys.header.goalp = cpu_to_scr(goalp); if (direction == SCSI_DATA_UNKNOWN) cp->phys.header.savep = cpu_to_scr(NCB_SCRIPTH_PHYS (np, data_io)); else cp->phys.header.savep= cpu_to_scr(lastp); /* ** Save the initial data pointer in order to be able ** to redo the command. ** We also have to save the initial lastp, since it ** will be changed to DATA_IO if we don't know the data ** direction and the device completes the command with ** QUEUE FULL status (without entering the data phase). */ cp->startp = cp->phys.header.savep; cp->lastp0 = cp->phys.header.lastp; /*---------------------------------------------------- ** ** fill in ccb ** **---------------------------------------------------- ** ** ** physical -> virtual backlink ** Generic SCSI command */ /* ** Startqueue */ cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np,select)); cp->phys.header.go.restart = cpu_to_scr(NCB_SCRIPT_PHYS (np,resel_dsa)); /* ** select */ cp->phys.select.sel_id = cp->target; cp->phys.select.sel_scntl3 = tp->wval; cp->phys.select.sel_sxfer = tp->sval; cp->phys.select.sel_scntl4 = tp->uval; /* ** message */ cp->phys.smsg.addr = cpu_to_scr(CCB_PHYS (cp, scsi_smsg)); cp->phys.smsg.size = cpu_to_scr(msglen); /* ** command */ memcpy(cp->cdb_buf, cmd->cmnd, MIN(cmd->cmd_len, sizeof(cp->cdb_buf))); cp->phys.cmd.addr = cpu_to_scr(CCB_PHYS (cp, cdb_buf[0])); cp->phys.cmd.size = cpu_to_scr(cmd->cmd_len); /* ** status */ cp->actualquirks = tp->quirks; cp->host_status = cp->nego_status ? HS_NEGOTIATE : HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->xerr_status = 0; cp->extra_bytes = 0; /* ** extreme data pointer. ** shall be positive, so -1 is lower than lowest.:) */ cp->ext_sg = -1; cp->ext_ofs = 0; /*---------------------------------------------------- ** ** Critical region: start this job. ** **---------------------------------------------------- */ /* ** activate this job. */ /* ** insert next CCBs into start queue. ** 2 max at a time is enough to flush the CCB wait queue. */ if (lp) ncr_start_next_ccb(np, lp, 2); else ncr_put_start_queue(np, cp); /* ** Command is successfully queued. */ return(DID_OK); } /*========================================================== ** ** ** Insert a CCB into the start queue and wake up the ** SCRIPTS processor. ** ** **========================================================== */ static void ncr_start_next_ccb(ncb_p np, lcb_p lp, int maxn) { XPT_QUEHEAD *qp; ccb_p cp; while (maxn-- && lp->queuedccbs < lp->queuedepth) { qp = xpt_remque_head(&lp->wait_ccbq); if (!qp) break; ++lp->queuedccbs; cp = xpt_que_entry(qp, struct ccb, link_ccbq); xpt_insque_tail(qp, &lp->busy_ccbq); lp->tasktbl[cp->tag == NO_TAG ? 0 : cp->tag] = cpu_to_scr(cp->p_ccb); ncr_put_start_queue(np, cp); } } static void ncr_put_start_queue(ncb_p np, ccb_p cp) { u_short qidx; #ifdef SCSI_NCR_IARB_SUPPORT /* ** If the previously queued CCB is not yet done, ** set the IARB hint. The SCRIPTS will go with IARB ** for this job when starting the previous one. ** We leave devices a chance to win arbitration by ** not using more than 'iarb_max' consecutive ** immediate arbitrations. */ if (np->last_cp && np->iarb_count < np->iarb_max) { np->last_cp->host_flags |= HF_HINT_IARB; ++np->iarb_count; } else np->iarb_count = 0; np->last_cp = cp; #endif /* ** insert into start queue. */ qidx = np->squeueput + 2; if (qidx >= MAX_START*2) qidx = 0; np->squeue [qidx] = cpu_to_scr(np->p_idletask); MEMORY_BARRIER(); np->squeue [np->squeueput] = cpu_to_scr(cp->p_ccb); np->squeueput = qidx; cp->queued = 1; if (DEBUG_FLAGS & DEBUG_QUEUE) printk ("%s: queuepos=%d.\n", ncr_name (np), np->squeueput); /* ** Script processor may be waiting for reselect. ** Wake it up. */ MEMORY_BARRIER(); OUTB (nc_istat, SIGP|np->istat_sem); } /*========================================================== ** ** Soft reset the chip. ** ** Some 896 and 876 chip revisions may hang-up if we set ** the SRST (soft reset) bit at the wrong time when SCRIPTS ** are running. ** So, we need to abort the current operation prior to ** soft resetting the chip. ** **========================================================== */ static void ncr_chip_reset (ncb_p np) { OUTB (nc_istat, SRST); UDELAY (10); OUTB (nc_istat, 0); } static void ncr_soft_reset(ncb_p np) { u_char istat; int i; if (!(np->features & FE_ISTAT1) || !(INB (nc_istat1) & SRUN)) goto do_chip_reset; OUTB (nc_istat, CABRT); for (i = 100000 ; i ; --i) { istat = INB (nc_istat); if (istat & SIP) { INW (nc_sist); } else if (istat & DIP) { if (INB (nc_dstat) & ABRT) break; } UDELAY(5); } OUTB (nc_istat, 0); if (!i) printk("%s: unable to abort current chip operation, " "ISTAT=0x%02x.\n", ncr_name(np), istat); do_chip_reset: ncr_chip_reset(np); } /*========================================================== ** ** ** Start reset process. ** The interrupt handler will reinitialize the chip. ** The timeout handler will wait for settle_time before ** clearing it and so resuming command processing. ** ** **========================================================== */ static void ncr_start_reset(ncb_p np) { (void) ncr_reset_scsi_bus(np, 1, driver_setup.settle_delay); } static int ncr_reset_scsi_bus(ncb_p np, int enab_int, int settle_delay) { u_int32 term; int retv = 0; np->settle_time = ktime_get(settle_delay * HZ); if (bootverbose > 1) printk("%s: resetting, " "command processing suspended for %d seconds\n", ncr_name(np), settle_delay); ncr_soft_reset(np); /* Soft reset the chip */ UDELAY (2000); /* The 895/6 need time for the bus mode to settle */ if (enab_int) OUTW (nc_sien, RST); /* ** Enable Tolerant, reset IRQD if present and ** properly set IRQ mode, prior to resetting the bus. */ OUTB (nc_stest3, TE); OUTB (nc_dcntl, (np->rv_dcntl & IRQM)); OUTB (nc_scntl1, CRST); UDELAY (200); if (!driver_setup.bus_check) goto out; /* ** Check for no terminators or SCSI bus shorts to ground. ** Read SCSI data bus, data parity bits and control signals. ** We are expecting RESET to be TRUE and other signals to be ** FALSE. */ term = INB(nc_sstat0); term = ((term & 2) << 7) + ((term & 1) << 17); /* rst sdp0 */ term |= ((INB(nc_sstat2) & 0x01) << 26) | /* sdp1 */ ((INW(nc_sbdl) & 0xff) << 9) | /* d7-0 */ ((INW(nc_sbdl) & 0xff00) << 10) | /* d15-8 */ INB(nc_sbcl); /* req ack bsy sel atn msg cd io */ if (!(np->features & FE_WIDE)) term &= 0x3ffff; if (term != (2<<7)) { printk("%s: suspicious SCSI data while resetting the BUS.\n", ncr_name(np)); printk("%s: %sdp0,d7-0,rst,req,ack,bsy,sel,atn,msg,c/d,i/o = " "0x%lx, expecting 0x%lx\n", ncr_name(np), (np->features & FE_WIDE) ? "dp1,d15-8," : "", (u_long)term, (u_long)(2<<7)); if (driver_setup.bus_check == 1) retv = 1; } out: OUTB (nc_scntl1, 0); return retv; } /*========================================================== ** ** ** Reset the SCSI BUS. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_reset_bus (ncb_p np, Scsi_Cmnd *cmd, int sync_reset) { /* Scsi_Device *device = cmd->device; */ ccb_p cp; int found; /* * Return immediately if reset is in progress. */ if (np->settle_time) { return SCSI_RESET_PUNT; } /* * Start the reset process. * The script processor is then assumed to be stopped. * Commands will now be queued in the waiting list until a settle * delay of 2 seconds will be completed. */ ncr_start_reset(np); /* * First, look in the wakeup list */ for (found=0, cp=np->ccbc; cp; cp=cp->link_ccb) { /* ** look for the ccb of this command. */ if (cp->host_status == HS_IDLE) continue; if (cp->cmd == cmd) { found = 1; break; } } /* * Then, look in the waiting list */ if (!found && retrieve_from_waiting_list(0, np, cmd)) found = 1; /* * Wake-up all awaiting commands with DID_RESET. */ reset_waiting_list(np); /* * Wake-up all pending commands with HS_RESET -> DID_RESET. */ ncr_wakeup(np, HS_RESET); /* * If the involved command was not in a driver queue, and the * scsi driver told us reset is synchronous, and the command is not * currently in the waiting list, complete it with DID_RESET status, * in order to keep it alive. */ if (!found && sync_reset && !retrieve_from_waiting_list(0, np, cmd)) { SetScsiResult(cmd, DID_RESET, 0); ncr_queue_done_cmd(np, cmd); } return SCSI_RESET_SUCCESS; } /*========================================================== ** ** ** Abort an SCSI command. ** This is called from the generic SCSI driver. ** ** **========================================================== */ static int ncr_abort_command (ncb_p np, Scsi_Cmnd *cmd) { /* Scsi_Device *device = cmd->device; */ ccb_p cp; /* * First, look for the scsi command in the waiting list */ if (remove_from_waiting_list(np, cmd)) { SetScsiAbortResult(cmd); ncr_queue_done_cmd(np, cmd); return SCSI_ABORT_SUCCESS; } /* * Then, look in the wakeup list */ for (cp=np->ccbc; cp; cp=cp->link_ccb) { /* ** look for the ccb of this command. */ if (cp->host_status == HS_IDLE) continue; if (cp->cmd == cmd) break; } if (!cp) { return SCSI_ABORT_NOT_RUNNING; } /* ** Keep track we have to abort this job. */ cp->to_abort = 1; /* ** Tell the SCRIPTS processor to stop ** and synchronize with us. */ np->istat_sem = SEM; /* ** If there are no requests, the script ** processor will sleep on SEL_WAIT_RESEL. ** Let's wake it up, since it may have to work. */ OUTB (nc_istat, SIGP|SEM); /* ** Tell user we are working for him. */ return SCSI_ABORT_PENDING; } /*========================================================== ** ** Linux release module stuff. ** ** Called before unloading the module ** Detach the host. ** We have to free resources and halt the NCR chip ** **========================================================== */ static int ncr_detach(ncb_p np) { int i; printk("%s: detaching ...\n", ncr_name(np)); /* ** Stop the ncr_timeout process ** Set release_stage to 1 and wait that ncr_timeout() set it to 2. */ np->release_stage = 1; for (i = 50 ; i && np->release_stage != 2 ; i--) MDELAY (100); if (np->release_stage != 2) printk("%s: the timer seems to be already stopped\n", ncr_name(np)); else np->release_stage = 2; /* ** Reset NCR chip. ** We should use ncr_soft_reset(), but we donnot want to do ** so, since we may not be safe if interrupts occur. */ printk("%s: resetting chip\n", ncr_name(np)); ncr_chip_reset(np); /* ** Restore bios setting for automatic clock detection. */ OUTB(nc_dmode, np->sv_dmode); OUTB(nc_dcntl, np->sv_dcntl); OUTB(nc_ctest3, np->sv_ctest3); OUTB(nc_ctest4, np->sv_ctest4); OUTB(nc_ctest5, np->sv_ctest5); OUTB(nc_gpcntl, np->sv_gpcntl); OUTB(nc_stest2, np->sv_stest2); ncr_selectclock(np, np->sv_scntl3); /* ** Free host resources */ ncr_free_resources(np); return 1; } /*========================================================== ** ** ** Complete execution of a SCSI command. ** Signal completion to the generic SCSI driver. ** ** **========================================================== */ void ncr_complete (ncb_p np, ccb_p cp) { Scsi_Cmnd *cmd; tcb_p tp; lcb_p lp; /* ** Sanity check */ if (!cp || !cp->cmd) return; /* ** Print some debugging info. */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("CCB=%lx STAT=%x/%x\n", (unsigned long)cp, cp->host_status,cp->scsi_status); /* ** Get command, target and lun pointers. */ cmd = cp->cmd; cp->cmd = NULL; tp = &np->target[cp->target]; lp = ncr_lp(np, tp, cp->lun); /* ** We donnot queue more than 1 ccb per target ** with negotiation at any time. If this ccb was ** used for negotiation, clear this info in the tcb. */ if (cp == tp->nego_cp) tp->nego_cp = 0; #ifdef SCSI_NCR_IARB_SUPPORT /* ** We just complete the last queued CCB. ** Clear this info that is no more relevant. */ if (cp == np->last_cp) np->last_cp = 0; #endif /* ** If auto-sense performed, change scsi status, ** Otherwise, compute the residual. */ if (cp->host_flags & HF_AUTO_SENSE) { cp->scsi_status = cp->sv_scsi_status; cp->xerr_status = cp->sv_xerr_status; } else { cp->resid = 0; if (cp->xerr_status || cp->phys.header.lastp != cp->phys.header.goalp) cp->resid = ncr_compute_residual(np, cp); } /* ** Check for extended errors. */ if (cp->xerr_status) { if (cp->xerr_status & XE_PARITY_ERR) { PRINT_ADDR(cmd); printk ("unrecovered SCSI parity error.\n"); } if (cp->xerr_status & XE_EXTRA_DATA) { PRINT_ADDR(cmd); printk ("extraneous data discarded.\n"); } if (cp->xerr_status & XE_BAD_PHASE) { PRINT_ADDR(cmd); printk ("illegal scsi phase (4/5).\n"); } if (cp->xerr_status & XE_SODL_UNRUN) { PRINT_ADDR(cmd); printk ("ODD transfer in DATA OUT phase.\n"); } if (cp->xerr_status & XE_SWIDE_OVRUN){ PRINT_ADDR(cmd); printk ("ODD transfer in DATA IN phase.\n"); } if (cp->host_status==HS_COMPLETE) cp->host_status = HS_FAIL; } /* ** Print out any error for debugging purpose. */ if (DEBUG_FLAGS & (DEBUG_RESULT|DEBUG_TINY)) { if (cp->host_status!=HS_COMPLETE || cp->scsi_status!=S_GOOD || cp->resid) { PRINT_ADDR(cmd); printk ("ERROR: cmd=%x host_status=%x scsi_status=%x " "data_len=%d residual=%d\n", cmd->cmnd[0], cp->host_status, cp->scsi_status, cp->data_len, cp->resid); } } #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,99) /* ** Move residual byte count to user structure. */ cmd->resid = cp->resid; #endif /* ** Check the status. */ if ( (cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_GOOD || cp->scsi_status == S_COND_MET)) { /* ** All went well (GOOD status). ** CONDITION MET status is returned on ** `Pre-Fetch' or `Search data' success. */ SetScsiResult(cmd, DID_OK, cp->scsi_status); /* ** Allocate the lcb if not yet. */ if (!lp) ncr_alloc_lcb (np, cp->target, cp->lun); /* ** On standard INQUIRY response (EVPD and CmDt ** not set), setup logical unit according to ** announced capabilities (we need the 1rst 8 bytes). */ if (cmd->cmnd[0] == 0x12 && !(cmd->cmnd[1] & 0x3) && cmd->request_bufflen - cp->resid > 7 && !cmd->use_sg) { sync_scsi_data(np, cmd); /* SYNC the data */ ncr_setup_lcb (np, cp->target, cp->lun, (char *) cmd->request_buffer); } /* ** If tags was reduced due to queue full, ** increase tags if 1000 good status received. */ if (lp && lp->usetags && lp->numtags < lp->maxtags) { ++lp->num_good; if (lp->num_good >= 1000) { lp->num_good = 0; ++lp->numtags; ncr_setup_tags (np, cp->target, cp->lun); } } } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_CHECK_COND)) { /* ** Check condition code */ SetScsiResult(cmd, DID_OK, S_CHECK_COND); if (DEBUG_FLAGS & (DEBUG_RESULT|DEBUG_TINY)) { PRINT_ADDR(cmd); ncr_printl_hex("sense data:", cmd->sense_buffer, 14); } } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_CONFLICT)) { /* ** Reservation Conflict condition code */ SetScsiResult(cmd, DID_OK, S_CONFLICT); } else if ((cp->host_status == HS_COMPLETE) && (cp->scsi_status == S_BUSY || cp->scsi_status == S_QUEUE_FULL)) { /* ** Target is busy. */ SetScsiResult(cmd, DID_OK, cp->scsi_status); } else if ((cp->host_status == HS_SEL_TIMEOUT) || (cp->host_status == HS_TIMEOUT)) { /* ** No response */ SetScsiResult(cmd, DID_TIME_OUT, cp->scsi_status); } else if (cp->host_status == HS_RESET) { /* ** SCSI bus reset */ SetScsiResult(cmd, DID_RESET, cp->scsi_status); } else if (cp->host_status == HS_ABORTED) { /* ** Transfer aborted */ SetScsiAbortResult(cmd); } else { int did_status; /* ** Other protocol messes */ PRINT_ADDR(cmd); printk ("COMMAND FAILED (%x %x) @%p.\n", cp->host_status, cp->scsi_status, cp); did_status = DID_ERROR; if (cp->xerr_status & XE_PARITY_ERR) did_status = DID_PARITY; SetScsiResult(cmd, did_status, cp->scsi_status); } /* ** trace output */ if (tp->usrflag & UF_TRACE) { PRINT_ADDR(cmd); printk (" CMD:"); ncr_print_hex(cmd->cmnd, cmd->cmd_len); if (cp->host_status==HS_COMPLETE) { switch (cp->scsi_status) { case S_GOOD: printk (" GOOD"); break; case S_CHECK_COND: printk (" SENSE:"); ncr_print_hex(cmd->sense_buffer, 14); break; default: printk (" STAT: %x\n", cp->scsi_status); break; } } else printk (" HOSTERROR: %x", cp->host_status); printk ("\n"); } /* ** Free this ccb */ ncr_free_ccb (np, cp); /* ** requeue awaiting scsi commands for this lun. */ if (lp && lp->queuedccbs < lp->queuedepth && !xpt_que_empty(&lp->wait_ccbq)) ncr_start_next_ccb(np, lp, 2); /* ** requeue awaiting scsi commands for this controller. */ if (np->waiting_list) requeue_waiting_list(np); /* ** signal completion to generic driver. */ ncr_queue_done_cmd(np, cmd); } /*========================================================== ** ** ** Signal all (or one) control block done. ** ** **========================================================== */ /* ** The NCR has completed CCBs. ** Look at the DONE QUEUE. ** ** On architectures that may reorder LOAD/STORE operations, ** a memory barrier may be needed after the reading of the ** so-called `flag' and prior to dealing with the data. */ int ncr_wakeup_done (ncb_p np) { ccb_p cp; int i, n; u_long dsa; n = 0; i = np->dqueueget; while (1) { dsa = scr_to_cpu(np->dqueue[i]); if (!dsa) break; np->dqueue[i] = 0; if ((i = i+2) >= MAX_START*2) i = 0; cp = ncr_ccb_from_dsa(np, dsa); if (cp) { MEMORY_BARRIER(); ncr_complete (np, cp); ++n; } else printk (KERN_ERR "%s: bad DSA (%lx) in done queue.\n", ncr_name(np), dsa); } np->dqueueget = i; return n; } /* ** Complete all active CCBs. */ void ncr_wakeup (ncb_p np, u_long code) { ccb_p cp = np->ccbc; while (cp) { if (cp->host_status != HS_IDLE) { cp->host_status = code; ncr_complete (np, cp); } cp = cp->link_ccb; } } /*========================================================== ** ** ** Start NCR chip. ** ** **========================================================== */ void ncr_init (ncb_p np, int reset, char * msg, u_long code) { int i; u_long phys; /* ** Reset chip if asked, otherwise just clear fifos. */ if (reset) ncr_soft_reset(np); else { OUTB (nc_stest3, TE|CSF); OUTONB (nc_ctest3, CLF); } /* ** Message. */ if (msg) printk (KERN_INFO "%s: restart (%s).\n", ncr_name (np), msg); /* ** Clear Start Queue */ phys = np->p_squeue; np->queuedepth = MAX_START - 1; /* 1 entry needed as end marker */ for (i = 0; i < MAX_START*2; i += 2) { np->squeue[i] = cpu_to_scr(np->p_idletask); np->squeue[i+1] = cpu_to_scr(phys + (i+2)*4); } np->squeue[MAX_START*2-1] = cpu_to_scr(phys); /* ** Start at first entry. */ np->squeueput = 0; np->scripth0->startpos[0] = cpu_to_scr(phys); /* ** Clear Done Queue */ phys = vtobus(np->dqueue); for (i = 0; i < MAX_START*2; i += 2) { np->dqueue[i] = 0; np->dqueue[i+1] = cpu_to_scr(phys + (i+2)*4); } np->dqueue[MAX_START*2-1] = cpu_to_scr(phys); /* ** Start at first entry. */ np->scripth0->done_pos[0] = cpu_to_scr(phys); np->dqueueget = 0; /* ** Wakeup all pending jobs. */ ncr_wakeup (np, code); /* ** Init chip. */ OUTB (nc_istat, 0x00 ); /* Remove Reset, abort */ UDELAY (2000); /* The 895 needs time for the bus mode to settle */ OUTB (nc_scntl0, np->rv_scntl0 | 0xc0); /* full arb., ena parity, par->ATN */ OUTB (nc_scntl1, 0x00); /* odd parity, and remove CRST!! */ ncr_selectclock(np, np->rv_scntl3); /* Select SCSI clock */ OUTB (nc_scid , RRE|np->myaddr); /* Adapter SCSI address */ OUTW (nc_respid, 1ul<myaddr); /* Id to respond to */ OUTB (nc_istat , SIGP ); /* Signal Process */ OUTB (nc_dmode , np->rv_dmode); /* Burst length, dma mode */ OUTB (nc_ctest5, np->rv_ctest5); /* Large fifo + large burst */ OUTB (nc_dcntl , NOCOM|np->rv_dcntl); /* Protect SFBR */ OUTB (nc_ctest3, np->rv_ctest3); /* Write and invalidate */ OUTB (nc_ctest4, np->rv_ctest4); /* Master parity checking */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)){ OUTB (nc_stest2, EXT|np->rv_stest2); /* Extended Sreq/Sack filtering, not supported in C1010/C1010_66 */ } OUTB (nc_stest3, TE); /* TolerANT enable */ OUTB (nc_stime0, 0x0c); /* HTH disabled STO 0.25 sec */ /* ** DEL 441 - 53C876 Rev 5 - Part Number 609-0392787/2788 - ITEM 2. ** Disable overlapped arbitration for all dual-function ** devices, regardless revision id. ** We may consider it is a post-chip-design feature. ;-) ** ** Errata applies to all 896 and 1010 parts. */ if (np->device_id == PCI_DEVICE_ID_NCR_53C875) OUTB (nc_ctest0, (1<<5)); else if (np->device_id == PCI_DEVICE_ID_NCR_53C896 || np->device_id == PCI_DEVICE_ID_LSI_53C1010 || np->device_id == PCI_DEVICE_ID_LSI_53C1010_66 ) np->rv_ccntl0 |= DPR; /* ** C1010_66MHz rev 0 part requires AIPCNTL1 bit 3 to be set. */ if (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66) OUTB(nc_aipcntl1, (1<<3)); /* ** Write CCNTL0/CCNTL1 for chips capable of 64 bit addressing ** and/or hardware phase mismatch, since only such chips ** seem to support those IO registers. */ if (np->features & (FE_DAC | FE_NOPM)) { OUTB (nc_ccntl0, np->rv_ccntl0); OUTB (nc_ccntl1, np->rv_ccntl1); } /* ** If phase mismatch handled by scripts (53C895A or 53C896 ** or 53C1010 or 53C1010_66), set PM jump addresses. */ if (np->features & FE_NOPM) { printk(KERN_INFO "%s: handling phase mismatch from SCRIPTS.\n", ncr_name(np)); OUTL (nc_pmjad1, NCB_SCRIPTH_PHYS (np, pm_handle)); OUTL (nc_pmjad2, NCB_SCRIPTH_PHYS (np, pm_handle)); } /* ** Enable GPIO0 pin for writing if LED support from SCRIPTS. ** Also set GPIO5 and clear GPIO6 if hardware LED control. */ if (np->features & FE_LED0) OUTB(nc_gpcntl, INB(nc_gpcntl) & ~0x01); else if (np->features & FE_LEDC) OUTB(nc_gpcntl, (INB(nc_gpcntl) & ~0x41) | 0x20); /* ** enable ints */ OUTW (nc_sien , STO|HTH|MA|SGE|UDC|RST|PAR); OUTB (nc_dien , MDPE|BF|SSI|SIR|IID); /* ** For 895/895A/896/c1010 ** Enable SBMC interrupt and save current SCSI bus mode. */ if ( (np->features & FE_ULTRA2) || (np->features & FE_ULTRA3) ) { OUTONW (nc_sien, SBMC); np->scsi_mode = INB (nc_stest4) & SMODE; } /* ** Fill in target structure. ** Reinitialize usrsync. ** Reinitialize usrwide. ** Prepare sync negotiation according to actual SCSI bus mode. */ for (i=0;itarget[i]; tp->to_reset = 0; tp->sval = 0; tp->wval = np->rv_scntl3; tp->uval = np->rv_scntl4; if (tp->usrsync != 255) { if (tp->usrsync <= np->maxsync) { if (tp->usrsync < np->minsync) { tp->usrsync = np->minsync; } } else tp->usrsync = 255; }; if (tp->usrwide > np->maxwide) tp->usrwide = np->maxwide; ncr_negotiate (np, tp); } /* ** Download SCSI SCRIPTS to on-chip RAM if present, ** and start script processor. ** We do the download preferently from the CPU. ** For platforms that may not support PCI memory mapping, ** we use a simple SCRIPTS that performs MEMORY MOVEs. */ if (np->base2_ba) { if (bootverbose) printk ("%s: Downloading SCSI SCRIPTS.\n", ncr_name(np)); #ifdef SCSI_NCR_PCI_MEM_NOT_SUPPORTED if (np->base2_ws == 8192) phys = NCB_SCRIPTH0_PHYS (np, start_ram64); else phys = NCB_SCRIPTH_PHYS (np, start_ram); #else if (np->base2_ws == 8192) { memcpy_to_pci(np->base2_va + 4096, np->scripth0, sizeof(struct scripth)); OUTL (nc_mmws, np->scr_ram_seg); OUTL (nc_mmrs, np->scr_ram_seg); OUTL (nc_sfs, np->scr_ram_seg); phys = NCB_SCRIPTH_PHYS (np, start64); } else phys = NCB_SCRIPT_PHYS (np, init); memcpy_to_pci(np->base2_va, np->script0, sizeof(struct script)); #endif /* SCSI_NCR_PCI_MEM_NOT_SUPPORTED */ } else phys = NCB_SCRIPT_PHYS (np, init); np->istat_sem = 0; OUTL (nc_dsa, np->p_ncb); OUTL_DSP (phys); } /*========================================================== ** ** Prepare the negotiation values for wide and ** synchronous transfers. ** **========================================================== */ static void ncr_negotiate (struct ncb* np, struct tcb* tp) { /* ** minsync unit is 4ns ! */ u_long minsync = tp->usrsync; /* ** SCSI bus mode limit */ if (np->scsi_mode && np->scsi_mode == SMODE_SE) { if (minsync < 12) minsync = 12; } /* ** our limit .. */ if (minsync < np->minsync) minsync = np->minsync; /* ** divider limit */ if (minsync > np->maxsync) minsync = 255; tp->minsync = minsync; tp->maxoffs = (minsync<255 ? np->maxoffs : 0); /* ** period=0: has to negotiate sync transfer */ tp->period=0; /* ** widedone=0: has to negotiate wide transfer */ tp->widedone=0; } /*========================================================== ** ** Get clock factor and sync divisor for a given ** synchronous factor period. ** Returns the clock factor (in sxfer) and scntl3 ** synchronous divisor field. ** **========================================================== */ static void ncr_getsync(ncb_p np, u_char sfac, u_char *fakp, u_char *scntl3p) { u_long clk = np->clock_khz; /* SCSI clock frequency in kHz */ int div = np->clock_divn; /* Number of divisors supported */ u_long fak; /* Sync factor in sxfer */ u_long per; /* Period in tenths of ns */ u_long kpc; /* (per * clk) */ /* ** Compute the synchronous period in tenths of nano-seconds ** from sfac. ** ** Note, if sfac == 9, DT is being used. Double the period of 125 ** to 250. */ if (sfac <= 10) per = 250; else if (sfac == 11) per = 303; else if (sfac == 12) per = 500; else per = 40 * sfac; /* ** Look for the greatest clock divisor that allows an ** input speed faster than the period. */ kpc = per * clk; while (--div >= 0) if (kpc >= (div_10M[div] << 2)) break; /* ** Calculate the lowest clock factor that allows an output ** speed not faster than the period. */ fak = (kpc - 1) / div_10M[div] + 1; #if 0 /* This optimization does not seem very useful */ per = (fak * div_10M[div]) / clk; /* ** Why not to try the immediate lower divisor and to choose ** the one that allows the fastest output speed ? ** We don't want input speed too much greater than output speed. */ if (div >= 1 && fak < 8) { u_long fak2, per2; fak2 = (kpc - 1) / div_10M[div-1] + 1; per2 = (fak2 * div_10M[div-1]) / clk; if (per2 < per && fak2 <= 8) { fak = fak2; per = per2; --div; } } #endif if (fak < 4) fak = 4; /* Should never happen, too bad ... */ /* ** Compute and return sync parameters for the ncr */ *fakp = fak - 4; /* ** If sfac < 25, and 8xx parts, desire that the chip operate at ** least at Ultra speeds. Must set bit 7 of scntl3. ** For C1010, do not set this bit. If operating at Ultra3 speeds, ** set the U3EN bit instead. */ if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { *scntl3p = (div+1) << 4; *fakp = 0; } else { *scntl3p = ((div+1) << 4) + (sfac < 25 ? 0x80 : 0); *fakp = fak - 4; } } /*========================================================== ** ** Utility routine to return the current bus width ** synchronous period and offset. ** Utilizes target sval, wval and uval ** **========================================================== */ static void ncr_get_xfer_info(ncb_p np, tcb_p tp, u_char *factor, u_char *offset, u_char *width) { u_char idiv; u_long period; *width = (tp->wval & EWS) ? 1 : 0; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) *offset = (tp->sval & 0x3f); else *offset = (tp->sval & 0x1f); /* * Midlayer signal to the driver that all of the scsi commands * for the integrity check have completed. Save the negotiated * parameters (extracted from sval, wval and uval). * See ncr_setsync for alg. details. */ idiv = (tp->wval>>4) & 0x07; if ( *offset && idiv ) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)){ if (tp->uval & 0x80) period = (2*div_10M[idiv-1])/np->clock_khz; else period = (4*div_10M[idiv-1])/np->clock_khz; } else period = (((tp->sval>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else period = 0xffff; if (period <= 125) *factor = 9; else if (period <= 250) *factor = 10; else if (period <= 303) *factor = 11; else if (period <= 500) *factor = 12; else *factor = (period + 40 - 1) / 40; } /*========================================================== ** ** Set actual values, sync status and patch all ccbs of ** a target according to new sync/wide agreement. ** **========================================================== */ static void ncr_set_sync_wide_status (ncb_p np, u_char target) { ccb_p cp = np->ccbc; tcb_p tp = &np->target[target]; /* ** set actual value and sync_status ** ** TEMP register contains current scripts address ** which is data type/direction/dependent. */ OUTB (nc_sxfer, tp->sval); OUTB (nc_scntl3, tp->wval); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) OUTB (nc_scntl4, tp->uval); /* ** patch ALL ccbs of this target. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status == HS_IDLE) continue; if (cp->target != target) continue; cp->phys.select.sel_scntl3 = tp->wval; cp->phys.select.sel_sxfer = tp->sval; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) cp->phys.select.sel_scntl4 = tp->uval; }; } /*========================================================== ** ** Switch sync mode for current job and it's target ** **========================================================== */ static void ncr_setsync (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4) { tcb_p tp; u_char target = INB (nc_sdid) & 0x0f; u_char idiv; u_char offset; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { offset = sxfer & 0x3f; /* bits 5-0 */ scntl3 = (scntl3 & 0xf0) | (tp->wval & EWS); scntl4 = (scntl4 & 0x80); } else { offset = sxfer & 0x1f; /* bits 4-0 */ if (!scntl3 || !offset) scntl3 = np->rv_scntl3; scntl3 = (scntl3 & 0xf0) | (tp->wval & EWS) | (np->rv_scntl3 & 0x07); } /* ** Deduce the value of controller sync period from scntl3. ** period is in tenths of nano-seconds. */ idiv = ((scntl3 >> 4) & 0x7); if ( offset && idiv) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { /* Note: If extra data hold clocks are used, * the formulas below must be modified. * When scntl4 == 0, ST mode. */ if (scntl4 & 0x80) tp->period = (2*div_10M[idiv-1])/np->clock_khz; else tp->period = (4*div_10M[idiv-1])/np->clock_khz; } else tp->period = (((sxfer>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else tp->period = 0xffff; /* ** Stop there if sync parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3 && tp->uval == scntl4) return; tp->sval = sxfer; tp->wval = scntl3; tp->uval = scntl4; /* ** Bells and whistles ;-) ** Donnot announce negotiations due to auto-sense, ** unless user really want us to be verbose. :) */ if ( bootverbose < 2 && (cp->host_flags & HF_AUTO_SENSE)) goto next; PRINT_TARGET(np, target); if (offset) { unsigned f10 = 100000 << (tp->widedone ? tp->widedone -1 : 0); unsigned mb10 = (f10 + tp->period/2) / tp->period; char *scsi; /* ** Disable extended Sreq/Sack filtering */ if ((tp->period <= 2000) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) OUTOFFB (nc_stest2, EXT); /* ** Bells and whistles ;-) */ if (tp->period < 250) scsi = "FAST-80"; else if (tp->period < 500) scsi = "FAST-40"; else if (tp->period < 1000) scsi = "FAST-20"; else if (tp->period < 2000) scsi = "FAST-10"; else scsi = "FAST-5"; printk ("%s %sSCSI %d.%d MB/s (%d.%d ns, offset %d)\n", scsi, tp->widedone > 1 ? "WIDE " : "", mb10 / 10, mb10 % 10, tp->period / 10, tp->period % 10, offset); } else printk ("%sasynchronous.\n", tp->widedone > 1 ? "wide " : ""); next: /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch wide mode for current job and it's target ** SCSI specs say: a SCSI device that accepts a WDTR ** message shall reset the synchronous agreement to ** asynchronous mode. ** **========================================================== */ static void ncr_setwide (ncb_p np, ccb_p cp, u_char wide, u_char ack) { u_short target = INB (nc_sdid) & 0x0f; tcb_p tp; u_char scntl3; u_char sxfer; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; tp->widedone = wide+1; scntl3 = (tp->wval & (~EWS)) | (wide ? EWS : 0); sxfer = ack ? 0 : tp->sval; /* ** Stop there if sync/wide parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3) return; tp->sval = sxfer; tp->wval = scntl3; /* ** Bells and whistles ;-) */ if (bootverbose >= 2) { PRINT_TARGET(np, target); if (scntl3 & EWS) printk ("WIDE SCSI (16 bit) enabled.\n"); else printk ("WIDE SCSI disabled.\n"); } /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch sync/wide mode for current job and it's target ** PPR negotiations only ** **========================================================== */ static void ncr_setsyncwide (ncb_p np, ccb_p cp, u_char scntl3, u_char sxfer, u_char scntl4, u_char wide) { tcb_p tp; u_char target = INB (nc_sdid) & 0x0f; u_char idiv; u_char offset; assert (cp); if (!cp) return; assert (target == (cp->target & 0xf)); tp = &np->target[target]; tp->widedone = wide+1; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { offset = sxfer & 0x3f; /* bits 5-0 */ scntl3 = (scntl3 & 0xf0) | (wide ? EWS : 0); scntl4 = (scntl4 & 0x80); } else { offset = sxfer & 0x1f; /* bits 4-0 */ if (!scntl3 || !offset) scntl3 = np->rv_scntl3; scntl3 = (scntl3 & 0xf0) | (wide ? EWS : 0) | (np->rv_scntl3 & 0x07); } /* ** Deduce the value of controller sync period from scntl3. ** period is in tenths of nano-seconds. */ idiv = ((scntl3 >> 4) & 0x7); if ( offset && idiv) { if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { /* Note: If extra data hold clocks are used, * the formulas below must be modified. * When scntl4 == 0, ST mode. */ if (scntl4 & 0x80) tp->period = (2*div_10M[idiv-1])/np->clock_khz; else tp->period = (4*div_10M[idiv-1])/np->clock_khz; } else tp->period = (((sxfer>>5)+4)*div_10M[idiv-1])/np->clock_khz; } else tp->period = 0xffff; /* ** Stop there if sync parameters are unchanged */ if (tp->sval == sxfer && tp->wval == scntl3 && tp->uval == scntl4) return; tp->sval = sxfer; tp->wval = scntl3; tp->uval = scntl4; /* ** Bells and whistles ;-) ** Donnot announce negotiations due to auto-sense, ** unless user really want us to be verbose. :) */ if ( bootverbose < 2 && (cp->host_flags & HF_AUTO_SENSE)) goto next; PRINT_TARGET(np, target); if (offset) { unsigned f10 = 100000 << (tp->widedone ? tp->widedone -1 : 0); unsigned mb10 = (f10 + tp->period/2) / tp->period; char *scsi; /* ** Disable extended Sreq/Sack filtering */ if ((tp->period <= 2000) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) OUTOFFB (nc_stest2, EXT); /* ** Bells and whistles ;-) */ if (tp->period < 250) scsi = "FAST-80"; else if (tp->period < 500) scsi = "FAST-40"; else if (tp->period < 1000) scsi = "FAST-20"; else if (tp->period < 2000) scsi = "FAST-10"; else scsi = "FAST-5"; printk ("%s %sSCSI %d.%d MB/s (%d.%d ns, offset %d)\n", scsi, tp->widedone > 1 ? "WIDE " : "", mb10 / 10, mb10 % 10, tp->period / 10, tp->period % 10, offset); } else printk ("%sasynchronous.\n", tp->widedone > 1 ? "wide " : ""); next: /* ** set actual value and sync_status ** patch ALL ccbs of this target. */ ncr_set_sync_wide_status(np, target); } /*========================================================== ** ** Switch tagged mode for a target. ** **========================================================== */ static void ncr_setup_tags (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_short reqtags, maxdepth; /* ** Just in case ... */ if ((!tp) || (!lp)) return; /* ** If SCSI device queue depth is not yet set, leave here. */ if (!lp->scdev_depth) return; /* ** Donnot allow more tags than the SCSI driver can queue ** for this device. ** Donnot allow more tags than we can handle. */ maxdepth = lp->scdev_depth; if (maxdepth > lp->maxnxs) maxdepth = lp->maxnxs; if (lp->maxtags > maxdepth) lp->maxtags = maxdepth; if (lp->numtags > maxdepth) lp->numtags = maxdepth; /* ** only devices conformant to ANSI Version >= 2 ** only devices capable of tagged commands ** only if enabled by user .. */ if ((lp->inq_byte7 & INQ7_QUEUE) && lp->numtags > 1) { reqtags = lp->numtags; } else { reqtags = 1; }; /* ** Update max number of tags */ lp->numtags = reqtags; if (lp->numtags > lp->maxtags) lp->maxtags = lp->numtags; /* ** If we want to switch tag mode, we must wait ** for no CCB to be active. */ if (reqtags > 1 && lp->usetags) { /* Stay in tagged mode */ if (lp->queuedepth == reqtags) /* Already announced */ return; lp->queuedepth = reqtags; } else if (reqtags <= 1 && !lp->usetags) { /* Stay in untagged mode */ lp->queuedepth = reqtags; return; } else { /* Want to switch tag mode */ if (lp->busyccbs) /* If not yet safe, return */ return; lp->queuedepth = reqtags; lp->usetags = reqtags > 1 ? 1 : 0; } /* ** Patch the lun mini-script, according to tag mode. */ lp->resel_task = lp->usetags? cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_tag)) : cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_notag)); /* ** Announce change to user. */ if (bootverbose) { PRINT_LUN(np, tn, ln); if (lp->usetags) printk("tagged command queue depth set to %d\n", reqtags); else printk("tagged command queueing disabled\n"); } } /*---------------------------------------------------- ** ** handle user commands ** **---------------------------------------------------- */ #ifdef SCSI_NCR_USER_COMMAND_SUPPORT static void ncr_usercmd (ncb_p np) { u_char t; tcb_p tp; int ln; u_long size; switch (np->user.cmd) { case 0: return; case UC_SETDEBUG: #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT ncr_debug = np->user.data; #endif break; case UC_SETORDER: np->order = np->user.data; break; case UC_SETVERBOSE: np->verbose = np->user.data; break; default: /* ** We assume that other commands apply to targets. ** This should always be the case and avoid the below ** 4 lines to be repeated 5 times. */ for (t = 0; t < MAX_TARGET; t++) { if (!((np->user.target >> t) & 1)) continue; tp = &np->target[t]; switch (np->user.cmd) { case UC_SETSYNC: tp->usrsync = np->user.data; ncr_negotiate (np, tp); break; case UC_SETWIDE: size = np->user.data; if (size > np->maxwide) size=np->maxwide; tp->usrwide = size; ncr_negotiate (np, tp); break; case UC_SETTAGS: tp->usrtags = np->user.data; for (ln = 0; ln < MAX_LUN; ln++) { lcb_p lp; lp = ncr_lp(np, tp, ln); if (!lp) continue; lp->numtags = np->user.data; lp->maxtags = lp->numtags; ncr_setup_tags (np, t, ln); } break; case UC_RESETDEV: tp->to_reset = 1; np->istat_sem = SEM; OUTB (nc_istat, SIGP|SEM); break; case UC_CLEARDEV: for (ln = 0; ln < MAX_LUN; ln++) { lcb_p lp; lp = ncr_lp(np, tp, ln); if (lp) lp->to_clear = 1; } np->istat_sem = SEM; OUTB (nc_istat, SIGP|SEM); break; case UC_SETFLAG: tp->usrflag = np->user.data; break; } } break; } np->user.cmd=0; } #endif /*========================================================== ** ** ** ncr timeout handler. ** ** **========================================================== ** ** Misused to keep the driver running when ** interrupts are not configured correctly. ** **---------------------------------------------------------- */ static void ncr_timeout (ncb_p np) { u_long thistime = ktime_get(0); /* ** If release process in progress, let's go ** Set the release stage from 1 to 2 to synchronize ** with the release process. */ if (np->release_stage) { if (np->release_stage == 1) np->release_stage = 2; return; } #ifdef SCSI_NCR_PCIQ_BROKEN_INTR np->timer.expires = ktime_get((HZ+9)/10); #else np->timer.expires = ktime_get(SCSI_NCR_TIMER_INTERVAL); #endif add_timer(&np->timer); /* ** If we are resetting the ncr, wait for settle_time before ** clearing it. Then command processing will be resumed. */ if (np->settle_time) { if (np->settle_time <= thistime) { if (bootverbose > 1) printk("%s: command processing resumed\n", ncr_name(np)); np->settle_time = 0; requeue_waiting_list(np); } return; } /* ** Nothing to do for now, but that may come. */ if (np->lasttime + 4*HZ < thistime) { np->lasttime = thistime; } #ifdef SCSI_NCR_PCIQ_MAY_MISS_COMPLETIONS /* ** Some way-broken PCI bridges may lead to ** completions being lost when the clearing ** of the INTFLY flag by the CPU occurs ** concurrently with the chip raising this flag. ** If this ever happen, lost completions will ** be reaped here. */ ncr_wakeup_done(np); #endif #ifdef SCSI_NCR_PCIQ_BROKEN_INTR if (INB(nc_istat) & (INTF|SIP|DIP)) { /* ** Process pending interrupts. */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("{"); ncr_exception (np); if (DEBUG_FLAGS & DEBUG_TINY) printk ("}"); } #endif /* SCSI_NCR_PCIQ_BROKEN_INTR */ } /*========================================================== ** ** log message for real hard errors ** ** "ncr0 targ 0?: ERROR (ds:si) (so-si-sd) (sxfer/scntl3) @ name (dsp:dbc)." ** " reg: r0 r1 r2 r3 r4 r5 r6 ..... rf." ** ** exception register: ** ds: dstat ** si: sist ** ** SCSI bus lines: ** so: control lines as driver by NCR. ** si: control lines as seen by NCR. ** sd: scsi data lines as seen by NCR. ** ** wide/fastmode: ** sxfer: (see the manual) ** scntl3: (see the manual) ** ** current script command: ** dsp: script address (relative to start of script). ** dbc: first word of script command. ** ** First 24 register of the chip: ** r0..rf ** **========================================================== */ static void ncr_log_hard_error(ncb_p np, u_short sist, u_char dstat) { u_int32 dsp; int script_ofs; int script_size; char *script_name; u_char *script_base; int i; dsp = INL (nc_dsp); if (dsp > np->p_script && dsp <= np->p_script + sizeof(struct script)) { script_ofs = dsp - np->p_script; script_size = sizeof(struct script); script_base = (u_char *) np->script0; script_name = "script"; } else if (np->p_scripth < dsp && dsp <= np->p_scripth + sizeof(struct scripth)) { script_ofs = dsp - np->p_scripth; script_size = sizeof(struct scripth); script_base = (u_char *) np->scripth0; script_name = "scripth"; } else { script_ofs = dsp; script_size = 0; script_base = 0; script_name = "mem"; } printk ("%s:%d: ERROR (%x:%x) (%x-%x-%x) (%x/%x) @ (%s %x:%08x).\n", ncr_name (np), (unsigned)INB (nc_sdid)&0x0f, dstat, sist, (unsigned)INB (nc_socl), (unsigned)INB (nc_sbcl), (unsigned)INB (nc_sbdl), (unsigned)INB (nc_sxfer),(unsigned)INB (nc_scntl3), script_name, script_ofs, (unsigned)INL (nc_dbc)); if (((script_ofs & 3) == 0) && (unsigned)script_ofs < script_size) { printk ("%s: script cmd = %08x\n", ncr_name(np), scr_to_cpu((int) *(ncrcmd *)(script_base + script_ofs))); } printk ("%s: regdump:", ncr_name(np)); for (i=0; i<24;i++) printk (" %02x", (unsigned)INB_OFF(i)); printk (".\n"); } /*============================================================ ** ** ncr chip exception handler. ** **============================================================ ** ** In normal situations, interrupt conditions occur one at ** a time. But when something bad happens on the SCSI BUS, ** the chip may raise several interrupt flags before ** stopping and interrupting the CPU. The additional ** interrupt flags are stacked in some extra registers ** after the SIP and/or DIP flag has been raised in the ** ISTAT. After the CPU has read the interrupt condition ** flag from SIST or DSTAT, the chip unstacks the other ** interrupt flags and sets the corresponding bits in ** SIST or DSTAT. Since the chip starts stacking once the ** SIP or DIP flag is set, there is a small window of time ** where the stacking does not occur. ** ** Typically, multiple interrupt conditions may happen in ** the following situations: ** ** - SCSI parity error + Phase mismatch (PAR|MA) ** When an parity error is detected in input phase ** and the device switches to msg-in phase inside a ** block MOV. ** - SCSI parity error + Unexpected disconnect (PAR|UDC) ** When a stupid device does not want to handle the ** recovery of an SCSI parity error. ** - Some combinations of STO, PAR, UDC, ... ** When using non compliant SCSI stuff, when user is ** doing non compliant hot tampering on the BUS, when ** something really bad happens to a device, etc ... ** ** The heuristic suggested by SYMBIOS to handle ** multiple interrupts is to try unstacking all ** interrupts conditions and to handle them on some ** priority based on error severity. ** This will work when the unstacking has been ** successful, but we cannot be 100 % sure of that, ** since the CPU may have been faster to unstack than ** the chip is able to stack. Hmmm ... But it seems that ** such a situation is very unlikely to happen. ** ** If this happen, for example STO catched by the CPU ** then UDC happenning before the CPU have restarted ** the SCRIPTS, the driver may wrongly complete the ** same command on UDC, since the SCRIPTS didn't restart ** and the DSA still points to the same command. ** We avoid this situation by setting the DSA to an ** invalid value when the CCB is completed and before ** restarting the SCRIPTS. ** ** Another issue is that we need some section of our ** recovery procedures to be somehow uninterruptible and ** that the SCRIPTS processor does not provides such a ** feature. For this reason, we handle recovery preferently ** from the C code and check against some SCRIPTS ** critical sections from the C code. ** ** Hopefully, the interrupt handling of the driver is now ** able to resist to weird BUS error conditions, but donnot ** ask me for any guarantee that it will never fail. :-) ** Use at your own decision and risk. ** **============================================================ */ void ncr_exception (ncb_p np) { u_char istat, istatc; u_char dstat; u_short sist; int i; /* ** interrupt on the fly ? ** ** A `dummy read' is needed to ensure that the ** clear of the INTF flag reaches the device ** before the scanning of the DONE queue. */ istat = INB (nc_istat); if (istat & INTF) { OUTB (nc_istat, (istat & SIGP) | INTF | np->istat_sem); istat = INB (nc_istat); /* DUMMY READ */ if (DEBUG_FLAGS & DEBUG_TINY) printk ("F "); (void)ncr_wakeup_done (np); }; if (!(istat & (SIP|DIP))) return; #if 0 /* We should never get this one */ if (istat & CABRT) OUTB (nc_istat, CABRT); #endif /* ** Steinbach's Guideline for Systems Programming: ** Never test for an error condition you don't know how to handle. */ /*======================================================== ** PAR and MA interrupts may occur at the same time, ** and we need to know of both in order to handle ** this situation properly. We try to unstack SCSI ** interrupts for that reason. BTW, I dislike a LOT ** such a loop inside the interrupt routine. ** Even if DMA interrupt stacking is very unlikely to ** happen, we also try unstacking these ones, since ** this has no performance impact. **========================================================= */ sist = 0; dstat = 0; istatc = istat; do { if (istatc & SIP) sist |= INW (nc_sist); if (istatc & DIP) dstat |= INB (nc_dstat); istatc = INB (nc_istat); istat |= istatc; } while (istatc & (SIP|DIP)); if (DEBUG_FLAGS & DEBUG_TINY) printk ("<%d|%x:%x|%x:%x>", (int)INB(nc_scr0), dstat,sist, (unsigned)INL(nc_dsp), (unsigned)INL(nc_dbc)); /* ** On paper, a memory barrier may be needed here. ** And since we are paranoid ... :) */ MEMORY_BARRIER(); /*======================================================== ** First, interrupts we want to service cleanly. ** ** Phase mismatch (MA) is the most frequent interrupt ** for chip earlier than the 896 and so we have to service ** it as quickly as possible. ** A SCSI parity error (PAR) may be combined with a phase ** mismatch condition (MA). ** Programmed interrupts (SIR) are used to call the C code ** from SCRIPTS. ** The single step interrupt (SSI) is not used in this ** driver. **========================================================= */ if (!(sist & (STO|GEN|HTH|SGE|UDC|SBMC|RST)) && !(dstat & (MDPE|BF|ABRT|IID))) { if (sist & PAR) ncr_int_par (np, sist); else if (sist & MA) ncr_int_ma (np); else if (dstat & SIR) ncr_int_sir (np); else if (dstat & SSI) OUTONB_STD (); else goto unknown_int; return; }; /*======================================================== ** Now, interrupts that donnot happen in normal ** situations and that we may need to recover from. ** ** On SCSI RESET (RST), we reset everything. ** On SCSI BUS MODE CHANGE (SBMC), we complete all ** active CCBs with RESET status, prepare all devices ** for negotiating again and restart the SCRIPTS. ** On STO and UDC, we complete the CCB with the corres- ** ponding status and restart the SCRIPTS. **========================================================= */ if (sist & RST) { ncr_init (np, 1, bootverbose ? "scsi reset" : NULL, HS_RESET); return; }; OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* clear dma fifo */ OUTB (nc_stest3, TE|CSF); /* clear scsi fifo */ if (!(sist & (GEN|HTH|SGE)) && !(dstat & (MDPE|BF|ABRT|IID))) { if (sist & SBMC) ncr_int_sbmc (np); else if (sist & STO) ncr_int_sto (np); else if (sist & UDC) ncr_int_udc (np); else goto unknown_int; return; }; /*========================================================= ** Now, interrupts we are not able to recover cleanly. ** ** Do the register dump. ** Log message for hard errors. ** Reset everything. **========================================================= */ if (ktime_exp(np->regtime)) { np->regtime = ktime_get(10*HZ); for (i = 0; iregdump); i++) ((char*)&np->regdump)[i] = INB_OFF(i); np->regdump.nc_dstat = dstat; np->regdump.nc_sist = sist; }; ncr_log_hard_error(np, sist, dstat); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) { u_char ctest4_o, ctest4_m; u_char shadow; /* * Get shadow register data * Write 1 to ctest4 */ ctest4_o = INB(nc_ctest4); OUTB(nc_ctest4, ctest4_o | 0x10); ctest4_m = INB(nc_ctest4); shadow = INW_OFF(0x42); OUTB(nc_ctest4, ctest4_o); printk("%s: ctest4/sist original 0x%x/0x%X mod: 0x%X/0x%x\n", ncr_name(np), ctest4_o, sist, ctest4_m, shadow); } if ((sist & (GEN|HTH|SGE)) || (dstat & (MDPE|BF|ABRT|IID))) { ncr_start_reset(np); return; }; unknown_int: /*========================================================= ** We just miss the cause of the interrupt. :( ** Print a message. The timeout will do the real work. **========================================================= */ printk( "%s: unknown interrupt(s) ignored, " "ISTAT=0x%x DSTAT=0x%x SIST=0x%x\n", ncr_name(np), istat, dstat, sist); } /*========================================================== ** ** generic recovery from scsi interrupt ** **========================================================== ** ** The doc says that when the chip gets an SCSI interrupt, ** it tries to stop in an orderly fashion, by completing ** an instruction fetch that had started or by flushing ** the DMA fifo for a write to memory that was executing. ** Such a fashion is not enough to know if the instruction ** that was just before the current DSP value has been ** executed or not. ** ** There are 3 small SCRIPTS sections that deal with the ** start queue and the done queue that may break any ** assumption from the C code if we are interrupted ** inside, so we reset if it happens. Btw, since these ** SCRIPTS sections are executed while the SCRIPTS hasn't ** started SCSI operations, it is very unlikely to happen. ** ** All the driver data structures are supposed to be ** allocated from the same 4 GB memory window, so there ** is a 1 to 1 relationship between DSA and driver data ** structures. Since we are careful :) to invalidate the ** DSA when we complete a command or when the SCRIPTS ** pushes a DSA into a queue, we can trust it when it ** points to a CCB. ** **---------------------------------------------------------- */ static void ncr_recover_scsi_int (ncb_p np, u_char hsts) { u_int32 dsp = INL (nc_dsp); u_int32 dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); /* ** If we haven't been interrupted inside the SCRIPTS ** critical paths, we can safely restart the SCRIPTS ** and trust the DSA value if it matches a CCB. */ if ((!(dsp > NCB_SCRIPT_PHYS (np, getjob_begin) && dsp < NCB_SCRIPT_PHYS (np, getjob_end) + 1)) && (!(dsp > NCB_SCRIPT_PHYS (np, ungetjob) && dsp < NCB_SCRIPT_PHYS (np, reselect) + 1)) && (!(dsp > NCB_SCRIPTH_PHYS (np, sel_for_abort) && dsp < NCB_SCRIPTH_PHYS (np, sel_for_abort_1) + 1)) && (!(dsp > NCB_SCRIPT_PHYS (np, done) && dsp < NCB_SCRIPT_PHYS (np, done_end) + 1))) { if (cp) { cp->host_status = hsts; ncr_complete (np, cp); } OUTL (nc_dsa, DSA_INVALID); OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* clear dma fifo */ OUTB (nc_stest3, TE|CSF); /* clear scsi fifo */ OUTL_DSP (NCB_SCRIPT_PHYS (np, start)); } else goto reset_all; return; reset_all: ncr_start_reset(np); } /*========================================================== ** ** ncr chip exception handler for selection timeout ** **========================================================== ** ** There seems to be a bug in the 53c810. ** Although a STO-Interrupt is pending, ** it continues executing script commands. ** But it will fail and interrupt (IID) on ** the next instruction where it's looking ** for a valid phase. ** **---------------------------------------------------------- */ void ncr_int_sto (ncb_p np) { u_int32 dsp = INL (nc_dsp); if (DEBUG_FLAGS & DEBUG_TINY) printk ("T"); if (dsp == NCB_SCRIPT_PHYS (np, wf_sel_done) + 8 || !(driver_setup.recovery & 1)) ncr_recover_scsi_int(np, HS_SEL_TIMEOUT); else ncr_start_reset(np); } /*========================================================== ** ** ncr chip exception handler for unexpected disconnect ** **========================================================== ** **---------------------------------------------------------- */ void ncr_int_udc (ncb_p np) { u_int32 dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); /* * Fix Up. Some disks respond to a PPR negotiation with * a bus free instead of a message reject. * Disable ppr negotiation if this is first time * tried ppr negotiation. */ if (cp) { tcb_p tp = &np->target[cp->target]; if (tp->ppr_negotiation == 1) tp->ppr_negotiation = 0; } printk ("%s: unexpected disconnect\n", ncr_name(np)); ncr_recover_scsi_int(np, HS_UNEXPECTED); } /*========================================================== ** ** ncr chip exception handler for SCSI bus mode change ** **========================================================== ** ** spi2-r12 11.2.3 says a transceiver mode change must ** generate a reset event and a device that detects a reset ** event shall initiate a hard reset. It says also that a ** device that detects a mode change shall set data transfer ** mode to eight bit asynchronous, etc... ** So, just resetting should be enough. ** ** **---------------------------------------------------------- */ static void ncr_int_sbmc (ncb_p np) { u_char scsi_mode = INB (nc_stest4) & SMODE; printk("%s: SCSI bus mode change from %x to %x.\n", ncr_name(np), np->scsi_mode, scsi_mode); np->scsi_mode = scsi_mode; /* ** Suspend command processing for 1 second and ** reinitialize all except the chip. */ np->settle_time = ktime_get(1*HZ); ncr_init (np, 0, bootverbose ? "scsi mode change" : NULL, HS_RESET); } /*========================================================== ** ** ncr chip exception handler for SCSI parity error. ** **========================================================== ** ** When the chip detects a SCSI parity error and is ** currently executing a (CH)MOV instruction, it does ** not interrupt immediately, but tries to finish the ** transfer of the current scatter entry before ** interrupting. The following situations may occur: ** ** - The complete scatter entry has been transferred ** without the device having changed phase. ** The chip will then interrupt with the DSP pointing ** to the instruction that follows the MOV. ** ** - A phase mismatch occurs before the MOV finished ** and phase errors are to be handled by the C code. ** The chip will then interrupt with both PAR and MA ** conditions set. ** ** - A phase mismatch occurs before the MOV finished and ** phase errors are to be handled by SCRIPTS (895A or 896). ** The chip will load the DSP with the phase mismatch ** JUMP address and interrupt the host processor. ** **---------------------------------------------------------- */ static void ncr_int_par (ncb_p np, u_short sist) { u_char hsts = INB (HS_PRT); u_int32 dsp = INL (nc_dsp); u_int32 dbc = INL (nc_dbc); u_int32 dsa = INL (nc_dsa); u_char sbcl = INB (nc_sbcl); u_char cmd = dbc >> 24; int phase = cmd & 7; ccb_p cp = ncr_ccb_from_dsa(np, dsa); printk("%s: SCSI parity error detected: SCR1=%d DBC=%x SBCL=%x\n", ncr_name(np), hsts, dbc, sbcl); /* ** Check that the chip is connected to the SCSI BUS. */ if (!(INB (nc_scntl1) & ISCON)) { if (!(driver_setup.recovery & 1)) { ncr_recover_scsi_int(np, HS_FAIL); return; } goto reset_all; } /* ** If the nexus is not clearly identified, reset the bus. ** We will try to do better later. */ if (!cp) goto reset_all; /* ** Check instruction was a MOV, direction was INPUT and ** ATN is asserted. */ if ((cmd & 0xc0) || !(phase & 1) || !(sbcl & 0x8)) goto reset_all; /* ** Keep track of the parity error. */ OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_PARITY_ERR; /* ** Prepare the message to send to the device. */ np->msgout[0] = (phase == 7) ? M_PARITY : M_ID_ERROR; #ifdef SCSI_NCR_INTEGRITY_CHECKING /* ** Save error message. For integrity check use only. */ if (np->check_integrity) np->check_integ_par = np->msgout[0]; #endif /* ** If the old phase was DATA IN or DT DATA IN phase, ** we have to deal with the 3 situations described above. ** For other input phases (MSG IN and STATUS), the device ** must resend the whole thing that failed parity checking ** or signal error. So, jumping to dispatcher should be OK. */ if ((phase == 1) || (phase == 5)) { /* Phase mismatch handled by SCRIPTS */ if (dsp == NCB_SCRIPTH_PHYS (np, pm_handle)) OUTL_DSP (dsp); /* Phase mismatch handled by the C code */ else if (sist & MA) ncr_int_ma (np); /* No phase mismatch occurred */ else { OUTL (nc_temp, dsp); OUTL_DSP (NCB_SCRIPT_PHYS (np, dispatch)); } } else OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; reset_all: ncr_start_reset(np); return; } /*========================================================== ** ** ** ncr chip exception handler for phase errors. ** ** **========================================================== ** ** We have to construct a new transfer descriptor, ** to transfer the rest of the current block. ** **---------------------------------------------------------- */ static void ncr_int_ma (ncb_p np) { u_int32 dbc; u_int32 rest; u_int32 dsp; u_int32 dsa; u_int32 nxtdsp; u_int32 *vdsp; u_int32 oadr, olen; u_int32 *tblp; u_int32 newcmd; u_int delta; u_char cmd; u_char hflags, hflags0; struct pm_ctx *pm; ccb_p cp; dsp = INL (nc_dsp); dbc = INL (nc_dbc); dsa = INL (nc_dsa); cmd = dbc >> 24; rest = dbc & 0xffffff; delta = 0; /* ** locate matching cp. */ cp = ncr_ccb_from_dsa(np, dsa); if (DEBUG_FLAGS & DEBUG_PHASE) printk("CCB = %2x %2x %2x %2x %2x %2x\n", cp->cmd->cmnd[0], cp->cmd->cmnd[1], cp->cmd->cmnd[2], cp->cmd->cmnd[3], cp->cmd->cmnd[4], cp->cmd->cmnd[5]); /* ** Donnot take into account dma fifo and various buffers in ** INPUT phase since the chip flushes everything before ** raising the MA interrupt for interrupted INPUT phases. ** For DATA IN phase, we will check for the SWIDE later. */ if ((cmd & 7) != 1 && (cmd & 7) != 5) { u_int32 dfifo; u_char ss0, ss2; /* ** If C1010, DFBC contains number of bytes in DMA fifo. ** else read DFIFO, CTEST[4-6] using 1 PCI bus ownership. */ if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) delta = INL(nc_dfbc) & 0xffff; else { dfifo = INL(nc_dfifo); /* ** Calculate remaining bytes in DMA fifo. ** C1010 - always large fifo, value in dfbc ** Otherwise, (CTEST5 = dfifo >> 16) */ if (dfifo & (DFS << 16)) delta = ((((dfifo >> 8) & 0x300) | (dfifo & 0xff)) - rest) & 0x3ff; else delta = ((dfifo & 0xff) - rest) & 0x7f; /* ** The data in the dma fifo has not been ** transferred to the target -> add the amount ** to the rest and clear the data. ** Check the sstat2 register in case of wide ** transfer. */ } rest += delta; ss0 = INB (nc_sstat0); if (ss0 & OLF) rest++; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (ss0 & ORF)) rest++; if (cp && (cp->phys.select.sel_scntl3 & EWS)) { ss2 = INB (nc_sstat2); if (ss2 & OLF1) rest++; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (ss2 & ORF)) rest++; }; /* ** Clear fifos. */ OUTB (nc_ctest3, np->rv_ctest3 | CLF); /* dma fifo */ OUTB (nc_stest3, TE|CSF); /* scsi fifo */ } /* ** log the information */ if (DEBUG_FLAGS & (DEBUG_TINY|DEBUG_PHASE)) printk ("P%x%x RL=%d D=%d ", cmd&7, INB(nc_sbcl)&7, (unsigned) rest, (unsigned) delta); /* ** try to find the interrupted script command, ** and the address at which to continue. */ vdsp = 0; nxtdsp = 0; if (dsp > np->p_script && dsp <= np->p_script + sizeof(struct script)) { vdsp = (u_int32 *)((char*)np->script0 + (dsp-np->p_script-8)); nxtdsp = dsp; } else if (dsp > np->p_scripth && dsp <= np->p_scripth + sizeof(struct scripth)) { vdsp = (u_int32 *)((char*)np->scripth0 + (dsp-np->p_scripth-8)); nxtdsp = dsp; } /* ** log the information */ if (DEBUG_FLAGS & DEBUG_PHASE) { printk ("\nCP=%p DSP=%x NXT=%x VDSP=%p CMD=%x ", cp, (unsigned)dsp, (unsigned)nxtdsp, vdsp, cmd); }; if (!vdsp) { printk ("%s: interrupted SCRIPT address not found.\n", ncr_name (np)); goto reset_all; } if (!cp) { printk ("%s: SCSI phase error fixup: CCB already dequeued.\n", ncr_name (np)); goto reset_all; } /* ** get old startaddress and old length. */ oadr = scr_to_cpu(vdsp[1]); if (cmd & 0x10) { /* Table indirect */ tblp = (u_int32 *) ((char*) &cp->phys + oadr); olen = scr_to_cpu(tblp[0]); oadr = scr_to_cpu(tblp[1]); } else { tblp = (u_int32 *) 0; olen = scr_to_cpu(vdsp[0]) & 0xffffff; }; if (DEBUG_FLAGS & DEBUG_PHASE) { printk ("OCMD=%x\nTBLP=%p OLEN=%x OADR=%x\n", (unsigned) (scr_to_cpu(vdsp[0]) >> 24), tblp, (unsigned) olen, (unsigned) oadr); }; /* ** check cmd against assumed interrupted script command. ** If dt data phase, the MOVE instruction hasn't bit 4 of ** the phase. */ if (((cmd & 2) ? cmd : (cmd & ~4)) != (scr_to_cpu(vdsp[0]) >> 24)) { PRINT_ADDR(cp->cmd); printk ("internal error: cmd=%02x != %02x=(vdsp[0] >> 24)\n", (unsigned)cmd, (unsigned)scr_to_cpu(vdsp[0]) >> 24); goto reset_all; }; /* ** if old phase not dataphase, leave here. ** C/D line is low if data. */ if (cmd & 0x02) { PRINT_ADDR(cp->cmd); printk ("phase change %x-%x %d@%08x resid=%d.\n", cmd&7, INB(nc_sbcl)&7, (unsigned)olen, (unsigned)oadr, (unsigned)rest); goto unexpected_phase; }; /* ** Choose the correct PM save area. ** ** Look at the PM_SAVE SCRIPT if you want to understand ** this stuff. The equivalent code is implemented in ** SCRIPTS for the 895A and 896 that are able to handle ** PM from the SCRIPTS processor. */ hflags0 = INB (HF_PRT); hflags = hflags0; if (hflags & (HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED)) { if (hflags & HF_IN_PM0) nxtdsp = scr_to_cpu(cp->phys.pm0.ret); else if (hflags & HF_IN_PM1) nxtdsp = scr_to_cpu(cp->phys.pm1.ret); if (hflags & HF_DP_SAVED) hflags ^= HF_ACT_PM; } if (!(hflags & HF_ACT_PM)) { pm = &cp->phys.pm0; newcmd = NCB_SCRIPT_PHYS(np, pm0_data); } else { pm = &cp->phys.pm1; newcmd = NCB_SCRIPT_PHYS(np, pm1_data); } hflags &= ~(HF_IN_PM0 | HF_IN_PM1 | HF_DP_SAVED); if (hflags != hflags0) OUTB (HF_PRT, hflags); /* ** fillin the phase mismatch context */ pm->sg.addr = cpu_to_scr(oadr + olen - rest); pm->sg.size = cpu_to_scr(rest); pm->ret = cpu_to_scr(nxtdsp); /* ** If we have a SWIDE, ** - prepare the address to write the SWIDE from SCRIPTS, ** - compute the SCRIPTS address to restart from, ** - move current data pointer context by one byte. */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); if ( ((cmd & 7) == 1 || (cmd & 7) == 5) && cp && (cp->phys.select.sel_scntl3 & EWS) && (INB (nc_scntl2) & WSR)) { u32 tmp; #ifdef SYM_DEBUG_PM_WITH_WSR PRINT_ADDR(cp); printk ("MA interrupt with WSR set - " "pm->sg.addr=%x - pm->sg.size=%d\n", pm->sg.addr, pm->sg.size); #endif /* * Set up the table indirect for the MOVE * of the residual byte and adjust the data * pointer context. */ tmp = scr_to_cpu(pm->sg.addr); cp->phys.wresid.addr = cpu_to_scr(tmp); pm->sg.addr = cpu_to_scr(tmp + 1); tmp = scr_to_cpu(pm->sg.size); cp->phys.wresid.size = cpu_to_scr((tmp&0xff000000) | 1); pm->sg.size = cpu_to_scr(tmp - 1); /* * If only the residual byte is to be moved, * no PM context is needed. */ if ((tmp&0xffffff) == 1) newcmd = pm->ret; /* * Prepare the address of SCRIPTS that will * move the residual byte to memory. */ nxtdsp = NCB_SCRIPTH_PHYS (np, wsr_ma_helper); } if (DEBUG_FLAGS & DEBUG_PHASE) { PRINT_ADDR(cp->cmd); printk ("PM %x %x %x / %x %x %x.\n", hflags0, hflags, newcmd, (unsigned)scr_to_cpu(pm->sg.addr), (unsigned)scr_to_cpu(pm->sg.size), (unsigned)scr_to_cpu(pm->ret)); } /* ** Restart the SCRIPTS processor. */ OUTL (nc_temp, newcmd); OUTL_DSP (nxtdsp); return; /* ** Unexpected phase changes that occurs when the current phase ** is not a DATA IN or DATA OUT phase are due to error conditions. ** Such event may only happen when the SCRIPTS is using a ** multibyte SCSI MOVE. ** ** Phase change Some possible cause ** ** COMMAND --> MSG IN SCSI parity error detected by target. ** COMMAND --> STATUS Bad command or refused by target. ** MSG OUT --> MSG IN Message rejected by target. ** MSG OUT --> COMMAND Bogus target that discards extended ** negotiation messages. ** ** The code below does not care of the new phase and so ** trusts the target. Why to annoy it ? ** If the interrupted phase is COMMAND phase, we restart at ** dispatcher. ** If a target does not get all the messages after selection, ** the code assumes blindly that the target discards extended ** messages and clears the negotiation status. ** If the target does not want all our response to negotiation, ** we force a SIR_NEGO_PROTO interrupt (it is a hack that avoids ** bloat for such a should_not_happen situation). ** In all other situation, we reset the BUS. ** Are these assumptions reasonable ? (Wait and see ...) */ unexpected_phase: dsp -= 8; nxtdsp = 0; switch (cmd & 7) { case 2: /* COMMAND phase */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); break; #if 0 case 3: /* STATUS phase */ nxtdsp = NCB_SCRIPT_PHYS (np, dispatch); break; #endif case 6: /* MSG OUT phase */ /* ** If the device may want to use untagged when we want ** tagged, we prepare an IDENTIFY without disc. granted, ** since we will not be able to handle reselect. ** Otherwise, we just don't care. */ if (dsp == NCB_SCRIPT_PHYS (np, send_ident)) { if (cp->tag != NO_TAG && olen - rest <= 3) { cp->host_status = HS_BUSY; np->msgout[0] = M_IDENTIFY | cp->lun; nxtdsp = NCB_SCRIPTH_PHYS (np, ident_break_atn); } else nxtdsp = NCB_SCRIPTH_PHYS (np, ident_break); } else if (dsp == NCB_SCRIPTH_PHYS (np, send_wdtr) || dsp == NCB_SCRIPTH_PHYS (np, send_sdtr) || dsp == NCB_SCRIPTH_PHYS (np, send_ppr)) { nxtdsp = NCB_SCRIPTH_PHYS (np, nego_bad_phase); } break; #if 0 case 7: /* MSG IN phase */ nxtdsp = NCB_SCRIPT_PHYS (np, clrack); break; #endif } if (nxtdsp) { OUTL_DSP (nxtdsp); return; } reset_all: ncr_start_reset(np); } /*========================================================== ** ** ncr chip handler for QUEUE FULL and CHECK CONDITION ** **========================================================== ** ** On QUEUE FULL status, we set the actual tagged command ** queue depth to the number of disconnected CCBs that is ** hopefully a good value to avoid further QUEUE FULL. ** ** On CHECK CONDITION or COMMAND TERMINATED, we use the ** CCB of the failed command for performing a REQUEST ** SENSE SCSI command. ** ** We do not want to change the order commands will be ** actually queued to the device after we received a ** QUEUE FULL status. We also want to properly deal with ** contingent allegiance condition. For these reasons, ** we remove from the start queue all commands for this ** LUN that haven't been yet queued to the device and ** put them back in the corresponding LUN queue, then ** requeue the CCB that failed in front of the LUN queue. ** I just hope this not to be performed too often. :) ** ** If we are using IMMEDIATE ARBITRATION, we clear the ** IARB hint for every commands we encounter in order not ** to be stuck with a won arbitration and no job to queue ** to a device. **---------------------------------------------------------- */ static void ncr_sir_to_redo(ncb_p np, int num, ccb_p cp) { Scsi_Cmnd *cmd = cp->cmd; tcb_p tp = &np->target[cp->target]; lcb_p lp = ncr_lp(np, tp, cp->lun); ccb_p cp2; int busyccbs = 1; u_int32 startp; u_char s_status = INB (SS_PRT); int msglen; int i, j; /* ** If the LCB is not yet available, then only ** 1 IO is accepted, so we should have it. */ if (!lp) goto next; /* ** Remove all CCBs queued to the chip for that LUN and put ** them back in the LUN CCB wait queue. */ busyccbs = lp->queuedccbs; i = (INL (nc_scratcha) - np->p_squeue) / 4; j = i; while (i != np->squeueput) { cp2 = ncr_ccb_from_dsa(np, scr_to_cpu(np->squeue[i])); assert(cp2); #ifdef SCSI_NCR_IARB_SUPPORT /* IARB hints may not be relevant any more. Forget them. */ cp2->host_flags &= ~HF_HINT_IARB; #endif if (cp2 && cp2->target == cp->target && cp2->lun == cp->lun) { xpt_remque(&cp2->link_ccbq); xpt_insque_head(&cp2->link_ccbq, &lp->wait_ccbq); --lp->queuedccbs; cp2->queued = 0; } else { if (i != j) np->squeue[j] = np->squeue[i]; if ((j += 2) >= MAX_START*2) j = 0; } if ((i += 2) >= MAX_START*2) i = 0; } if (i != j) /* Copy back the idle task if needed */ np->squeue[j] = np->squeue[i]; np->squeueput = j; /* Update our current start queue pointer */ /* ** Requeue the interrupted CCB in front of the ** LUN CCB wait queue to preserve ordering. */ xpt_remque(&cp->link_ccbq); xpt_insque_head(&cp->link_ccbq, &lp->wait_ccbq); --lp->queuedccbs; cp->queued = 0; next: #ifdef SCSI_NCR_IARB_SUPPORT /* IARB hint may not be relevant any more. Forget it. */ cp->host_flags &= ~HF_HINT_IARB; if (np->last_cp) np->last_cp = 0; #endif /* ** Now we can restart the SCRIPTS processor safely. */ OUTL_DSP (NCB_SCRIPT_PHYS (np, start)); switch(s_status) { default: case S_BUSY: ncr_complete(np, cp); break; case S_QUEUE_FULL: if (!lp || !lp->queuedccbs) { ncr_complete(np, cp); break; } if (bootverbose >= 1) { PRINT_ADDR(cmd); printk ("QUEUE FULL! %d busy, %d disconnected CCBs\n", busyccbs, lp->queuedccbs); } /* ** Decrease number of tags to the number of ** disconnected commands. */ if (lp->queuedccbs < lp->numtags) { lp->numtags = lp->queuedccbs; lp->num_good = 0; ncr_setup_tags (np, cp->target, cp->lun); } /* ** Repair the offending CCB. */ cp->phys.header.savep = cp->startp; cp->phys.header.lastp = cp->lastp0; cp->host_status = HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->xerr_status = 0; cp->extra_bytes = 0; cp->host_flags &= (HF_PM_TO_C|HF_DATA_IN); break; case S_TERMINATED: case S_CHECK_COND: /* ** If we were requesting sense, give up. */ if (cp->host_flags & HF_AUTO_SENSE) { ncr_complete(np, cp); break; } /* ** Save SCSI status and extended error. ** Compute the data residual now. */ cp->sv_scsi_status = cp->scsi_status; cp->sv_xerr_status = cp->xerr_status; cp->resid = ncr_compute_residual(np, cp); /* ** Device returned CHECK CONDITION status. ** Prepare all needed data structures for getting ** sense data. */ /* ** identify message */ cp->scsi_smsg2[0] = M_IDENTIFY | cp->lun; msglen = 1; /* ** If we are currently using anything different from ** async. 8 bit data transfers with that target, ** start a negotiation, since the device may want ** to report us a UNIT ATTENTION condition due to ** a cause we currently ignore, and we donnot want ** to be stuck with WIDE and/or SYNC data transfer. ** ** cp->nego_status is filled by ncr_prepare_nego(). ** ** Do NOT negotiate if performing integrity check ** or if integrity check has completed, all check ** conditions will have been cleared. */ #ifdef SCSI_NCR_INTEGRITY_CHECKING if (DEBUG_FLAGS & DEBUG_IC) { printk("%s: ncr_sir_to_redo: ic_done %2X, in_progress %2X\n", ncr_name(np), tp->ic_done, cp->cmd->ic_in_progress); } /* ** If parity error during integrity check, ** set the target width to narrow. Otherwise, ** do not negotiate on a request sense. */ if ( np->check_integ_par && np->check_integrity && cp->cmd->ic_in_progress ) { cp->nego_status = 0; msglen += ncr_ic_nego (np, cp, cmd ,&cp->scsi_smsg2[msglen]); } if (!np->check_integrity || (np->check_integrity && (!cp->cmd->ic_in_progress && !tp->ic_done)) ) { ncr_negotiate(np, tp); cp->nego_status = 0; { u_char sync_offset; if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)) sync_offset = tp->sval & 0x3f; else sync_offset = tp->sval & 0x1f; if ((tp->wval & EWS) || sync_offset) msglen += ncr_prepare_nego (np, cp, &cp->scsi_smsg2[msglen]); } } #else ncr_negotiate(np, tp); cp->nego_status = 0; if ((tp->wval & EWS) || (tp->sval & 0x1f)) msglen += ncr_prepare_nego (np, cp, &cp->scsi_smsg2[msglen]); #endif /* SCSI_NCR_INTEGRITY_CHECKING */ /* ** Message table indirect structure. */ cp->phys.smsg.addr = cpu_to_scr(CCB_PHYS (cp, scsi_smsg2)); cp->phys.smsg.size = cpu_to_scr(msglen); /* ** sense command */ cp->phys.cmd.addr = cpu_to_scr(CCB_PHYS (cp, sensecmd)); cp->phys.cmd.size = cpu_to_scr(6); /* ** patch requested size into sense command */ cp->sensecmd[0] = 0x03; cp->sensecmd[1] = cp->lun << 5; cp->sensecmd[4] = sizeof(cp->sense_buf); /* ** sense data */ bzero(cp->sense_buf, sizeof(cp->sense_buf)); cp->phys.sense.addr = cpu_to_scr(CCB_PHYS(cp,sense_buf[0])); cp->phys.sense.size = cpu_to_scr(sizeof(cp->sense_buf)); /* ** requeue the command. */ startp = NCB_SCRIPTH_PHYS (np, sdata_in); cp->phys.header.savep = cpu_to_scr(startp); cp->phys.header.goalp = cpu_to_scr(startp + 16); cp->phys.header.lastp = cpu_to_scr(startp); cp->phys.header.wgoalp = cpu_to_scr(startp + 16); cp->phys.header.wlastp = cpu_to_scr(startp); cp->host_status = cp->nego_status ? HS_NEGOTIATE : HS_BUSY; cp->scsi_status = S_ILLEGAL; cp->host_flags = (HF_AUTO_SENSE|HF_DATA_IN); cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, select)); /* ** If lp not yet allocated, requeue the command. */ if (!lp) ncr_put_start_queue(np, cp); break; } /* ** requeue awaiting scsi commands for this lun. */ if (lp) ncr_start_next_ccb(np, lp, 1); return; } /*---------------------------------------------------------- ** ** After a device has accepted some management message ** as BUS DEVICE RESET, ABORT TASK, etc ..., or when ** a device signals a UNIT ATTENTION condition, some ** tasks are thrown away by the device. We are required ** to reflect that on our tasks list since the device ** will never complete these tasks. ** ** This function completes all disconnected CCBs for a ** given target that matches the following criteria: ** - lun=-1 means any logical UNIT otherwise a given one. ** - task=-1 means any task, otherwise a given one. **---------------------------------------------------------- */ static int ncr_clear_tasks(ncb_p np, u_char hsts, int target, int lun, int task) { int i = 0; ccb_p cp; for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->target != target) continue; if (lun != -1 && cp->lun != lun) continue; if (task != -1 && cp->tag != NO_TAG && cp->scsi_smsg[2] != task) continue; cp->host_status = hsts; cp->scsi_status = S_ILLEGAL; ncr_complete(np, cp); ++i; } return i; } /*========================================================== ** ** ncr chip handler for TASKS recovery. ** **========================================================== ** ** We cannot safely abort a command, while the SCRIPTS ** processor is running, since we just would be in race ** with it. ** ** As long as we have tasks to abort, we keep the SEM ** bit set in the ISTAT. When this bit is set, the ** SCRIPTS processor interrupts (SIR_SCRIPT_STOPPED) ** each time it enters the scheduler. ** ** If we have to reset a target, clear tasks of a unit, ** or to perform the abort of a disconnected job, we ** restart the SCRIPTS for selecting the target. Once ** selected, the SCRIPTS interrupts (SIR_TARGET_SELECTED). ** If it loses arbitration, the SCRIPTS will interrupt again ** the next time it will enter its scheduler, and so on ... ** ** On SIR_TARGET_SELECTED, we scan for the more ** appropriate thing to do: ** ** - If nothing, we just sent a M_ABORT message to the ** target to get rid of the useless SCSI bus ownership. ** According to the specs, no tasks shall be affected. ** - If the target is to be reset, we send it a M_RESET ** message. ** - If a logical UNIT is to be cleared , we send the ** IDENTIFY(lun) + M_ABORT. ** - If an untagged task is to be aborted, we send the ** IDENTIFY(lun) + M_ABORT. ** - If a tagged task is to be aborted, we send the ** IDENTIFY(lun) + task attributes + M_ABORT_TAG. ** ** Once our 'kiss of death' :) message has been accepted ** by the target, the SCRIPTS interrupts again ** (SIR_ABORT_SENT). On this interrupt, we complete ** all the CCBs that should have been aborted by the ** target according to our message. ** **---------------------------------------------------------- */ static void ncr_sir_task_recovery(ncb_p np, int num) { ccb_p cp; tcb_p tp; int target=-1, lun=-1, task; int i, k; u_char *p; switch(num) { /* ** The SCRIPTS processor stopped before starting ** the next command in order to allow us to perform ** some task recovery. */ case SIR_SCRIPT_STOPPED: /* ** Do we have any target to reset or unit to clear ? */ for (i = 0 ; i < MAX_TARGET ; i++) { tp = &np->target[i]; if (tp->to_reset || (tp->l0p && tp->l0p->to_clear)) { target = i; break; } if (!tp->lmp) continue; for (k = 1 ; k < MAX_LUN ; k++) { if (tp->lmp[k] && tp->lmp[k]->to_clear) { target = i; break; } } if (target != -1) break; } /* ** If not, look at the CCB list for any ** disconnected CCB to be aborted. */ if (target == -1) { for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->to_abort) { target = cp->target; break; } } } /* ** If some target is to be selected, ** prepare and start the selection. */ if (target != -1) { tp = &np->target[target]; np->abrt_sel.sel_id = target; np->abrt_sel.sel_scntl3 = tp->wval; np->abrt_sel.sel_sxfer = tp->sval; np->abrt_sel.sel_scntl4 = tp->uval; OUTL(nc_dsa, np->p_ncb); OUTL_DSP (NCB_SCRIPTH_PHYS (np, sel_for_abort)); return; } /* ** Nothing is to be selected, so we donnot need ** to synchronize with the SCRIPTS anymore. ** Remove the SEM flag from the ISTAT. */ np->istat_sem = 0; OUTB (nc_istat, SIGP); /* ** Now look at CCBs to abort that haven't started yet. ** Remove all those CCBs from the start queue and ** complete them with appropriate status. ** Btw, the SCRIPTS processor is still stopped, so ** we are not in race. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_BUSY && cp->host_status != HS_NEGOTIATE) continue; if (!cp->to_abort) continue; #ifdef SCSI_NCR_IARB_SUPPORT /* ** If we are using IMMEDIATE ARBITRATION, we donnot ** want to cancel the last queued CCB, since the ** SCRIPTS may have anticipated the selection. */ if (cp == np->last_cp) { cp->to_abort = 0; continue; } #endif /* ** Compute index of next position in the start ** queue the SCRIPTS will schedule. */ i = (INL (nc_scratcha) - np->p_squeue) / 4; /* ** Remove the job from the start queue. */ k = -1; while (1) { if (i == np->squeueput) break; if (k == -1) { /* Not found yet */ if (cp == ncr_ccb_from_dsa(np, scr_to_cpu(np->squeue[i]))) k = i; /* Found */ } else { /* ** Once found, we have to move ** back all jobs by 1 position. */ np->squeue[k] = np->squeue[i]; k += 2; if (k >= MAX_START*2) k = 0; } i += 2; if (i >= MAX_START*2) i = 0; } /* ** If job removed, repair the start queue. */ if (k != -1) { np->squeue[k] = np->squeue[i]; /* Idle task */ np->squeueput = k; /* Start queue pointer */ } cp->host_status = HS_ABORTED; cp->scsi_status = S_ILLEGAL; ncr_complete(np, cp); } break; /* ** The SCRIPTS processor has selected a target ** we may have some manual recovery to perform for. */ case SIR_TARGET_SELECTED: target = (INB (nc_sdid) & 0xf); tp = &np->target[target]; np->abrt_tbl.addr = cpu_to_scr(vtobus(np->abrt_msg)); /* ** If the target is to be reset, prepare a ** M_RESET message and clear the to_reset flag ** since we donnot expect this operation to fail. */ if (tp->to_reset) { np->abrt_msg[0] = M_RESET; np->abrt_tbl.size = 1; tp->to_reset = 0; break; } /* ** Otherwise, look for some logical unit to be cleared. */ if (tp->l0p && tp->l0p->to_clear) lun = 0; else if (tp->lmp) { for (k = 1 ; k < MAX_LUN ; k++) { if (tp->lmp[k] && tp->lmp[k]->to_clear) { lun = k; break; } } } /* ** If a logical unit is to be cleared, prepare ** an IDENTIFY(lun) + ABORT MESSAGE. */ if (lun != -1) { lcb_p lp = ncr_lp(np, tp, lun); lp->to_clear = 0; /* We donnot expect to fail here */ np->abrt_msg[0] = M_IDENTIFY | lun; np->abrt_msg[1] = M_ABORT; np->abrt_tbl.size = 2; break; } /* ** Otherwise, look for some disconnected job to ** abort for this target. */ for (cp = np->ccbc; cp; cp = cp->link_ccb) { if (cp->host_status != HS_DISCONNECT) continue; if (cp->target != target) continue; if (cp->to_abort) break; } /* ** If we have none, probably since the device has ** completed the command before we won arbitration, ** send a M_ABORT message without IDENTIFY. ** According to the specs, the device must just ** disconnect the BUS and not abort any task. */ if (!cp) { np->abrt_msg[0] = M_ABORT; np->abrt_tbl.size = 1; break; } /* ** We have some task to abort. ** Set the IDENTIFY(lun) */ np->abrt_msg[0] = M_IDENTIFY | cp->lun; /* ** If we want to abort an untagged command, we ** will send a IDENTIFY + M_ABORT. ** Otherwise (tagged command), we will send ** a IDENTITFY + task attributes + ABORT TAG. */ if (cp->tag == NO_TAG) { np->abrt_msg[1] = M_ABORT; np->abrt_tbl.size = 2; } else { np->abrt_msg[1] = cp->scsi_smsg[1]; np->abrt_msg[2] = cp->scsi_smsg[2]; np->abrt_msg[3] = M_ABORT_TAG; np->abrt_tbl.size = 4; } cp->to_abort = 0; /* We donnot expect to fail here */ break; /* ** The target has accepted our message and switched ** to BUS FREE phase as we expected. */ case SIR_ABORT_SENT: target = (INB (nc_sdid) & 0xf); tp = &np->target[target]; /* ** If we didn't abort anything, leave here. */ if (np->abrt_msg[0] == M_ABORT) break; /* ** If we sent a M_RESET, then a hardware reset has ** been performed by the target. ** - Reset everything to async 8 bit ** - Tell ourselves to negotiate next time :-) ** - Prepare to clear all disconnected CCBs for ** this target from our task list (lun=task=-1) */ lun = -1; task = -1; if (np->abrt_msg[0] == M_RESET) { tp->sval = 0; tp->wval = np->rv_scntl3; tp->uval = np->rv_scntl4; ncr_set_sync_wide_status(np, target); ncr_negotiate(np, tp); } /* ** Otherwise, check for the LUN and TASK(s) ** concerned by the cancellation. ** If it is not ABORT_TAG then it is CLEAR_QUEUE ** or an ABORT message :-) */ else { lun = np->abrt_msg[0] & 0x3f; if (np->abrt_msg[1] == M_ABORT_TAG) task = np->abrt_msg[2]; } /* ** Complete all the CCBs the device should have ** aborted due to our 'kiss of death' message. */ (void) ncr_clear_tasks(np, HS_ABORTED, target, lun, task); break; /* ** We have performed a auto-sense that succeeded. ** If the device reports a UNIT ATTENTION condition ** due to a RESET condition, we must complete all ** disconnect CCBs for this unit since the device ** shall have thrown them away. ** Since I haven't time to guess what the specs are ** expecting for other UNIT ATTENTION conditions, I ** decided to only care about RESET conditions. :) */ case SIR_AUTO_SENSE_DONE: cp = ncr_ccb_from_dsa(np, INL (nc_dsa)); if (!cp) break; memcpy(cp->cmd->sense_buffer, cp->sense_buf, sizeof(cp->cmd->sense_buffer)); p = &cp->cmd->sense_buffer[0]; if (p[0] != 0x70 || p[2] != 0x6 || p[12] != 0x29) break; #if 0 (void) ncr_clear_tasks(np, HS_RESET, cp->target, cp->lun, -1); #endif break; } /* ** Print to the log the message we intend to send. */ if (num == SIR_TARGET_SELECTED) { PRINT_TARGET(np, target); ncr_printl_hex("control msgout:", np->abrt_msg, np->abrt_tbl.size); np->abrt_tbl.size = cpu_to_scr(np->abrt_tbl.size); } /* ** Let the SCRIPTS processor continue. */ OUTONB_STD (); } /*========================================================== ** ** Grard's alchemy:) that deals with with the data ** pointer for both MDP and the residual calculation. ** **========================================================== ** ** I didn't want to bloat the code by more than 200 ** lignes for the handling of both MDP and the residual. ** This has been achieved by using a data pointer ** representation consisting in an index in the data ** array (dp_sg) and a negative offset (dp_ofs) that ** have the following meaning: ** ** - dp_sg = MAX_SCATTER ** we are at the end of the data script. ** - dp_sg < MAX_SCATTER ** dp_sg points to the next entry of the scatter array ** we want to transfer. ** - dp_ofs < 0 ** dp_ofs represents the residual of bytes of the ** previous entry scatter entry we will send first. ** - dp_ofs = 0 ** no residual to send first. ** ** The function ncr_evaluate_dp() accepts an arbitray ** offset (basically from the MDP message) and returns ** the corresponding values of dp_sg and dp_ofs. ** **---------------------------------------------------------- */ static int ncr_evaluate_dp(ncb_p np, ccb_p cp, u_int32 scr, int *ofs) { u_int32 dp_scr; int dp_ofs, dp_sg, dp_sgmin; int tmp; struct pm_ctx *pm; /* ** Compute the resulted data pointer in term of a script ** address within some DATA script and a signed byte offset. */ dp_scr = scr; dp_ofs = *ofs; if (dp_scr == NCB_SCRIPT_PHYS (np, pm0_data)) pm = &cp->phys.pm0; else if (dp_scr == NCB_SCRIPT_PHYS (np, pm1_data)) pm = &cp->phys.pm1; else pm = 0; if (pm) { dp_scr = scr_to_cpu(pm->ret); dp_ofs -= scr_to_cpu(pm->sg.size); } /* ** Deduce the index of the sg entry. ** Keep track of the index of the first valid entry. ** If result is dp_sg = MAX_SCATTER, then we are at the ** end of the data and vice-versa. */ tmp = scr_to_cpu(cp->phys.header.goalp); dp_sg = MAX_SCATTER; if (dp_scr != tmp) dp_sg -= (tmp - 8 - (int)dp_scr) / (SCR_SG_SIZE*4); dp_sgmin = MAX_SCATTER - cp->segments; /* ** Move to the sg entry the data pointer belongs to. ** ** If we are inside the data area, we expect result to be: ** ** Either, ** dp_ofs = 0 and dp_sg is the index of the sg entry ** the data pointer belongs to (or the end of the data) ** Or, ** dp_ofs < 0 and dp_sg is the index of the sg entry ** the data pointer belongs to + 1. */ if (dp_ofs < 0) { int n; while (dp_sg > dp_sgmin) { --dp_sg; tmp = scr_to_cpu(cp->phys.data[dp_sg].size); n = dp_ofs + (tmp & 0xffffff); if (n > 0) { ++dp_sg; break; } dp_ofs = n; } } else if (dp_ofs > 0) { while (dp_sg < MAX_SCATTER) { tmp = scr_to_cpu(cp->phys.data[dp_sg].size); dp_ofs -= (tmp & 0xffffff); ++dp_sg; if (dp_ofs <= 0) break; } } /* ** Make sure the data pointer is inside the data area. ** If not, return some error. */ if (dp_sg < dp_sgmin || (dp_sg == dp_sgmin && dp_ofs < 0)) goto out_err; else if (dp_sg > MAX_SCATTER || (dp_sg == MAX_SCATTER && dp_ofs > 0)) goto out_err; /* ** Save the extreme pointer if needed. */ if (dp_sg > cp->ext_sg || (dp_sg == cp->ext_sg && dp_ofs > cp->ext_ofs)) { cp->ext_sg = dp_sg; cp->ext_ofs = dp_ofs; } /* ** Return data. */ *ofs = dp_ofs; return dp_sg; out_err: return -1; } /*========================================================== ** ** ncr chip handler for MODIFY DATA POINTER MESSAGE ** **========================================================== ** ** We also call this function on IGNORE WIDE RESIDUE ** messages that do not match a SWIDE full condition. ** Btw, we assume in that situation that such a message ** is equivalent to a MODIFY DATA POINTER (offset=-1). ** **---------------------------------------------------------- */ static void ncr_modify_dp(ncb_p np, tcb_p tp, ccb_p cp, int ofs) { int dp_ofs = ofs; u_int32 dp_scr = INL (nc_temp); u_int32 dp_ret; u_int32 tmp; u_char hflags; int dp_sg; struct pm_ctx *pm; /* ** Not supported for auto_sense; */ if (cp->host_flags & HF_AUTO_SENSE) goto out_reject; /* ** Apply our alchemy:) (see comments in ncr_evaluate_dp()), ** to the resulted data pointer. */ dp_sg = ncr_evaluate_dp(np, cp, dp_scr, &dp_ofs); if (dp_sg < 0) goto out_reject; /* ** And our alchemy:) allows to easily calculate the data ** script address we want to return for the next data phase. */ dp_ret = cpu_to_scr(cp->phys.header.goalp); dp_ret = dp_ret - 8 - (MAX_SCATTER - dp_sg) * (SCR_SG_SIZE*4); /* ** If offset / scatter entry is zero we donnot need ** a context for the new current data pointer. */ if (dp_ofs == 0) { dp_scr = dp_ret; goto out_ok; } /* ** Get a context for the new current data pointer. */ hflags = INB (HF_PRT); if (hflags & HF_DP_SAVED) hflags ^= HF_ACT_PM; if (!(hflags & HF_ACT_PM)) { pm = &cp->phys.pm0; dp_scr = NCB_SCRIPT_PHYS (np, pm0_data); } else { pm = &cp->phys.pm1; dp_scr = NCB_SCRIPT_PHYS (np, pm1_data); } hflags &= ~(HF_DP_SAVED); OUTB (HF_PRT, hflags); /* ** Set up the new current data pointer. ** ofs < 0 there, and for the next data phase, we ** want to transfer part of the data of the sg entry ** corresponding to index dp_sg-1 prior to returning ** to the main data script. */ pm->ret = cpu_to_scr(dp_ret); tmp = scr_to_cpu(cp->phys.data[dp_sg-1].addr); tmp += scr_to_cpu(cp->phys.data[dp_sg-1].size) + dp_ofs; pm->sg.addr = cpu_to_scr(tmp); pm->sg.size = cpu_to_scr(-dp_ofs); out_ok: OUTL (nc_temp, dp_scr); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; out_reject: OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } /*========================================================== ** ** ncr chip calculation of the data residual. ** **========================================================== ** ** As I used to say, the requirement of data residual ** in SCSI is broken, useless and cannot be achieved ** without huge complexity. ** But most OSes and even the official CAM require it. ** When stupidity happens to be so widely spread inside ** a community, it gets hard to convince. ** ** Anyway, I don't care, since I am not going to use ** any software that considers this data residual as ** a relevant information. :) ** **---------------------------------------------------------- */ static int ncr_compute_residual(ncb_p np, ccb_p cp) { int dp_sg, dp_sgmin, tmp; int resid=0; int dp_ofs = 0; /* * Check for some data lost or just thrown away. * We are not required to be quite accurate in this * situation. Btw, if we are odd for output and the * device claims some more data, it may well happen * than our residual be zero. :-) */ if (cp->xerr_status & (XE_EXTRA_DATA|XE_SODL_UNRUN|XE_SWIDE_OVRUN)) { if (cp->xerr_status & XE_EXTRA_DATA) resid -= cp->extra_bytes; if (cp->xerr_status & XE_SODL_UNRUN) ++resid; if (cp->xerr_status & XE_SWIDE_OVRUN) --resid; } /* ** If SCRIPTS reaches its goal point, then ** there is no additional residual. */ if (cp->phys.header.lastp == cp->phys.header.goalp) return resid; /* ** If the last data pointer is data_io (direction ** unknown), then no data transfer should have ** taken place. */ if (cp->phys.header.lastp == NCB_SCRIPTH_PHYS (np, data_io)) return cp->data_len; /* ** If no data transfer occurs, or if the data ** pointer is weird, return full residual. */ if (cp->startp == cp->phys.header.lastp || ncr_evaluate_dp(np, cp, scr_to_cpu(cp->phys.header.lastp), &dp_ofs) < 0) { return cp->data_len; } /* ** We are now full comfortable in the computation ** of the data residual (2's complement). */ dp_sgmin = MAX_SCATTER - cp->segments; resid = -cp->ext_ofs; for (dp_sg = cp->ext_sg; dp_sg < MAX_SCATTER; ++dp_sg) { tmp = scr_to_cpu(cp->phys.data[dp_sg].size); resid += (tmp & 0xffffff); } /* ** Hopefully, the result is not too wrong. */ return resid; } /*========================================================== ** ** Print out the containt of a SCSI message. ** **========================================================== */ static int ncr_show_msg (u_char * msg) { u_char i; printk ("%x",*msg); if (*msg==M_EXTENDED) { for (i=1;i<8;i++) { if (i-1>msg[1]) break; printk ("-%x",msg[i]); }; return (i+1); } else if ((*msg & 0xf0) == 0x20) { printk ("-%x",msg[1]); return (2); }; return (1); } static void ncr_print_msg (ccb_p cp, char *label, u_char *msg) { if (cp) PRINT_ADDR(cp->cmd); if (label) printk ("%s: ", label); (void) ncr_show_msg (msg); printk (".\n"); } /*=================================================================== ** ** Negotiation for WIDE and SYNCHRONOUS DATA TRANSFER. ** **=================================================================== ** ** Was Sie schon immer ueber transfermode negotiation wissen wollten ... ** ** We try to negotiate sync and wide transfer only after ** a successful inquire command. We look at byte 7 of the ** inquire data to determine the capabilities of the target. ** ** When we try to negotiate, we append the negotiation message ** to the identify and (maybe) simple tag message. ** The host status field is set to HS_NEGOTIATE to mark this ** situation. ** ** If the target doesn't answer this message immediately ** (as required by the standard), the SIR_NEGO_FAILED interrupt ** will be raised eventually. ** The handler removes the HS_NEGOTIATE status, and sets the ** negotiated value to the default (async / nowide). ** ** If we receive a matching answer immediately, we check it ** for validity, and set the values. ** ** If we receive a Reject message immediately, we assume the ** negotiation has failed, and fall back to standard values. ** ** If we receive a negotiation message while not in HS_NEGOTIATE ** state, it's a target initiated negotiation. We prepare a ** (hopefully) valid answer, set our parameters, and send back ** this answer to the target. ** ** If the target doesn't fetch the answer (no message out phase), ** we assume the negotiation has failed, and fall back to default ** settings (SIR_NEGO_PROTO interrupt). ** ** When we set the values, we adjust them in all ccbs belonging ** to this target, in the controller's register, and in the "phys" ** field of the controller's struct ncb. ** **--------------------------------------------------------------------- */ /*========================================================== ** ** ncr chip handler for SYNCHRONOUS DATA TRANSFER ** REQUEST (SDTR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_sync_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char scntl3, scntl4; u_char chg, ofs, per, fak; /* ** Synchronous request message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "sync msg in", np->msgin); }; /* ** get requested values. */ chg = 0; per = np->msgin[3]; ofs = np->msgin[4]; if (ofs==0) per=255; /* ** if target sends SDTR message, ** it CAN transfer sync. */ if (ofs) tp->inq_byte7 |= INQ7_SYNC; /* ** check values against driver limits. */ if (per < np->minsync) {chg = 1; per = np->minsync;} if (per < tp->minsync) {chg = 1; per = tp->minsync;} if (ofs > np->maxoffs_st) {chg = 1; ofs = np->maxoffs_st;} if (ofs > tp->maxoffs) {chg = 1; ofs = tp->maxoffs;} /* ** Check against controller limits. */ fak = 7; scntl3 = 0; scntl4 = 0; if (ofs != 0) { ncr_getsync(np, per, &fak, &scntl3); if (fak > 7) { chg = 1; ofs = 0; } } if (ofs == 0) { fak = 7; per = 0; scntl3 = 0; scntl4 = 0; tp->minsync = 0; } if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("sync: per=%d scntl3=0x%x scntl4=0x%x ofs=%d fak=%d chg=%d.\n", per, scntl3, scntl4, ofs, fak, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_SYNC: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ ncr_setsync (np, cp, 0, 0xe0, 0); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsync (np, cp, scntl3, (fak<<5)|ofs,0); else ncr_setsync (np, cp, scntl3, ofs, scntl4); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; }; }; /* ** It was a request. Set value and ** prepare an answer message */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsync (np, cp, scntl3, (fak<<5)|ofs,0); else ncr_setsync (np, cp, scntl3, ofs, scntl4); np->msgout[0] = M_EXTENDED; np->msgout[1] = 3; np->msgout[2] = M_X_SYNC_REQ; np->msgout[3] = per; np->msgout[4] = ofs; cp->nego_status = NS_SYNC; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "sync msgout", np->msgout); } np->msgin [0] = M_NOOP; if (!ofs) OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); else OUTL_DSP (NCB_SCRIPTH_PHYS (np, sdtr_resp)); } /*========================================================== ** ** ncr chip handler for WIDE DATA TRANSFER REQUEST ** (WDTR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_wide_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char chg, wide; /* ** Wide request message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "wide msgin", np->msgin); }; /* ** get requested values. */ chg = 0; wide = np->msgin[3]; /* ** if target sends WDTR message, ** it CAN transfer wide. */ if (wide) tp->inq_byte7 |= INQ7_WIDE16; /* ** check values against driver limits. */ if (wide > tp->usrwide) {chg = 1; wide = tp->usrwide;} if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("wide: wide=%d chg=%d.\n", wide, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_WIDE: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ ncr_setwide (np, cp, 0, 1); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ ncr_setwide (np, cp, wide, 1); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; }; }; /* ** It was a request, set value and ** prepare an answer message */ ncr_setwide (np, cp, wide, 1); np->msgout[0] = M_EXTENDED; np->msgout[1] = 2; np->msgout[2] = M_X_WIDE_REQ; np->msgout[3] = wide; np->msgin [0] = M_NOOP; cp->nego_status = NS_WIDE; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "wide msgout", np->msgout); } OUTL_DSP (NCB_SCRIPTH_PHYS (np, wdtr_resp)); } /*========================================================== ** ** ncr chip handler for PARALLEL PROTOCOL REQUEST ** (PPR) message. ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_ppr_nego(ncb_p np, tcb_p tp, ccb_p cp) { u_char scntl3, scntl4; u_char chg, ofs, per, fak, wth, dt; /* ** PPR message received. */ if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "ppr msg in", np->msgin); }; /* ** get requested values. */ chg = 0; per = np->msgin[3]; ofs = np->msgin[5]; wth = np->msgin[6]; dt = np->msgin[7]; if (ofs==0) per=255; /* ** if target sends sync (wide), ** it CAN transfer sync (wide). */ if (ofs) tp->inq_byte7 |= INQ7_SYNC; if (wth) tp->inq_byte7 |= INQ7_WIDE16; /* ** check values against driver limits. */ if (wth > tp->usrwide) {chg = 1; wth = tp->usrwide;} if (per < np->minsync) {chg = 1; per = np->minsync;} if (per < tp->minsync) {chg = 1; per = tp->minsync;} if (ofs > tp->maxoffs) {chg = 1; ofs = tp->maxoffs;} /* ** Check against controller limits. */ fak = 7; scntl3 = 0; scntl4 = 0; if (ofs != 0) { scntl4 = dt ? 0x80 : 0; ncr_getsync(np, per, &fak, &scntl3); if (fak > 7) { chg = 1; ofs = 0; } } if (ofs == 0) { fak = 7; per = 0; scntl3 = 0; scntl4 = 0; tp->minsync = 0; } /* ** If target responds with Ultra 3 speed ** but narrow or not DT, reject. ** If target responds with DT request ** but not Ultra3 speeds, reject message, ** reset min sync for target to 0x0A and ** set flags to re-negotiate. */ if ((per == 0x09) && ofs && (!wth || !dt)) chg = 1; else if (( (per > 0x09) && dt) ) chg = 2; /* Not acceptable since beyond controller limit */ if (!dt && ofs > np->maxoffs_st) {chg = 2; ofs = np->maxoffs_st;} if (DEBUG_FLAGS & DEBUG_NEGO) { PRINT_ADDR(cp->cmd); printk ("ppr: wth=%d per=%d scntl3=0x%x scntl4=0x%x ofs=%d fak=%d chg=%d.\n", wth, per, scntl3, scntl4, ofs, fak, chg); } if (INB (HS_PRT) == HS_NEGOTIATE) { OUTB (HS_PRT, HS_BUSY); switch (cp->nego_status) { case NS_PPR: /* ** This was an answer message */ if (chg) { /* ** Answer wasn't acceptable. */ if (chg == 2) { /* Send message reject and reset flags for ** host to re-negotiate with min period 0x0A. */ tp->minsync = 0x0A; tp->period = 0; tp->widedone = 0; } ncr_setsyncwide (np, cp, 0, 0xe0, 0, 0); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); } else { /* ** Answer is ok. */ if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsyncwide (np, cp, scntl3, (fak<<5)|ofs,0, wth); else ncr_setsyncwide (np, cp, scntl3, ofs, scntl4, wth); OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); }; return; case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; }; }; /* ** It was a request. Set value and ** prepare an answer message ** ** If narrow or not DT and requesting Ultra3 ** slow the bus down and force ST. If not ** requesting Ultra3, force ST. ** Max offset is 31=0x1f if ST mode. */ if ((per == 0x09) && ofs && (!wth || !dt)) { per = 0x0A; dt = 0; } else if ( (per > 0x09) && dt) { dt = 0; } if (!dt && ofs > np->maxoffs_st) ofs = np->maxoffs_st; if ((np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66)) ncr_setsyncwide (np, cp, scntl3, (fak<<5)|ofs,0, wth); else ncr_setsyncwide (np, cp, scntl3, ofs, scntl4, wth); np->msgout[0] = M_EXTENDED; np->msgout[1] = 6; np->msgout[2] = M_X_PPR_REQ; np->msgout[3] = per; np->msgout[4] = 0; np->msgout[5] = ofs; np->msgout[6] = wth; np->msgout[7] = dt; cp->nego_status = NS_PPR; if (DEBUG_FLAGS & DEBUG_NEGO) { ncr_print_msg(cp, "ppr msgout", np->msgout); } np->msgin [0] = M_NOOP; if (!ofs) OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); else OUTL_DSP (NCB_SCRIPTH_PHYS (np, ppr_resp)); } /* ** Reset SYNC or WIDE to default settings. ** Called when a negotiation does not succeed either ** on rejection or on protocol error. */ static void ncr_nego_default(ncb_p np, tcb_p tp, ccb_p cp) { /* ** any error in negotiation: ** fall back to default mode. */ switch (cp->nego_status) { case NS_SYNC: ncr_setsync (np, cp, 0, 0xe0, 0); break; case NS_WIDE: ncr_setwide (np, cp, 0, 0); break; case NS_PPR: /* * ppr_negotiation is set to 1 on the first ppr nego command. * If ppr is successful, it is reset to 2. * If unsuccessful it is reset to 0. */ if (DEBUG_FLAGS & DEBUG_NEGO) { tcb_p tp=&np->target[cp->target]; u_char factor, offset, width; ncr_get_xfer_info ( np, tp, &factor, &offset, &width); printk("Current factor %d offset %d width %d\n", factor, offset, width); } if (tp->ppr_negotiation == 2) ncr_setsyncwide (np, cp, 0, 0xe0, 0, 0); else if (tp->ppr_negotiation == 1) { /* First ppr command has received a M REJECT. * Do not change the existing wide/sync parameter * values (asyn/narrow if this as the first nego; * may be different if target initiates nego.). */ tp->ppr_negotiation = 0; } else { tp->ppr_negotiation = 0; ncr_setwide (np, cp, 0, 0); } break; }; np->msgin [0] = M_NOOP; np->msgout[0] = M_NOOP; cp->nego_status = 0; } /*========================================================== ** ** ncr chip handler for MESSAGE REJECT received for ** a WIDE or SYNCHRONOUS negotiation. ** ** clear the PPR negotiation flag, all future nego. ** will be SDTR and WDTR ** **========================================================== ** ** Read comments above. ** **---------------------------------------------------------- */ static void ncr_nego_rejected(ncb_p np, tcb_p tp, ccb_p cp) { ncr_nego_default(np, tp, cp); OUTB (HS_PRT, HS_BUSY); } /*========================================================== ** ** ** ncr chip exception handler for programmed interrupts. ** ** **========================================================== */ void ncr_int_sir (ncb_p np) { u_char num = INB (nc_dsps); u_long dsa = INL (nc_dsa); ccb_p cp = ncr_ccb_from_dsa(np, dsa); u_char target = INB (nc_sdid) & 0x0f; tcb_p tp = &np->target[target]; int tmp; if (DEBUG_FLAGS & DEBUG_TINY) printk ("I#%d", num); switch (num) { /* ** See comments in the SCRIPTS code. */ #ifdef SCSI_NCR_PCIQ_SYNC_ON_INTR case SIR_DUMMY_INTERRUPT: goto out; #endif /* ** The C code is currently trying to recover from something. ** Typically, user want to abort some command. */ case SIR_SCRIPT_STOPPED: case SIR_TARGET_SELECTED: case SIR_ABORT_SENT: case SIR_AUTO_SENSE_DONE: ncr_sir_task_recovery(np, num); return; /* ** The device didn't go to MSG OUT phase after having ** been selected with ATN. We donnot want to handle ** that. */ case SIR_SEL_ATN_NO_MSG_OUT: printk ("%s:%d: No MSG OUT phase after selection with ATN.\n", ncr_name (np), target); goto out_stuck; /* ** The device didn't switch to MSG IN phase after ** having reseleted the initiator. */ case SIR_RESEL_NO_MSG_IN: /* ** After reselection, the device sent a message that wasn't ** an IDENTIFY. */ case SIR_RESEL_NO_IDENTIFY: /* ** If devices reselecting without sending an IDENTIFY ** message still exist, this should help. ** We just assume lun=0, 1 CCB, no tag. */ if (tp->l0p) { OUTL (nc_dsa, scr_to_cpu(tp->l0p->tasktbl[0])); OUTL_DSP (NCB_SCRIPT_PHYS (np, resel_go)); return; } /* ** The device reselected a LUN we donnot know of. */ case SIR_RESEL_BAD_LUN: np->msgout[0] = M_RESET; goto out; /* ** The device reselected for an untagged nexus and we ** haven't any. */ case SIR_RESEL_BAD_I_T_L: np->msgout[0] = M_ABORT; goto out; /* ** The device reselected for a tagged nexus that we donnot ** have. */ case SIR_RESEL_BAD_I_T_L_Q: np->msgout[0] = M_ABORT_TAG; goto out; /* ** The SCRIPTS let us know that the device has grabbed ** our message and will abort the job. */ case SIR_RESEL_ABORTED: np->lastmsg = np->msgout[0]; np->msgout[0] = M_NOOP; printk ("%s:%d: message %x sent on bad reselection.\n", ncr_name (np), target, np->lastmsg); goto out; /* ** The SCRIPTS let us know that a message has been ** successfully sent to the device. */ case SIR_MSG_OUT_DONE: np->lastmsg = np->msgout[0]; np->msgout[0] = M_NOOP; /* Should we really care of that */ if (np->lastmsg == M_PARITY || np->lastmsg == M_ID_ERROR) { if (cp) { cp->xerr_status &= ~XE_PARITY_ERR; if (!cp->xerr_status) OUTOFFB (HF_PRT, HF_EXT_ERR); } } goto out; /* ** The device didn't send a GOOD SCSI status. ** We may have some work to do prior to allow ** the SCRIPTS processor to continue. */ case SIR_BAD_STATUS: if (!cp) goto out; ncr_sir_to_redo(np, num, cp); return; /* ** We are asked by the SCRIPTS to prepare a ** REJECT message. */ case SIR_REJECT_TO_SEND: ncr_print_msg(cp, "M_REJECT to send for ", np->msgin); np->msgout[0] = M_REJECT; goto out; /* ** We have been ODD at the end of a DATA IN ** transfer and the device didn't send a ** IGNORE WIDE RESIDUE message. ** It is a data overrun condition. */ case SIR_SWIDE_OVERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_SWIDE_OVRUN; } goto out; /* ** We have been ODD at the end of a DATA OUT ** transfer. ** It is a data underrun condition. */ case SIR_SODL_UNDERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_SODL_UNRUN; } goto out; /* ** The device wants us to transfer more data than ** expected or in the wrong direction. ** The number of extra bytes is in scratcha. ** It is a data overrun condition. */ case SIR_DATA_OVERRUN: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_EXTRA_DATA; cp->extra_bytes += INL (nc_scratcha); } goto out; /* ** The device switched to an illegal phase (4/5). */ case SIR_BAD_PHASE: if (cp) { OUTONB (HF_PRT, HF_EXT_ERR); cp->xerr_status |= XE_BAD_PHASE; } goto out; /* ** We received a message. */ case SIR_MSG_RECEIVED: if (!cp) goto out_stuck; switch (np->msgin [0]) { /* ** We received an extended message. ** We handle MODIFY DATA POINTER, SDTR, WDTR ** and reject all other extended messages. */ case M_EXTENDED: switch (np->msgin [2]) { case M_X_MODIFY_DP: if (DEBUG_FLAGS & DEBUG_POINTER) ncr_print_msg(cp,"modify DP",np->msgin); tmp = (np->msgin[3]<<24) + (np->msgin[4]<<16) + (np->msgin[5]<<8) + (np->msgin[6]); ncr_modify_dp(np, tp, cp, tmp); return; case M_X_SYNC_REQ: ncr_sync_nego(np, tp, cp); return; case M_X_WIDE_REQ: ncr_wide_nego(np, tp, cp); return; case M_X_PPR_REQ: ncr_ppr_nego(np, tp, cp); return; default: goto out_reject; } break; /* ** We received a 1/2 byte message not handled from SCRIPTS. ** We are only expecting MESSAGE REJECT and IGNORE WIDE ** RESIDUE messages that haven't been anticipated by ** SCRIPTS on SWIDE full condition. Unanticipated IGNORE ** WIDE RESIDUE messages are aliased as MODIFY DP (-1). */ case M_IGN_RESIDUE: if (DEBUG_FLAGS & DEBUG_POINTER) ncr_print_msg(cp,"ign wide residue", np->msgin); ncr_modify_dp(np, tp, cp, -1); return; case M_REJECT: if (INB (HS_PRT) == HS_NEGOTIATE) ncr_nego_rejected(np, tp, cp); else { PRINT_ADDR(cp->cmd); printk ("M_REJECT received (%x:%x).\n", scr_to_cpu(np->lastmsg), np->msgout[0]); } goto out_clrack; break; default: goto out_reject; } break; /* ** We received an unknown message. ** Ignore all MSG IN phases and reject it. */ case SIR_MSG_WEIRD: ncr_print_msg(cp, "WEIRD message received", np->msgin); OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_weird)); return; /* ** Negotiation failed. ** Target does not send us the reply. ** Remove the HS_NEGOTIATE status. */ case SIR_NEGO_FAILED: OUTB (HS_PRT, HS_BUSY); /* ** Negotiation failed. ** Target does not want answer message. */ case SIR_NEGO_PROTO: ncr_nego_default(np, tp, cp); goto out; }; out: OUTONB_STD (); return; out_reject: OUTL_DSP (NCB_SCRIPTH_PHYS (np, msg_bad)); return; out_clrack: OUTL_DSP (NCB_SCRIPT_PHYS (np, clrack)); return; out_stuck: return; } /*========================================================== ** ** ** Acquire a control block ** ** **========================================================== */ static ccb_p ncr_get_ccb (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_short tag = NO_TAG; XPT_QUEHEAD *qp; ccb_p cp = (ccb_p) 0; /* ** Allocate a new CCB if needed. */ if (xpt_que_empty(&np->free_ccbq)) (void) ncr_alloc_ccb(np); /* ** Look for a free CCB */ qp = xpt_remque_head(&np->free_ccbq); if (!qp) goto out; cp = xpt_que_entry(qp, struct ccb, link_ccbq); /* ** If the LCB is not yet available and we already ** have queued a CCB for a LUN without LCB, ** give up. Otherwise all is fine. :-) */ if (!lp) { if (xpt_que_empty(&np->b0_ccbq)) xpt_insque_head(&cp->link_ccbq, &np->b0_ccbq); else goto out_free; } else { /* ** Tune tag mode if asked by user. */ if (lp->queuedepth != lp->numtags) { ncr_setup_tags(np, tn, ln); } /* ** Get a tag for this nexus if required. ** Keep from using more tags than we can handle. */ if (lp->usetags) { if (lp->busyccbs < lp->maxnxs) { tag = lp->cb_tags[lp->ia_tag]; ++lp->ia_tag; if (lp->ia_tag == MAX_TAGS) lp->ia_tag = 0; cp->tags_si = lp->tags_si; ++lp->tags_sum[cp->tags_si]; } else goto out_free; } /* ** Put the CCB in the LUN wait queue and ** count it as busy. */ xpt_insque_tail(&cp->link_ccbq, &lp->wait_ccbq); ++lp->busyccbs; } /* ** Remember all informations needed to free this CCB. */ cp->to_abort = 0; cp->tag = tag; cp->target = tn; cp->lun = ln; if (DEBUG_FLAGS & DEBUG_TAGS) { PRINT_LUN(np, tn, ln); printk ("ccb @%p using tag %d.\n", cp, tag); } out: return cp; out_free: xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); return (ccb_p) 0; } /*========================================================== ** ** ** Release one control block ** ** **========================================================== */ static void ncr_free_ccb (ncb_p np, ccb_p cp) { tcb_p tp = &np->target[cp->target]; lcb_p lp = ncr_lp(np, tp, cp->lun); if (DEBUG_FLAGS & DEBUG_TAGS) { PRINT_LUN(np, cp->target, cp->lun); printk ("ccb @%p freeing tag %d.\n", cp, cp->tag); } /* ** If lun control block available, make available ** the task slot and the tag if any. ** Decrement counters. */ if (lp) { if (cp->tag != NO_TAG) { lp->cb_tags[lp->if_tag++] = cp->tag; if (lp->if_tag == MAX_TAGS) lp->if_tag = 0; --lp->tags_sum[cp->tags_si]; lp->tasktbl[cp->tag] = cpu_to_scr(np->p_bad_i_t_l_q); } else { lp->tasktbl[0] = cpu_to_scr(np->p_bad_i_t_l); } --lp->busyccbs; if (cp->queued) { --lp->queuedccbs; } } /* ** Make this CCB available. */ xpt_remque(&cp->link_ccbq); xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); cp -> host_status = HS_IDLE; cp -> queued = 0; } /*------------------------------------------------------------------------ ** Allocate a CCB and initialize its fixed part. **------------------------------------------------------------------------ **------------------------------------------------------------------------ */ static ccb_p ncr_alloc_ccb(ncb_p np) { ccb_p cp = 0; int hcode; /* ** Allocate memory for this CCB. */ cp = m_calloc_dma(sizeof(struct ccb), "CCB"); if (!cp) return 0; /* ** Count it and initialyze it. */ np->actccbs++; /* ** Remember virtual and bus address of this ccb. */ cp->p_ccb = vtobus(cp); /* ** Insert this ccb into the hashed list. */ hcode = CCB_HASH_CODE(cp->p_ccb); cp->link_ccbh = np->ccbh[hcode]; np->ccbh[hcode] = cp; /* ** Initialize the start and restart actions. */ cp->phys.header.go.start = cpu_to_scr(NCB_SCRIPT_PHYS (np, idle)); cp->phys.header.go.restart = cpu_to_scr(NCB_SCRIPTH_PHYS(np,bad_i_t_l)); /* ** Initilialyze some other fields. */ cp->phys.smsg_ext.addr = cpu_to_scr(NCB_PHYS(np, msgin[2])); /* ** Chain into wakeup list and free ccb queue. */ cp->link_ccb = np->ccbc; np->ccbc = cp; xpt_insque_head(&cp->link_ccbq, &np->free_ccbq); return cp; } /*------------------------------------------------------------------------ ** Look up a CCB from a DSA value. **------------------------------------------------------------------------ **------------------------------------------------------------------------ */ static ccb_p ncr_ccb_from_dsa(ncb_p np, u_long dsa) { int hcode; ccb_p cp; hcode = CCB_HASH_CODE(dsa); cp = np->ccbh[hcode]; while (cp) { if (cp->p_ccb == dsa) break; cp = cp->link_ccbh; } return cp; } /*========================================================== ** ** ** Allocation of resources for Targets/Luns/Tags. ** ** **========================================================== */ /*------------------------------------------------------------------------ ** Target control block initialisation. **------------------------------------------------------------------------ ** This data structure is fully initialized after a SCSI command ** has been successfully completed for this target. **------------------------------------------------------------------------ */ static void ncr_init_tcb (ncb_p np, u_char tn) { /* ** Check some alignments required by the chip. */ assert (( (offsetof(struct ncr_reg, nc_sxfer) ^ offsetof(struct tcb , sval )) &3) == 0); assert (( (offsetof(struct ncr_reg, nc_scntl3) ^ offsetof(struct tcb , wval )) &3) == 0); if ((np->device_id == PCI_DEVICE_ID_LSI_53C1010) || (np->device_id == PCI_DEVICE_ID_LSI_53C1010_66)){ assert (( (offsetof(struct ncr_reg, nc_scntl4) ^ offsetof(struct tcb , uval )) &3) == 0); } } /*------------------------------------------------------------------------ ** Lun control block allocation and initialization. **------------------------------------------------------------------------ ** This data structure is allocated and initialized after a SCSI ** command has been successfully completed for this target/lun. **------------------------------------------------------------------------ */ static lcb_p ncr_alloc_lcb (ncb_p np, u_char tn, u_char ln) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); /* ** Already done, return. */ if (lp) return lp; /* ** Initialize the target control block if not yet. */ ncr_init_tcb(np, tn); /* ** Allocate the lcb bus address array. ** Compute the bus address of this table. */ if (ln && !tp->luntbl) { int i; tp->luntbl = m_calloc_dma(256, "LUNTBL"); if (!tp->luntbl) goto fail; for (i = 0 ; i < 64 ; i++) tp->luntbl[i] = cpu_to_scr(NCB_PHYS(np, resel_badlun)); tp->b_luntbl = cpu_to_scr(vtobus(tp->luntbl)); } /* ** Allocate the table of pointers for LUN(s) > 0, if needed. */ if (ln && !tp->lmp) { tp->lmp = m_calloc(MAX_LUN * sizeof(lcb_p), "LMP"); if (!tp->lmp) goto fail; } /* ** Allocate the lcb. ** Make it available to the chip. */ lp = m_calloc_dma(sizeof(struct lcb), "LCB"); if (!lp) goto fail; if (ln) { tp->lmp[ln] = lp; tp->luntbl[ln] = cpu_to_scr(vtobus(lp)); } else { tp->l0p = lp; tp->b_lun0 = cpu_to_scr(vtobus(lp)); } /* ** Initialize the CCB queue headers. */ xpt_que_init(&lp->busy_ccbq); xpt_que_init(&lp->wait_ccbq); /* ** Set max CCBs to 1 and use the default task array ** by default. */ lp->maxnxs = 1; lp->tasktbl = &lp->tasktbl_0; lp->b_tasktbl = cpu_to_scr(vtobus(lp->tasktbl)); lp->tasktbl[0] = cpu_to_scr(np->p_notask); lp->resel_task = cpu_to_scr(NCB_SCRIPT_PHYS(np, resel_notag)); /* ** Initialize command queuing control. */ lp->busyccbs = 1; lp->queuedccbs = 1; lp->queuedepth = 1; fail: return lp; } /*------------------------------------------------------------------------ ** Lun control block setup on INQUIRY data received. **------------------------------------------------------------------------ ** We only support WIDE, SYNC for targets and CMDQ for logical units. ** This setup is done on each INQUIRY since we are expecting user ** will play with CHANGE DEFINITION commands. :-) **------------------------------------------------------------------------ */ static lcb_p ncr_setup_lcb (ncb_p np, u_char tn, u_char ln, u_char *inq_data) { tcb_p tp = &np->target[tn]; lcb_p lp = ncr_lp(np, tp, ln); u_char inq_byte7; int i; /* ** If no lcb, try to allocate it. */ if (!lp && !(lp = ncr_alloc_lcb(np, tn, ln))) goto fail; #if 0 /* No more used. Left here as provision */ /* ** Get device quirks. */ tp->quirks = 0; if (tp->quirks && bootverbose) { PRINT_LUN(np, tn, ln); printk ("quirks=%x.\n", tp->quirks); } #endif /* ** Evaluate trustable target/unit capabilities. ** We only believe device version >= SCSI-2 that ** use appropriate response data format (2). ** But it seems that some CCS devices also ** support SYNC and I donnot want to frustrate ** anybody. ;-) */ inq_byte7 = 0; if ((inq_data[2] & 0x7) >= 2 && (inq_data[3] & 0xf) == 2) inq_byte7 = inq_data[7]; else if ((inq_data[2] & 0x7) == 1 && (inq_data[3] & 0xf) == 1) inq_byte7 = INQ7_SYNC; /* ** Throw away announced LUN capabilities if we are told ** that there is no real device supported by the logical unit. */ if ((inq_data[0] & 0xe0) > 0x20 || (inq_data[0] & 0x1f) == 0x1f) inq_byte7 &= (INQ7_SYNC | INQ7_WIDE16); /* ** If user is wanting SYNC, force this feature. */ if (driver_setup.force_sync_nego) inq_byte7 |= INQ7_SYNC; /* ** Prepare negotiation if SIP capabilities have changed. */ tp->inq_done = 1; if ((inq_byte7 ^ tp->inq_byte7) & (INQ7_SYNC | INQ7_WIDE16)) { tp->inq_byte7 = inq_byte7; ncr_negotiate(np, tp); } /* ** If unit supports tagged commands, allocate and ** initialyze the task table if not yet. */ if ((inq_byte7 & INQ7_QUEUE) && lp->tasktbl == &lp->tasktbl_0) { lp->tasktbl = m_calloc_dma(MAX_TASKS*4, "TASKTBL"); if (!lp->tasktbl) { lp->tasktbl = &lp->tasktbl_0; goto fail; } lp->b_tasktbl = cpu_to_scr(vtobus(lp->tasktbl)); for (i = 0 ; i < MAX_TASKS ; i++) lp->tasktbl[i] = cpu_to_scr(np->p_notask); lp->cb_tags = m_calloc(MAX_TAGS, "CB_TAGS"); if (!lp->cb_tags) goto fail; for (i = 0 ; i < MAX_TAGS ; i++) lp->cb_tags[i] = i; lp->maxnxs = MAX_TAGS; lp->tags_stime = ktime_get(3*HZ); } /* ** Adjust tagged queueing status if needed. */ if ((inq_byte7 ^ lp->inq_byte7) & INQ7_QUEUE) { lp->inq_byte7 = inq_byte7; lp->numtags = lp->maxtags; ncr_setup_tags (np, tn, ln); } fail: return lp; } /*========================================================== ** ** ** Build Scatter Gather Block ** ** **========================================================== ** ** The transfer area may be scattered among ** several non adjacent physical pages. ** ** We may use MAX_SCATTER blocks. ** **---------------------------------------------------------- */ /* ** We try to reduce the number of interrupts caused ** by unexpected phase changes due to disconnects. ** A typical harddisk may disconnect before ANY block. ** If we wanted to avoid unexpected phase changes at all ** we had to use a break point every 512 bytes. ** Of course the number of scatter/gather blocks is ** limited. ** Under Linux, the scatter/gatter blocks are provided by ** the generic driver. We just have to copy addresses and ** sizes to the data segment array. */ /* ** For 64 bit systems, we use the 8 upper bits of the size field ** to provide bus address bits 32-39 to the SCRIPTS processor. ** This allows the 895A and 896 to address up to 1 TB of memory. ** For 32 bit chips on 64 bit systems, we must be provided with ** memory addresses that fit into the first 32 bit bus address ** range and so, this does not matter and we expect an error from ** the chip if this ever happen. ** ** We use a separate function for the case Linux does not provide ** a scatter list in order to allow better code optimization ** for the case we have a scatter list (BTW, for now this just wastes ** about 40 bytes of code for x86, but my guess is that the scatter ** code will get more complex later). */ #define SCATTER_ONE(data, badd, len) \ (data)->addr = cpu_to_scr(badd); \ (data)->size = cpu_to_scr((((badd) >> 8) & 0xff000000) + len); #define CROSS_16MB(p, n) (((((u_long) p) + n - 1) ^ ((u_long) p)) & ~0xffffff) static int ncr_scatter_no_sglist(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { struct scr_tblmove *data = &cp->phys.data[MAX_SCATTER-1]; int segment; cp->data_len = cmd->request_bufflen; if (cmd->request_bufflen) { dma_addr_t baddr = map_scsi_single_data(np, cmd); SCATTER_ONE(data, baddr, cmd->request_bufflen); if (CROSS_16MB(baddr, cmd->request_bufflen)) { cp->host_flags |= HF_PM_TO_C; #ifdef DEBUG_896R1 printk("He! we are crossing a 16 MB boundary (0x%lx, 0x%x)\n", baddr, cmd->request_bufflen); #endif } segment = 1; } else segment = 0; return segment; } /* ** DEL 472 - 53C896 Rev 1 - Part Number 609-0393055 - ITEM 5. ** ** We disable data phase mismatch handling from SCRIPTS for data ** transfers that contains scatter/gather entries that cross ** a 16 MB boundary. ** We use a different scatter function for 896 rev. 1 that needs ** such a work-around. Doing so, we do not affect performance for ** other chips. ** This problem should not be triggered for disk IOs under Linux, ** since such IOs are performed using pages and buffers that are ** nicely power-of-two sized and aligned. But, since this may change ** at any time, a work-around was required. */ static int ncr_scatter_896R1(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { int segn; int use_sg = (int) cmd->use_sg; cp->data_len = 0; if (!use_sg) segn = ncr_scatter_no_sglist(np, cp, cmd); else { struct scatterlist *scatter = (struct scatterlist *)cmd->buffer; struct scr_tblmove *data; use_sg = map_scsi_sg_data(np, cmd); if (use_sg > MAX_SCATTER) { unmap_scsi_data(np, cmd); return -1; } data = &cp->phys.data[MAX_SCATTER - use_sg]; for (segn = 0; segn < use_sg; segn++) { dma_addr_t baddr = scsi_sg_dma_address(&scatter[segn]); unsigned int len = scsi_sg_dma_len(&scatter[segn]); SCATTER_ONE(&data[segn], baddr, len); if (CROSS_16MB(baddr, scatter[segn].length)) { cp->host_flags |= HF_PM_TO_C; #ifdef DEBUG_896R1 printk("He! we are crossing a 16 MB boundary (0x%lx, 0x%x)\n", baddr, scatter[segn].length); #endif } cp->data_len += len; } } return segn; } static int ncr_scatter(ncb_p np, ccb_p cp, Scsi_Cmnd *cmd) { int segment; int use_sg = (int) cmd->use_sg; cp->data_len = 0; if (!use_sg) segment = ncr_scatter_no_sglist(np, cp, cmd); else { struct scatterlist *scatter = (struct scatterlist *)cmd->buffer; struct scr_tblmove *data; use_sg = map_scsi_sg_data(np, cmd); if (use_sg > MAX_SCATTER) { unmap_scsi_data(np, cmd); return -1; } data = &cp->phys.data[MAX_SCATTER - use_sg]; for (segment = 0; segment < use_sg; segment++) { dma_addr_t baddr = scsi_sg_dma_address(&scatter[segment]); unsigned int len = scsi_sg_dma_len(&scatter[segment]); SCATTER_ONE(&data[segment], baddr, len); cp->data_len += len; } } return segment; } /*========================================================== ** ** ** Test the pci bus snoop logic :-( ** ** Has to be called with interrupts disabled. ** ** **========================================================== */ #ifndef SCSI_NCR_IOMAPPED static int __init ncr_regtest (struct ncb* np) { register volatile u_int32 data; /* ** ncr registers may NOT be cached. ** write 0xffffffff to a read only register area, ** and try to read it back. */ data = 0xffffffff; OUTL_OFF(offsetof(struct ncr_reg, nc_dstat), data); data = INL_OFF(offsetof(struct ncr_reg, nc_dstat)); #if 1 if (data == 0xffffffff) { #else if ((data & 0xe2f0fffd) != 0x02000080) { #endif printk ("CACHE TEST FAILED: reg dstat-sstat2 readback %x.\n", (unsigned) data); return (0x10); }; return (0); } #endif static int __init ncr_snooptest (struct ncb* np) { u_int32 ncr_rd, ncr_wr, ncr_bk, host_rd, host_wr, pc; u_char dstat; int i, err=0; #ifndef SCSI_NCR_IOMAPPED if (np->reg) { err |= ncr_regtest (np); if (err) return (err); } #endif restart_test: /* ** Enable Master Parity Checking as we intend ** to enable it for normal operations. */ OUTB (nc_ctest4, (np->rv_ctest4 & MPEE)); /* ** init */ pc = NCB_SCRIPTH0_PHYS (np, snooptest); host_wr = 1; ncr_wr = 2; /* ** Set memory and register. */ np->ncr_cache = cpu_to_scr(host_wr); OUTL (nc_temp, ncr_wr); /* ** Start script (exchange values) */ OUTL (nc_dsa, np->p_ncb); OUTL_DSP (pc); /* ** Wait 'til done (with timeout) */ for (i=0; i=NCR_SNOOP_TIMEOUT) { printk ("CACHE TEST FAILED: timeout.\n"); return (0x20); }; /* ** Check for fatal DMA errors. */ dstat = INB (nc_dstat); #if 1 /* Band aiding for broken hardwares that fail PCI parity */ if ((dstat & MDPE) && (np->rv_ctest4 & MPEE)) { printk ("%s: PCI DATA PARITY ERROR DETECTED - " "DISABLING MASTER DATA PARITY CHECKING.\n", ncr_name(np)); np->rv_ctest4 &= ~MPEE; goto restart_test; } #endif if (dstat & (MDPE|BF|IID)) { printk ("CACHE TEST FAILED: DMA error (dstat=0x%02x).", dstat); return (0x80); } /* ** Save termination position. */ pc = INL (nc_dsp); /* ** Read memory and register. */ host_rd = scr_to_cpu(np->ncr_cache); ncr_rd = INL (nc_scratcha); ncr_bk = INL (nc_temp); /* ** Check termination position. */ if (pc != NCB_SCRIPTH0_PHYS (np, snoopend)+8) { printk ("CACHE TEST FAILED: script execution failed.\n"); printk ("start=%08lx, pc=%08lx, end=%08lx\n", (u_long) NCB_SCRIPTH0_PHYS (np, snooptest), (u_long) pc, (u_long) NCB_SCRIPTH0_PHYS (np, snoopend) +8); return (0x40); }; /* ** Show results. */ if (host_wr != ncr_rd) { printk ("CACHE TEST FAILED: host wrote %d, ncr read %d.\n", (int) host_wr, (int) ncr_rd); err |= 1; }; if (host_rd != ncr_wr) { printk ("CACHE TEST FAILED: ncr wrote %d, host read %d.\n", (int) ncr_wr, (int) host_rd); err |= 2; }; if (ncr_bk != ncr_wr) { printk ("CACHE TEST FAILED: ncr wrote %d, read back %d.\n", (int) ncr_wr, (int) ncr_bk); err |= 4; }; return (err); } /*========================================================== ** ** Determine the ncr's clock frequency. ** This is essential for the negotiation ** of the synchronous transfer rate. ** **========================================================== ** ** Note: we have to return the correct value. ** THERE IS NO SAFE DEFAULT VALUE. ** ** Most NCR/SYMBIOS boards are delivered with a 40 Mhz clock. ** 53C860 and 53C875 rev. 1 support fast20 transfers but ** do not have a clock doubler and so are provided with a ** 80 MHz clock. All other fast20 boards incorporate a doubler ** and so should be delivered with a 40 MHz clock. ** The recent fast40 chips (895/896/895A) and the ** fast80 chip (C1010) use a 40 Mhz base clock ** and provide a clock quadrupler (160 Mhz). The code below ** tries to deal as cleverly as possible with all this stuff. ** **---------------------------------------------------------- */ /* * Select NCR SCSI clock frequency */ static void ncr_selectclock(ncb_p np, u_char scntl3) { if (np->multiplier < 2) { OUTB(nc_scntl3, scntl3); return; } if (bootverbose >= 2) printk ("%s: enabling clock multiplier\n", ncr_name(np)); OUTB(nc_stest1, DBLEN); /* Enable clock multiplier */ if ( (np->device_id != PCI_DEVICE_ID_LSI_53C1010) && (np->device_id != PCI_DEVICE_ID_LSI_53C1010_66) && (np->multiplier > 2)) { int i = 20; /* Poll bit 5 of stest4 for quadrupler */ while (!(INB(nc_stest4) & LCKFRQ) && --i > 0) UDELAY (20); if (!i) printk("%s: the chip cannot lock the frequency\n", ncr_name(np)); } else /* Wait 120 micro-seconds for multiplier*/ UDELAY (120); OUTB(nc_stest3, HSC); /* Halt the scsi clock */ OUTB(nc_scntl3, scntl3); OUTB(nc_stest1, (DBLEN|DBLSEL));/* Select clock multiplier */ OUTB(nc_stest3, 0x00); /* Restart scsi clock */ } /* * calculate NCR SCSI clock frequency (in KHz) */ static unsigned __init ncrgetfreq (ncb_p np, int gen) { unsigned int ms = 0; unsigned int f; int count; /* * Measure GEN timer delay in order * to calculate SCSI clock frequency * * This code will never execute too * many loop iterations (if DELAY is * reasonably correct). It could get * too low a delay (too high a freq.) * if the CPU is slow executing the * loop for some reason (an NMI, for * example). For this reason we will * if multiple measurements are to be * performed trust the higher delay * (lower frequency returned). */ OUTW (nc_sien , 0x0);/* mask all scsi interrupts */ /* enable general purpose timer */ (void) INW (nc_sist); /* clear pending scsi interrupt */ OUTB (nc_dien , 0); /* mask all dma interrupts */ (void) INW (nc_sist); /* another one, just to be sure :) */ OUTB (nc_scntl3, 4); /* set pre-scaler to divide by 3 */ OUTB (nc_stime1, 0); /* disable general purpose timer */ OUTB (nc_stime1, gen); /* set to nominal delay of 1<= 2) printk ("%s: Delay (GEN=%d): %u msec, %u KHz\n", ncr_name(np), gen, ms, f); return f; } static unsigned __init ncr_getfreq (ncb_p np) { u_int f1, f2; int gen = 11; (void) ncrgetfreq (np, gen); /* throw away first result */ f1 = ncrgetfreq (np, gen); f2 = ncrgetfreq (np, gen); if (f1 > f2) f1 = f2; /* trust lower result */ return f1; } /* * Get/probe NCR SCSI clock frequency */ static void __init ncr_getclock (ncb_p np, int mult) { unsigned char scntl3 = np->sv_scntl3; unsigned char stest1 = np->sv_stest1; unsigned f1; np->multiplier = 1; f1 = 40000; /* ** True with 875/895/896/895A with clock multiplier selected */ if (mult > 1 && (stest1 & (DBLEN+DBLSEL)) == DBLEN+DBLSEL) { if (bootverbose >= 2) printk ("%s: clock multiplier found\n", ncr_name(np)); np->multiplier = mult; } /* ** If multiplier not found or scntl3 not 7,5,3, ** reset chip and get frequency from general purpose timer. ** Otherwise trust scntl3 BIOS setting. */ if (np->multiplier != mult || (scntl3 & 7) < 3 || !(scntl3 & 1)) { OUTB (nc_stest1, 0); /* make sure doubler is OFF */ f1 = ncr_getfreq (np); if (bootverbose) printk ("%s: NCR clock is %uKHz\n", ncr_name(np), f1); if (f1 < 55000) f1 = 40000; else f1 = 80000; /* ** Suggest to also check the PCI clock frequency ** to make sure our frequency calculation algorithm ** is not too biased. */ if (np->features & FE_66MHZ) { np->pciclock_min = (66000*55+80-1)/80; np->pciclock_max = (66000*55)/40; } else { np->pciclock_min = (33000*55+80-1)/80; np->pciclock_max = (33000*55)/40; } if (f1 == 40000 && mult > 1) { if (bootverbose >= 2) printk ("%s: clock multiplier assumed\n", ncr_name(np)); np->multiplier = mult; } } else { if ((scntl3 & 7) == 3) f1 = 40000; else if ((scntl3 & 7) == 5) f1 = 80000; else f1 = 160000; f1 /= np->multiplier; } /* ** Compute controller synchronous parameters. */ f1 *= np->multiplier; np->clock_khz = f1; } /* * Get/probe PCI clock frequency */ static u_int __init ncr_getpciclock (ncb_p np) { static u_int f; OUTB (nc_stest1, SCLK); /* Use the PCI clock as SCSI clock */ f = ncr_getfreq (np); OUTB (nc_stest1, 0); return f; } /*===================== LINUX ENTRY POINTS SECTION ==========================*/ #ifndef uchar #define uchar unsigned char #endif #ifndef ushort #define ushort unsigned short #endif #ifndef ulong #define ulong unsigned long #endif /* --------------------------------------------------------------------- ** ** Driver setup from the boot command line ** ** --------------------------------------------------------------------- */ #ifdef MODULE #define ARG_SEP ' ' #else #define ARG_SEP ',' #endif #define OPT_TAGS 1 #define OPT_MASTER_PARITY 2 #define OPT_SCSI_PARITY 3 #define OPT_DISCONNECTION 4 #define OPT_SPECIAL_FEATURES 5 #define OPT_RESERVED_1 6 #define OPT_FORCE_SYNC_NEGO 7 #define OPT_REVERSE_PROBE 8 #define OPT_DEFAULT_SYNC 9 #define OPT_VERBOSE 10 #define OPT_DEBUG 11 #define OPT_BURST_MAX 12 #define OPT_LED_PIN 13 #define OPT_MAX_WIDE 14 #define OPT_SETTLE_DELAY 15 #define OPT_DIFF_SUPPORT 16 #define OPT_IRQM 17 #define OPT_PCI_FIX_UP 18 #define OPT_BUS_CHECK 19 #define OPT_OPTIMIZE 20 #define OPT_RECOVERY 21 #define OPT_SAFE_SETUP 22 #define OPT_USE_NVRAM 23 #define OPT_EXCLUDE 24 #define OPT_HOST_ID 25 #ifdef SCSI_NCR_IARB_SUPPORT #define OPT_IARB 26 #endif static char setup_token[] __initdata = "tags:" "mpar:" "spar:" "disc:" "specf:" "_rsvd1:" "fsn:" "revprob:" "sync:" "verb:" "debug:" "burst:" "led:" "wide:" "settle:" "diff:" "irqm:" "pcifix:" "buschk:" "optim:" "recovery:" "safe:" "nvram:" "excl:" "hostid:" #ifdef SCSI_NCR_IARB_SUPPORT "iarb:" #endif ; /* DONNOT REMOVE THIS ';' */ #ifdef MODULE #define ARG_SEP ' ' #else #define ARG_SEP ',' #endif static int __init get_setup_token(char *p) { char *cur = setup_token; char *pc; int i = 0; while (cur != NULL && (pc = strchr(cur, ':')) != NULL) { ++pc; ++i; if (!strncmp(p, cur, pc - cur)) return i; cur = pc; } return 0; } int __init sym53c8xx_setup(char *str) { #ifdef SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT char *cur = str; char *pc, *pv; unsigned long val; int i, c; int xi = 0; while (cur != NULL && (pc = strchr(cur, ':')) != NULL) { char *pe; val = 0; pv = pc; c = *++pv; if (c == 'n') val = 0; else if (c == 'y') val = 1; else val = (int) simple_strtoul(pv, &pe, 0); switch (get_setup_token(cur)) { case OPT_TAGS: driver_setup.default_tags = val; if (pe && *pe == '/') { i = 0; while (*pe && *pe != ARG_SEP && i < sizeof(driver_setup.tag_ctrl)-1) { driver_setup.tag_ctrl[i++] = *pe++; } driver_setup.tag_ctrl[i] = '\0'; } break; case OPT_MASTER_PARITY: driver_setup.master_parity = val; break; case OPT_SCSI_PARITY: driver_setup.scsi_parity = val; break; case OPT_DISCONNECTION: driver_setup.disconnection = val; break; case OPT_SPECIAL_FEATURES: driver_setup.special_features = val; break; case OPT_FORCE_SYNC_NEGO: driver_setup.force_sync_nego = val; break; case OPT_REVERSE_PROBE: driver_setup.reverse_probe = val; break; case OPT_DEFAULT_SYNC: driver_setup.default_sync = val; break; case OPT_VERBOSE: driver_setup.verbose = val; break; case OPT_DEBUG: driver_setup.debug = val; break; case OPT_BURST_MAX: driver_setup.burst_max = val; break; case OPT_LED_PIN: driver_setup.led_pin = val; break; case OPT_MAX_WIDE: driver_setup.max_wide = val? 1:0; break; case OPT_SETTLE_DELAY: driver_setup.settle_delay = val; break; case OPT_DIFF_SUPPORT: driver_setup.diff_support = val; break; case OPT_IRQM: driver_setup.irqm = val; break; case OPT_PCI_FIX_UP: driver_setup.pci_fix_up = val; break; case OPT_BUS_CHECK: driver_setup.bus_check = val; break; case OPT_OPTIMIZE: driver_setup.optimize = val; break; case OPT_RECOVERY: driver_setup.recovery = val; break; case OPT_USE_NVRAM: driver_setup.use_nvram = val; break; case OPT_SAFE_SETUP: memcpy(&driver_setup, &driver_safe_setup, sizeof(driver_setup)); break; case OPT_EXCLUDE: if (xi < SCSI_NCR_MAX_EXCLUDES) driver_setup.excludes[xi++] = val; break; case OPT_HOST_ID: driver_setup.host_id = val; break; #ifdef SCSI_NCR_IARB_SUPPORT case OPT_IARB: driver_setup.iarb = val; break; #endif default: printk("sym53c8xx_setup: unexpected boot option '%.*s' ignored\n", (int)(pc-cur+1), cur); break; } if ((cur = strchr(cur, ARG_SEP)) != NULL) ++cur; } #endif /* SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT */ return 1; } #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,3,13) #ifndef MODULE __setup("sym53c8xx=", sym53c8xx_setup); #endif #endif static int sym53c8xx_pci_init(Scsi_Host_Template *tpnt, pcidev_t pdev, ncr_device *device); /* ** Linux entry point for SYM53C8XX devices detection routine. ** ** Called by the middle-level scsi drivers at initialization time, ** or at module installation. ** ** Read the PCI configuration and try to attach each ** detected NCR board. ** ** If NVRAM is present, try to attach boards according to ** the used defined boot order. ** ** Returns the number of boards successfully attached. */ static void __init ncr_print_driver_setup(void) { #define YesNo(y) y ? 'y' : 'n' printk (NAME53C8XX ": setup=disc:%c,specf:%d,tags:%d,sync:%d," "burst:%d,wide:%c,diff:%d,revprob:%c,buschk:0x%x\n", YesNo(driver_setup.disconnection), driver_setup.special_features, driver_setup.default_tags, driver_setup.default_sync, driver_setup.burst_max, YesNo(driver_setup.max_wide), driver_setup.diff_support, YesNo(driver_setup.reverse_probe), driver_setup.bus_check); printk (NAME53C8XX ": setup=mpar:%c,spar:%c,fsn=%c,verb:%d,debug:0x%x," "led:%c,settle:%d,irqm:0x%x,nvram:0x%x,pcifix:0x%x\n", YesNo(driver_setup.master_parity), YesNo(driver_setup.scsi_parity), YesNo(driver_setup.force_sync_nego), driver_setup.verbose, driver_setup.debug, YesNo(driver_setup.led_pin), driver_setup.settle_delay, driver_setup.irqm, driver_setup.use_nvram, driver_setup.pci_fix_up); #undef YesNo } /*=================================================================== ** SYM53C8XX devices description table and chip ids list. **=================================================================== */ static ncr_chip ncr_chip_table[] __initdata = SCSI_NCR_CHIP_TABLE; static ushort ncr_chip_ids[] __initdata = SCSI_NCR_CHIP_IDS; #ifdef SCSI_NCR_PQS_PDS_SUPPORT /*=================================================================== ** Detect all NCR PQS/PDS boards and keep track of their bus nr. ** ** The NCR PQS or PDS card is constructed as a DEC bridge ** behind which sit a proprietary NCR memory controller and ** four or two 53c875s as separate devices. In its usual mode ** of operation, the 875s are slaved to the memory controller ** for all transfers. We can tell if an 875 is part of a ** PQS/PDS or not since if it is, it will be on the same bus ** as the memory controller. To operate with the Linux ** driver, the memory controller is disabled and the 875s ** freed to function independently. The only wrinkle is that ** the preset SCSI ID (which may be zero) must be read in from ** a special configuration space register of the 875 **=================================================================== */ #define SCSI_NCR_MAX_PQS_BUS 16 static int pqs_bus[SCSI_NCR_MAX_PQS_BUS] __initdata = { 0 }; static void __init ncr_detect_pqs_pds(void) { short index; pcidev_t dev = PCIDEV_NULL; for(index=0; index < SCSI_NCR_MAX_PQS_BUS; index++) { u_char tmp; dev = pci_find_device(0x101a, 0x0009, dev); if (dev == PCIDEV_NULL) { pqs_bus[index] = -1; break; } printk(KERN_INFO NAME53C8XX ": NCR PQS/PDS memory controller detected on bus %d\n", PciBusNumber(dev)); pci_read_config_byte(dev, 0x44, &tmp); /* bit 1: allow individual 875 configuration */ tmp |= 0x2; pci_write_config_byte(dev, 0x44, tmp); pci_read_config_byte(dev, 0x45, &tmp); /* bit 2: drive individual 875 interrupts to the bus */ tmp |= 0x4; pci_write_config_byte(dev, 0x45, tmp); pqs_bus[index] = PciBusNumber(dev); } } #endif /* SCSI_NCR_PQS_PDS_SUPPORT */ /*=================================================================== ** Detect all 53c8xx hosts and then attach them. ** ** If we are using NVRAM, once all hosts are detected, we need to ** check any NVRAM for boot order in case detect and boot order ** differ and attach them using the order in the NVRAM. ** ** If no NVRAM is found or data appears invalid attach boards in ** the order they are detected. **=================================================================== */ int __init sym53c8xx_detect(Scsi_Host_Template *tpnt) { pcidev_t pcidev; int i, j, chips, hosts, count; int attach_count = 0; ncr_device *devtbl, *devp; #ifdef SCSI_NCR_NVRAM_SUPPORT ncr_nvram nvram0, nvram, *nvp; #endif /* ** PCI is required. */ if (!pci_present()) return 0; /* ** Initialize driver general stuff. */ #ifdef SCSI_NCR_PROC_INFO_SUPPORT #if LINUX_VERSION_CODE < KERNEL_VERSION(2,3,27) tpnt->proc_dir = &proc_scsi_sym53c8xx; #else tpnt->proc_name = NAME53C8XX; #endif tpnt->proc_info = sym53c8xx_proc_info; #endif #if defined(SCSI_NCR_BOOT_COMMAND_LINE_SUPPORT) && defined(MODULE) if (sym53c8xx) sym53c8xx_setup(sym53c8xx); #endif #ifdef SCSI_NCR_DEBUG_INFO_SUPPORT ncr_debug = driver_setup.debug; #endif if (initverbose >= 2) ncr_print_driver_setup(); /* ** Allocate the device table since we donnot want to ** overflow the kernel stack. ** 1 x 4K PAGE is enough for more than 40 devices for i386. */ devtbl = m_calloc(PAGE_SIZE, "devtbl"); if (!devtbl) return 0; /* ** Detect all NCR PQS/PDS memory controllers. */ #ifdef SCSI_NCR_PQS_PDS_SUPPORT ncr_detect_pqs_pds(); #endif /* ** Detect all 53c8xx hosts. ** Save the first Symbios NVRAM content if any ** for the boot order. */ chips = sizeof(ncr_chip_ids) / sizeof(ncr_chip_ids[0]); hosts = PAGE_SIZE / sizeof(*devtbl); #ifdef SCSI_NCR_NVRAM_SUPPORT nvp = (driver_setup.use_nvram & 0x1) ? &nvram0 : 0; #endif j = 0; count = 0; pcidev = PCIDEV_NULL; while (1) { char *msg = ""; if (count >= hosts) break; if (j >= chips) break; i = driver_setup.reverse_probe ? chips - 1 - j : j; pcidev = pci_find_device(PCI_VENDOR_ID_NCR, ncr_chip_ids[i], pcidev); if (pcidev == PCIDEV_NULL) { ++j; continue; } if (pci_enable_device(pcidev)) /* @!*!$&*!%-*#;! */ continue; /* Some HW as the HP LH4 may report twice PCI devices */ for (i = 0; i < count ; i++) { if (devtbl[i].slot.bus == PciBusNumber(pcidev) && devtbl[i].slot.device_fn == PciDeviceFn(pcidev)) break; } if (i != count) /* Ignore this device if we already have it */ continue; pci_set_master(pcidev); devp = &devtbl[count]; devp->host_id = driver_setup.host_id; devp->attach_done = 0; if (sym53c8xx_pci_init(tpnt, pcidev, devp)) { continue; } ++count; #ifdef SCSI_NCR_NVRAM_SUPPORT if (nvp) { ncr_get_nvram(devp, nvp); switch(nvp->type) { case SCSI_NCR_SYMBIOS_NVRAM: /* * Switch to the other nvram buffer, so that * nvram0 will contain the first Symbios * format NVRAM content with boot order. */ nvp = &nvram; msg = "with Symbios NVRAM"; break; case SCSI_NCR_TEKRAM_NVRAM: msg = "with Tekram NVRAM"; break; } } #endif #ifdef SCSI_NCR_PQS_PDS_SUPPORT if (devp->pqs_pds) msg = "(NCR PQS/PDS)"; #endif printk(KERN_INFO NAME53C8XX ": 53c%s detected %s\n", devp->chip.name, msg); } /* ** If we have found a SYMBIOS NVRAM, use first the NVRAM boot ** sequence as device boot order. ** check devices in the boot record against devices detected. ** attach devices if we find a match. boot table records that ** do not match any detected devices will be ignored. ** devices that do not match any boot table will not be attached ** here but will attempt to be attached during the device table ** rescan. */ #ifdef SCSI_NCR_NVRAM_SUPPORT if (!nvp || nvram0.type != SCSI_NCR_SYMBIOS_NVRAM) goto next; for (i = 0; i < 4; i++) { Symbios_host *h = &nvram0.data.Symbios.host[i]; for (j = 0 ; j < count ; j++) { devp = &devtbl[j]; if (h->device_fn != devp->slot.device_fn || h->bus_nr != devp->slot.bus || h->device_id != devp->chip.device_id) continue; if (devp->attach_done) continue; if (h->flags & SYMBIOS_INIT_SCAN_AT_BOOT) { ncr_get_nvram(devp, nvp); if (!ncr_attach (tpnt, attach_count, devp)) attach_count++; } else if (!(driver_setup.use_nvram & 0x80)) printk(KERN_INFO NAME53C8XX ": 53c%s state OFF thus not attached\n", devp->chip.name); else continue; devp->attach_done = 1; break; } } next: #endif /* ** Rescan device list to make sure all boards attached. ** Devices without boot records will not be attached yet ** so try to attach them here. */ for (i= 0; i < count; i++) { devp = &devtbl[i]; if (!devp->attach_done) { #ifdef SCSI_NCR_NVRAM_SUPPORT ncr_get_nvram(devp, nvp); #endif if (!ncr_attach (tpnt, attach_count, devp)) attach_count++; } } m_free(devtbl, PAGE_SIZE, "devtbl"); return attach_count; } /*=================================================================== ** Read and check the PCI configuration for any detected NCR ** boards and save data for attaching after all boards have ** been detected. **=================================================================== */ static int __init sym53c8xx_pci_init(Scsi_Host_Template *tpnt, pcidev_t pdev, ncr_device *device) { u_short vendor_id, device_id, command, status_reg; u_char cache_line_size, latency_timer; u_char suggested_cache_line_size = 0; u_char pci_fix_up = driver_setup.pci_fix_up; u_char revision; u_int irq; u_long base, base_c, base_2, base_2_c, io_port; int i; ncr_chip *chip; printk(KERN_INFO NAME53C8XX ": at PCI bus %d, device %d, function %d\n", PciBusNumber(pdev), (int) (PciDeviceFn(pdev) & 0xf8) >> 3, (int) (PciDeviceFn(pdev) & 7)); /* ** Read info from the PCI config space. ** pci_read_config_xxx() functions are assumed to be used for ** successfully detected PCI devices. */ vendor_id = PciVendorId(pdev); device_id = PciDeviceId(pdev); irq = PciIrqLine(pdev); i = pci_get_base_address(pdev, 0, &io_port); io_port = pci_get_base_cookie(pdev, 0); base_c = pci_get_base_cookie(pdev, i); i = pci_get_base_address(pdev, i, &base); base_2_c = pci_get_base_cookie(pdev, i); (void) pci_get_base_address(pdev, i, &base_2); pci_read_config_word(pdev, PCI_COMMAND, &command); pci_read_config_byte(pdev, PCI_CLASS_REVISION, &revision); pci_read_config_byte(pdev, PCI_CACHE_LINE_SIZE, &cache_line_size); pci_read_config_byte(pdev, PCI_LATENCY_TIMER, &latency_timer); pci_read_config_word(pdev, PCI_STATUS, &status_reg); #ifdef SCSI_NCR_PQS_PDS_SUPPORT /* ** Match the BUS number for PQS/PDS devices. ** Read the SCSI ID from a special register mapped ** into the configuration space of the individual ** 875s. This register is set up by the PQS bios */ for(i = 0; i < SCSI_NCR_MAX_PQS_BUS && pqs_bus[i] != -1; i++) { u_char tmp; if (pqs_bus[i] == PciBusNumber(pdev)) { pci_read_config_byte(pdev, 0x84, &tmp); device->pqs_pds = 1; device->host_id = tmp; break; } } #endif /* SCSI_NCR_PQS_PDS_SUPPORT */ /* ** If user excludes this chip, donnot initialize it. */ for (i = 0 ; i < SCSI_NCR_MAX_EXCLUDES ; i++) { if (driver_setup.excludes[i] == (io_port & PCI_BASE_ADDRESS_IO_MASK)) return -1; } /* ** Check if the chip is supported */ chip = 0; for (i = 0; i < sizeof(ncr_chip_table)/sizeof(ncr_chip_table[0]); i++) { if (device_id != ncr_chip_table[i].device_id) continue; if (revision > ncr_chip_table[i].revision_id) continue; if (!(ncr_chip_table[i].features & FE_LDSTR)) break; chip = &device->chip; memcpy(chip, &ncr_chip_table[i], sizeof(*chip)); chip->revision_id = revision; break; } #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING /* Configure DMA attributes. For DAC capable boards, we can encode ** 32+8 bits for SCSI DMA data addresses with the extra bits used ** in the size field. We use normal 32-bit PCI addresses for ** descriptors. */ if (chip && (chip->features & FE_DAC)) { if (pci_set_dma_mask(pdev, (u64) 0xffffffffff)) chip->features &= ~FE_DAC_IN_USE; else chip->features |= FE_DAC_IN_USE; } if (chip && !(chip->features & FE_DAC_IN_USE)) { if (pci_set_dma_mask(pdev, (u64) 0xffffffff)) { printk(KERN_WARNING NAME53C8XX "32 BIT PCI BUS DMA ADDRESSING NOT SUPPORTED\n"); return -1; } } #endif /* ** Ignore Symbios chips controlled by SISL RAID controller. ** This controller sets value 0x52414944 at RAM end - 16. */ #if defined(__i386__) && !defined(SCSI_NCR_PCI_MEM_NOT_SUPPORTED) if (chip && (base_2_c & PCI_BASE_ADDRESS_MEM_MASK)) { unsigned int ram_size, ram_val; u_long ram_ptr; if (chip->features & FE_RAM8K) ram_size = 8192; else ram_size = 4096; ram_ptr = remap_pci_mem(base_2_c & PCI_BASE_ADDRESS_MEM_MASK, ram_size); if (ram_ptr) { ram_val = readl_raw(ram_ptr + ram_size - 16); unmap_pci_mem(ram_ptr, ram_size); if (ram_val == 0x52414944) { printk(NAME53C8XX": not initializing, " "driven by SISL RAID controller.\n"); return -1; } } } #endif /* i386 and PCI MEMORY accessible */ if (!chip) { printk(NAME53C8XX ": not initializing, device not supported\n"); return -1; } #if defined(__powerpc__) || defined(__hppa__) /* ** Fix-up for power/pc and hppa. ** Should not be performed by the driver. */ if ((command & (PCI_COMMAND_IO | PCI_COMMAND_MEMORY)) != (PCI_COMMAND_IO | PCI_COMMAND_MEMORY)) { printk(NAME53C8XX ": setting%s%s...\n", (command & PCI_COMMAND_IO) ? "" : " PCI_COMMAND_IO", (command & PCI_COMMAND_MEMORY) ? "" : " PCI_COMMAND_MEMORY"); command |= (PCI_COMMAND_IO | PCI_COMMAND_MEMORY); pci_write_config_word(pdev, PCI_COMMAND, command); } #if LINUX_VERSION_CODE < KERNEL_VERSION(2,2,0) if ( is_prep ) { if (io_port >= 0x10000000) { printk(NAME53C8XX ": reallocating io_port (Wacky IBM)"); io_port = (io_port & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_0, io_port); } if (base >= 0x10000000) { printk(NAME53C8XX ": reallocating base (Wacky IBM)"); base = (base & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_1, base); } if (base_2 >= 0x10000000) { printk(NAME53C8XX ": reallocating base2 (Wacky IBM)"); base_2 = (base_2 & 0x00FFFFFF) | 0x01000000; pci_write_config_dword(pdev, PCI_BASE_ADDRESS_2, base_2); } } #endif #endif /* __powerpc__ */ #if defined(__i386__) && !defined(MODULE) if (!cache_line_size) { #if LINUX_VERSION_CODE < KERNEL_VERSION(2,1,75) extern char x86; switch(x86) { #else switch(boot_cpu_data.x86) { #endif case 4: suggested_cache_line_size = 4; break; case 6: case 5: suggested_cache_line_size = 8; break; } } #endif /* __i386__ */ /* ** Check availability of IO space, memory space. ** Enable master capability if not yet. ** ** We shouldn't have to care about the IO region when ** we are using MMIO. But calling check_region() from ** both the ncr53c8xx and the sym53c8xx drivers prevents ** from attaching devices from the both drivers. ** If you have a better idea, let me know. */ /* #ifdef SCSI_NCR_IOMAPPED */ #if 1 if (!(command & PCI_COMMAND_IO)) { printk(NAME53C8XX ": I/O base address (0x%lx) disabled.\n", (long) io_port); io_port = 0; } #endif if (!(command & PCI_COMMAND_MEMORY)) { printk(NAME53C8XX ": PCI_COMMAND_MEMORY not set.\n"); base = 0; base_2 = 0; } io_port &= PCI_BASE_ADDRESS_IO_MASK; base &= PCI_BASE_ADDRESS_MEM_MASK; base_2 &= PCI_BASE_ADDRESS_MEM_MASK; /* #ifdef SCSI_NCR_IOMAPPED */ #if 1 if (io_port && check_region (io_port, 128)) { printk(NAME53C8XX ": IO region 0x%lx[0..127] is in use\n", (long) io_port); io_port = 0; } if (!io_port) return -1; #endif #ifndef SCSI_NCR_IOMAPPED if (!base) { printk(NAME53C8XX ": MMIO base address disabled.\n"); return -1; } #endif /* ** Set MASTER capable and PARITY bit, if not yet. */ if ((command & (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY)) != (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY)) { printk(NAME53C8XX ": setting%s%s...(fix-up)\n", (command & PCI_COMMAND_MASTER) ? "" : " PCI_COMMAND_MASTER", (command & PCI_COMMAND_PARITY) ? "" : " PCI_COMMAND_PARITY"); command |= (PCI_COMMAND_MASTER | PCI_COMMAND_PARITY); pci_write_config_word(pdev, PCI_COMMAND, command); } /* ** Fix some features according to driver setup. */ if (!(driver_setup.special_features & 1)) chip->features &= ~FE_SPECIAL_SET; else { if (driver_setup.special_features & 2) chip->features &= ~FE_WRIE; if (driver_setup.special_features & 4) chip->features &= ~FE_NOPM; } /* ** Work around for errant bit in 895A. The 66Mhz ** capable bit is set erroneously. Clear this bit. ** (Item 1 DEL 533) ** ** Make sure Config space and Features agree. ** ** Recall: writes are not normal to status register - ** write a 1 to clear and a 0 to leave unchanged. ** Can only reset bits. */ if (chip->features & FE_66MHZ) { if (!(status_reg & PCI_STATUS_66MHZ)) chip->features &= ~FE_66MHZ; } else { if (status_reg & PCI_STATUS_66MHZ) { status_reg = PCI_STATUS_66MHZ; pci_write_config_word(pdev, PCI_STATUS, status_reg); pci_read_config_word(pdev, PCI_STATUS, &status_reg); } } /* ** Some features are required to be enabled in order to ** work around some chip problems. :) ;) ** (ITEM 12 of a DEL about the 896 I haven't yet). ** We must ensure the chip will use WRITE AND INVALIDATE. ** The revision number limit is for now arbitrary. */ if (device_id == PCI_DEVICE_ID_NCR_53C896 && revision <= 0x10) { chip->features |= (FE_WRIE | FE_CLSE); pci_fix_up |= 3; /* Force appropriate PCI fix-up */ } #ifdef SCSI_NCR_PCI_FIX_UP_SUPPORT /* ** Try to fix up PCI config according to wished features. */ if ((pci_fix_up & 1) && (chip->features & FE_CLSE) && !cache_line_size && suggested_cache_line_size) { cache_line_size = suggested_cache_line_size; pci_write_config_byte(pdev, PCI_CACHE_LINE_SIZE, cache_line_size); printk(NAME53C8XX ": PCI_CACHE_LINE_SIZE set to %d (fix-up).\n", cache_line_size); } if ((pci_fix_up & 2) && cache_line_size && (chip->features & FE_WRIE) && !(command & PCI_COMMAND_INVALIDATE)) { printk(NAME53C8XX": setting PCI_COMMAND_INVALIDATE (fix-up)\n"); command |= PCI_COMMAND_INVALIDATE; pci_write_config_word(pdev, PCI_COMMAND, command); } /* ** Tune PCI LATENCY TIMER according to burst max length transfer. ** (latency timer >= burst length + 6, we add 10 to be quite sure) */ if (chip->burst_max && (latency_timer == 0 || (pci_fix_up & 4))) { uchar lt = (1 << chip->burst_max) + 6 + 10; if (latency_timer < lt) { printk(NAME53C8XX ": changing PCI_LATENCY_TIMER from %d to %d.\n", (int) latency_timer, (int) lt); latency_timer = lt; pci_write_config_byte(pdev, PCI_LATENCY_TIMER, latency_timer); } } #endif /* SCSI_NCR_PCI_FIX_UP_SUPPORT */ /* ** Initialize ncr_device structure with items required by ncr_attach. */ device->pdev = pdev; device->slot.bus = PciBusNumber(pdev); device->slot.device_fn = PciDeviceFn(pdev); device->slot.base = base; device->slot.base_2 = base_2; device->slot.base_c = base_c; device->slot.base_2_c = base_2_c; device->slot.io_port = io_port; device->slot.irq = irq; device->attach_done = 0; return 0; } /*=================================================================== ** Detect and try to read SYMBIOS and TEKRAM NVRAM. ** ** Data can be used to order booting of boards. ** ** Data is saved in ncr_device structure if NVRAM found. This ** is then used to find drive boot order for ncr_attach(). ** ** NVRAM data is passed to Scsi_Host_Template later during ** ncr_attach() for any device set up. *=================================================================== */ #ifdef SCSI_NCR_NVRAM_SUPPORT static void __init ncr_get_nvram(ncr_device *devp, ncr_nvram *nvp) { devp->nvram = nvp; if (!nvp) return; /* ** Get access to chip IO registers */ #ifdef SCSI_NCR_IOMAPPED request_region(devp->slot.io_port, 128, NAME53C8XX); devp->slot.base_io = devp->slot.io_port; #else devp->slot.reg = (struct ncr_reg *) remap_pci_mem(devp->slot.base_c, 128); if (!devp->slot.reg) return; #endif /* ** Try to read SYMBIOS nvram. ** Try to read TEKRAM nvram if Symbios nvram not found. */ if (!sym_read_Symbios_nvram(&devp->slot, &nvp->data.Symbios)) nvp->type = SCSI_NCR_SYMBIOS_NVRAM; else if (!sym_read_Tekram_nvram(&devp->slot, devp->chip.device_id, &nvp->data.Tekram)) nvp->type = SCSI_NCR_TEKRAM_NVRAM; else { nvp->type = 0; devp->nvram = 0; } /* ** Release access to chip IO registers */ #ifdef SCSI_NCR_IOMAPPED release_region(devp->slot.base_io, 128); #else unmap_pci_mem((u_long) devp->slot.reg, 128ul); #endif } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Linux select queue depths function */ #define DEF_DEPTH (driver_setup.default_tags) #define ALL_TARGETS -2 #define NO_TARGET -1 #define ALL_LUNS -2 #define NO_LUN -1 static int device_queue_depth(ncb_p np, int target, int lun) { int c, h, t, u, v; char *p = driver_setup.tag_ctrl; char *ep; h = -1; t = NO_TARGET; u = NO_LUN; while ((c = *p++) != 0) { v = simple_strtoul(p, &ep, 0); switch(c) { case '/': ++h; t = ALL_TARGETS; u = ALL_LUNS; break; case 't': if (t != target) t = (target == v) ? v : NO_TARGET; u = ALL_LUNS; break; case 'u': if (u != lun) u = (lun == v) ? v : NO_LUN; break; case 'q': if (h == np->unit && (t == ALL_TARGETS || t == target) && (u == ALL_LUNS || u == lun)) return v; break; case '-': t = ALL_TARGETS; u = ALL_LUNS; break; default: break; } p = ep; } return DEF_DEPTH; } int sym53c8xx_slave_configure(Scsi_Device *device) { struct Scsi_Host *host = device->host; ncb_p np; tcb_p tp; lcb_p lp; int numtags, depth_to_use; np = ((struct host_data *) host->hostdata)->ncb; tp = &np->target[device->id]; lp = ncr_lp(np, tp, device->lun); /* ** Select queue depth from driver setup. ** Donnot use more than configured by user. ** Use at least 2. ** Donnot use more than our maximum. */ numtags = device_queue_depth(np, device->id, device->lun); if (numtags > tp->usrtags) numtags = tp->usrtags; if (!device->tagged_supported) numtags = 1; depth_to_use = numtags; if (depth_to_use < 2) depth_to_use = 2; if (depth_to_use > MAX_TAGS) depth_to_use = MAX_TAGS; scsi_adjust_queue_depth(device, (device->tagged_supported ? MSG_SIMPLE_TAG : 0), depth_to_use); /* ** Since the queue depth is not tunable under Linux, ** we need to know this value in order not to ** announce stupid things to user. */ if (lp) { lp->numtags = lp->maxtags = numtags; lp->scdev_depth = depth_to_use; } ncr_setup_tags (np, device->id, device->lun); #ifdef DEBUG_SYM53C8XX printk("sym53c8xx_select_queue_depth: host=%d, id=%d, lun=%d, depth=%d\n", np->unit, device->id, device->lun, depth_to_use); #endif return 0; } /* ** Linux entry point for info() function */ const char *sym53c8xx_info (struct Scsi_Host *host) { return SCSI_NCR_DRIVER_NAME; } /* ** Linux entry point of queuecommand() function */ int sym53c8xx_queue_command (Scsi_Cmnd *cmd, void (* done)(Scsi_Cmnd *)) { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; unsigned long flags; int sts; #ifdef DEBUG_SYM53C8XX printk("sym53c8xx_queue_command\n"); #endif cmd->scsi_done = done; cmd->host_scribble = NULL; cmd->SCp.ptr = NULL; cmd->SCp.buffer = NULL; #ifdef SCSI_NCR_DYNAMIC_DMA_MAPPING __data_mapped(cmd) = 0; __data_mapping(cmd) = 0; #endif NCR_LOCK_NCB(np, flags); if ((sts = ncr_queue_command(np, cmd)) != DID_OK) { SetScsiResult(cmd, sts, 0); #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : command not queued - result=%d\n", sts); #endif } #ifdef DEBUG_SYM53C8XX else printk("sym53c8xx : command successfully queued\n"); #endif NCR_UNLOCK_NCB(np, flags); if (sts != DID_OK) { unmap_scsi_data(np, cmd); done(cmd); } return sts; } /* ** Linux entry point of the interrupt handler. ** Since linux versions > 1.3.70, we trust the kernel for ** passing the internal host descriptor as 'dev_id'. ** Otherwise, we scan the host list and call the interrupt ** routine for each host that uses this IRQ. */ static void sym53c8xx_intr(int irq, void *dev_id, struct pt_regs * regs) { unsigned long flags; ncb_p np = (ncb_p) dev_id; Scsi_Cmnd *done_list; #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : interrupt received\n"); #endif if (DEBUG_FLAGS & DEBUG_TINY) printk ("["); NCR_LOCK_NCB(np, flags); ncr_exception(np); done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); if (DEBUG_FLAGS & DEBUG_TINY) printk ("]\n"); if (done_list) { NCR_LOCK_SCSI_DONE(done_list->device->host, flags); ncr_flush_done_cmds(done_list); NCR_UNLOCK_SCSI_DONE(done_list->device->host, flags); } } /* ** Linux entry point of the timer handler */ static void sym53c8xx_timeout(unsigned long npref) { ncb_p np = (ncb_p) npref; unsigned long flags; Scsi_Cmnd *done_list; NCR_LOCK_NCB(np, flags); ncr_timeout((ncb_p) np); done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); if (done_list) { NCR_LOCK_SCSI_DONE(done_list->device->host, flags); ncr_flush_done_cmds(done_list); NCR_UNLOCK_SCSI_DONE(done_list->device->host, flags); } } /* ** Linux entry point of reset() function */ #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS int sym53c8xx_reset(Scsi_Cmnd *cmd, unsigned int reset_flags) #else int sym53c8xx_reset(Scsi_Cmnd *cmd) #endif { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; int sts; unsigned long flags; Scsi_Cmnd *done_list; #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS printk("sym53c8xx_reset: pid=%lu reset_flags=%x serial_number=%ld serial_number_at_timeout=%ld\n", cmd->pid, reset_flags, cmd->serial_number, cmd->serial_number_at_timeout); #else printk("sym53c8xx_reset: command pid %lu\n", cmd->pid); #endif NCR_LOCK_NCB(np, flags); /* * We have to just ignore reset requests in some situations. */ #if defined SCSI_RESET_NOT_RUNNING if (cmd->serial_number != cmd->serial_number_at_timeout) { sts = SCSI_RESET_NOT_RUNNING; goto out; } #endif /* * If the mid-level driver told us reset is synchronous, it seems * that we must call the done() callback for the involved command, * even if this command was not queued to the low-level driver, * before returning SCSI_RESET_SUCCESS. */ #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS sts = ncr_reset_bus(np, cmd, (reset_flags & (SCSI_RESET_SYNCHRONOUS | SCSI_RESET_ASYNCHRONOUS)) == SCSI_RESET_SYNCHRONOUS); #else sts = ncr_reset_bus(np, cmd, 0); #endif /* * Since we always reset the controller, when we return success, * we add this information to the return code. */ #if defined SCSI_RESET_HOST_RESET if (sts == SCSI_RESET_SUCCESS) sts |= SCSI_RESET_HOST_RESET; #endif out: done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); ncr_flush_done_cmds(done_list); return sts; } /* ** Linux entry point of abort() function */ int sym53c8xx_abort(Scsi_Cmnd *cmd) { ncb_p np = ((struct host_data *) cmd->device->host->hostdata)->ncb; int sts; unsigned long flags; Scsi_Cmnd *done_list; #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS printk("sym53c8xx_abort: pid=%lu serial_number=%ld serial_number_at_timeout=%ld\n", cmd->pid, cmd->serial_number, cmd->serial_number_at_timeout); #else printk("sym53c8xx_abort: command pid %lu\n", cmd->pid); #endif NCR_LOCK_NCB(np, flags); #if defined SCSI_RESET_SYNCHRONOUS && defined SCSI_RESET_ASYNCHRONOUS /* * We have to just ignore abort requests in some situations. */ if (cmd->serial_number != cmd->serial_number_at_timeout) { sts = SCSI_ABORT_NOT_RUNNING; goto out; } #endif sts = ncr_abort_command(np, cmd); out: done_list = np->done_list; np->done_list = 0; NCR_UNLOCK_NCB(np, flags); ncr_flush_done_cmds(done_list); return sts; } int sym53c8xx_release(struct Scsi_Host *host) { #ifdef DEBUG_SYM53C8XX printk("sym53c8xx : release\n"); #endif ncr_detach(((struct host_data *) host->hostdata)->ncb); return 1; } /* ** Scsi command waiting list management. ** ** It may happen that we cannot insert a scsi command into the start queue, ** in the following circumstances. ** Too few preallocated ccb(s), ** maxtags < cmd_per_lun of the Linux host control block, ** etc... ** Such scsi commands are inserted into a waiting list. ** When a scsi command complete, we try to requeue the commands of the ** waiting list. */ #define next_wcmd host_scribble static void insert_into_waiting_list(ncb_p np, Scsi_Cmnd *cmd) { Scsi_Cmnd *wcmd; #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx inserted into waiting list\n", ncr_name(np), (u_long) cmd); #endif cmd->next_wcmd = 0; if (!(wcmd = np->waiting_list)) np->waiting_list = cmd; else { while ((wcmd->next_wcmd) != 0) wcmd = (Scsi_Cmnd *) wcmd->next_wcmd; wcmd->next_wcmd = (char *) cmd; } } static Scsi_Cmnd *retrieve_from_waiting_list(int to_remove, ncb_p np, Scsi_Cmnd *cmd) { Scsi_Cmnd **pcmd = &np->waiting_list; while (*pcmd) { if (cmd == *pcmd) { if (to_remove) { *pcmd = (Scsi_Cmnd *) cmd->next_wcmd; cmd->next_wcmd = 0; } #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx retrieved from waiting list\n", ncr_name(np), (u_long) cmd); #endif return cmd; } pcmd = (Scsi_Cmnd **) &(*pcmd)->next_wcmd; } return 0; } static void process_waiting_list(ncb_p np, int sts) { Scsi_Cmnd *waiting_list, *wcmd; waiting_list = np->waiting_list; np->waiting_list = 0; #ifdef DEBUG_WAITING_LIST if (waiting_list) printk("%s: waiting_list=%lx processing sts=%d\n", ncr_name(np), (u_long) waiting_list, sts); #endif while ((wcmd = waiting_list) != 0) { waiting_list = (Scsi_Cmnd *) wcmd->next_wcmd; wcmd->next_wcmd = 0; if (sts == DID_OK) { #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx trying to requeue\n", ncr_name(np), (u_long) wcmd); #endif sts = ncr_queue_command(np, wcmd); } if (sts != DID_OK) { #ifdef DEBUG_WAITING_LIST printk("%s: cmd %lx done forced sts=%d\n", ncr_name(np), (u_long) wcmd, sts); #endif SetScsiResult(wcmd, sts, 0); ncr_queue_done_cmd(np, wcmd); } } } #undef next_wcmd #ifdef SCSI_NCR_PROC_INFO_SUPPORT /*========================================================================= ** Proc file system stuff ** ** A read operation returns adapter information. ** A write operation is a control command. ** The string is parsed in the driver code and the command is passed ** to the ncr_usercmd() function. **========================================================================= */ #ifdef SCSI_NCR_USER_COMMAND_SUPPORT #define is_digit(c) ((c) >= '0' && (c) <= '9') #define digit_to_bin(c) ((c) - '0') #define is_space(c) ((c) == ' ' || (c) == '\t') static int skip_spaces(char *ptr, int len) { int cnt, c; for (cnt = len; cnt > 0 && (c = *ptr++) && is_space(c); cnt--); return (len - cnt); } static int get_int_arg(char *ptr, int len, u_long *pv) { int cnt, c; u_long v; for (v = 0, cnt = len; cnt > 0 && (c = *ptr++) && is_digit(c); cnt--) { v = (v * 10) + digit_to_bin(c); } if (pv) *pv = v; return (len - cnt); } static int is_keyword(char *ptr, int len, char *verb) { int verb_len = strlen(verb); if (len >= strlen(verb) && !memcmp(verb, ptr, verb_len)) return verb_len; else return 0; } #define SKIP_SPACES(min_spaces) \ if ((arg_len = skip_spaces(ptr, len)) < (min_spaces)) \ return -EINVAL; \ ptr += arg_len; len -= arg_len; #define GET_INT_ARG(v) \ if (!(arg_len = get_int_arg(ptr, len, &(v)))) \ return -EINVAL; \ ptr += arg_len; len -= arg_len; /* ** Parse a control command */ static int ncr_user_command(ncb_p np, char *buffer, int length) { char *ptr = buffer; int len = length; struct usrcmd *uc = &np->user; int arg_len; u_long target; bzero(uc, sizeof(*uc)); if (len > 0 && ptr[len-1] == '\n') --len; if ((arg_len = is_keyword(ptr, len, "setsync")) != 0) uc->cmd = UC_SETSYNC; else if ((arg_len = is_keyword(ptr, len, "settags")) != 0) uc->cmd = UC_SETTAGS; else if ((arg_len = is_keyword(ptr, len, "setorder")) != 0) uc->cmd = UC_SETORDER; else if ((arg_len = is_keyword(ptr, len, "setverbose")) != 0) uc->cmd = UC_SETVERBOSE; else if ((arg_len = is_keyword(ptr, len, "setwide")) != 0) uc->cmd = UC_SETWIDE; else if ((arg_len = is_keyword(ptr, len, "setdebug")) != 0) uc->cmd = UC_SETDEBUG; else if ((arg_len = is_keyword(ptr, len, "setflag")) != 0) uc->cmd = UC_SETFLAG; else if ((arg_len = is_keyword(ptr, len, "resetdev")) != 0) uc->cmd = UC_RESETDEV; else if ((arg_len = is_keyword(ptr, len, "cleardev")) != 0) uc->cmd = UC_CLEARDEV; else arg_len = 0; #ifdef DEBUG_PROC_INFO printk("ncr_user_command: arg_len=%d, cmd=%ld\n", arg_len, uc->cmd); #endif if (!arg_len) return -EINVAL; ptr += arg_len; len -= arg_len; switch(uc->cmd) { case UC_SETSYNC: case UC_SETTAGS: case UC_SETWIDE: case UC_SETFLAG: case UC_RESETDEV: case UC_CLEARDEV: SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "all")) != 0) { ptr += arg_len; len -= arg_len; uc->target = ~0; } else { GET_INT_ARG(target); uc->target = (1<cmd) { case UC_SETVERBOSE: case UC_SETSYNC: case UC_SETTAGS: case UC_SETWIDE: SKIP_SPACES(1); GET_INT_ARG(uc->data); #ifdef DEBUG_PROC_INFO printk("ncr_user_command: data=%ld\n", uc->data); #endif break; case UC_SETORDER: SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "simple"))) uc->data = M_SIMPLE_TAG; else if ((arg_len = is_keyword(ptr, len, "ordered"))) uc->data = M_ORDERED_TAG; else if ((arg_len = is_keyword(ptr, len, "default"))) uc->data = 0; else return -EINVAL; break; case UC_SETDEBUG: while (len > 0) { SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "alloc"))) uc->data |= DEBUG_ALLOC; else if ((arg_len = is_keyword(ptr, len, "phase"))) uc->data |= DEBUG_PHASE; else if ((arg_len = is_keyword(ptr, len, "queue"))) uc->data |= DEBUG_QUEUE; else if ((arg_len = is_keyword(ptr, len, "result"))) uc->data |= DEBUG_RESULT; else if ((arg_len = is_keyword(ptr, len, "pointer"))) uc->data |= DEBUG_POINTER; else if ((arg_len = is_keyword(ptr, len, "script"))) uc->data |= DEBUG_SCRIPT; else if ((arg_len = is_keyword(ptr, len, "tiny"))) uc->data |= DEBUG_TINY; else if ((arg_len = is_keyword(ptr, len, "timing"))) uc->data |= DEBUG_TIMING; else if ((arg_len = is_keyword(ptr, len, "nego"))) uc->data |= DEBUG_NEGO; else if ((arg_len = is_keyword(ptr, len, "tags"))) uc->data |= DEBUG_TAGS; else return -EINVAL; ptr += arg_len; len -= arg_len; } #ifdef DEBUG_PROC_INFO printk("ncr_user_command: data=%ld\n", uc->data); #endif break; case UC_SETFLAG: while (len > 0) { SKIP_SPACES(1); if ((arg_len = is_keyword(ptr, len, "trace"))) uc->data |= UF_TRACE; else if ((arg_len = is_keyword(ptr, len, "no_disc"))) uc->data |= UF_NODISC; else return -EINVAL; ptr += arg_len; len -= arg_len; } break; default: break; } if (len) return -EINVAL; else { unsigned long flags; NCR_LOCK_NCB(np, flags); ncr_usercmd (np); NCR_UNLOCK_NCB(np, flags); } return length; } #endif /* SCSI_NCR_USER_COMMAND_SUPPORT */ #ifdef SCSI_NCR_USER_INFO_SUPPORT struct info_str { char *buffer; int length; int offset; int pos; }; static void copy_mem_info(struct info_str *info, char *data, int len) { if (info->pos + len > info->length) len = info->length - info->pos; if (info->pos + len < info->offset) { info->pos += len; return; } if (info->pos < info->offset) { data += (info->offset - info->pos); len -= (info->offset - info->pos); } if (len > 0) { memcpy(info->buffer + info->pos, data, len); info->pos += len; } } static int copy_info(struct info_str *info, char *fmt, ...) { va_list args; char buf[81]; int len; va_start(args, fmt); len = vsprintf(buf, fmt, args); va_end(args); copy_mem_info(info, buf, len); return len; } /* ** Copy formatted information into the input buffer. */ static int ncr_host_info(ncb_p np, char *ptr, off_t offset, int len) { struct info_str info; info.buffer = ptr; info.length = len; info.offset = offset; info.pos = 0; copy_info(&info, "General information:\n"); copy_info(&info, " Chip " NAME53C "%s, device id 0x%x, " "revision id 0x%x\n", np->chip_name, np->device_id, np->revision_id); copy_info(&info, " On PCI bus %d, device %d, function %d, " #ifdef __sparc__ "IRQ %s\n", #else "IRQ %d\n", #endif np->bus, (np->device_fn & 0xf8) >> 3, np->device_fn & 7, #ifdef __sparc__ __irq_itoa(np->irq)); #else (int) np->irq); #endif copy_info(&info, " Synchronous period factor %d, " "max commands per lun %d\n", (int) np->minsync, MAX_TAGS); if (driver_setup.debug || driver_setup.verbose > 1) { copy_info(&info, " Debug flags 0x%x, verbosity level %d\n", driver_setup.debug, driver_setup.verbose); } return info.pos > info.offset? info.pos - info.offset : 0; } #endif /* SCSI_NCR_USER_INFO_SUPPORT */ /* ** Entry point of the scsi proc fs of the driver. ** - func = 0 means read (returns adapter infos) ** - func = 1 means write (parse user control command) */ static int sym53c8xx_proc_info(char *buffer, char **start, off_t offset, int length, int hostno, int func) { struct Scsi_Host *host; struct host_data *host_data; ncb_p ncb = 0; int retv; #ifdef DEBUG_PROC_INFO printk("sym53c8xx_proc_info: hostno=%d, func=%d\n", hostno, func); #endif host = scsi_host_hn_get(hostno); if (!host) return -EINVAL; host_data = (struct host_data *) host->hostdata; ncb = host_data->ncb; retv = -EINVAL; if (!ncb) goto out; if (func) { #ifdef SCSI_NCR_USER_COMMAND_SUPPORT retv = ncr_user_command(ncb, buffer, length); #endif } else { if (start) *start = buffer; #ifdef SCSI_NCR_USER_INFO_SUPPORT retv = ncr_host_info(ncb, buffer, offset, length); #endif } out: scsi_host_put(host); return retv; } /*========================================================================= ** End of proc file system stuff **========================================================================= */ #endif #ifdef SCSI_NCR_NVRAM_SUPPORT /* * 24C16 EEPROM reading. * * GPOI0 - data in/data out * GPIO1 - clock * Symbios NVRAM wiring now also used by Tekram. */ #define SET_BIT 0 #define CLR_BIT 1 #define SET_CLK 2 #define CLR_CLK 3 /* * Set/clear data/clock bit in GPIO0 */ static void __init S24C16_set_bit(ncr_slot *np, u_char write_bit, u_char *gpreg, int bit_mode) { UDELAY (5); switch (bit_mode){ case SET_BIT: *gpreg |= write_bit; break; case CLR_BIT: *gpreg &= 0xfe; break; case SET_CLK: *gpreg |= 0x02; break; case CLR_CLK: *gpreg &= 0xfd; break; } OUTB (nc_gpreg, *gpreg); UDELAY (5); } /* * Send START condition to NVRAM to wake it up. */ static void __init S24C16_start(ncr_slot *np, u_char *gpreg) { S24C16_set_bit(np, 1, gpreg, SET_BIT); S24C16_set_bit(np, 0, gpreg, SET_CLK); S24C16_set_bit(np, 0, gpreg, CLR_BIT); S24C16_set_bit(np, 0, gpreg, CLR_CLK); } /* * Send STOP condition to NVRAM - puts NVRAM to sleep... ZZzzzz!! */ static void __init S24C16_stop(ncr_slot *np, u_char *gpreg) { S24C16_set_bit(np, 0, gpreg, SET_CLK); S24C16_set_bit(np, 1, gpreg, SET_BIT); } /* * Read or write a bit to the NVRAM, * read if GPIO0 input else write if GPIO0 output */ static void __init S24C16_do_bit(ncr_slot *np, u_char *read_bit, u_char write_bit, u_char *gpreg) { S24C16_set_bit(np, write_bit, gpreg, SET_BIT); S24C16_set_bit(np, 0, gpreg, SET_CLK); if (read_bit) *read_bit = INB (nc_gpreg); S24C16_set_bit(np, 0, gpreg, CLR_CLK); S24C16_set_bit(np, 0, gpreg, CLR_BIT); } /* * Output an ACK to the NVRAM after reading, * change GPIO0 to output and when done back to an input */ static void __init S24C16_write_ack(ncr_slot *np, u_char write_bit, u_char *gpreg, u_char *gpcntl) { OUTB (nc_gpcntl, *gpcntl & 0xfe); S24C16_do_bit(np, 0, write_bit, gpreg); OUTB (nc_gpcntl, *gpcntl); } /* * Input an ACK from NVRAM after writing, * change GPIO0 to input and when done back to an output */ static void __init S24C16_read_ack(ncr_slot *np, u_char *read_bit, u_char *gpreg, u_char *gpcntl) { OUTB (nc_gpcntl, *gpcntl | 0x01); S24C16_do_bit(np, read_bit, 1, gpreg); OUTB (nc_gpcntl, *gpcntl); } /* * WRITE a byte to the NVRAM and then get an ACK to see it was accepted OK, * GPIO0 must already be set as an output */ static void __init S24C16_write_byte(ncr_slot *np, u_char *ack_data, u_char write_data, u_char *gpreg, u_char *gpcntl) { int x; for (x = 0; x < 8; x++) S24C16_do_bit(np, 0, (write_data >> (7 - x)) & 0x01, gpreg); S24C16_read_ack(np, ack_data, gpreg, gpcntl); } /* * READ a byte from the NVRAM and then send an ACK to say we have got it, * GPIO0 must already be set as an input */ static void __init S24C16_read_byte(ncr_slot *np, u_char *read_data, u_char ack_data, u_char *gpreg, u_char *gpcntl) { int x; u_char read_bit; *read_data = 0; for (x = 0; x < 8; x++) { S24C16_do_bit(np, &read_bit, 1, gpreg); *read_data |= ((read_bit & 0x01) << (7 - x)); } S24C16_write_ack(np, ack_data, gpreg, gpcntl); } /* * Read 'len' bytes starting at 'offset'. */ static int __init sym_read_S24C16_nvram (ncr_slot *np, int offset, u_char *data, int len) { u_char gpcntl, gpreg; u_char old_gpcntl, old_gpreg; u_char ack_data; int retv = 1; int x; /* save current state of GPCNTL and GPREG */ old_gpreg = INB (nc_gpreg); old_gpcntl = INB (nc_gpcntl); gpcntl = old_gpcntl & 0x1c; /* set up GPREG & GPCNTL to set GPIO0 and GPIO1 in to known state */ OUTB (nc_gpreg, old_gpreg); OUTB (nc_gpcntl, gpcntl); /* this is to set NVRAM into a known state with GPIO0/1 both low */ gpreg = old_gpreg; S24C16_set_bit(np, 0, &gpreg, CLR_CLK); S24C16_set_bit(np, 0, &gpreg, CLR_BIT); /* now set NVRAM inactive with GPIO0/1 both high */ S24C16_stop(np, &gpreg); /* activate NVRAM */ S24C16_start(np, &gpreg); /* write device code and random address MSB */ S24C16_write_byte(np, &ack_data, 0xa0 | ((offset >> 7) & 0x0e), &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* write random address LSB */ S24C16_write_byte(np, &ack_data, offset & 0xff, &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* regenerate START state to set up for reading */ S24C16_start(np, &gpreg); /* rewrite device code and address MSB with read bit set (lsb = 0x01) */ S24C16_write_byte(np, &ack_data, 0xa1 | ((offset >> 7) & 0x0e), &gpreg, &gpcntl); if (ack_data & 0x01) goto out; /* now set up GPIO0 for inputting data */ gpcntl |= 0x01; OUTB (nc_gpcntl, gpcntl); /* input all requested data - only part of total NVRAM */ for (x = 0; x < len; x++) S24C16_read_byte(np, &data[x], (x == (len-1)), &gpreg, &gpcntl); /* finally put NVRAM back in inactive mode */ gpcntl &= 0xfe; OUTB (nc_gpcntl, gpcntl); S24C16_stop(np, &gpreg); retv = 0; out: /* return GPIO0/1 to original states after having accessed NVRAM */ OUTB (nc_gpcntl, old_gpcntl); OUTB (nc_gpreg, old_gpreg); return retv; } #undef SET_BIT #undef CLR_BIT #undef SET_CLK #undef CLR_CLK /* * Try reading Symbios NVRAM. * Return 0 if OK. */ static int __init sym_read_Symbios_nvram (ncr_slot *np, Symbios_nvram *nvram) { static u_char Symbios_trailer[6] = {0xfe, 0xfe, 0, 0, 0, 0}; u_char *data = (u_char *) nvram; int len = sizeof(*nvram); u_short csum; int x; /* probe the 24c16 and read the SYMBIOS 24c16 area */ if (sym_read_S24C16_nvram (np, SYMBIOS_NVRAM_ADDRESS, data, len)) return 1; /* check valid NVRAM signature, verify byte count and checksum */ if (nvram->type != 0 || memcmp(nvram->trailer, Symbios_trailer, 6) || nvram->byte_count != len - 12) return 1; /* verify checksum */ for (x = 6, csum = 0; x < len - 6; x++) csum += data[x]; if (csum != nvram->checksum) return 1; return 0; } /* * 93C46 EEPROM reading. * * GPOI0 - data in * GPIO1 - data out * GPIO2 - clock * GPIO4 - chip select * * Used by Tekram. */ /* * Pulse clock bit in GPIO0 */ static void __init T93C46_Clk(ncr_slot *np, u_char *gpreg) { OUTB (nc_gpreg, *gpreg | 0x04); UDELAY (2); OUTB (nc_gpreg, *gpreg); } /* * Read bit from NVRAM */ static void __init T93C46_Read_Bit(ncr_slot *np, u_char *read_bit, u_char *gpreg) { UDELAY (2); T93C46_Clk(np, gpreg); *read_bit = INB (nc_gpreg); } /* * Write bit to GPIO0 */ static void __init T93C46_Write_Bit(ncr_slot *np, u_char write_bit, u_char *gpreg) { if (write_bit & 0x01) *gpreg |= 0x02; else *gpreg &= 0xfd; *gpreg |= 0x10; OUTB (nc_gpreg, *gpreg); UDELAY (2); T93C46_Clk(np, gpreg); } /* * Send STOP condition to NVRAM - puts NVRAM to sleep... ZZZzzz!! */ static void __init T93C46_Stop(ncr_slot *np, u_char *gpreg) { *gpreg &= 0xef; OUTB (nc_gpreg, *gpreg); UDELAY (2); T93C46_Clk(np, gpreg); } /* * Send read command and address to NVRAM */ static void __init T93C46_Send_Command(ncr_slot *np, u_short write_data, u_char *read_bit, u_char *gpreg) { int x; /* send 9 bits, start bit (1), command (2), address (6) */ for (x = 0; x < 9; x++) T93C46_Write_Bit(np, (u_char) (write_data >> (8 - x)), gpreg); *read_bit = INB (nc_gpreg); } /* * READ 2 bytes from the NVRAM */ static void __init T93C46_Read_Word(ncr_slot *np, u_short *nvram_data, u_char *gpreg) { int x; u_char read_bit; *nvram_data = 0; for (x = 0; x < 16; x++) { T93C46_Read_Bit(np, &read_bit, gpreg); if (read_bit & 0x01) *nvram_data |= (0x01 << (15 - x)); else *nvram_data &= ~(0x01 << (15 - x)); } } /* * Read Tekram NvRAM data. */ static int __init T93C46_Read_Data(ncr_slot *np, u_short *data,int len,u_char *gpreg) { u_char read_bit; int x; for (x = 0; x < len; x++) { /* output read command and address */ T93C46_Send_Command(np, 0x180 | x, &read_bit, gpreg); if (read_bit & 0x01) return 1; /* Bad */ T93C46_Read_Word(np, &data[x], gpreg); T93C46_Stop(np, gpreg); } return 0; } /* * Try reading 93C46 Tekram NVRAM. */ static int __init sym_read_T93C46_nvram (ncr_slot *np, Tekram_nvram *nvram) { u_char gpcntl, gpreg; u_char old_gpcntl, old_gpreg; int retv = 1; /* save current state of GPCNTL and GPREG */ old_gpreg = INB (nc_gpreg); old_gpcntl = INB (nc_gpcntl); /* set up GPREG & GPCNTL to set GPIO0/1/2/4 in to known state, 0 in, 1/2/4 out */ gpreg = old_gpreg & 0xe9; OUTB (nc_gpreg, gpreg); gpcntl = (old_gpcntl & 0xe9) | 0x09; OUTB (nc_gpcntl, gpcntl); /* input all of NVRAM, 64 words */ retv = T93C46_Read_Data(np, (u_short *) nvram, sizeof(*nvram) / sizeof(short), &gpreg); /* return GPIO0/1/2/4 to original states after having accessed NVRAM */ OUTB (nc_gpcntl, old_gpcntl); OUTB (nc_gpreg, old_gpreg); return retv; } /* * Try reading Tekram NVRAM. * Return 0 if OK. */ static int __init sym_read_Tekram_nvram (ncr_slot *np, u_short device_id, Tekram_nvram *nvram) { u_char *data = (u_char *) nvram; int len = sizeof(*nvram); u_short csum; int x; switch (device_id) { case PCI_DEVICE_ID_NCR_53C885: case PCI_DEVICE_ID_NCR_53C895: case PCI_DEVICE_ID_NCR_53C896: x = sym_read_S24C16_nvram(np, TEKRAM_24C16_NVRAM_ADDRESS, data, len); break; case PCI_DEVICE_ID_NCR_53C875: x = sym_read_S24C16_nvram(np, TEKRAM_24C16_NVRAM_ADDRESS, data, len); if (!x) break; default: x = sym_read_T93C46_nvram(np, nvram); break; } if (x) return 1; /* verify checksum */ for (x = 0, csum = 0; x < len - 1; x += 2) csum += data[x] + (data[x+1] << 8); if (csum != 0x1234) return 1; return 0; } #endif /* SCSI_NCR_NVRAM_SUPPORT */ /* ** Module stuff */ MODULE_LICENSE("GPL"); static Scsi_Host_Template driver_template = { .name = "sym53c8xx", .detect = sym53c8xx_detect, .release = sym53c8xx_release, .info = sym53c8xx_info, .queuecommand = sym53c8xx_queue_command, .slave_configure = sym53c8xx_slave_configure, .abort = sym53c8xx_abort, .reset = sym53c8xx_reset, .can_queue = SCSI_NCR_CAN_QUEUE, .this_id = 7, .sg_tablesize = SCSI_NCR_SG_TABLESIZE, .cmd_per_lun = SCSI_NCR_CMD_PER_LUN, .max_sectors = MAX_HW_SEGMENTS*8, .use_clustering = DISABLE_CLUSTERING, .highmem_io = 1 }; #include "scsi_module.c" coccinelle-1.0.0-rc19/demos/demo_rule9/nsp_cs.c0000644000175000017500000014450712247437436020207 0ustar eugeneugen/*====================================================================== NinjaSCSI-3 / NinjaSCSI-32Bi PCMCIA SCSI host adapter card driver By: YOKOTA Hiroshi Ver.2.8 Support 32bit MMIO mode Support Synchronous Data TRansfer (SDTR) mode Ver.2.0 Support 32bit PIO mode Ver.1.1.2 Fix for scatter list buffer exceeds Ver.1.1 Support scatter list Ver.0.1 Initial version This software may be used and distributed according to the terms of the GNU General Public License. ======================================================================*/ /*********************************************************************** This driver is for these PCcards. I-O DATA PCSC-F (Workbit NinjaSCSI-3) "WBT", "NinjaSCSI-3", "R1.0" I-O DATA CBSC-II (Workbit NinjaSCSI-32Bi in 16bit mode) "IO DATA", "CBSC16 ", "1" ***********************************************************************/ /* */ #ifdef NSP_KERNEL_2_2 #include #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "scsi.h" #include "hosts.h" #include #include #include #include #include #include #include #include #include "nsp_cs.h" MODULE_AUTHOR("YOKOTA Hiroshi "); MODULE_DESCRIPTION("WorkBit NinjaSCSI-3 / NinjaSCSI-32Bi(16bit) PCMCIA SCSI host adapter module $Revision$"); MODULE_SUPPORTED_DEVICE("sd,sr,sg,st"); #ifdef MODULE_LICENSE MODULE_LICENSE("GPL"); #endif #ifdef PCMCIA_DEBUG static int pc_debug = PCMCIA_DEBUG; MODULE_PARM(pc_debug, "i"); MODULE_PARM_DESC(pc_debug, "set debug level"); static char *version = ""; #define DEBUG(n, args...) if (pc_debug>(n)) printk(KERN_DEBUG args) #else #define DEBUG(n, args...) /* */ #endif #include "nsp_io.h" /*====================================================================*/ typedef struct scsi_info_t { dev_link_t link; dev_node_t node; struct Scsi_Host *host; int stop; } scsi_info_t; /*----------------------------------------------------------------*/ #if (KERNEL_VERSION(2,4,0) > LINUX_VERSION_CODE) #define PROC_SCSI_NSP PROC_SCSI_IBMMCA /* bad hack... */ static struct proc_dir_entry proc_scsi_nsp = { PROC_SCSI_NSP, 6, "nsp_cs", S_IFDIR | S_IRUGO | S_IXUGO, 2 }; #endif /*====================================================================*/ /* Parameters that can be set with 'insmod' */ static unsigned int irq_mask = 0xffff; MODULE_PARM(irq_mask, "i"); MODULE_PARM_DESC(irq_mask, "IRQ mask bits (default: 0xffff)"); static int irq_list[4] = { -1 }; MODULE_PARM(irq_list, "1-4i"); MODULE_PARM_DESC(irq_list, "Use specified IRQ number. (default: auto select)"); static int nsp_burst_mode = 2; MODULE_PARM(nsp_burst_mode, "i"); MODULE_PARM_DESC(nsp_burst_mode, "Burst transfer mode (0=io8, 1=io32, 2=mem32(default))"); /* Release IO ports after configuration? */ static int free_ports = 0; MODULE_PARM(free_ports, "i"); MODULE_PARM_DESC(free_ports, "Release IO ports after configuration? (default: 0 (=no))"); /* /usr/src/linux/drivers/scsi/hosts.h */ static Scsi_Host_Template nsp_driver_template = { #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,0)) .proc_name = "nsp_cs", /* kernel 2.4 */ #else .proc_dir = &proc_scsi_nsp, /* kernel 2.2 */ #endif .proc_info = nsp_proc_info, .name = "WorkBit NinjaSCSI-3/32Bi(16bit)", #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) .detect = nsp_detect, .release = nsp_release, #endif .info = nsp_info, .queuecommand = nsp_queuecommand, /* .eh_strategy_handler = nsp_eh_strategy,*/ /* .eh_abort_handler = nsp_eh_abort,*/ /* .eh_device_reset_handler = nsp_eh_device_reset,*/ .eh_bus_reset_handler = nsp_eh_bus_reset, .eh_host_reset_handler = nsp_eh_host_reset, .can_queue = 1, .this_id = NSP_INITIATOR_ID, .sg_tablesize = SG_ALL, .cmd_per_lun = 1, .use_clustering = DISABLE_CLUSTERING, #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,2)) .use_new_eh_code = 1, #endif }; static dev_link_t *dev_list = NULL; static dev_info_t dev_info = {"nsp_cs"}; static nsp_hw_data nsp_data; /***********************************************************/ static int nsp_queuecommand(Scsi_Cmnd *SCpnt, void (*done)(Scsi_Cmnd *)) { #ifdef PCMCIA_DEBUG /*unsigned int host_id = SCpnt->host->this_id;*/ /*unsigned int base = SCpnt->host->io_port;*/ unsigned char target = SCpnt->target; #endif nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: SCpnt=0x%p target=%d lun=%d buff=0x%p bufflen=%d use_sg=%d\n", __FUNCTION__, SCpnt, target, SCpnt->lun, SCpnt->request_buffer, SCpnt->request_bufflen, SCpnt->use_sg); //DEBUG(0, " before CurrentSC=0x%p\n", data->CurrentSC); if(data->CurrentSC != NULL) { printk(KERN_DEBUG " %s: CurrentSC!=NULL this can't be happen\n", __FUNCTION__); data->CurrentSC = NULL; SCpnt->result = DID_BAD_TARGET << 16; done(SCpnt); return -1; } show_command(SCpnt); SCpnt->scsi_done = done; data->CurrentSC = SCpnt; SCpnt->SCp.Status = CHECK_CONDITION; SCpnt->SCp.Message = 0; SCpnt->SCp.have_data_in = IO_UNKNOWN; SCpnt->SCp.sent_command = 0; SCpnt->SCp.phase = PH_UNDETERMINED; RESID = SCpnt->request_bufflen; /* setup scratch area SCp.ptr : buffer pointer SCp.this_residual : buffer length SCp.buffer : next buffer SCp.buffers_residual : left buffers in list SCp.phase : current state of the command */ if (SCpnt->use_sg) { SCpnt->SCp.buffer = (struct scatterlist *) SCpnt->request_buffer; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; SCpnt->SCp.buffers_residual = SCpnt->use_sg - 1; } else { SCpnt->SCp.ptr = (char *) SCpnt->request_buffer; SCpnt->SCp.this_residual = SCpnt->request_bufflen; SCpnt->SCp.buffer = NULL; SCpnt->SCp.buffers_residual = 0; } if(nsphw_start_selection(SCpnt, data) == FALSE) { DEBUG(0, " selection fail\n"); data->CurrentSC = NULL; SCpnt->result = DID_NO_CONNECT << 16; done(SCpnt); return -1; } //DEBUG(0, "%s: out\n", __FUNCTION__); return 0; } /* * setup PIO FIFO transfer mode and enable/disable to data out */ static void nsp_setup_fifo(nsp_hw_data *data, int enabled) { unsigned int base = data->BaseAddress; unsigned char transfer_mode_reg; //DEBUG(0, "%s: enabled=%d\n", __FUNCTION__, enabled); if (enabled != FALSE) { transfer_mode_reg = TRANSFER_GO | BRAIND; } else { transfer_mode_reg = 0; } transfer_mode_reg |= data->TransferMode; nsp_index_write(base, TRANSFERMODE, transfer_mode_reg); } static void nsphw_init_sync(nsp_hw_data *data) { sync_data tmp_sync = { .SyncNegotiation = SYNC_NOT_YET, .SyncPeriod = 0, .SyncOffset = 0 }; int i; /* setup sync data */ for ( i = 0; i < NUMBER(data->Sync); i++ ) { data->Sync[i] = tmp_sync; } } /* * Initialize Ninja hardware */ static int nsphw_init(nsp_hw_data *data) { unsigned int base = data->BaseAddress; DEBUG(0, "%s: in base=0x%x\n", __FUNCTION__, base); data->ScsiClockDiv = CLOCK_40M | FAST_20; data->CurrentSC = NULL; data->FifoCount = 0; data->TransferMode = MODE_IO8; nsphw_init_sync(data); /* block all interrupts */ nsp_write(base, IRQCONTROL, IRQCONTROL_ALLMASK); /* setup SCSI interface */ nsp_write(base, IFSELECT, IF_IFSEL); nsp_index_write(base, SCSIIRQMODE, 0); nsp_index_write(base, TRANSFERMODE, MODE_IO8); nsp_index_write(base, CLOCKDIV, data->ScsiClockDiv); nsp_index_write(base, PARITYCTRL, 0); nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER_CLEAR | REQ_COUNTER_CLEAR | HOST_COUNTER_CLEAR); /* setup fifo asic */ nsp_write(base, IFSELECT, IF_REGSEL); nsp_index_write(base, TERMPWRCTRL, 0); if ((nsp_index_read(base, OTHERCONTROL) & TPWR_SENSE) == 0) { printk(KERN_INFO "nsp_cs: terminator power on\n"); nsp_index_write(base, TERMPWRCTRL, POWER_ON); } nsp_index_write(base, TIMERCOUNT, 0); nsp_index_write(base, TIMERCOUNT, 0); /* requires 2 times!! */ nsp_index_write(base, SYNCREG, 0); nsp_index_write(base, ACKWIDTH, 0); /* enable interrupts and ack them */ nsp_index_write(base, SCSIIRQMODE, SCSI_PHASE_CHANGE_EI | RESELECT_EI | SCSI_RESET_IRQ_EI ); nsp_write(base, IRQCONTROL, IRQCONTROL_ALLCLEAR); nsp_setup_fifo(data, FALSE); return TRUE; } /* * Start selection phase */ static unsigned int nsphw_start_selection(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int host_id = SCpnt->device->host->this_id; unsigned int base = SCpnt->device->host->io_port; unsigned char target = SCpnt->device->id; int time_out; unsigned char phase, arbit; //DEBUG(0, "%s:in\n", __FUNCTION__); phase = nsp_index_read(base, SCSIBUSMON); if(phase != BUSMON_BUS_FREE) { //DEBUG(0, " bus busy\n"); return FALSE; } /* start arbitration */ //DEBUG(0, " start arbit\n"); SCpnt->SCp.phase = PH_ARBSTART; nsp_index_write(base, SETARBIT, ARBIT_GO); time_out = 1000; do { /* XXX: what a stupid chip! */ arbit = nsp_index_read(base, ARBITSTATUS); //DEBUG(0, " arbit=%d, wait_count=%d\n", arbit, wait_count); udelay(1); /* hold 1.2us */ } while((arbit & (ARBIT_WIN | ARBIT_FAIL)) == 0 && (time_out-- != 0)); if((arbit & ARBIT_WIN) == 0) { //DEBUG(0, " arbit fail\n"); nsp_index_write(base, SETARBIT, ARBIT_FLAG_CLEAR); return FALSE; } /* assert select line */ //DEBUG(0, " assert SEL line\n"); SCpnt->SCp.phase = PH_SELSTART; udelay(3); nsp_index_write(base, SCSIDATALATCH, BIT(host_id) | BIT(target)); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_BSY | SCSI_ATN); udelay(3); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_BSY | SCSI_DATAOUT_ENB | SCSI_ATN); nsp_index_write(base, SETARBIT, ARBIT_FLAG_CLEAR); udelay(3); nsp_index_write(base, SCSIBUSCTRL, SCSI_SEL | SCSI_DATAOUT_ENB | SCSI_ATN); /* check selection timeout */ nsp_start_timer(SCpnt, data, 1000/51); data->SelectionTimeOut = 1; return TRUE; } struct nsp_sync_table { unsigned int min_period; unsigned int max_period; unsigned int chip_period; unsigned int ack_width; }; static struct nsp_sync_table nsp_sync_table_40M[] = { {0x0c,0x0c,0x1,0}, /* 20MB 50ns*/ {0x19,0x19,0x3,1}, /* 10MB 100ns*/ {0x1a,0x25,0x5,2}, /* 7.5MB 150ns*/ {0x26,0x32,0x7,3}, /* 5MB 200ns*/ {0x0, 0, 0, 0} }; static struct nsp_sync_table nsp_sync_table_20M[] = { {0x19,0x19,0x1,0}, /* 10MB 100ns*/ {0x1a,0x25,0x2,0}, /* 7.5MB 150ns*/ {0x26,0x32,0x3,1}, /* 5MB 200ns*/ {0x0, 0, 0, 0} }; /* * setup synchronous data transfer mode */ static int nsp_msg(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned char target = SCpnt->device->id; // unsigned char lun = SCpnt->lun; sync_data *sync = &(data->Sync[target]); struct nsp_sync_table *sync_table; unsigned int period, offset; int i; DEBUG(0, "%s:\n", __FUNCTION__); period = sync->SyncPeriod; offset = sync->SyncOffset; DEBUG(0, " period=0x%x, offset=0x%x\n", period, offset); if ((data->ScsiClockDiv & (BIT(0)|BIT(1))) == CLOCK_20M) { sync_table = &nsp_sync_table_20M[0]; } else { sync_table = &nsp_sync_table_40M[0]; } for ( i = 0; sync_table->max_period != 0; i++, sync_table++) { if ( period >= sync_table->min_period && period <= sync_table->max_period ) { break; } } if (period != 0 && sync_table->max_period == 0) { /* * No proper period/offset found */ DEBUG(0, " no proper period/offset\n"); sync->SyncPeriod = 0; sync->SyncOffset = 0; sync->SyncRegister = 0; sync->AckWidth = 0; return FALSE; } sync->SyncRegister = (sync_table->chip_period << SYNCREG_PERIOD_SHIFT) | (offset & SYNCREG_OFFSET_MASK); sync->AckWidth = sync_table->ack_width; DEBUG(0, " sync_reg=0x%x, ack_width=0x%x\n", sync->SyncRegister, sync->AckWidth); return TRUE; } /* * start ninja hardware timer */ static void nsp_start_timer(Scsi_Cmnd *SCpnt, nsp_hw_data *data, int time) { unsigned int base = SCpnt->device->host->io_port; //DEBUG(0, "%s: in SCpnt=0x%p, time=%d\n", __FUNCTION__, SCpnt, time); data->TimerCount = time; nsp_index_write(base, TIMERCOUNT, time); } /* * wait for bus phase change */ static int nsp_negate_signal(Scsi_Cmnd *SCpnt, unsigned char mask, char *str) { unsigned int base = SCpnt->device->host->io_port; unsigned char reg; int time_out; //DEBUG(0, "%s:\n", __FUNCTION__); time_out = 100; do { reg = nsp_index_read(base, SCSIBUSMON); if (reg == 0xff) { break; } } while ((time_out-- != 0) && (reg & mask) != 0); if (time_out == 0) { printk(KERN_DEBUG "%s:: %s signal off timeut\n", __FUNCTION__, str); } return 0; } /* * expect Ninja Irq */ static int nsp_expect_signal(Scsi_Cmnd *SCpnt, unsigned char current_phase, unsigned char mask) { unsigned int base = SCpnt->device->host->io_port; int time_out; unsigned char phase, i_src; //DEBUG(0, "%s: current_phase=0x%x, mask=0x%x\n", __FUNCTION__, current_phase, mask); time_out = 100; do { phase = nsp_index_read(base, SCSIBUSMON); if (phase == 0xff) { //DEBUG(0, " ret -1\n"); return -1; } i_src = nsp_read(base, IRQSTATUS); if (i_src & IRQSTATUS_SCSI) { //DEBUG(0, " ret 0 found scsi signal\n"); return 0; } if ((phase & mask) != 0 && (phase & BUSMON_PHASE_MASK) == current_phase) { //DEBUG(0, " ret 1 phase=0x%x\n", phase); return 1; } } while(time_out-- != 0); //DEBUG(0, "%s: timeout\n", __FUNCTION__); return -1; } /* * transfer SCSI message */ static int nsp_xfer(Scsi_Cmnd *SCpnt, nsp_hw_data *data, int phase) { unsigned int base = SCpnt->device->host->io_port; char *buf = data->MsgBuffer; int len = MIN(MSGBUF_SIZE, data->MsgLen); int ptr; int ret; //DEBUG(0, "%s:\n", __FUNCTION__); for (ptr = 0; len > 0; len --, ptr ++) { ret = nsp_expect_signal(SCpnt, phase, BUSMON_REQ); if (ret <= 0) { DEBUG(0, " xfer quit\n"); return 0; } /* if last byte, negate ATN */ if (len == 1 && SCpnt->SCp.phase == PH_MSG_OUT) { nsp_index_write(base, SCSIBUSCTRL, AUTODIRECTION | ACKENB); } /* read & write message */ if (phase & BUSMON_IO) { DEBUG(0, " read msg\n"); buf[ptr] = nsp_index_read(base, SCSIDATAWITHACK); } else { DEBUG(0, " write msg\n"); nsp_index_write(base, SCSIDATAWITHACK, buf[ptr]); } nsp_negate_signal(SCpnt, BUSMON_ACK, "xfer"); } return len; } /* * get extra SCSI data from fifo */ static int nsp_dataphase_bypass(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int count; //DEBUG(0, "%s:\n", __FUNCTION__); if (SCpnt->SCp.have_data_in != IO_IN) { return 0; } count = nsp_fifo_count(SCpnt); if (data->FifoCount == count) { //DEBUG(0, " not use bypass quirk\n"); return 0; } /* * XXX: NSP_QUIRK * data phase skip only occurs in case of SCSI_LOW_READ */ DEBUG(0, " use bypass quirk\n"); SCpnt->SCp.phase = PH_DATA; nsp_pio_read(SCpnt, data); nsp_setup_fifo(data, FALSE); return 0; } /* * accept reselection */ static int nsp_reselected(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned char reg; //DEBUG(0, "%s:\n", __FUNCTION__); nsp_negate_signal(SCpnt, BUSMON_SEL, "reselect"); nsp_nexus(SCpnt, data); reg = nsp_index_read(base, SCSIBUSCTRL) & ~(SCSI_BSY | SCSI_ATN); nsp_index_write(base, SCSIBUSCTRL, reg); nsp_index_write(base, SCSIBUSCTRL, reg | AUTODIRECTION | ACKENB); return TRUE; } /* * count how many data transferd */ static int nsp_fifo_count(Scsi_Cmnd *SCpnt) { unsigned int base = SCpnt->device->host->io_port; unsigned int count; unsigned int l, m, h, dummy; nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER); l = nsp_index_read(base, TRANSFERCOUNT); m = nsp_index_read(base, TRANSFERCOUNT); h = nsp_index_read(base, TRANSFERCOUNT); dummy = nsp_index_read(base, TRANSFERCOUNT); count = (h << 16) | (m << 8) | (l << 0); //DEBUG(0, "%s: =0x%x\n", __FUNCTION__, count); return count; } /* fifo size */ #define RFIFO_CRIT 64 #define WFIFO_CRIT 64 /* * read data in DATA IN phase */ static void nsp_pio_read(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned long mmio_base = SCpnt->device->host->base; long time_out; int ocount, res; unsigned char stat, fifo_stat; ocount = data->FifoCount; DEBUG(0, "%s: in SCpnt=0x%p resid=%d ocount=%d ptr=0x%p this_residual=%d buffers=0x%p nbuf=%d\n", __FUNCTION__, SCpnt, RESID, ocount, SCpnt->SCp.ptr, SCpnt->SCp.this_residual, SCpnt->SCp.buffer, SCpnt->SCp.buffers_residual); time_out = 1000; while ((time_out-- != 0) && (SCpnt->SCp.this_residual > 0 || SCpnt->SCp.buffers_residual > 0 ) ) { stat = nsp_index_read(base, SCSIBUSMON); stat &= BUSMON_PHASE_MASK; res = nsp_fifo_count(SCpnt) - ocount; //DEBUG(0, " ptr=0x%p this=0x%x ocount=0x%x res=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, ocount, res); if (res == 0) { /* if some data available ? */ if (stat == BUSPHASE_DATA_IN) { /* phase changed? */ //DEBUG(0, " wait for data this=%d\n", SCpnt->SCp.this_residual); continue; } else { DEBUG(0, " phase changed stat=0x%x\n", stat); break; } } fifo_stat = nsp_read(base, FIFOSTATUS); if ((fifo_stat & FIFOSTATUS_FULL_EMPTY) == 0 && stat == BUSPHASE_DATA_IN) { continue; } res = MIN(res, SCpnt->SCp.this_residual); switch (data->TransferMode) { case MODE_IO32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_fifo32_read(base, SCpnt->SCp.ptr, res >> 2); break; case MODE_IO8: nsp_fifo8_read (base, SCpnt->SCp.ptr, res ); break; case MODE_MEM32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_mmio_fifo32_read(mmio_base, SCpnt->SCp.ptr, res >> 2); break; default: DEBUG(0, "unknown read mode\n"); return; } RESID -= res; SCpnt->SCp.ptr += res; SCpnt->SCp.this_residual -= res; ocount += res; //DEBUG(0, " ptr=0x%p this_residual=0x%x ocount=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, ocount); /* go to next scatter list if available */ if (SCpnt->SCp.this_residual == 0 && SCpnt->SCp.buffers_residual != 0 ) { //DEBUG(0, " scatterlist next timeout=%d\n", time_out); SCpnt->SCp.buffers_residual--; SCpnt->SCp.buffer++; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; time_out = 1000; //DEBUG(0, "page: 0x%p, off: 0x%x\n", SCpnt->SCp.buffer->page, SCpnt->SCp.buffer->offset); } } data->FifoCount = ocount; if (time_out == 0) { printk(KERN_DEBUG "%s: pio read timeout resid=%d this_residual=%d buffers_residual=%d\n", __FUNCTION__, RESID, SCpnt->SCp.this_residual, SCpnt->SCp.buffers_residual); } DEBUG(0, " read ocount=0x%x\n", ocount); } /* * write data in DATA OUT phase */ static void nsp_pio_write(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned long mmio_base = SCpnt->device->host->base; int time_out; int ocount, res; unsigned char stat; ocount = data->FifoCount; DEBUG(0, "%s: in fifocount=%d ptr=0x%p this_residual=%d buffers=0x%p nbuf=%d resid=0x%x\n", __FUNCTION__, data->FifoCount, SCpnt->SCp.ptr, SCpnt->SCp.this_residual, SCpnt->SCp.buffer, SCpnt->SCp.buffers_residual, RESID); time_out = 1000; while ((time_out-- != 0) && (SCpnt->SCp.this_residual > 0 || SCpnt->SCp.buffers_residual > 0)) { stat = nsp_index_read(base, SCSIBUSMON); stat &= BUSMON_PHASE_MASK; if (stat != BUSPHASE_DATA_OUT) { res = ocount - nsp_fifo_count(SCpnt); DEBUG(0, " phase changed stat=0x%x, res=%d\n", stat, res); /* Put back pointer */ RESID += res; SCpnt->SCp.ptr -= res; SCpnt->SCp.this_residual += res; ocount -= res; break; } res = ocount - nsp_fifo_count(SCpnt); if (res > 0) { /* write all data? */ DEBUG(0, " wait for all data out. ocount=0x%x res=%d\n", ocount, res); continue; } res = MIN(SCpnt->SCp.this_residual, WFIFO_CRIT); //DEBUG(0, " ptr=0x%p this=0x%x res=0x%x\n", SCpnt->SCp.ptr, SCpnt->SCp.this_residual, res); switch (data->TransferMode) { case MODE_IO32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_fifo32_write(base, SCpnt->SCp.ptr, res >> 2); break; case MODE_IO8: nsp_fifo8_write (base, SCpnt->SCp.ptr, res ); break; case MODE_MEM32: res &= ~(BIT(1)|BIT(0)); /* align 4 */ nsp_mmio_fifo32_write(mmio_base, SCpnt->SCp.ptr, res >> 2); break; default: DEBUG(0, "unknown write mode\n"); break; } RESID -= res; SCpnt->SCp.ptr += res; SCpnt->SCp.this_residual -= res; ocount += res; /* go to next scatter list if available */ if (SCpnt->SCp.this_residual == 0 && SCpnt->SCp.buffers_residual != 0 ) { //DEBUG(0, " scatterlist next\n"); SCpnt->SCp.buffers_residual--; SCpnt->SCp.buffer++; SCpnt->SCp.ptr = BUFFER_ADDR; SCpnt->SCp.this_residual = SCpnt->SCp.buffer->length; time_out = 1000; } } data->FifoCount = ocount; if (time_out == 0) { printk(KERN_DEBUG "%s: pio write timeout resid=0x%x\n", __FUNCTION__, RESID); } DEBUG(0, " write ocount=0x%x\n", ocount); } #undef RFIFO_CRIT #undef WFIFO_CRIT /* * setup synchronous/asynchronous data transfer mode */ static int nsp_nexus(Scsi_Cmnd *SCpnt, nsp_hw_data *data) { unsigned int base = SCpnt->device->host->io_port; unsigned char target = SCpnt->device->id; // unsigned char lun = SCpnt->lun; sync_data *sync = &(data->Sync[target]); //DEBUG(0, "%s: in SCpnt=0x%p\n", __FUNCTION__, SCpnt); /* setup sync transfer registers */ nsp_index_write(base, SYNCREG, sync->SyncRegister); nsp_index_write(base, ACKWIDTH, sync->AckWidth); if (SCpnt->use_sg == 0 || RESID % 4 != 0 || RESID <= PAGE_SIZE ) { data->TransferMode = MODE_IO8; } else if (nsp_burst_mode == BURST_MEM32) { data->TransferMode = MODE_MEM32; } else if (nsp_burst_mode == BURST_IO32) { data->TransferMode = MODE_IO32; } else { data->TransferMode = MODE_IO8; } /* setup pdma fifo */ nsp_setup_fifo(data, TRUE); /* clear ack counter */ data->FifoCount = 0; nsp_index_write(base, POINTERCLR, POINTER_CLEAR | ACK_COUNTER_CLEAR | REQ_COUNTER_CLEAR | HOST_COUNTER_CLEAR); return 0; } #include "nsp_message.c" /* * interrupt handler */ static void nspintr(int irq, void *dev_id, struct pt_regs *regs) { unsigned int base; unsigned char i_src, irq_phase, phase; Scsi_Cmnd *tmpSC; unsigned char target, lun; unsigned int *sync_neg; int i, tmp; nsp_hw_data *data = dev_id; //printk("&nsp_data=0x%p, dev_id=0x%p\n", &nsp_data, dev_id); base = data->BaseAddress; //DEBUG(0, " base=0x%x\n", base); /* * interrupt check */ nsp_write(base, IRQCONTROL, IRQCONTROL_IRQDISABLE); i_src = nsp_read(base, IRQSTATUS); //DEBUG(0, " i_src=0x%x\n", i_src); if ((i_src == 0xff) || ((i_src & IRQSTATUS_MASK) == 0)) { nsp_write(base, IRQCONTROL, 0); //DEBUG(0, " no irq/shared irq\n"); return; } /* XXX: IMPORTANT * Do not read an irq_phase register if no scsi phase interrupt. * Unless, you should lose a scsi phase interrupt. */ phase = nsp_index_read(base, SCSIBUSMON); if((i_src & IRQSTATUS_SCSI) != 0) { irq_phase = nsp_index_read(base, IRQPHASESENCE); } else { irq_phase = 0; } //DEBUG(0, " irq_phase=0x%x\n", irq_phase); /* * timer interrupt handler (scsi vs timer interrupts) */ //DEBUG(0, " timercount=%d\n", data->TimerCount); if (data->TimerCount != 0) { //DEBUG(0, " stop timer\n"); nsp_index_write(base, TIMERCOUNT, 0); nsp_index_write(base, TIMERCOUNT, 0); data->TimerCount = 0; } if ((i_src & IRQSTATUS_MASK) == IRQSTATUS_TIMER && data->SelectionTimeOut == 0) { //DEBUG(0, " timer start\n"); nsp_write(base, IRQCONTROL, IRQCONTROL_TIMER_CLEAR); return; } nsp_write(base, IRQCONTROL, IRQCONTROL_TIMER_CLEAR | IRQCONTROL_FIFO_CLEAR); if (data->CurrentSC == NULL) { printk(KERN_DEBUG "%s: CurrentSC==NULL irq_status=0x%x phase=0x%x irq_phase=0x%x this can't be happen\n", __FUNCTION__, i_src, phase, irq_phase); return; } else { tmpSC = data->CurrentSC; target = tmpSC->device->id; lun = tmpSC->device->lun; sync_neg = &(data->Sync[target].SyncNegotiation); } /* * parse hardware SCSI irq reasons register */ if ((i_src & IRQSTATUS_SCSI) != 0) { if ((irq_phase & SCSI_RESET_IRQ) != 0) { printk(KERN_DEBUG " %s: bus reset (power off?)\n", __FUNCTION__); *sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = (DID_RESET << 16) | ((tmpSC->SCp.Message & 0xff) << 8) | ((tmpSC->SCp.Status & 0xff) << 0); tmpSC->scsi_done(tmpSC); return; } if ((irq_phase & RESELECT_IRQ) != 0) { DEBUG(0, " reselect\n"); nsp_write(base, IRQCONTROL, IRQCONTROL_RESELECT_CLEAR); if (nsp_reselected(tmpSC, data) != FALSE) { return; } } if ((irq_phase & (PHASE_CHANGE_IRQ | LATCHED_BUS_FREE)) == 0) { return; } } //show_phase(tmpSC); switch(tmpSC->SCp.phase) { case PH_SELSTART: //*sync_neg = SYNC_NOT_YET; if ((phase & BUSMON_BSY) == 0) { //DEBUG(0, " selection count=%d\n", data->SelectionTimeOut); if (data->SelectionTimeOut >= NSP_SELTIMEOUT) { DEBUG(0, " selection time out\n"); data->SelectionTimeOut = 0; nsp_index_write(base, SCSIBUSCTRL, 0); data->CurrentSC = NULL; tmpSC->result = DID_NO_CONNECT << 16; tmpSC->scsi_done(tmpSC); return; } data->SelectionTimeOut += 1; nsp_start_timer(tmpSC, data, 1000/51); return; } /* attention assert */ //DEBUG(0, " attention assert\n"); data->SelectionTimeOut = 0; tmpSC->SCp.phase = PH_SELECTED; nsp_index_write(base, SCSIBUSCTRL, SCSI_ATN); udelay(1); nsp_index_write(base, SCSIBUSCTRL, SCSI_ATN | AUTODIRECTION | ACKENB); return; break; case PH_RESELECT: //DEBUG(0, " phase reselect\n"); //*sync_neg = SYNC_NOT_YET; if ((phase & BUSMON_PHASE_MASK) != BUSPHASE_MESSAGE_IN) { data->CurrentSC = NULL; tmpSC->result = DID_ABORT << 16; tmpSC->scsi_done(tmpSC); return; } /* fall through */ default: if ((i_src & (IRQSTATUS_SCSI | IRQSTATUS_FIFO)) == 0) { return; } break; } /* * SCSI sequencer */ //DEBUG(0, " start scsi seq\n"); /* normal disconnect */ if (((tmpSC->SCp.phase == PH_MSG_IN) || (tmpSC->SCp.phase == PH_MSG_OUT)) && (irq_phase & LATCHED_BUS_FREE) != 0 ) { DEBUG(0, " normal disconnect i_src=0x%x, phase=0x%x, irq_phase=0x%x\n", i_src, phase, irq_phase); if ((tmpSC->SCp.Message == MSG_COMMAND_COMPLETE)) { /* all command complete and return status */ //*sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = (DID_OK << 16) | ((tmpSC->SCp.Message & 0xff) << 8) | ((tmpSC->SCp.Status & 0xff) << 0); DEBUG(0, " command complete result=0x%x\n", tmpSC->result); tmpSC->scsi_done(tmpSC); return; } return; } /* check unexpected bus free state */ if (phase == 0) { printk(KERN_DEBUG " %s: unexpected bus free. i_src=0x%x, phase=0x%x, irq_phase=0x%x\n", __FUNCTION__, i_src, phase, irq_phase); *sync_neg = SYNC_NOT_YET; data->CurrentSC = NULL; tmpSC->result = DID_ERROR << 16; tmpSC->scsi_done(tmpSC); return; } switch (phase & BUSMON_PHASE_MASK) { case BUSPHASE_COMMAND: DEBUG(0, " BUSPHASE_COMMAND\n"); if ((phase & BUSMON_REQ) == 0) { DEBUG(0, " REQ == 0\n"); return; } tmpSC->SCp.phase = PH_COMMAND; nsp_nexus(tmpSC, data); /* write scsi command */ DEBUG(0, " cmd_len=%d\n", tmpSC->cmd_len); nsp_index_write(base, COMMANDCTRL, CLEAR_COMMAND_POINTER); for (i = 0; i < tmpSC->cmd_len; i++) { nsp_index_write(base, COMMANDDATA, tmpSC->cmnd[i]); } nsp_index_write(base, COMMANDCTRL, CLEAR_COMMAND_POINTER | AUTO_COMMAND_GO); break; case BUSPHASE_DATA_OUT: DEBUG(0, " BUSPHASE_DATA_OUT\n"); tmpSC->SCp.phase = PH_DATA; tmpSC->SCp.have_data_in = IO_OUT; nsp_pio_write(tmpSC, data); break; case BUSPHASE_DATA_IN: DEBUG(0, " BUSPHASE_DATA_IN\n"); tmpSC->SCp.phase = PH_DATA; tmpSC->SCp.have_data_in = IO_IN; nsp_pio_read(tmpSC, data); break; case BUSPHASE_STATUS: nsp_dataphase_bypass(tmpSC, data); DEBUG(0, " BUSPHASE_STATUS\n"); tmpSC->SCp.phase = PH_STATUS; tmpSC->SCp.Status = nsp_index_read(base, SCSIDATAWITHACK); DEBUG(0, " message=0x%x status=0x%x\n", tmpSC->SCp.Message, tmpSC->SCp.Status); break; case BUSPHASE_MESSAGE_OUT: DEBUG(0, " BUSPHASE_MESSAGE_OUT\n"); if ((phase & BUSMON_REQ) == 0) { goto timer_out; } tmpSC->SCp.phase = PH_MSG_OUT; data->MsgLen = i = 0; data->MsgBuffer[i] = IDENTIFY(TRUE, lun); i++; if (*sync_neg == SYNC_NOT_YET) { data->Sync[target].SyncPeriod = 0; data->Sync[target].SyncOffset = 0; /**/ data->MsgBuffer[i] = MSG_EXTENDED; i++; data->MsgBuffer[i] = 3; i++; data->MsgBuffer[i] = MSG_EXT_SDTR; i++; data->MsgBuffer[i] = 0x0c; i++; data->MsgBuffer[i] = 15; i++; /**/ } data->MsgLen = i; nsp_msg(tmpSC, data); show_message(data); nsp_message_out(tmpSC, data); break; case BUSPHASE_MESSAGE_IN: nsp_dataphase_bypass(tmpSC, data); DEBUG(0, " BUSPHASE_MESSAGE_IN\n"); if ((phase & BUSMON_REQ) == 0) { goto timer_out; } tmpSC->SCp.phase = PH_MSG_IN; nsp_message_in(tmpSC, data); /**/ if (*sync_neg == SYNC_NOT_YET) { //printk("%d,%d\n",target,lun); if (data->MsgLen >= 5 && data->MsgBuffer[0] == MSG_EXTENDED && data->MsgBuffer[1] == 3 && data->MsgBuffer[2] == MSG_EXT_SDTR ) { data->Sync[target].SyncPeriod = data->MsgBuffer[3]; data->Sync[target].SyncOffset = data->MsgBuffer[4]; //printk("sync ok, %d %d\n", data->MsgBuffer[3], data->MsgBuffer[4]); *sync_neg = SYNC_OK; } else { data->Sync[target].SyncPeriod = 0; data->Sync[target].SyncOffset = 0; *sync_neg = SYNC_NG; } nsp_msg(tmpSC, data); } /**/ /* search last messeage byte */ tmp = -1; for (i = 0; i < data->MsgLen; i++) { tmp = data->MsgBuffer[i]; if (data->MsgBuffer[i] == MSG_EXTENDED) { i += (1 + data->MsgBuffer[i+1]); } } tmpSC->SCp.Message = tmp; DEBUG(0, " message=0x%x len=%d\n", tmpSC->SCp.Message, data->MsgLen); show_message(data); break; case BUSPHASE_SELECT: default: DEBUG(0, " BUSPHASE other\n"); break; } //DEBUG(0, "%s: out\n", __FUNCTION__); return; timer_out: nsp_start_timer(tmpSC, data, 1000/102); return; } #ifdef PCMCIA_DEBUG #include "nsp_debug.c" #endif /* DBG_SHOWCOMMAND */ /*----------------------------------------------------------------*/ /* look for ninja3 card and init if found */ /*----------------------------------------------------------------*/ static struct Scsi_Host *__nsp_detect(Scsi_Host_Template *sht) { struct Scsi_Host *host; /* registered host structure */ nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: this_id=%d\n", __FUNCTION__, sht->this_id); request_region(data->BaseAddress, data->NumAddress, "nsp_cs"); host = scsi_register(sht, 0); if(host == NULL) return NULL; host->unique_id = data->BaseAddress; host->io_port = data->BaseAddress; host->n_io_port = data->NumAddress; host->irq = data->IrqNumber; #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,4,0)) host->base = data->MmioAddress; /* kernel 2.4 */ #else host->base = (char *)(data->MmioAddress); /* 2.2 */ #endif spin_lock_init(&(data->Lock)); snprintf(data->nspinfo, sizeof(data->nspinfo), "NinjaSCSI-3/32Bi Driver $Revision$ IO:0x%04lx-0x%04lx MMIO(virt addr):0x%04lx IRQ:%02d", host->io_port, host->io_port + host->n_io_port - 1, host->base, host->irq); data->nspinfo[sizeof(data->nspinfo) - 1] = '\0'; sht->name = data->nspinfo; DEBUG(0, "%s: end\n", __FUNCTION__); //MOD_INC_USE_COUNT; return host; } #if (LINUX_VERSION_CODE < KERNEL_VERSION(2,5,0)) static int nsp_detect(Scsi_Host_Template *sht) { return (__nsp_detect(sht) != NULL); } static int nsp_release(struct Scsi_Host *shpnt) { //nsp_hw_data *data = &nsp_data; /* PCMCIA Card Service dose same things */ //if (shpnt->irq) { // free_irq(shpnt->irq, data); //} //if (shpnt->io_port) { // release_region(shpnt->io_port, shpnt->n_io_port); //} //MOD_DEC_USE_COUNT; return 0; } #endif /*----------------------------------------------------------------*/ /* return info string */ /*----------------------------------------------------------------*/ static const char *nsp_info(struct Scsi_Host *shpnt) { nsp_hw_data *data = &nsp_data; return data->nspinfo; } #undef SPRINTF #define SPRINTF(args...) \ do { if(pos < buffer + length) pos += sprintf(pos, ## args); } while(0) static int nsp_proc_info(char *buffer, char **start, off_t offset, int length, int hostno, int inout) { int id; char *pos = buffer; int thislength; int speed; unsigned long flags; nsp_hw_data *data = &nsp_data; struct Scsi_Host *host = NULL; if (inout) { return -EINVAL; } /* search this HBA host */ #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,5,45)) host = scsi_host_hn_get(hostno); #else for (host=scsi_hostlist; host; host=host->next) { if (host->host_no == hostno) { break; } } #endif if (host == NULL) { return -ESRCH; } SPRINTF("NinjaSCSI status\n\n"); SPRINTF("Driver version: $Revision$\n"); SPRINTF("SCSI host No.: %d\n", hostno); SPRINTF("IRQ: %d\n", host->irq); SPRINTF("IO: 0x%lx-0x%lx\n", host->io_port, host->io_port + host->n_io_port - 1); SPRINTF("MMIO(virtual address): 0x%lx\n", host->base); SPRINTF("sg_tablesize: %d\n", host->sg_tablesize); SPRINTF("burst transfer mode: "); switch (nsp_burst_mode) { case BURST_IO8: SPRINTF("io8"); break; case BURST_IO32: SPRINTF("io32"); break; case BURST_MEM32: SPRINTF("mem32"); break; default: SPRINTF("???"); break; } SPRINTF("\n"); spin_lock_irqsave(&(data->Lock), flags); SPRINTF("CurrentSC: 0x%p\n\n", data->CurrentSC); spin_unlock_irqrestore(&(data->Lock), flags); SPRINTF("SDTR status\n"); for(id = 0; id < N_TARGET; id++) { SPRINTF("id %d: ", id); if (id == host->this_id) { SPRINTF("----- NinjaSCSI-3 host adapter\n"); continue; } switch(data->Sync[id].SyncNegotiation) { case SYNC_OK: SPRINTF(" sync"); break; case SYNC_NG: SPRINTF("async"); break; case SYNC_NOT_YET: SPRINTF(" none"); break; default: SPRINTF("?????"); break; } if (data->Sync[id].SyncPeriod != 0) { speed = 1000000 / (data->Sync[id].SyncPeriod * 4); SPRINTF(" transfer %d.%dMB/s, offset %d", speed / 1000, speed % 1000, data->Sync[id].SyncOffset ); } SPRINTF("\n"); } thislength = pos - (buffer + offset); if(thislength < 0) { *start = 0; return 0; } thislength = MIN(thislength, length); *start = buffer + offset; return thislength; } #undef SPRINTF /*static int nsp_eh_strategy(struct Scsi_Host *Shost) { return FAILED; }*/ /* static int nsp_eh_abort(Scsi_Cmnd *SCpnt) { DEBUG(0, "%s: SCpnt=0x%p\n", __FUNCTION__, SCpnt); return nsp_eh_bus_reset(SCpnt); }*/ /* static int nsp_eh_device_reset(Scsi_Cmnd *SCpnt) { DEBUG(0, "%s: SCpnt=0x%p\n", __FUNCTION__, SCpnt); return FAILED; }*/ static int nsp_eh_bus_reset(Scsi_Cmnd *SCpnt) { nsp_hw_data *data = &nsp_data; unsigned int base = SCpnt->device->host->io_port; int i; DEBUG(0, "%s: SCpnt=0x%p base=0x%x\n", __FUNCTION__, SCpnt, base); nsp_write(base, IRQCONTROL, IRQCONTROL_ALLMASK); nsp_index_write(base, SCSIBUSCTRL, SCSI_RST); mdelay(100); /* 100ms */ nsp_index_write(base, SCSIBUSCTRL, 0); for(i = 0; i < 5; i++) { nsp_index_read(base, IRQPHASESENCE); /* dummy read */ } nsp_write(base, IRQCONTROL, IRQCONTROL_ALLCLEAR); nsphw_init_sync(data); return SUCCESS; } static int nsp_eh_host_reset(Scsi_Cmnd *SCpnt) { nsp_hw_data *data = &nsp_data; DEBUG(0, "%s:\n", __FUNCTION__); nsphw_init(data); return SUCCESS; } /********************************************************************** PCMCIA functions **********************************************************************/ /*====================================================================== nsp_cs_attach() creates an "instance" of the driver, allocating local data structures for one device. The device is registered with Card Services. The dev_link structure is initialized, but we don't actually configure the card at this point -- we wait until we receive a card insertion event. ======================================================================*/ static dev_link_t *nsp_cs_attach(void) { scsi_info_t *info; client_reg_t client_reg; dev_link_t *link; int ret, i; DEBUG(0, "%s:\n", __FUNCTION__); /* Create new SCSI device */ info = kmalloc(sizeof(*info), GFP_KERNEL); if (!info) { return NULL; } memset(info, 0, sizeof(*info)); link = &info->link; link->priv = info; /* Initialize the dev_link_t structure */ link->release.function = &nsp_cs_release; link->release.data = (u_long)link; /* The io structure describes IO port mapping */ link->io.NumPorts1 = 0x10; link->io.Attributes1 = IO_DATA_PATH_WIDTH_AUTO; link->io.IOAddrLines = 10; /* not used */ /* Interrupt setup */ link->irq.Attributes = IRQ_TYPE_EXCLUSIVE | IRQ_HANDLE_PRESENT; link->irq.IRQInfo1 = IRQ_INFO2_VALID | IRQ_LEVEL_ID; if (irq_list[0] == -1) { link->irq.IRQInfo2 = irq_mask; } else { for (i = 0; i < 4; i++) { link->irq.IRQInfo2 |= 1 << irq_list[i]; } } /* IRQ $B$N3NJ]$O$3$3$G(B PCMCIA $B$N4X?t$rMQ$$$F9T$J$&$N$G(B * host->hostdata $B$r(B irq.Instance $B$KBeF~$G$-$J$$!#(B * host->hostdata $B$,;H$($l$PJ#?t$N(B NinjaSCSI $B$,(B * $B;HMQ$G$-$k$N$@$,!#(B */ link->irq.Handler = &nspintr; link->irq.Instance = &nsp_data; link->irq.Attributes |= (SA_SHIRQ | SA_SAMPLE_RANDOM); /* General socket configuration */ link->conf.Attributes = CONF_ENABLE_IRQ; link->conf.Vcc = 50; link->conf.IntType = INT_MEMORY_AND_IO; link->conf.Present = PRESENT_OPTION; /* Register with Card Services */ link->next = dev_list; dev_list = link; client_reg.dev_info = &dev_info; client_reg.Attributes = INFO_IO_CLIENT | INFO_CARD_SHARE; client_reg.EventMask = CS_EVENT_CARD_INSERTION | CS_EVENT_CARD_REMOVAL | CS_EVENT_RESET_PHYSICAL | CS_EVENT_CARD_RESET | CS_EVENT_PM_SUSPEND | CS_EVENT_PM_RESUME ; client_reg.event_handler = &nsp_cs_event; client_reg.Version = 0x0210; client_reg.event_callback_args.client_data = link; ret = CardServices(RegisterClient, &link->handle, &client_reg); if (ret != CS_SUCCESS) { cs_error(link->handle, RegisterClient, ret); nsp_cs_detach(link); return NULL; } return link; } /* nsp_cs_attach */ /*====================================================================== This deletes a driver "instance". The device is de-registered with Card Services. If it has been released, all local data structures are freed. Otherwise, the structures will be freed when the device is released. ======================================================================*/ static void nsp_cs_detach(dev_link_t *link) { dev_link_t **linkp; DEBUG(0, "%s(0x%p)\n", __FUNCTION__, link); /* Locate device structure */ for (linkp = &dev_list; *linkp; linkp = &(*linkp)->next) { if (*linkp == link) { break; } } if (*linkp == NULL) { return; } del_timer(&link->release); if (link->state & DEV_CONFIG) { nsp_cs_release((u_long)link); if (link->state & DEV_STALE_CONFIG) { link->state |= DEV_STALE_LINK; return; } } /* Break the link with Card Services */ if (link->handle) { CardServices(DeregisterClient, link->handle); } /* Unlink device structure, free bits */ *linkp = link->next; kfree(link->priv); link->priv = NULL; } /* nsp_cs_detach */ /*====================================================================== nsp_cs_config() is scheduled to run after a CARD_INSERTION event is received, to configure the PCMCIA socket, and to make the ethernet device available to the system. ======================================================================*/ #define CS_CHECK(fn, args...) \ while ((last_ret=CardServices(last_fn=(fn),args))!=0) goto cs_failed #define CFG_CHECK(fn, args...) \ if (CardServices(fn, args) != 0) goto next_entry /*====================================================================*/ static void nsp_cs_config(dev_link_t *link) { client_handle_t handle = link->handle; scsi_info_t *info = link->priv; tuple_t tuple; cisparse_t parse; int last_ret, last_fn; u_char tuple_data[64]; config_info_t conf; win_req_t req; memreq_t map; cistpl_cftable_entry_t dflt = { 0 }; struct Scsi_Host *host; nsp_hw_data *data = &nsp_data; DEBUG(0, "%s: in\n", __FUNCTION__); tuple.DesiredTuple = CISTPL_CONFIG; tuple.Attributes = 0; tuple.TupleData = tuple_data; tuple.TupleDataMax = sizeof(tuple_data); tuple.TupleOffset = 0; CS_CHECK(GetFirstTuple, handle, &tuple); CS_CHECK(GetTupleData, handle, &tuple); CS_CHECK(ParseTuple, handle, &tuple, &parse); link->conf.ConfigBase = parse.config.base; link->conf.Present = parse.config.rmask[0]; /* Configure card */ link->state |= DEV_CONFIG; /* Look up the current Vcc */ CS_CHECK(GetConfigurationInfo, handle, &conf); link->conf.Vcc = conf.Vcc; tuple.DesiredTuple = CISTPL_CFTABLE_ENTRY; CS_CHECK(GetFirstTuple, handle, &tuple); while (1) { cistpl_cftable_entry_t *cfg = &(parse.cftable_entry); CFG_CHECK(GetTupleData, handle, &tuple); CFG_CHECK(ParseTuple, handle, &tuple, &parse); if (cfg->flags & CISTPL_CFTABLE_DEFAULT) { dflt = *cfg; } if (cfg->index == 0) { goto next_entry; } link->conf.ConfigIndex = cfg->index; /* Does this card need audio output? */ if (cfg->flags & CISTPL_CFTABLE_AUDIO) { link->conf.Attributes |= CONF_ENABLE_SPKR; link->conf.Status = CCSR_AUDIO_ENA; } /* Use power settings for Vcc and Vpp if present */ /* Note that the CIS values need to be rescaled */ if (cfg->vcc.present & (1<vcc.param[CISTPL_POWER_VNOM]/10000) { goto next_entry; } } else if (dflt.vcc.present & (1<vpp1.present & (1<conf.Vpp1 = link->conf.Vpp2 = cfg->vpp1.param[CISTPL_POWER_VNOM]/10000; } else if (dflt.vpp1.present & (1<conf.Vpp1 = link->conf.Vpp2 = dflt.vpp1.param[CISTPL_POWER_VNOM]/10000; } /* Do we need to allocate an interrupt? */ if (cfg->irq.IRQInfo1 || dflt.irq.IRQInfo1) { link->conf.Attributes |= CONF_ENABLE_IRQ; } /* IO window settings */ link->io.NumPorts1 = link->io.NumPorts2 = 0; if ((cfg->io.nwin > 0) || (dflt.io.nwin > 0)) { cistpl_io_t *io = (cfg->io.nwin) ? &cfg->io : &dflt.io; link->io.Attributes1 = IO_DATA_PATH_WIDTH_AUTO; if (!(io->flags & CISTPL_IO_8BIT)) link->io.Attributes1 = IO_DATA_PATH_WIDTH_16; if (!(io->flags & CISTPL_IO_16BIT)) link->io.Attributes1 = IO_DATA_PATH_WIDTH_8; link->io.IOAddrLines = io->flags & CISTPL_IO_LINES_MASK; link->io.BasePort1 = io->win[0].base; link->io.NumPorts1 = io->win[0].len; if (io->nwin > 1) { link->io.Attributes2 = link->io.Attributes1; link->io.BasePort2 = io->win[1].base; link->io.NumPorts2 = io->win[1].len; } /* This reserves IO space but doesn't actually enable it */ CFG_CHECK(RequestIO, link->handle, &link->io); } if ((cfg->mem.nwin > 0) || (dflt.mem.nwin > 0)) { cistpl_mem_t *mem = (cfg->mem.nwin) ? &cfg->mem : &dflt.mem; req.Attributes = WIN_DATA_WIDTH_16|WIN_MEMORY_TYPE_CM; req.Attributes |= WIN_ENABLE; req.Base = mem->win[0].host_addr; req.Size = mem->win[0].len; if (req.Size < 0x1000) req.Size = 0x1000; req.AccessSpeed = 0; link->win = (window_handle_t)link->handle; CFG_CHECK(RequestWindow, &link->win, &req); map.Page = 0; map.CardOffset = mem->win[0].card_addr; CFG_CHECK(MapMemPage, link->win, &map); data->MmioAddress = (u_long)ioremap_nocache(req.Base, req.Size); } /* If we got this far, we're cool! */ break; next_entry: DEBUG(0, "%s: next\n", __FUNCTION__); if (link->io.NumPorts1) CardServices(ReleaseIO, link->handle, &link->io); CS_CHECK(GetNextTuple, handle, &tuple); } if (link->conf.Attributes & CONF_ENABLE_IRQ) CS_CHECK(RequestIRQ, link->handle, &link->irq); CS_CHECK(RequestConfiguration, handle, &link->conf); if (free_ports) { if (link->io.BasePort1) release_region(link->io.BasePort1, link->io.NumPorts1); if (link->io.BasePort2) release_region(link->io.BasePort2, link->io.NumPorts2); } /* Set port and IRQ */ data->BaseAddress = link->io.BasePort1; data->NumAddress = link->io.NumPorts1; data->IrqNumber = link->irq.AssignedIRQ; DEBUG(0, "%s: I/O[0x%x+0x%x] IRQ %d\n", __FUNCTION__, data->BaseAddress, data->NumAddress, data->IrqNumber); if(nsphw_init(data) == FALSE) { goto cs_failed; } host = __nsp_detect(&nsp_driver_template); if (!host) goto cs_failed; sprintf(info->node.dev_name, "scsi%d", host->host_no); link->dev = &info->node; info->host = host; /* Finally, report what we've done */ printk(KERN_INFO "nsp_cs: index 0x%02x: Vcc %d.%d", link->conf.ConfigIndex, link->conf.Vcc/10, link->conf.Vcc%10); if (link->conf.Vpp1) { printk(", Vpp %d.%d", link->conf.Vpp1/10, link->conf.Vpp1%10); } if (link->conf.Attributes & CONF_ENABLE_IRQ) { printk(", irq %d", link->irq.AssignedIRQ); } if (link->io.NumPorts1) { printk(", io 0x%04x-0x%04x", link->io.BasePort1, link->io.BasePort1+link->io.NumPorts1-1); } if (link->io.NumPorts2) printk(" & 0x%04x-0x%04x", link->io.BasePort2, link->io.BasePort2+link->io.NumPorts2-1); if (link->win) printk(", mem 0x%06lx-0x%06lx", req.Base, req.Base+req.Size-1); printk("\n"); scsi_add_host(host, NULL); link->state &= ~DEV_CONFIG_PENDING; return; cs_failed: cs_error(link->handle, last_fn, last_ret); nsp_cs_release((u_long)link); return; } /* nsp_cs_config */ #undef CS_CHECK #undef CFG_CHECK /*====================================================================== After a card is removed, nsp_cs_release() will unregister the net device, and release the PCMCIA configuration. If the device is still open, this will be postponed until it is closed. ======================================================================*/ static void nsp_cs_release(u_long arg) { dev_link_t *link = (dev_link_t *)arg; scsi_info_t *info = link->priv; DEBUG(0, "%s(0x%p)\n", __FUNCTION__, link); /* * If the device is currently in use, we won't release until it * is actually closed. */ if (link->open) { DEBUG(1, "nsp_cs: release postponed, '%s' still open\n", link->dev->dev_name); link->state |= DEV_STALE_CONFIG; return; } /* Unlink the device chain */ #if (LINUX_VERSION_CODE <= KERNEL_VERSION(2,5,2)) scsi_unregister_module(MODULE_SCSI_HA, &nsp_driver_template); #else scsi_remove_host(info->host); scsi_unregister(info->host); #endif link->dev = NULL; if (link->win) { iounmap((void *)(nsp_data.MmioAddress)); CardServices(ReleaseWindow, link->win); } CardServices(ReleaseConfiguration, link->handle); if (link->io.NumPorts1) { CardServices(ReleaseIO, link->handle, &link->io); } if (link->irq.AssignedIRQ) { CardServices(ReleaseIRQ, link->handle, &link->irq); } link->state &= ~DEV_CONFIG; if (link->state & DEV_STALE_LINK) { nsp_cs_detach(link); } } /* nsp_cs_release */ /*====================================================================== The card status event handler. Mostly, this schedules other stuff to run after an event is received. A CARD_REMOVAL event also sets some flags to discourage the net drivers from trying to talk to the card any more. When a CARD_REMOVAL event is received, we immediately set a flag to block future accesses to this device. All the functions that actually access the device should check this flag to make sure the card is still present. ======================================================================*/ static int nsp_cs_event(event_t event, int priority, event_callback_args_t *args) { dev_link_t *link = args->client_data; scsi_info_t *info = link->priv; Scsi_Cmnd tmp; DEBUG(1, "%s(0x%06x)\n", __FUNCTION__, event); switch (event) { case CS_EVENT_CARD_REMOVAL: DEBUG(0, " event: remove\n"); link->state &= ~DEV_PRESENT; if (link->state & DEV_CONFIG) { ((scsi_info_t *)link->priv)->stop = 1; mod_timer(&link->release, jiffies + HZ/20); } break; case CS_EVENT_CARD_INSERTION: DEBUG(0, " event: insert\n"); link->state |= DEV_PRESENT | DEV_CONFIG_PENDING; nsp_cs_config(link); break; case CS_EVENT_PM_SUSPEND: link->state |= DEV_SUSPEND; /* Fall through... */ case CS_EVENT_RESET_PHYSICAL: /* Mark the device as stopped, to block IO until later */ info->stop = 1; if (link->state & DEV_CONFIG) { CardServices(ReleaseConfiguration, link->handle); } break; case CS_EVENT_PM_RESUME: link->state &= ~DEV_SUSPEND; /* Fall through... */ case CS_EVENT_CARD_RESET: DEBUG(0, " event: reset\n"); if (link->state & DEV_CONFIG) { CardServices(RequestConfiguration, link->handle, &link->conf); } info->stop = 0; tmp.device->host = info->host; nsp_eh_host_reset(&tmp); nsp_eh_bus_reset(&tmp); break; default: DEBUG(0, " event: unknown\n"); break; } DEBUG(0, "%s: end\n", __FUNCTION__); return 0; } /* nsp_cs_event */ static struct pcmcia_driver nsp_driver = { .owner = THIS_MODULE, .drv = { .name = "nsp_cs", }, .attach = nsp_cs_attach, .detach = nsp_cs_detach, }; static int __init nsp_cs_init(void) { return pcmcia_register_driver(&nsp_driver); } static void __exit nsp_cs_exit(void) { pcmcia_unregister_driver(&nsp_driver); /* XXX: this really needs to move into generic code.. */ while (dev_list != NULL) { if (dev_list->state & DEV_CONFIG) { nsp_cs_release((u_long)dev_list); } nsp_cs_detach(dev_list); } } module_init(nsp_cs_init) module_exit(nsp_cs_exit) coccinelle-1.0.0-rc19/demos/demo_rule9/scsiglue.c0000644000175000017500000005743412247437436020542 0ustar eugeneugen/* Driver for USB Mass Storage compliant devices * SCSI layer glue code * * * * Current development and maintenance by: * (c) 1999-2002 Matthew Dharm (mdharm-usb@one-eyed-alien.net) * * Developed with the assistance of: * (c) 2000 David L. Brown, Jr. (usb-storage@davidb.org) * (c) 2000 Stephen J. Gowdy (SGowdy@lbl.gov) * * Initial work by: * (c) 1999 Michael Gee (michael@linuxspecific.com) * * This driver is based on the 'USB Mass Storage Class' document. This * describes in detail the protocol used to communicate with such * devices. Clearly, the designers had SCSI and ATAPI commands in * mind when they created this document. The commands are all very * similar to commands in the SCSI-II and ATAPI specifications. * * It is important to note that in a number of cases this class * exhibits class-specific exemptions from the USB specification. * Notably the usage of NAK, STALL and ACK differs from the norm, in * that they are used to communicate wait, failed and OK on commands. * * Also, for certain devices, the interrupt endpoint is used to convey * status of a command. * * Please see http://www.one-eyed-alien.net/~mdharm/linux-usb for more * information about this driver. * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the * Free Software Foundation; either version 2, or (at your option) any * later version. * * This program is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "scsiglue.h" #include "usb.h" #include "debug.h" #include "transport.h" #include #include /*********************************************************************** * Host functions ***********************************************************************/ static const char* usb_storage_info(struct Scsi_Host *host) { return "SCSI emulation for USB Mass Storage devices"; } #if 0 /* detect a virtual adapter (always works) * Synchronization: 2.4: with the io_request_lock * 2.5: no locks. * fortunately we don't care. * */ static int usb_storage_detect(struct SHT *sht) { struct us_data *us; char local_name[32]; /* This is not nice at all, but how else are we to get the * data here? */ us = (struct us_data *)sht->proc_dir; /* set up the name of our subdirectory under /proc/scsi/ */ sprintf(local_name, "usb-storage-%d", us->host_number); sht->proc_name = kmalloc (strlen(local_name) + 1, GFP_ATOMIC); if (!sht->proc_name) return 0; strcpy(sht->proc_name, local_name); /* we start with no /proc directory entry */ sht->proc_dir = NULL; /* register the host */ us->host = scsi_register(sht, sizeof(us)); if (us->host) { struct usb_interface *iface; us->host->hostdata[0] = (unsigned long)us; us->host_no = us->host->host_no; iface = usb_ifnum_to_if(us->pusb_dev, us->ifnum); if (iface) scsi_set_device(us->host, &iface->dev); return 1; } /* odd... didn't register properly. Abort and free pointers */ kfree(sht->proc_name); sht->proc_name = NULL; return 0; } /* Release all resources used by the virtual host * * NOTE: There is no contention here, because we're already deregistered * the driver and we're doing each virtual host in turn, not in parallel * Synchronization: BKL, no spinlock. */ static int usb_storage_release(struct Scsi_Host *psh) { struct us_data *us = (struct us_data *)psh->hostdata[0]; US_DEBUGP("release() called for host %s\n", us->htmplt.name); /* Kill the control threads * * Enqueue the command, wake up the thread, and wait for * notification that it has exited. */ US_DEBUGP("-- sending exit command to thread\n"); BUG_ON(atomic_read(&us->sm_state) != US_STATE_IDLE); us->srb = NULL; up(&(us->sema)); wait_for_completion(&(us->notify)); /* remove the pointer to the data structure we were using */ (struct us_data*)psh->hostdata[0] = NULL; /* we always have a successful release */ return 0; } #endif /* queue a command */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_queuecommand( Scsi_Cmnd *srb , void (*done)(Scsi_Cmnd *)) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; int state = atomic_read(&us->sm_state); US_DEBUGP("queuecommand() called\n"); srb->host_scribble = (unsigned char *)us; /* enqueue the command */ if (state != US_STATE_IDLE || us->srb != NULL) { printk(KERN_ERR USB_STORAGE "Error in %s: " "state = %d, us->srb = %p\n", __FUNCTION__, state, us->srb); return SCSI_MLQUEUE_HOST_BUSY; } srb->scsi_done = done; us->srb = srb; /* wake up the process task */ up(&(us->sema)); return 0; } /*********************************************************************** * Error handling functions ***********************************************************************/ /* Command abort */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_command_abort( Scsi_Cmnd *srb ) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; US_DEBUGP("command_abort() called\n"); /* Is this command still active? */ if (us->srb != srb) { US_DEBUGP ("-- nothing to abort\n"); return FAILED; } return usb_stor_abort_transport(us); } /* This invokes the transport reset mechanism to reset the state of the * device */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_device_reset( Scsi_Cmnd *srb ) { struct us_data *us = (struct us_data *)srb->device->host->hostdata[0]; int state = atomic_read(&us->sm_state); int result; US_DEBUGP("device_reset() called\n" ); if (state != US_STATE_IDLE) { printk(KERN_ERR USB_STORAGE "Error in %s: " "invalid state %d\n", __FUNCTION__, state); return FAILED; } /* set the state and release the lock */ atomic_set(&us->sm_state, US_STATE_RESETTING); scsi_unlock(srb->device->host); /* lock the device pointers */ down(&(us->dev_semaphore)); /* do the reset */ result = us->transport_reset(us); /* unlock */ up(&(us->dev_semaphore)); /* lock access to the state and clear it */ scsi_lock(srb->device->host); atomic_set(&us->sm_state, US_STATE_IDLE); return result; } /* This resets the device port */ /* It refuses to work if there's more than one interface in this device, so that other users are not affected. */ /* This is always called with scsi_lock(srb->host) held */ static int usb_storage_bus_reset( Scsi_Cmnd *srb ) { struct us_data *us; int result; /* we use the usb_reset_device() function to handle this for us */ US_DEBUGP("bus_reset() called\n"); scsi_unlock(srb->device->host); us = (struct us_data *)srb->device->host->hostdata[0]; /* The USB subsystem doesn't handle synchronisation between a device's several drivers. Therefore we reset only devices with one interface which we of course own. */ //FIXME: needs locking against config changes if ( us->pusb_dev->actconfig->desc.bNumInterfaces == 1) { /* attempt to reset the port */ result = usb_reset_device(us->pusb_dev); US_DEBUGP("usb_reset_device returns %d\n", result); } else { result = -EBUSY; US_DEBUGP("cannot reset a multiinterface device. failing to reset.\n"); } US_DEBUGP("bus_reset() complete\n"); scsi_lock(srb->device->host); return result < 0 ? FAILED : SUCCESS; } /*********************************************************************** * /proc/scsi/ functions ***********************************************************************/ /* we use this macro to help us write into the buffer */ #undef SPRINTF #define SPRINTF(args...) \ do { if (pos < buffer+length) pos += sprintf(pos, ## args); } while (0) static int usb_storage_proc_info (char *buffer, char **start, off_t offset, int length, int hostno, int inout) { struct us_data *us; char *pos = buffer; struct Scsi_Host *hostptr; unsigned long f; /* if someone is sending us data, just throw it away */ if (inout) return length; /* find our data from the given hostno */ hostptr = scsi_host_hn_get(hostno); if (!hostptr) { /* if we couldn't find it, we return an error */ return -ESRCH; } us = (struct us_data*)hostptr->hostdata[0]; /* if we couldn't find it, we return an error */ if (!us) { scsi_host_put(hostptr); return -ESRCH; } /* print the controller name */ SPRINTF(" Host scsi%d: usb-storage\n", hostno); /* print product, vendor, and serial number strings */ SPRINTF(" Vendor: %s\n", us->vendor); SPRINTF(" Product: %s\n", us->product); SPRINTF("Serial Number: %s\n", us->serial); /* show the protocol and transport */ SPRINTF(" Protocol: %s\n", us->protocol_name); SPRINTF(" Transport: %s\n", us->transport_name); /* show the device flags */ if (pos < buffer + length) { pos += sprintf(pos, " Quirks:"); f = us->flags; #define DO_FLAG(a) if (f & US_FL_##a) pos += sprintf(pos, " " #a) DO_FLAG(SINGLE_LUN); DO_FLAG(MODE_XLATE); DO_FLAG(START_STOP); DO_FLAG(IGNORE_SER); DO_FLAG(SCM_MULT_TARG); DO_FLAG(FIX_INQUIRY); DO_FLAG(FIX_CAPACITY); #undef DO_FLAG *(pos++) = '\n'; } /* release the reference count on this host */ scsi_host_put(hostptr); /* * Calculate start of next buffer, and return value. */ *start = buffer + offset; if ((pos - buffer) < offset) return (0); else if ((pos - buffer - offset) < length) return (pos - buffer - offset); else return (length); } /* * this defines our host template, with which we'll allocate hosts */ struct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; /* For a device that is "Not Ready" */ unsigned char usb_stor_sense_notready[18] = { [0] = 0x70, /* current error */ [2] = 0x02, /* not ready */ [7] = 0x0a, /* additional length */ [12] = 0x04, /* not ready */ [13] = 0x03 /* manual intervention */ }; /* To Report "Illegal Request: Invalid Field in CDB */ unsigned char usb_stor_sense_invalidCDB[18] = { [0] = 0x70, /* current error */ [2] = ILLEGAL_REQUEST, /* Illegal Request = 0x05 */ [7] = 0x0a, /* additional length */ [12] = 0x24 /* Invalid Field in CDB */ }; #define USB_STOR_SCSI_SENSE_HDRSZ 4 #define USB_STOR_SCSI_SENSE_10_HDRSZ 8 struct usb_stor_scsi_sense_hdr { __u8* dataLength; __u8* mediumType; __u8* devSpecParms; __u8* blkDescLength; }; typedef struct usb_stor_scsi_sense_hdr Usb_Stor_Scsi_Sense_Hdr; union usb_stor_scsi_sense_hdr_u { Usb_Stor_Scsi_Sense_Hdr hdr; __u8* array[USB_STOR_SCSI_SENSE_HDRSZ]; }; typedef union usb_stor_scsi_sense_hdr_u Usb_Stor_Scsi_Sense_Hdr_u; struct usb_stor_scsi_sense_hdr_10 { __u8* dataLengthMSB; __u8* dataLengthLSB; __u8* mediumType; __u8* devSpecParms; __u8* reserved1; __u8* reserved2; __u8* blkDescLengthMSB; __u8* blkDescLengthLSB; }; typedef struct usb_stor_scsi_sense_hdr_10 Usb_Stor_Scsi_Sense_Hdr_10; union usb_stor_scsi_sense_hdr_10_u { Usb_Stor_Scsi_Sense_Hdr_10 hdr; __u8* array[USB_STOR_SCSI_SENSE_10_HDRSZ]; }; typedef union usb_stor_scsi_sense_hdr_10_u Usb_Stor_Scsi_Sense_Hdr_10_u; void usb_stor_scsiSenseParseBuffer( Scsi_Cmnd* , Usb_Stor_Scsi_Sense_Hdr_u*, Usb_Stor_Scsi_Sense_Hdr_10_u*, int* ); int usb_stor_scsiSense10to6( Scsi_Cmnd* the10 ) { __u8 *buffer=0; int outputBufferSize = 0; int length=0; struct scatterlist *sg = 0; int i=0, j=0, element=0; Usb_Stor_Scsi_Sense_Hdr_u the6Locations; Usb_Stor_Scsi_Sense_Hdr_10_u the10Locations; int sb=0,si=0,db=0,di=0; int sgLength=0; US_DEBUGP("-- converting 10 byte sense data to 6 byte\n"); the10->cmnd[0] = the10->cmnd[0] & 0xBF; /* Determine buffer locations */ usb_stor_scsiSenseParseBuffer( the10, &the6Locations, &the10Locations, &length ); /* Work out minimum buffer to output */ outputBufferSize = *the10Locations.hdr.dataLengthLSB; outputBufferSize += USB_STOR_SCSI_SENSE_HDRSZ; /* Check to see if we need to truncate the output */ if ( outputBufferSize > length ) { printk( KERN_WARNING USB_STORAGE "Had to truncate MODE_SENSE_10 buffer into MODE_SENSE.\n" ); printk( KERN_WARNING USB_STORAGE "outputBufferSize is %d and length is %d.\n", outputBufferSize, length ); } outputBufferSize = length; /* Data length */ if ( *the10Locations.hdr.dataLengthMSB != 0 ) /* MSB must be zero */ { printk( KERN_WARNING USB_STORAGE "Command will be truncated to fit in SENSE6 buffer.\n" ); *the6Locations.hdr.dataLength = 0xff; } else { *the6Locations.hdr.dataLength = *the10Locations.hdr.dataLengthLSB; } /* Medium type and DevSpecific parms */ *the6Locations.hdr.mediumType = *the10Locations.hdr.mediumType; *the6Locations.hdr.devSpecParms = *the10Locations.hdr.devSpecParms; /* Block descriptor length */ if ( *the10Locations.hdr.blkDescLengthMSB != 0 ) /* MSB must be zero */ { printk( KERN_WARNING USB_STORAGE "Command will be truncated to fit in SENSE6 buffer.\n" ); *the6Locations.hdr.blkDescLength = 0xff; } else { *the6Locations.hdr.blkDescLength = *the10Locations.hdr.blkDescLengthLSB; } if ( the10->use_sg == 0 ) { buffer = the10->request_buffer; /* Copy the rest of the data */ memmove( &(buffer[USB_STOR_SCSI_SENSE_HDRSZ]), &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), outputBufferSize - USB_STOR_SCSI_SENSE_HDRSZ ); /* initialise last bytes left in buffer due to smaller header */ memset( &(buffer[outputBufferSize -(USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ)]), 0, USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ ); } else { sg = (struct scatterlist *) the10->request_buffer; /* scan through this scatterlist and figure out starting positions */ for ( i=0; i < the10->use_sg; i++) { sgLength = sg[i].length; for ( j=0; juse_sg; } element++; } } /* Now we know where to start the copy from */ element = USB_STOR_SCSI_SENSE_HDRSZ; while ( element < outputBufferSize -(USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ) ) { /* check limits */ if ( sb >= the10->use_sg || si >= sg[sb].length || db >= the10->use_sg || di >= sg[db].length ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } /* copy one byte */ { char *src = sg_address(sg[sb]) + si; char *dst = sg_address(sg[db]) + di; *dst = *src; } /* get next destination */ if ( sg[db].length-1 == di ) { db++; di=0; } else { di++; } /* get next source */ if ( sg[sb].length-1 == si ) { sb++; si=0; } else { si++; } element++; } /* zero the remaining bytes */ while ( element < outputBufferSize ) { /* check limits */ if ( db >= the10->use_sg || di >= sg[db].length ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } *(char*)(sg_address(sg[db])) = 0; /* get next destination */ if ( sg[db].length-1 == di ) { db++; di=0; } else { di++; } element++; } } /* All done any everything was fine */ return 0; } int usb_stor_scsiSense6to10( Scsi_Cmnd* the6 ) { /* will be used to store part of buffer */ __u8 tempBuffer[USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ], *buffer=0; int outputBufferSize = 0; int length=0; struct scatterlist *sg = 0; int i=0, j=0, element=0; Usb_Stor_Scsi_Sense_Hdr_u the6Locations; Usb_Stor_Scsi_Sense_Hdr_10_u the10Locations; int sb=0,si=0,db=0,di=0; int lsb=0,lsi=0,ldb=0,ldi=0; US_DEBUGP("-- converting 6 byte sense data to 10 byte\n"); the6->cmnd[0] = the6->cmnd[0] | 0x40; /* Determine buffer locations */ usb_stor_scsiSenseParseBuffer( the6, &the6Locations, &the10Locations, &length ); /* Work out minimum buffer to output */ outputBufferSize = *the6Locations.hdr.dataLength; outputBufferSize += USB_STOR_SCSI_SENSE_10_HDRSZ; /* Check to see if we need to truncate the output */ if ( outputBufferSize > length ) { printk( KERN_WARNING USB_STORAGE "Had to truncate MODE_SENSE into MODE_SENSE_10 buffer.\n" ); printk( KERN_WARNING USB_STORAGE "outputBufferSize is %d and length is %d.\n", outputBufferSize, length ); } outputBufferSize = length; /* Block descriptor length - save these before overwriting */ tempBuffer[2] = *the10Locations.hdr.blkDescLengthMSB; tempBuffer[3] = *the10Locations.hdr.blkDescLengthLSB; *the10Locations.hdr.blkDescLengthLSB = *the6Locations.hdr.blkDescLength; *the10Locations.hdr.blkDescLengthMSB = 0; /* reserved - save these before overwriting */ tempBuffer[0] = *the10Locations.hdr.reserved1; tempBuffer[1] = *the10Locations.hdr.reserved2; *the10Locations.hdr.reserved1 = *the10Locations.hdr.reserved2 = 0; /* Medium type and DevSpecific parms */ *the10Locations.hdr.devSpecParms = *the6Locations.hdr.devSpecParms; *the10Locations.hdr.mediumType = *the6Locations.hdr.mediumType; /* Data length */ *the10Locations.hdr.dataLengthLSB = *the6Locations.hdr.dataLength; *the10Locations.hdr.dataLengthMSB = 0; if ( !the6->use_sg ) { buffer = the6->request_buffer; /* Copy the rest of the data */ memmove( &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), &(buffer[USB_STOR_SCSI_SENSE_HDRSZ]), outputBufferSize-USB_STOR_SCSI_SENSE_10_HDRSZ ); /* Put the first four bytes (after header) in place */ memcpy( &(buffer[USB_STOR_SCSI_SENSE_10_HDRSZ]), tempBuffer, USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ ); } else { sg = (struct scatterlist *) the6->request_buffer; /* scan through this scatterlist and figure out ending positions */ for ( i=0; i < the6->use_sg; i++) { for ( j=0; juse_sg; break; } element++; } } /* scan through this scatterlist and figure out starting positions */ element = length-1; /* destination is the last element */ db=the6->use_sg-1; di=sg[db].length-1; for ( i=the6->use_sg-1; i >= 0; i--) { for ( j=sg[i].length-1; j>=0; j-- ) { /* get to end of header and find source for copy */ if ( element == length - 1 - (USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ) ) { sb=i; si=j; /* we've found both sets now, exit loops */ j=-1; i=-1; } element--; } } /* Now we know where to start the copy from */ element = length-1 - (USB_STOR_SCSI_SENSE_10_HDRSZ-USB_STOR_SCSI_SENSE_HDRSZ); while ( element >= USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* check limits */ if ( ( sb <= lsb && si < lsi ) || ( db <= ldb && di < ldi ) ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } /* copy one byte */ { char *src = sg_address(sg[sb]) + si; char *dst = sg_address(sg[db]) + di; *dst = *src; } /* get next destination */ if ( di == 0 ) { db--; di=sg[db].length-1; } else { di--; } /* get next source */ if ( si == 0 ) { sb--; si=sg[sb].length-1; } else { si--; } element--; } /* copy the remaining four bytes */ while ( element >= USB_STOR_SCSI_SENSE_HDRSZ ) { /* check limits */ if ( db <= ldb && di < ldi ) { printk( KERN_ERR USB_STORAGE "Buffer overrun averted, this shouldn't happen!\n" ); break; } { char *dst = sg_address(sg[db]) + di; *dst = tempBuffer[element-USB_STOR_SCSI_SENSE_HDRSZ]; } /* get next destination */ if ( di == 0 ) { db--; di=sg[db].length-1; } else { di--; } element--; } } /* All done and everything was fine */ return 0; } void usb_stor_scsiSenseParseBuffer( Scsi_Cmnd* srb, Usb_Stor_Scsi_Sense_Hdr_u* the6, Usb_Stor_Scsi_Sense_Hdr_10_u* the10, int* length_p ) { int i = 0, j=0, element=0; struct scatterlist *sg = 0; int length = 0; __u8* buffer=0; /* are we scatter-gathering? */ if ( srb->use_sg != 0 ) { /* loop over all the scatter gather structures and * get pointer to the data members in the headers * (also work out the length while we're here) */ sg = (struct scatterlist *) srb->request_buffer; for (i = 0; i < srb->use_sg; i++) { length += sg[i].length; /* We only do the inner loop for the headers */ if ( element < USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* scan through this scatterlist */ for ( j=0; jarray[element] = sg_address(sg[i]) + j; the10->array[element] = sg_address(sg[i]) + j; } else if ( element < USB_STOR_SCSI_SENSE_10_HDRSZ ) { /* only the longer headers still cares now */ the10->array[element] = sg_address(sg[i]) + j; } /* increase element counter */ element++; } } } } else { length = srb->request_bufflen; buffer = srb->request_buffer; if ( length < USB_STOR_SCSI_SENSE_10_HDRSZ ) printk( KERN_ERR USB_STORAGE "Buffer length smaller than header!!" ); for( i=0; iarray[i] = &(buffer[i]); the10->array[i] = &(buffer[i]); } else { the10->array[i] = &(buffer[i]); } } } /* Set value of length passed in */ *length_p = length; } coccinelle-1.0.0-rc19/demos/external_ana.c0000644000175000017500000000063012247437436017303 0ustar eugeneugen/* An indirect way to compute zero, for an external analysis to find out. */ #include int sum(const int x, const int y) { return x + y; } int add4(const int z) { return sum(z, 1) + 3; } int main() { int x = add4(1) - 5; /* should be zero */ if (x) { printf("Dead code."); } int y = getchar() < 0; /* can happen */ if (y) { printf("Not dead code."); } return 0; } coccinelle-1.0.0-rc19/demos/foo.cocci0000644000175000017500000000001712247437436016262 0ustar eugeneugen@@ @@ - foo();coccinelle-1.0.0-rc19/demos/pcre.c0000644000175000017500000000003712247437436015574 0ustar eugeneugen void foo() { WINE_ERR(0); } coccinelle-1.0.0-rc19/demos/type_fields.c0000644000175000017500000000023412247437436017151 0ustar eugeneugenvoid foo(int i) { struct file_operations myfops; foo(myfops.ioctl); } void foo(int i) { struct dir_operations myfops; foo(myfops.ioctl); } coccinelle-1.0.0-rc19/demos/itimer.c0000644000175000017500000000166312247437436016142 0ustar eugeneugenint do_setitimer(int which, struct itimerval *value, struct itimerval *ovalue) { unsigned long expire; cputime_t cputime; int k; if (ovalue && (k = do_getitimer(which, ovalue)) < 0) return k; switch (which) { case ITIMER_VIRTUAL: cputime = timeval_to_cputime(&value->it_value); if (cputime_eq(cputime, cputime_zero)) cputime = jiffies_to_cputime(1); current->it_virt_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_virt_incr = cputime; break; case ITIMER_PROF: cputime = timeval_to_cputime(&value->it_value); if (cputime_eq(cputime, cputime_zero)) cputime = jiffies_to_cputime(1); current->it_prof_value = cputime; cputime = timeval_to_cputime(&value->it_interval); current->it_prof_incr = cputime; break; default: return -EINVAL; } return 0; } coccinelle-1.0.0-rc19/demos/ocaml2.cocci0000644000175000017500000000221112247437436016652 0ustar eugeneugen@r@ expression E; statement S; @@ if (f(E)) S @script:ocaml@ (es,e) << r.E; @@ (* note that an expression is a pair after being unwrapped *) match Ast_c.unwrap e with (Ast_c.Ident nm,_) -> Printf.printf "argument %s is an identifier\n" es | _ -> Printf.printf "argument %s is not an identifier\n" es @script:ocaml@ (es,_) << r.E; (ss,s) << r.S; @@ (* note that a statement is not a pair after being unwrapped *) match Ast_c.unwrap s with Ast_c.Jump _ -> Printf.printf "%s: branch %s is a jump\n" es ss | _ -> Printf.printf "%s: branch %s is not a jump\n" es ss @script:ocaml@ (ss,s) << r.S; (es,_) << r.E; @@ (* note that a statement is not a pair after being unwrapped *) match Ast_c.unwrap s with Ast_c.Decl _ -> Printf.printf "%s: branch %s is a declaration\n" es ss | _ -> Printf.printf "%s: branch %s is not a declaration\n" es ss @script:ocaml@ (ss,s) << r.S; es << r.E; @@ (* note that a statement is not a pair after being unwrapped *) match Ast_c.unwrap s with Ast_c.ExprStatement _ -> Printf.printf "%s: branch %s is an exprstatement\n" es ss | _ -> Printf.printf "%s: branch %s is not an exprstatement\n" es ss coccinelle-1.0.0-rc19/demos/iso-kzalloc.c0000644000175000017500000000014512247437436017072 0ustar eugeneugenvoid main(int i) { kzalloc(2 * sizeof(int), GFP_KERNEL); kzalloc(sizeof(int) * 2, GFP_KERNEL); } coccinelle-1.0.0-rc19/demos/printloc.c0000644000175000017500000000004512247437436016474 0ustar eugeneugenint main() { f(12); x = f(12); } coccinelle-1.0.0-rc19/demos/usb_submit_urb.cocci0000644000175000017500000000041612247437436020526 0ustar eugeneugen@@ expression lock, flags; expression urb; @@ spin_lock_irqsave(lock, flags); <... - usb_submit_urb(urb) + usb_submit_urb(urb, GFP_ATOMIC) ...> spin_unlock_irqrestore(lock, flags); @@ expression urb; @@ - usb_submit_urb(urb) + usb_submit_urb(urb, GFP_KERNEL) coccinelle-1.0.0-rc19/demos/python_identifier.cocci0000644000175000017500000000034412247437436021225 0ustar eugeneugen@r@ expression E; identifier func; @@ func(E); @script:python s@ func << r.func; prefix_func; @@ prefix_func = "one_argument_function_%s" % func @@ expression E; identifier r.func,s.prefix_func; @@ -func(E); +prefix_func(E); coccinelle-1.0.0-rc19/demos/pcre.cocci0000644000175000017500000000010112247437436016422 0ustar eugeneugen@@ identifier SPAM =~ "(WINE_)?(ERR|FIXME|WARN)"; @@ -SPAM +bar coccinelle-1.0.0-rc19/demos/platform_ifdef.cocci0000644000175000017500000000011112247437436020453 0ustar eugeneugen@@ expression E; @@ //-alloca(E) //+malloc(E) - alloca + malloc (E) coccinelle-1.0.0-rc19/demos/ioctl_multiple_rules.c0000644000175000017500000000023512247437436021102 0ustar eugeneugen struct file_operations fops; void init(int i) { fops.ioctl = my_ioctl; } void my_ioctl(int i) { foo(1); } void not_ioctl(int i) { foo(1); } coccinelle-1.0.0-rc19/demos/simple.c0000644000175000017500000000006712247437436016137 0ustar eugeneugenint main(int i) { f("ca va"); f(g("ca va pas")); } coccinelle-1.0.0-rc19/demos/headers.iso0000644000175000017500000000006212247437436016624 0ustar eugeneugenExpression @ one @ expression E; @@ f(E) => g(E) coccinelle-1.0.0-rc19/demos/ocaml/0000755000175000017500000000000012247437436015572 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/ocaml/pg.c0000644000175000017500000000012112247437436016336 0ustar eugeneugenint main() { foo(12,120); foobar(23,230); barfoo(34,340); bar(45,450); } coccinelle-1.0.0-rc19/demos/ocaml/pg.cocci0000644000175000017500000000063512247437436017206 0ustar eugeneugen@initialize:ocaml@ open Postgresql (* let conn = let conninfo = "" in new Postgresql.connection ~conninfo () *) @r@ identifier f; expression x,a; @@ f(x,a) @script:ocaml@ f << r.f; y << r.x; yy << r.a; @@ if Str.string_match (Str.regexp "^foo") f 0 then Printf.eprintf "Fct '%s' matchs \"^foo\"\n" f else Printf.eprintf "Fct '%s' does not match \"^foo\"\n" f @finalize:ocaml@ () (* conn#finish *) coccinelle-1.0.0-rc19/demos/ocaml/dbm.c0000644000175000017500000000012112247437436016472 0ustar eugeneugenint main() { foo(12,120); foobar(23,230); barfoo(34,340); bar(45,450); } coccinelle-1.0.0-rc19/demos/ocaml/dbm.cocci0000644000175000017500000000114612247437436017340 0ustar eugeneugen@initialize:ocaml@ let filename = "/tmp/pgtest" let db = Dbm.opendbm filename [Dbm.Dbm_rdwr;Dbm.Dbm_create] 600 let _ = Printf.eprintf "Applies to %s\n" (Coccilib.dir ()) @r@ identifier f; expression x,a; @@ f(x,a) @script:ocaml@ f << r.f; y << r.x; yy << r.a; @@ Dbm.add db y yy; if Str.string_match (Str.regexp "^foo") f 0 then Printf.eprintf "Fct '%s' matchs \"^foo\"\n" f else Printf.eprintf "Fct '%s' does not match \"^foo\"\n" f @finalize:ocaml@ Dbm.iter (fun key data -> Printf.printf "'%s' goes with '%s'\n" key data) db; Dbm.close db; Sys.remove (filename^".dir"); Sys.remove (filename^".pag") coccinelle-1.0.0-rc19/demos/simple.cocci0000644000175000017500000000005012247437436016765 0ustar eugeneugen@@ expression E; @@ - f(E); + f(E,3); coccinelle-1.0.0-rc19/demos/iteration.cocci0000644000175000017500000000364412247437436017506 0ustar eugeneugen// run with the options -no_show_diff and -dir {directory} virtual after_start @initialize:ocaml@ let tbl = Hashtbl.create(100) let add_if_not_present from f file = try let _ = Hashtbl.find tbl (f,file) in () with Not_found -> Hashtbl.add tbl (f,file) file; let it = new iteration() in (match file with Some fl -> it#set_files [fl] | None -> ()); it#add_virtual_rule After_start; it#add_virtual_identifier Err_ptr_function f; it#register() @r depends on !after_start exists@ identifier fn; position p; @@ fn@p(...) { <+... return (ERR_PTR(...)); ...+> } @statfns@ identifier r.fn; position r.p; @@ static fn@p(...) { ... } @script:ocaml depends on statfns@ fn << r.fn; p << r.p; @@ add_if_not_present "ERR_PTR" fn (Some ((List.hd p).file)) @script:ocaml depends on !statfns@ fn << r.fn; p << r.p; @@ add_if_not_present "ERR_PTR" fn None // ----------------------------------------------------------------------- // iterate @s depends on after_start exists@ identifier virtual.err_ptr_function, fn; position p; @@ fn@p(...) { <+... return err_ptr_function(...); ...+> } @statfns_call@ identifier s.fn; position s.p; @@ static fn@p(...) { ... } @script:ocaml depends on statfns_call@ fn << s.fn; p << s.p; err_ptr_function << virtual.err_ptr_function; @@ add_if_not_present err_ptr_function fn (Some ((List.hd p).file)) @script:ocaml depends on !statfns_call@ fn << s.fn; p << s.p; err_ptr_function << virtual.err_ptr_function; @@ add_if_not_present err_ptr_function fn None // ----------------------------------------------------------------------- // find bugs @e depends on after_start exists@ identifier virtual.err_ptr_function; expression x; identifier fld; position p1,p2; @@ ( IS_ERR(x = err_ptr_function(...)) | x@p1 = err_ptr_function(...) ) ... when != IS_ERR(x) ( (IS_ERR(x) ||...) | x@p2->fld ) @script:python@ p1 << e.p1; p2 << e.p2; @@ cocci.print_main("def",p1) cocci.print_secs("ref",p2) coccinelle-1.0.0-rc19/demos/ifdef_skip_tag.c0000644000175000017500000000042412247437436017601 0ustar eugeneugen/* Example provided by: Flavien@lebarbe.net */ int foo(int x) { /* {{coccinelle:skip_start}} */ #ifdef PLATFORM_A while(func_a()) { #endif /* {{coccinelle:skip_end}} */ #ifdef PLATFORM_B while(func_b()) { #endif do_stuff(); } } void main() { } coccinelle-1.0.0-rc19/demos/ocaml1.c0000644000175000017500000000005112247437436016013 0ustar eugeneugenint main() { f(12,120); f(27,270); } coccinelle-1.0.0-rc19/demos/not.c0000644000175000017500000000015312247437436015442 0ustar eugeneugenint main() { int x; this(12,x); this(foo,x); bar(12,x); foo(12,x); this(12,x); this(12,x); } coccinelle-1.0.0-rc19/demos/interprocedural_adhoc.cocci0000644000175000017500000000041512247437436022041 0ustar eugeneugen// Even if our analysis does not go through nodes containing // funcall, we can still do some (limited) interprocedural modification. @ rule1 @ identifier foo; @@ ioctl (...) { ... foo(3); ... } @@ identifier rule1.foo; @@ foo(...) { - bar(1); + bar(2); }coccinelle-1.0.0-rc19/demos/initial_final.cocci0000644000175000017500000000031012247437436020275 0ustar eugeneugen// Options: -dir {directory} @initialize:python@ counter = 0 @x@ position p; @@ kmalloc@p(...) @script:python@ p< @ script:python @ x_mv << rule1.C; xp << rule1.p3; y_mv << rule1.E; yp << rule1.p4; @@ x = cocci.combine(x_mv, xp) y = cocci.combine(y_mv, yp) cocci.register_match(True, [(x, 'Array match'), (y, 'Array use')]) coccinelle-1.0.0-rc19/demos/ocaml.cocci0000644000175000017500000000127112247437436016575 0ustar eugeneugen@r@ expression x,a; position p1, p2; @@ f(x@p1,a@p2) @script:ocaml@ y << r.x; yy << r.a; p1 << r.p1; p2 << r.p2; @@ let p1_ = List.hd p1 in let file1 = p1_.Coccilib.file in let cure1 = p1_.Coccilib.current_element in let line1 = p1_.Coccilib.line in let line_end1 = p1_.Coccilib.line_end in let colb1 = p1_.Coccilib.col in let cole1 = p1_.Coccilib.col_end in Printf.printf "%s and %s\n" y yy; Printf.printf "%s @ p1 (file:\"%s\" fct:\"%s\" line:%d-%d col:%d-%d)\n" y file1 cure1 line1 line_end1 colb1 cole1; Printf.printf "%s @ p2 - p2 is not used in the SP. ocamlc should have reported a warning.\n" yy @script:ocaml@ y << r.a; zz << r.x; @@ Printf.printf "%s again and %s again \n" zz y coccinelle-1.0.0-rc19/demos/xxx_info.c0000644000175000017500000000032212247437436016502 0ustar eugeneugenint wd7000_info(int x) { float z; scsi *y; z = x + 1; y = scsi_get(); if(!y) { kprintf("error"); return -1; } kprintf("val = %d", y->field + z); scsi_put(y); return 0; } coccinelle-1.0.0-rc19/demos/pcre2.cocci0000644000175000017500000000055512247437436016521 0ustar eugeneugen@m@ identifier SPAM ; @@ SPAM @script:ocaml r@ s << m.SPAM; new_s; @@ let re = Pcre.regexp "(WINE_)?(ERR|FIXME|WARN)" in if Pcre.pmatch ~rex:re s then (Printf.eprintf "Match %s\n" s; new_s := Pcre.replace_first ~pat:"WINE_" s ) else (Printf.eprintf "Not match %s\n" s; Coccilib.include_match false ) @@ identifier m.SPAM; identifier r.new_s; @@ -SPAM +new_s coccinelle-1.0.0-rc19/demos/proc_info.c0000644000175000017500000000605612247437436016630 0ustar eugeneugenvoid main(int i) { } static int usb_storage_proc_info (char *buffer, char **start, off_t offset, int length, int hostno, int inout) { struct us_data *us; char *pos = buffer; struct Scsi_Host *hostptr; unsigned long f; /* if someone is sending us data, just throw it away */ if (inout) return length; /* find our data from the given hostno */ hostptr = scsi_host_hn_get(hostno); if (!hostptr) { /* if we couldn't find it, we return an error */ return -ESRCH; } us = (struct us_data*)hostptr->hostdata[0]; /* if we couldn't find it, we return an error */ if (!us) { scsi_host_put(hostptr); return -ESRCH; } /* print the controller name */ SPRINTF(" Host scsi%d: usb-storage\n", hostno); SPRINTF(" Transport: %s\n", us->transport_name); /* show the device flags */ if (pos < buffer + length) { pos += sprintf(pos, " Quirks:"); f = us->flags; #define DO_FLAG(a) if (f & US_FL_##a) pos += sprintf(pos, " " #a) DO_FLAG(SINGLE_LUN); DO_FLAG(MODE_XLATE); DO_FLAG(START_STOP); DO_FLAG(IGNORE_SER); DO_FLAG(SCM_MULT_TARG); DO_FLAG(FIX_INQUIRY); DO_FLAG(FIX_CAPACITY); #undef DO_FLAG *(pos++) = '\n'; } /* release the reference count on this host */ scsi_host_put(hostptr); /* * Calculate start of next buffer, and return value. */ *start = buffer + offset; if ((pos - buffer) < offset) return (0); else if ((pos - buffer - offset) < length) return (pos - buffer - offset); else return (length); } static int usb_storage_info (int i, struct Scsi_Host *myhostptr) { char *buffer; int hostno = 40; usb_storage_proc_info(buffer, 0, 0, 100, 40, -1); } struct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; coccinelle-1.0.0-rc19/demos/proc_info.cocci0000644000175000017500000000222012247437436017453 0ustar eugeneugen@ rule1 @ identifier buffer, start, offset, length, inout, hostno; identifier hostptr; identifier proc_info_func; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... return ...; } ... ?- scsi_host_put(hostptr); ... } //alt: //- proc_info_func(char *buffer, char **start, off_t offset, int length, //- int hostno, int inout) //+ proc_info_func(struct Scsi_Host *hostptr, char *buffer, char **start, //+ off_t offset, int length, int inout) //{ @@ identifier rule1.proc_info_func; identifier rule1.hostno; @@ proc_info_func(...) { <... - hostno + hostptr->host_no ...> } @@ identifier func; expression buffer, start, offset, length, inout, hostno; identifier hostptr; identifier rule1.proc_info_func; @@ func(..., struct Scsi_Host *hostptr, ...) { <... proc_info_func( + hostptr, buffer, start, offset, length, - hostno, inout) ...> } coccinelle-1.0.0-rc19/demos/headers2.iso0000644000175000017500000000014712247437436016712 0ustar eugeneugenExpression @ two @ expression E; @@ x(E) => y(E) Expression @ three @ expression E; @@ m(E) => n(E) coccinelle-1.0.0-rc19/demos/pcre2.c0000644000175000017500000000006712247437436015661 0ustar eugeneugen void foo() { bar(0); WINE_ERR(0); WINE_WARN(0); } coccinelle-1.0.0-rc19/demos/xxx_info.cocci0000644000175000017500000000033412247437436017343 0ustar eugeneugen@@ function xxx_info; identifier x,y; @@ int xxx_info(int x + ,scsi *y ) { ... - scsi *y; ... - y = scsi_get(); - if(!y) { ... return -1; } ... - scsi_put(y); ... } coccinelle-1.0.0-rc19/demos/virt.cocci0000644000175000017500000000062212247437436016465 0ustar eugeneugen// Illustrate the use of virtual rules // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, INRIA, DIKU. GPLv2. // Options: some permutation of -D/U p1 -D/U p2 virtual p1, p2 @script:python depends on p1@ @@ print "p1" @script:python depends on p2@ @@ print "p2" @script:python depends on p1 && !p2@ @@ print "only p1" @script:python depends on p2 && !p1@ @@ print "only p2" coccinelle-1.0.0-rc19/demos/itimerfullfunc.sgrep0000644000175000017500000000200012247437436020561 0ustar eugeneugen// ex 2.1 @@ @@ int do_setitimer(int which, struct itimerval *value, struct itimerval *ovalue) { unsigned long expire; cputime_t cputime; int k; if (ovalue && (k = do_getitimer(which, ovalue)) < 0) return k; switch (which) { // work even when reversed case case ITIMER_PROF: cputime = timeval_to_cputime(&value->it_value); if (cputime_eq(cputime, cputime_zero)) cputime = jiffies_to_cputime(1); current->it_prof_value = cputime; cputime = timeval_to_cputime(&value->it_interval); - current->it_prof_incr = cputime; + B; break; case ITIMER_VIRTUAL: cputime = timeval_to_cputime(&value->it_value); if (cputime_eq(cputime, cputime_zero)) cputime = jiffies_to_cputime(1); current->it_virt_value = cputime; - cputime = timeval_to_cputime(&value->it_interval); + A; current->it_virt_incr = cputime; break; default: return -EINVAL; } return 0; } coccinelle-1.0.0-rc19/demos/camltococci.c0000644000175000017500000000004412247437436017121 0ustar eugeneugenint main () { foo(a0); bar(); } coccinelle-1.0.0-rc19/demos/assignment_matching.res0000644000175000017500000000103512247437436021233 0ustar eugeneugenint first() { int a = f(3); matches_little(); if (c = f(3)) return 1; if (d = (int)f(3)) return 2; return 0; } int second() { int a = g(3); matches_more(); if (matches_more()) return 1; if (d = (int)g(3)) return 2; return 0; } int third() { int a = h(3); matches_even_more(); if (matches_even_more()) return 1; if (matches_even_more()) return 2; return 0; } int fourth() { int a = matches_most(); b = matches_most(); if (c = matches_most()) return 1; if (d = matches_most()) return 2; return 0; } coccinelle-1.0.0-rc19/demos/change_all_param.cocci0000644000175000017500000000110312247437436020731 0ustar eugeneugen// author: Pad. Example based on discussions with Nicholas Mc Guire. // call site @ r1 @ identifier fn; expression ret; @@ - ret = fn( + ret, ...) @ r2 @ identifier r1.fn; expression e; @@ fn (..., - e + &e ,...) // definition site @@ type T; identifier r1.fn; @@ - T + void fn( + T ret, ...) { ... } @ rparam @ identifier r1.fn; type T; identifier x; @@ fn(..., - T x + T *x ,...) { ... } // weird, if I inline this rule in previous rule it does // not work @@ identifier r1.fn; identifier rparam.x; @@ fn(...) { <... - x + *x ...> }coccinelle-1.0.0-rc19/demos/orgmode2.cocci0000644000175000017500000000101512247437436017214 0ustar eugeneugen @r@ position p1, p2; identifier f; expression E; @@ f@p1(E@p2) @ script:python @ p1 << r.p1; p2 << r.p2; f << r.f; @@ coccilib.org.print_todo (p1[0]) coccilib.org.print_link (p2[0]) print "" coccilib.org.print_safe_todo (p1[0], "arr[i]") coccilib.org.print_safe_link (p2[0], "arr[i]") print "" cocci.print_main ("foo", p1) cocci.print_sec ("foo", p2) cocci.print_secs ("foo", p2) print "" cocci.print_main ("foo", p1, "ovl-face3") cocci.print_sec ("foo", p2, "ovl-face4") cocci.print_secs ("foo", p2, "ovl-face4") coccinelle-1.0.0-rc19/demos/camltococci.res0000644000175000017500000000007512247437436017474 0ustar eugeneugenint main () { foo(a0); matched_bar(a0, something, a0); } coccinelle-1.0.0-rc19/demos/change_all_param.c0000644000175000017500000000025712247437436020104 0ustar eugeneugenint foo(int a, int b) { return a + b; } int bar(int a, int b, int c) { return a + b + c; } void main(void) { int res; int x,y,y; res = foo(x,y); res = bar(x,y,z); } coccinelle-1.0.0-rc19/demos/regexp2.cocci0000644000175000017500000000010612247437436017052 0ustar eugeneugen@@ identifier SPAM =~ "\(WINE_\)?\(ERR\|FIXME\|WARN\)"; @@ -SPAM +barcoccinelle-1.0.0-rc19/demos/pythontococci.res0000644000175000017500000000007512247437436020101 0ustar eugeneugenint main () { foo(a0); matched_bar(a0, something, a0); } coccinelle-1.0.0-rc19/demos/orgmode.c0000644000175000017500000000003012247437436016270 0ustar eugeneugenint main() { f(12); } coccinelle-1.0.0-rc19/demos/not.cocci0000644000175000017500000000013012247437436016273 0ustar eugeneugen@@ expression x != foo; identifier y != {foo,bar}; expression a; @@ - y(x,a); + f(20); coccinelle-1.0.0-rc19/demos/sgrep/0000755000175000017500000000000012247437436015617 5ustar eugeneugencoccinelle-1.0.0-rc19/demos/sgrep/double_cast.sgrep0000644000175000017500000000010212247437436021136 0ustar eugeneugen@@ type T1; type T2; expression E1,E2; @@ - E1 = (T1) (T2) E2; coccinelle-1.0.0-rc19/demos/sgrep/README0000644000175000017500000000025512247437436016501 0ustar eugeneugenThese are what appear to be the most recent versions of the scripts used in the PASTE submission. "run" is an example of how to run them, specialized for the intr example. coccinelle-1.0.0-rc19/demos/sgrep/intr4.sgrep0000644000175000017500000000043212247437436017720 0ustar eugeneugen@@ @@ ( cli(); | spin_lock_irqsave(...); ) ... when != \( sti(); \| restore_flags(...); \| spin_unlock_irqrestore(...); \) ? \( cli(); \| spin_lock_irqsave(...); \) @@ @@ ( sti(); | restore_flags(...); ) ... when != cli(); ( sti(); | restore_flags(...); ) coccinelle-1.0.0-rc19/demos/sgrep/run.sh0000644000175000017500000000046012247437436016757 0ustar eugeneugen#! /bin/sh find linux -name "*\.c" -exec ../../spatch.opt -cocci_file intr4.cocci {} \ -no_show_ctl_text -no_show_transinfo -no_parse_error_msg -no_show_misc \ -sgrep -save_output_file \; find linux -name "*\.cocci_res" -exec ./doit {} \; -print > err_found # doit contains cat -n $1 | grep '/\*<\*/' coccinelle-1.0.0-rc19/demos/sgrep/dangerous_arith_pointer_cast.sgrep0000644000175000017500000000011612247437436024607 0ustar eugeneugen @@ type T; expression E1, E2; @@ // safer is ((T) E1) + E2 - (T *) E1 + E2 coccinelle-1.0.0-rc19/demos/sgrep/device_id.sgrep0000644000175000017500000000112712247437436020575 0ustar eugeneugen// from LKN book de greg // in fact search more specifically in initializer zone for // the string 157e for the usb, and for the macro which // is bound to 0x8139 for the pci // could functorize/parametrize this script to be generic // to handle any kind of device_id number --- include/linux/pci_ids.h +++ include/linux/pci_ids.h // would like a $VAL passed to sgrep via a -DVAL=0x8139 #define V 0x8139 --- +++ @@ identifier X; @@ struct ( pci_device_id | usb_device_id ) X[] = - { ... }; // would like a // { // <... - V // en fait voudrait toute la ligne ...> // } coccinelle-1.0.0-rc19/demos/sgrep/null.sgrep0000644000175000017500000000307112247437436017634 0ustar eugeneugen@@ expression x; type T1, T2, T3; expression e1, e2; expression f; identifier fld; @@ x = (T1) kmalloc(...) ... when != x = e1 if(x == NULL) { ... when != x = e2 ( *x | *((T2)x) | x->fld | (x)->fld | f(...,x,...) | f(...,(T3)x,...) ) ... } @@ expression x; type T1, T2, T3; expression e1, e2; expression f; identifier fld; statement S; @@ x = (T1) kmalloc(...) ... when != x = e1 if(x != NULL) S else { ... when != x = e2 ( *x | *((T2)x) | x->fld | (x)->fld | f(...,x,...) | f(...,(T3)x,...) ) ... } // for some "good" reason, isomorphisms don't apply to whencode @@ expression x; type T1, T2, T3; expression e; expression f; identifier fld; statement S; @@ x = (T1) kmalloc(...); ... when != \( if(\(x == NULL\|NULL == x\|!x\)) { ... \(return;\|return e;\) } \| if(\(x == NULL\|NULL == x\|!x\)) \(return;\|return e;\) \| if(\(x != NULL\|NULL != x\|x\)) S else { ... \(return;\|return e;\) } \| if(\(x != NULL\|NULL != x\|x\)) S else \(return;\|return e;\) \| x = e; \) ( *x | *((T2)x) | x->fld | (x)->fld | f(...,x,...) | f(...,(T3)x,...) ) @@ expression x; type T1; expression e1, e2; @@ x = (T1) kmalloc(...) ... when != x = e1 if(x == NULL) { ... when != x = e2 return x; } // for some "good" reason, isomorphisms don't apply to whencode @@ expression x; type T1; expression e; @@ x = (T1) kmalloc(...); ... when != \( if(\(x == NULL\|NULL == x\|!x\)) { ... \(return;\|return e;\) } \| if(\(x == NULL\|NULL == x\|!x\)) \(return;\|return e;\) \| x = e; \) return x; coccinelle-1.0.0-rc19/demos/sgrep/a_and_b.sgrep0000644000175000017500000000023612247437436020225 0ustar eugeneugen@ rule1 @ identifier fn; @@ fn(...) { <... \+ foo(); ...> } @ rule2 depends on rule1 @ identifier rule1.fn; @@ - fn(...) { - <... -\+ bar(); - ...> - } coccinelle-1.0.0-rc19/demos/sgrep/simple.c0000644000175000017500000000013712247437436017255 0ustar eugeneugenvoid main(int i) { foo(f(1),2); f(2); g(3); } void notmain(int i) { f(3); f(4); } coccinelle-1.0.0-rc19/demos/sgrep/dangerous_GFP_KERNEL2.sgrep0000644000175000017500000000021112247437436022460 0ustar eugeneugen@@ identifier fn; @@ spin_lock_irqsave(...) ... when != spin_unlock_irqrestore(...) fn(..., - GFP_KERNEL + GFP_ATOMIC ,... ) coccinelle-1.0.0-rc19/demos/sgrep/a_and_b.c0000644000175000017500000000023612247437436017327 0ustar eugeneugenint test1(int i) { foo(); bar(); } int test2(int i) { bar(); foo(); } int test3(int i) { bar(); } int test4(int i) { bar(); foo(); foo(); } coccinelle-1.0.0-rc19/demos/sgrep/free.sgrep0000644000175000017500000000377312247437436017614 0ustar eugeneugen@@ identifier x; expression E,E1; expression f; identifier fld; @@ ( free(x); | kfree(x); | kfree_skb(x); | dev_kfree_skb(x); | dev_kfree_skb_any(x); ) ... WHEN != x = E ( f(...,x,...) | *x | x[E1] | x->fld ) @@ identifier x; expression E; @@ ( free(x); | kfree(x); | kfree_skb(x); | dev_kfree_skb(x); | dev_kfree_skb_any(x); ) ... WHEN != x = E return x; //------------------------------------------------------------ @@ expression x; expression E,E1,E2; expression f; identifier fld; @@ ( free(x[E2]); | kfree(x[E2]); | kfree_skb(x[E2]); | dev_kfree_skb(x[E2]); | dev_kfree_skb_any(x[E2]); ) ... WHEN != \(x = E \| E2 = E\) ( f(...,x[E2],...) | *x[E2] | x[E2][E1] | x[E2]->fld ) @@ expression x; expression E; @@ ( free(x[E2]); | kfree(x[E2]); | kfree_skb(x[E2]); | dev_kfree_skb(x[E2]); | dev_kfree_skb_any(x[E2]); ) ... WHEN != \(x = E \| E2 = E\) return x[E2]; //------------------------------------------------------------ @@ expression x; expression E,E1; expression f; identifier fld,f1; @@ ( free(x->f1); | kfree(x->f1); | kfree_skb(x->f1); | dev_kfree_skb(x->f1); | dev_kfree_skb_any(x->f1); ) ... WHEN != \(x = E\|x->f1 = E\) ( f(...,x->f1,...) | *x->f1 | x->f1[E1] | x->f1->fld ) @@ expression x; expression E; @@ ( free(x->f1); | kfree(x->f1); | kfree_skb(x->f1); | dev_kfree_skb(x->f1); | dev_kfree_skb_any(x->f1); ) ... WHEN != \(x = E\|x->f1 = E\) return x->f1; //------------------------------------------------------------ @@ expression x; expression E,E1; expression f; identifier fld; @@ ( free(*x); | kfree(*x); | kfree_skb(*x); | dev_kfree_skb(*x); | dev_kfree_skb_any(*x); ) ... WHEN != \(x = E\|*x = E\) ( f(...,*x,...) | **x | *x[E1] | *x->fld ) @@ expression x; expression E; @@ ( free(*x); | kfree(*x); | kfree_skb(*x); | dev_kfree_skb(*x); | dev_kfree_skb_any(*x); ) ... WHEN != \(x = E\|*x = E\) return *x; //------------------------------------------------------------ coccinelle-1.0.0-rc19/demos/sgrep/dangerous_GFP_KERNEL.sgrep0000644000175000017500000000200712247437436022403 0ustar eugeneugen // note that need -sgrep options otherwise don't detect // every situation as for instance: // static int start_command_port(struct usb_serial *serial) // { // spin_lock_irqsave(&command_info->lock, flags); // if (!command_info->port_running) { // retval = usb_submit_urb(command_port->read_urb, GFP_KERNEL); // if (retval) { // err("%s - failed submitting read urb, error %d", __FUNCTION__, retval); // goto exit; // } // } // command_info->port_running++; // // exit: // spin_unlock_irqrestore(&command_info->lock, flags); // return retval; // } // note that better to send a .sgrep than a .cocci, that is // to not do the fix because sometimes the correct fix is not to replace // the use of GFP_KERNEL but instead to move the function call outside // the spin_locked region. @@ //expression E; identifier fn; @@ ( spin_lock_irqsave(...) | spin_lock(...) ) ... when != \(spin_unlock_irqrestore(...)\|spin_unlock(...)\) //- usb_submit_urb(E, GFP_KERNEL) fn(..., - GFP_KERNEL //+ GFP_ATOMIC ,... ) coccinelle-1.0.0-rc19/demos/sgrep/simple.sgrep0000644000175000017500000000017612247437436020156 0ustar eugeneugen@@ expression X; @@ void main(...) { <... - f(X) ...> } @@ expression X; @@ void main(...) { <... - g(X) ...> } coccinelle-1.0.0-rc19/demos/python_regexp.c0000644000175000017500000000010012247437436017525 0ustar eugeneugenint main() { int x; x = foo(); x = foo_new(); x = bar(); } coccinelle-1.0.0-rc19/setup/0000755000175000017500000000000012247442646014527 5ustar eugeneugencoccinelle-1.0.0-rc19/setup/ocaml.m40000644000175000017500000001367412247437436016100 0ustar eugeneugendnl changes from the original for coccinelle: dnl replaced AC_CHECK_TOOL with AC_PATH_TOOL to obtain full paths dnl removed some of the AC_REQUIRE calls dnl autoconf macros for OCaml dnl dnl Copyright © 2009 Richard W.M. Jones dnl Copyright © 2009 Stefano Zacchiroli dnl Copyright © 2000-2005 Olivier Andrieu dnl Copyright © 2000-2005 Jean-Christophe Filliâtre dnl Copyright © 2000-2005 Georges Mariano dnl dnl For documentation, please read the ocaml.m4 man page. AC_DEFUN([AC_PROG_OCAML], [dnl # checking for ocamlc AC_PATH_TOOL([OCAMLC],[ocamlc],[no]) if test "$OCAMLC" != "no"; then OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) # If OCAMLLIB is set, use it if test "$OCAMLLIB" = ""; then OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` else AC_MSG_RESULT([OCAMLLIB previously set; preserving it.]) fi AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) AC_SUBST([OCAMLVERSION]) AC_SUBST([OCAMLLIB]) # checking for ocamlopt AC_PATH_TOOL([OCAMLOPT],[ocamlopt],[no]) OCAMLBEST=byte if test "$OCAMLOPT" = "no"; then AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) else TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) OCAMLOPT=no else OCAMLBEST=opt fi fi AC_SUBST([OCAMLBEST]) # checking for ocamlc.opt AC_PATH_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no]) if test "$OCAMLCDOTOPT" != "no"; then TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) else OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" != "no" ; then AC_PATH_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) if test "$OCAMLOPTDOTOPT" != "no"; then TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) else OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi AC_SUBST([OCAMLOPT]) fi AC_SUBST([OCAMLC]) # checking for ocaml toplevel AC_PATH_TOOL([OCAML],[ocaml],[no]) # checking for ocamldep AC_PATH_TOOL([OCAMLDEP],[ocamldep],[no]) # checking for ocamlmktop AC_PATH_TOOL([OCAMLMKTOP],[ocamlmktop],[no]) # checking for ocamlmklib AC_PATH_TOOL([OCAMLMKLIB],[ocamlmklib],[no]) # checking for ocamldoc AC_PATH_TOOL([OCAMLDOC],[ocamldoc],[no]) # checking for ocamlbuild AC_PATH_TOOL([OCAMLBUILD],[ocamlbuild],[no]) ]) AC_DEFUN([AC_PROG_OCAMLLEX], [dnl # checking for ocamllex AC_PATH_TOOL([OCAMLLEX],[ocamllex],[no]) if test "$OCAMLLEX" != "no"; then AC_PATH_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi AC_SUBST([OCAMLLEX]) ]) AC_DEFUN([AC_PROG_OCAMLYACC], [dnl AC_PATH_TOOL([OCAMLYACC],[ocamlyacc],[no]) AC_SUBST([OCAMLYACC]) ]) AC_DEFUN([AC_PROG_CAMLP4], [dnl AC_REQUIRE([AC_PROG_OCAML])dnl # checking for camlp4 AC_PATH_TOOL([CAMLP4],[camlp4],[no]) if test "$CAMLP4" != "no"; then TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc]) CAMLP4=no fi fi AC_SUBST([CAMLP4]) # checking for companion tools AC_PATH_TOOL([CAMLP4BOOT],[camlp4boot],[no]) AC_PATH_TOOL([CAMLP4O],[camlp4o],[no]) AC_PATH_TOOL([CAMLP4OF],[camlp4of],[no]) AC_PATH_TOOL([CAMLP4OOF],[camlp4oof],[no]) AC_PATH_TOOL([CAMLP4ORF],[camlp4orf],[no]) AC_PATH_TOOL([CAMLP4PROF],[camlp4prof],[no]) AC_PATH_TOOL([CAMLP4R],[camlp4r],[no]) AC_PATH_TOOL([CAMLP4RF],[camlp4rf],[no]) AC_SUBST([CAMLP4BOOT]) AC_SUBST([CAMLP4O]) AC_SUBST([CAMLP4OF]) AC_SUBST([CAMLP4OOF]) AC_SUBST([CAMLP4ORF]) AC_SUBST([CAMLP4PROF]) AC_SUBST([CAMLP4R]) AC_SUBST([CAMLP4RF]) ]) AC_DEFUN([AC_PROG_FINDLIB], [dnl dnl AC_REQUIRE([AC_PROG_OCAML])dnl # checking for ocamlfind AC_PATH_TOOL([OCAMLFIND],[ocamlfind],[no]) AC_SUBST([OCAMLFIND]) ]) dnl Thanks to Jim Meyering for working this next bit out for us. dnl XXX We should define AS_TR_SH if it's not defined already dnl (eg. for old autoconf). AC_DEFUN([AC_CHECK_OCAML_PKG], [dnl dnl AC_REQUIRE([AC_PROG_FINDLIB])dnl AC_MSG_CHECKING([for OCaml findlib package $1]) unset found unset pkg found=no for pkg in $1 $2 ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then AC_MSG_RESULT([found]) AS_TR_SH([OCAML_PKG_$1])=$pkg found=yes break fi done if test "$found" = "no" ; then AC_MSG_RESULT([not found]) AS_TR_SH([OCAML_PKG_$1])=no fi AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) ]) AC_DEFUN([AC_CHECK_OCAML_MODULE], [dnl AC_MSG_CHECKING([for OCaml module $2]) cat > conftest.ml <&5 2>&5 ; then found=yes break fi done if test "$found" ; then AC_MSG_RESULT([$$1]) else AC_MSG_RESULT([not found]) $1=no fi AC_SUBST([$1]) ]) dnl XXX Cross-compiling AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], [dnl AC_REQUIRE([AC_PROG_OCAML])dnl AC_MSG_CHECKING([for OCaml compiler word size]) cat > conftest.ml < conftest.ml < /dev/null; then # exits the script if the command succeeds. $@ && exit $? fi # # Trying a substitute # cmdline="$@" scriptdir=$(dirname "${BASH_SOURCE}") responsefile="${scriptdir}/replies.txt" # learning mode # echo "$cmdline" >> /tmp/queries.txt # some helper functions callable from the replacement macros ocamllibdir() { ocamlc -where } # outputs with what prefix 'python' was configured pythonprefix() { python -c "import sys; print(sys.prefix)" } pythonversion() { python -c "import sys; print('%d.%d' % (sys.version_info[0], sys.version_info[1]))" } pythonexists() { local version=$1 local prefix="$(pythonprefix)" test $? = 0 if test -z "$version"; then version="$(pythonversion)" fi if test ! -f "${prefix}/include/python${version}/Python.h"; then echo "error: ${prefix}/include/python${version}/Python.h not found (a development version of python is not installed?)" 1>&2 false fi } # outputs the "include" cflags for python pythoncflags() { local version=$1 local prefix="$(pythonprefix)" test $? = 0 echo "-I${prefix}/include/python${version}" } # outputs the "linker" flags for python pythonlibs() { local version=$1 local prefix="$(pythonprefix)" test $? = 0 echo "-L${prefix}/lib -lpython${version}" } # succeeds only if "/usr/include/pcre.h" exists checkpcre() { test -f /usr/include/pcre.h } # interate through pattern-response pairs found= response= while read pattern do # empty lines preceeding pattern if test -z "${pattern}"; then continue fi # response may be empty read replace read response if echo "${cmdline}" | grep -qE "${pattern}"; then found=1 break fi done < "${responsefile}" if test -n "${found}"; then MATCH=no if test -n "${replace}"; then MATCH="$(echo "$cmdline" | sed -E "${replace}")" fi if test -n "${response}"; then (eval "R=\"${response}\""; test $? = 0; if test -n "${R}"; then echo "${R}"; fi) test $? = 0 fi exit 0 else # fallback case echo "fake-subst.sh: no substitution for: ${cmdline}. Running the original." 1>&2 exec $@ fi coccinelle-1.0.0-rc19/setup/fake-menhir.sh0000755000175000017500000000365612247437436017267 0ustar eugeneugen#! /bin/sh -e set -e # If you don't have menhir installed, but you do have the generated files, then # this script fakes menhir by providing the generated files as the result of the # menhir invocation. STATE=0 base= reqml= reqmli= for arg in "$@"; do if test "x$STATE" = x0 -a "x$arg" = "x--base" -o "x$arg" = "x-b"; then STATE=1 elif test "x$STATE" = x1; then base="$arg" STATE=0 else filename="$arg" basename="${filename%.*}" extension="${filename##*.}" # assumes that all commandline parameters ending in .mly are files to be processed by menhir if test "x$extension" = xmly; then reqml="${basename}.ml" reqmli="${basename}.mli" # do we have a preprocessed ml file? if test ! -f "$reqml"; then echo "error: the file $reqml is needed, which requires preprocessing by menhir to obtain it from ${filename}. However, menhir is not enabled." 1>&2 exit 1 fi # do we have a preprocessed mli file? if test ! -f "$reqmli"; then echo "error: the files ${basename}.mli is needed, which requires preprocessing by menhir to obtain it from ${filename}. However, menhir is not enabled." 1>&2 exit 1 fi # is the preprocessed file not older than the original source? if test "$reqml" -ot "$filename" -o "$reqmli" -ot "$filename"; then echo "error: ${basename}.ml(i) is older than $filename, which requires preprocessing by menhir to update them from ${filename}. However, menhir is not enabled." 1>&2 exit 1 fi if test -z "$base"; then base="$basename" fi fi fi done if test -n "$reqml" -a -n "$reqmli" -a -n "$base"; then if test "$reqml" != "${base}.ml"; then cp -f "$reqml" "${base}.ml" fi if test "$reqmli" != "${base}.mli"; then cp -f "$reqmli" "${base}.mli" fi touch "${base}.ml" touch "${base}.mli" exit 0 else echo "error: do not know how to handle: $@" 1>&2 exit 1 fi coccinelle-1.0.0-rc19/setup/cocci.m40000644000175000017500000002421412247437436016055 0ustar eugeneugendnl dnl autoconf helper macros for coccinelle dnl dnl check if the ocaml version is recent enough dnl $1: the variable to assign dnl $2: version to test against AC_DEFUN([AC_CHECK_OCAMLVERSION], [dnl AS_UNSET([versioncheck]) AC_MSG_CHECKING([that the OCaml version is at least $2]) AS_VERSION_COMPARE([$OCAMLVERSION],[$2],[versioncheck=no],[versioncheck=yes],[versioncheck=yes]) AC_MSG_RESULT([$versioncheck]) AC_SUBST([$1], [$versioncheck]) ]) dnl using ocamlfind to store into $1 the location where dnl a package $2 resides. AC_DEFUN([AC_COCCI_OCAMLPKGDIR], [dnl AC_SUBST(AS_TR_SH([PATH_$1]),[`$OCAMLFIND query $1 2>/dev/null`]) ]) dnl stores the result of checking for the dnl ocaml package given as $2 in the dnl variable given as $1 AC_DEFUN([AC_COCCI_OCAMLPKG], [dnl AC_CHECK_OCAML_PKG([$1]) AS_IF([test "x$[]AS_TR_SH([OCAML_PKG_$1])" != xno],[AC_COCCI_OCAMLPKGDIR([$1])]) ]) dnl requires that the ocaml package is installed. dnl it is assumed that this package is part of the dnl ocaml installation. AC_DEFUN([AC_REQ_COCCI_STDPKG], [dnl AC_COCCI_OCAMLPKG([$1]) AS_IF([test "x$[]AS_TR_SH([OCAML_PKG_$1])" = xno], [dnl AC_MSG_ERROR([package $1 is required. It should be part of your ocaml installation.]) ]) ]) dnl defines the COCCI_OCAML_EXTERNAL variable to point to the directory dnl with extra ocaml packages AC_DEFUN([AC_COCCI_SET_EXTERNAL_DIR], [dnl AC_ARG_VAR(COCCI_OCAML_EXTERNAL, [path to extra ocaml packages (default: $1)]) AC_SUBST([COCCI_OCAML_EXTERNAL],["$1"]) AC_MSG_NOTICE([coccinelle may use external ocaml libraries in $COCCI_OCAML_EXTERNAL]) ]) dnl handle optional packages for which coccinelle may have dnl local versions. dnl dnl Note: this macro sets additional variables for use with dnl 'Makefile.config'. dnl dnl variables: dnl enable_$1: either 'yes', 'local', or 'no' AC_DEFUN([AC_CHECK_COCCI_EXTPKG], [dnl AC_MSG_NOTICE([configuring package $1]) AC_ARG_ENABLE([$1], AS_HELP_STRING([--enable-$1], [enable global package $1 (yes,no) (default: auto)])) dnl try and find a globally installed version dnl if not, enable_$1 will be "no" AS_IF([test "x$[]AS_TR_SH([enable_$1])" != xno], [dnl AC_COCCI_OCAMLPKG([$1]) AC_SUBST(AS_TR_SH([GLOBAL_$1]),[$[]AS_TR_SH([OCAML_PKG_$1])]) AS_IF([test "x$[]AS_TR_SH([GLOBAL_$1])" != xno], [dnl when the package is available AC_SUBST(AS_TR_SH([enable_$1]),[yes]) ], [dnl when the package is not available AS_IF([test "x$[]AS_TR_SH([enable_$1])" = xyes], [dnl when explicitly requested the global version AC_MSG_ERROR([OCaml package $1 is not available but requested explicitly]) ]) AC_MSG_NOTICE([OCaml package $1 is not available]) AC_SUBST(AS_TR_SH([enable_$1]),[no]) ]) ]) dnl check for a local package AS_IF([test "x$AS_TR_SH([enable_$1])" = xno], [dnl AS_UNSET([pkgdir]) pkgdir="$COCCI_OCAML_EXTERNAL/$1/" AC_MSG_CHECKING([for a bundled substitute of $1]) AS_IF([test -d "$pkgdir"], [dnl AC_MSG_RESULT([yes]) AC_MSG_NOTICE([using bundled substitute for $1 in $pkgdir]) AC_SUBST(AS_TR_SH([enable_$1]), [local]) AC_SUBST(AS_TR_SH([PATH_$1]), ["$pkgdir"]) ], [AC_MSG_RESULT([not available])]) ]) dnl additional handling AS_IF([test "x$[]AS_TR_SH([enable_$1])" != xno], [dnl AC_SUBST(AS_TR_SH([FEATURE_$1]),[1]) AC_SUBST(AS_TR_SH([FLAGS_$1]),['$([]AS_TR_SH([FLAGS_$1]))']) AC_SUBST(AS_TR_SH([OPTFLAGS_$1]),['$([]AS_TR_SH([OPTFLAGS_$1]))']) dnl distinguish global/local AS_IF([test "x$[]AS_TR_SH([enable_$1])" = xlocal], [dnl AC_SUBST(AS_TR_SH([LOCALLIB_$1]),[1]) AC_SUBST(AS_TR_SH([MODULES_$1]),['$(AS_TR_SH([LOCAL_$1]))']) AC_SUBST(AS_TR_SH([MODULESOPT_$1]),['$(AS_TR_SH([LOCALOPT_$1]))']) dnl check if the local directory has a Makefile AS_IF([test -f "$[]AS_TR_SH([PATH_$1])/Makefile"], [dnl AC_SUBST(AS_TR_SH([MAKE_$1]),[$[]AS_TR_SH([PATH_$1])]) ], [dnl AC_SUBST(AS_TR_SH([MAKE_$1]),[ ]) ]) ], [dnl AC_SUBST(AS_TR_SH([MODULES_$1]),['$(AS_TR_SH([GLOBAL_$1]))']) AC_SUBST(AS_TR_SH([MODULESOPT_$1]),['$(AS_TR_SH([GLOBALOPT_$1]))']) ]) ]) ]) dnl initializes the defaults substitutions for dnl configuration variables of packages AC_DEFUN([AC_COCCI_INIT_PKG_EMPTY], [dnl AC_SUBST(AS_TR_SH([FEATURE_$1]), [0]) AC_SUBST(AS_TR_SH([LOCALLIB_$1]), [0]) AC_SUBST(AS_TR_SH([FLAGS_$1]), [ ]) AC_SUBST(AS_TR_SH([MODULES_$1]), [ ]) AC_SUBST(AS_TR_SH([MODULESOPT_$1]), [ ]) AC_SUBST(AS_TR_SH([PATH_$1]), [ ]) ]) dnl version of AC_CHECK_COCCI_EXTPKG that fails with an dnl error if the package could not be found and no local dnl substitute is available. AC_DEFUN([AC_REQ_COCCI_EXTPKG], [dnl AC_CHECK_COCCI_EXTPKG([$1]) AS_IF([test "x$[]AS_TR_SH([enable_$1])" = xno], [dnl AC_MSG_ERROR([OCaml package $1 is required. Please make sure it is available.]) ]) ]) dnl determine python version AC_ARG_VAR([PYVER], [python version]) AC_DEFUN([AC_COCCI_PYVER], [dnl AS_IF([test -z "$PYVER"], [dnl PYVER not set before, determine it dnl first try the generic "python" executable or what the user configured dnl as commandline parameter AC_COCCI_TOOL([PYTHON],[python],[]) dnl some fall-back alternatives in case the above did not find anything AS_IF([test "x$PYTHON" = xno -a -z "$with_python"], [dnl AC_PATH_PROGS([PYTHON],[python python3 python3.2 python3.1 python2 python2.7 python2.6 python2.5]) AS_IF([test -z "$PYTHON"],[AC_SUBST([PYTHON],[no])]) ]) AS_IF([test "x$PYTHON" = xno -a -n "$with_python" -a "x$with_python" != xyes], [dnl python interpreter not found, but perhaps it was a version AC_MSG_NOTICE([$with_python is not a found as tool, therefore interpreted as version]) AC_SUBST([PYVER],["$with_python"]) ]) AS_IF([test "x$PYTHON" != xno], [dnl python interpereter found AC_MSG_CHECKING([python version]) PYVER=`$PYTHON -c "import sys; print(sys.version[[:3]])"` AS_IF([test -n "$PYVER"],[AC_MSG_RESULT([$PYVER found])],[AC_MSG_RESULT([failed])]) AC_SUBST([PYVER]) ]) ], [dnl PYVER set before AC_MSG_NOTICE([python version assumed to be $PYVER]) ]) dnl determine major version of pyver AC_SUBST([PYVER_MAJOR],[${PYVER%%.*}]) AC_MSG_NOTICE([python major version: $PYVER_MAJOR]) ]) dnl determine version date (RTC format) AC_DEFUN([AC_COCCI_CONFVERSION], [dnl AC_SUBST([CONFVERSION]) AC_MSG_NOTICE([determining version suffix]) AS_IF([test -z "$CONFVERSION" -a -d "./.git"], [dnl git administration found AC_MSG_NOTICE([building a version from a git repository]) AC_PATH_TOOL([GIT],[git]) AS_IF([test -n "$GIT"], [dnl ask git CONFVERSION=`$GIT log -1 --date-order --date=rfc --pretty="format:%cd"` ]) ]) AS_IF([test -z "$CONFVERSION"], [dnl otherwise, take the current date AC_PATH_TOOL([DATE],[date]) AS_IF([test -n "$DATE"], [dnl CONFVERSION=`$DATE "+%a, %d %b %Y %H:%M:%S %z"` ]) ]) AS_IF([test -z "$CONFVERSION"], [dnl fallback CONFVERSION=unknown ]) AC_MSG_NOTICE([version suffix set to $CONFVERSION]) ]) dnl find a tool, with specialized macros for certain cases dnl $1: name of the variable dnl $2: name of the tool AC_DEFUN([AC_COCCI_FINDTOOL], [dnl AS_IF([test "x$2" = xpkg-config -a "x$1" = xPKG_CONFIG], [dnl specialized macro for pkg-config (from pkg-config m4 macros) PKG_PROG_PKG_CONFIG ], [test "x$2" = xocamllex -a "x$1" = xOCAMLLEX], [dnl specialized macro for ocamllex (from ocaml.m4) AC_PROG_OCAMLLEX ], [test "x$2" = xocamlyacc -a "x$1" = xOCAMLYACC], [dnl specialized macro for ocamlyacc (from ocaml.m4) AC_PROG_OCAMLYACC ], [dnl generic macro AC_PATH_TOOL([$1], [$2]) ]) ]) dnl find/override a particular tool dnl $1: var name dnl $2: prog name dnl $3: path to substitute (or empty) AC_DEFUN([AC_COCCI_TOOL], [dnl AC_ARG_VAR([$1], [path to $2]) AC_ARG_WITH([$2], [AS_HELP_STRING([--with-$2], [whether/which $2 to use (default: auto)])]) AC_SUBST([with_$1],["$with_[]AS_TR_SH([$2])"]) dnl sets with_$1 dnl explicit tool or command given AS_IF([test -n "$with_[]$1" -a "x$with_[]$1" != xno -a "x$with_[]$1" != xyes], [dnl custom $with_$1 given AC_SUBST([$1], ["$with_[]$1"]) ], [dnl otherwise, use the default command name AC_SUBST([$1], ["$2"]) ]) dnl searches for the tool (result either empty or 'no' if not found) AS_IF([test "x$with_$1" = xno], [dnl disabled AC_MSG_NOTICE([$2 is disabled explicitly]) AC_SUBST([$1], [no]) ], [dnl find the tool AC_COCCI_FINDTOOL([$1],[[$]$1]) ]) AS_IF([test -z "[$]$1" -o "x[$]$1" = xno], [dnl command not found AS_IF([test "x$with_$1" = xyes], [dnl abort if a command was given explicitly AC_MSG_ERROR([--with=$2 is given explicitly but not found]) ]) AS_IF([test -n "$3"], [dnl try substitute AC_MSG_NOTICE([$2 not found. Trying substitute $3.]) AC_SUBST([$1],["$3"]) AC_COCCI_FINDTOOL([$1],[$2]) AC_SUBST([SUBSTITUTED_$1], [yes]) ]) ]) dnl $1 will always be defined at the exit of this macro AS_IF([test -z "[$]$1"],[AC_SUBST([$1],[no])]) ]) dnl defines a $1_CMD with $1 if set to a tool, otherwise dnl takes $2 AC_DEFUN([AC_COCCI_RUNTIME_CMD], [dnl AC_ARG_VAR([RUNTIME_$1_CMD], [path to $2]) AC_ARG_WITH([runtime-$2], [AS_HELP_STRING([--with-runtime-$2], [override the runtime cmd for $2])]) AS_IF([test -z "$RUNTIME_$1_CMD"], [dnl variable not yet set AS_IF([test "x$with_runtime_[]AS_TR_SH([$2])" = xno], [dnl with_runtime_$2 set to no: use configured with_$2 AC_SUBST([RUNTIME_$1_CMD],[$][$1]) ], [test -n "$with_runtime_[]AS_TR_SH([$2])" -a "x$with_runtime_[]AS_TR_SH([$2])" != xyes], [dnl explicit with_runtime_$2 parameter given: use that as default AC_SUBST([RUNTIME_$1_CMD],["$with_runtime_[]AS_TR_SH([$2])"]) ], [dnl otherwise, use $2 AC_SUBST([RUNTIME_$1_CMD],["$2"]) ]) ]) ]) AC_DEFUN([AC_COCCI_YESNO], [dnl AC_PATH_TOOL([YES], [yes]) AS_IF([test -n "$YES" -a "x$YES" != xno], [dnl AC_SUBST([YES_N_CMD],["$YES n"]) ], [dnl AC_SUBST([YES_N_CMD],["echo -e 'n\nn'"]) ]) ]) coccinelle-1.0.0-rc19/setup/missing0000755000175000017500000002370312247437436016134 0ustar eugeneugen#! /bin/sh # Common stub for a few missing GNU programs while installing. scriptversion=2012-01-06.18; # UTC # Copyright (C) 1996-2012 Free Software Foundation, Inc. # Originally by Fran,cois Pinard , 1996. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program. If not, see . # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. if test $# -eq 0; then echo 1>&2 "Try '$0 --help' for more information" exit 1 fi run=: sed_output='s/.* --output[ =]\([^ ]*\).*/\1/p' sed_minuso='s/.* -o \([^ ]*\).*/\1/p' # In the cases where this matters, 'missing' is being run in the # srcdir already. if test -f configure.ac; then configure_ac=configure.ac else configure_ac=configure.in fi msg="missing on your system" case $1 in --run) # Try to run requested program, and just exit if it succeeds. run= shift "$@" && exit 0 # Exit code 63 means version mismatch. This often happens # when the user try to use an ancient version of a tool on # a file that requires a minimum version. In this case we # we should proceed has if the program had been absent, or # if --run hadn't been passed. if test $? = 63; then run=: msg="probably too old" fi ;; -h|--h|--he|--hel|--help) echo "\ $0 [OPTION]... PROGRAM [ARGUMENT]... Handle 'PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an error status if there is no known handling for PROGRAM. Options: -h, --help display this help and exit -v, --version output version information and exit --run try to run the given command, and emulate it if it fails Supported PROGRAM values: aclocal touch file 'aclocal.m4' autoconf touch file 'configure' autoheader touch file 'config.h.in' autom4te touch the output file, or create a stub one automake touch all 'Makefile.in' files bison create 'y.tab.[ch]', if possible, from existing .[ch] flex create 'lex.yy.c', if possible, from existing .c help2man touch the output file lex create 'lex.yy.c', if possible, from existing .c makeinfo touch the output file yacc create 'y.tab.[ch]', if possible, from existing .[ch] Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and 'g' are ignored when checking the name. Send bug reports to ." exit $? ;; -v|--v|--ve|--ver|--vers|--versi|--versio|--version) echo "missing $scriptversion (GNU Automake)" exit $? ;; -*) echo 1>&2 "$0: Unknown '$1' option" echo 1>&2 "Try '$0 --help' for more information" exit 1 ;; esac # normalize program name to check for. program=`echo "$1" | sed ' s/^gnu-//; t s/^gnu//; t s/^g//; t'` # Now exit if we have it, but it failed. Also exit now if we # don't have it and --version was passed (most likely to detect # the program). This is about non-GNU programs, so use $1 not # $program. case $1 in lex*|yacc*) # Not GNU programs, they don't have --version. ;; *) if test -z "$run" && ($1 --version) > /dev/null 2>&1; then # We have it, but it failed. exit 1 elif test "x$2" = "x--version" || test "x$2" = "x--help"; then # Could not run --version or --help. This is probably someone # running '$TOOL --version' or '$TOOL --help' to check whether # $TOOL exists and not knowing $TOOL uses missing. exit 1 fi ;; esac # If it does not exist, or fails to run (possibly an outdated version), # try to emulate it. case $program in aclocal*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified 'acinclude.m4' or '${configure_ac}'. You might want to install the Automake and Perl packages. Grab them from any GNU archive site." touch aclocal.m4 ;; autoconf*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified '${configure_ac}'. You might want to install the Autoconf and GNU m4 packages. Grab them from any GNU archive site." touch configure ;; autoheader*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified 'acconfig.h' or '${configure_ac}'. You might want to install the Autoconf and GNU m4 packages. Grab them from any GNU archive site." files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}` test -z "$files" && files="config.h" touch_files= for f in $files; do case $f in *:*) touch_files="$touch_files "`echo "$f" | sed -e 's/^[^:]*://' -e 's/:.*//'`;; *) touch_files="$touch_files $f.in";; esac done touch $touch_files ;; automake*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified 'Makefile.am', 'acinclude.m4' or '${configure_ac}'. You might want to install the Automake and Perl packages. Grab them from any GNU archive site." find . -type f -name Makefile.am -print | sed 's/\.am$/.in/' | while read f; do touch "$f"; done ;; autom4te*) echo 1>&2 "\ WARNING: '$1' is needed, but is $msg. You might have modified some files without having the proper tools for further handling them. You can get '$1' as part of Autoconf from any GNU archive site." file=`echo "$*" | sed -n "$sed_output"` test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` if test -f "$file"; then touch $file else test -z "$file" || exec >$file echo "#! /bin/sh" echo "# Created by GNU Automake missing as a replacement of" echo "# $ $@" echo "exit 0" chmod +x $file exit 1 fi ;; bison*|yacc*) echo 1>&2 "\ WARNING: '$1' $msg. You should only need it if you modified a '.y' file. You may need the Bison package in order for those modifications to take effect. You can get Bison from any GNU archive site." rm -f y.tab.c y.tab.h if test $# -ne 1; then eval LASTARG=\${$#} case $LASTARG in *.y) SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` if test -f "$SRCFILE"; then cp "$SRCFILE" y.tab.c fi SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` if test -f "$SRCFILE"; then cp "$SRCFILE" y.tab.h fi ;; esac fi if test ! -f y.tab.h; then echo >y.tab.h fi if test ! -f y.tab.c; then echo 'main() { return 0; }' >y.tab.c fi ;; lex*|flex*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified a '.l' file. You may need the Flex package in order for those modifications to take effect. You can get Flex from any GNU archive site." rm -f lex.yy.c if test $# -ne 1; then eval LASTARG=\${$#} case $LASTARG in *.l) SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` if test -f "$SRCFILE"; then cp "$SRCFILE" lex.yy.c fi ;; esac fi if test ! -f lex.yy.c; then echo 'main() { return 0; }' >lex.yy.c fi ;; help2man*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified a dependency of a manual page. You may need the Help2man package in order for those modifications to take effect. You can get Help2man from any GNU archive site." file=`echo "$*" | sed -n "$sed_output"` test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` if test -f "$file"; then touch $file else test -z "$file" || exec >$file echo ".ab help2man is required to generate this page" exit $? fi ;; makeinfo*) echo 1>&2 "\ WARNING: '$1' is $msg. You should only need it if you modified a '.texi' or '.texinfo' file, or any other file indirectly affecting the aspect of the manual. The spurious call might also be the consequence of using a buggy 'make' (AIX, DU, IRIX). You might want to install the Texinfo package or the GNU make package. Grab either from any GNU archive site." # The file to touch is that specified with -o ... file=`echo "$*" | sed -n "$sed_output"` test -z "$file" && file=`echo "$*" | sed -n "$sed_minuso"` if test -z "$file"; then # ... or it is the one specified with @setfilename ... infile=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` file=`sed -n ' /^@setfilename/{ s/.* \([^ ]*\) *$/\1/ p q }' $infile` # ... or it is derived from the source name (dir/f.texi becomes f.info) test -z "$file" && file=`echo "$infile" | sed 's,.*/,,;s,.[^.]*$,,'`.info fi # If the file does not exist, the user really needs makeinfo; # let's fail without touching anything. test -f $file || exit 1 touch $file ;; *) echo 1>&2 "\ WARNING: '$1' is needed, and is $msg. You might have modified some files without having the proper tools for further handling them. Check the 'README' file, it often tells you about the needed prerequisites for installing this package. You may also peek at any GNU archive site, in case some other package would contain this missing '$1' program." exit 1 ;; esac exit 0 # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC" # time-stamp-end: "; # UTC" # End: coccinelle-1.0.0-rc19/setup/install-sh0000755000175000017500000003325512247437436016544 0ustar eugeneugen#!/bin/sh # install - install a program, script, or datafile scriptversion=2011-11-20.07; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the # following copyright and license. # # Copyright (C) 1994 X Consortium # # Permission is hereby granted, free of charge, to any person obtaining a copy # of this software and associated documentation files (the "Software"), to # deal in the Software without restriction, including without limitation the # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or # sell copies of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be included in # all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the name of the X Consortium shall not # be used in advertising or otherwise to promote the sale, use or other deal- # ings in this Software without prior written authorization from the X Consor- # tium. # # # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent # 'make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. nl=' ' IFS=" "" $nl" # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit=${DOITPROG-} if test -z "$doit"; then doit_exec=exec else doit_exec=$doit fi # Put in absolute file names if you don't have them in your path; # or use environment vars. chgrpprog=${CHGRPPROG-chgrp} chmodprog=${CHMODPROG-chmod} chownprog=${CHOWNPROG-chown} cmpprog=${CMPPROG-cmp} cpprog=${CPPROG-cp} mkdirprog=${MKDIRPROG-mkdir} mvprog=${MVPROG-mv} rmprog=${RMPROG-rm} stripprog=${STRIPPROG-strip} posix_glob='?' initialize_posix_glob=' test "$posix_glob" != "?" || { if (set -f) 2>/dev/null; then posix_glob= else posix_glob=: fi } ' posix_mkdir= # Desired mode of installed file. mode=0755 chgrpcmd= chmodcmd=$chmodprog chowncmd= mvcmd=$mvprog rmcmd="$rmprog -f" stripcmd= src= dst= dir_arg= dst_arg= copy_on_change=false no_target_directory= usage="\ Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE or: $0 [OPTION]... SRCFILES... DIRECTORY or: $0 [OPTION]... -t DIRECTORY SRCFILES... or: $0 [OPTION]... -d DIRECTORIES... In the 1st form, copy SRCFILE to DSTFILE. In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. In the 4th, create DIRECTORIES. Options: --help display this help and exit. --version display version info and exit. -c (ignored) -C install only if different (preserve the last data modification time) -d create directories instead of installing files. -g GROUP $chgrpprog installed files to GROUP. -m MODE $chmodprog installed files to MODE. -o USER $chownprog installed files to USER. -s $stripprog installed files. -t DIRECTORY install into DIRECTORY. -T report an error if DSTFILE is a directory. Environment variables override the default commands: CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG " while test $# -ne 0; do case $1 in -c) ;; -C) copy_on_change=true;; -d) dir_arg=true;; -g) chgrpcmd="$chgrpprog $2" shift;; --help) echo "$usage"; exit $?;; -m) mode=$2 case $mode in *' '* | *' '* | *' '* | *'*'* | *'?'* | *'['*) echo "$0: invalid mode: $mode" >&2 exit 1;; esac shift;; -o) chowncmd="$chownprog $2" shift;; -s) stripcmd=$stripprog;; -t) dst_arg=$2 # Protect names problematic for 'test' and other utilities. case $dst_arg in -* | [=\(\)!]) dst_arg=./$dst_arg;; esac shift;; -T) no_target_directory=true;; --version) echo "$0 $scriptversion"; exit $?;; --) shift break;; -*) echo "$0: invalid option: $1" >&2 exit 1;; *) break;; esac shift done if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then # When -d is used, all remaining arguments are directories to create. # When -t is used, the destination is already specified. # Otherwise, the last argument is the destination. Remove it from $@. for arg do if test -n "$dst_arg"; then # $@ is not empty: it contains at least $arg. set fnord "$@" "$dst_arg" shift # fnord fi shift # arg dst_arg=$arg # Protect names problematic for 'test' and other utilities. case $dst_arg in -* | [=\(\)!]) dst_arg=./$dst_arg;; esac done fi if test $# -eq 0; then if test -z "$dir_arg"; then echo "$0: no input file specified." >&2 exit 1 fi # It's OK to call 'install-sh -d' without argument. # This can happen when creating conditional directories. exit 0 fi if test -z "$dir_arg"; then do_exit='(exit $ret); exit $ret' trap "ret=129; $do_exit" 1 trap "ret=130; $do_exit" 2 trap "ret=141; $do_exit" 13 trap "ret=143; $do_exit" 15 # Set umask so as not to create temps with too-generous modes. # However, 'strip' requires both read and write access to temps. case $mode in # Optimize common cases. *644) cp_umask=133;; *755) cp_umask=22;; *[0-7]) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw='% 200' fi cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; *) if test -z "$stripcmd"; then u_plus_rw= else u_plus_rw=,u+rw fi cp_umask=$mode$u_plus_rw;; esac fi for src do # Protect names problematic for 'test' and other utilities. case $src in -* | [=\(\)!]) src=./$src;; esac if test -n "$dir_arg"; then dst=$src dstdir=$dst test -d "$dstdir" dstdir_status=$? else # Waiting for this to be detected by the "$cpprog $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if test ! -f "$src" && test ! -d "$src"; then echo "$0: $src does not exist." >&2 exit 1 fi if test -z "$dst_arg"; then echo "$0: no destination specified." >&2 exit 1 fi dst=$dst_arg # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. if test -d "$dst"; then if test -n "$no_target_directory"; then echo "$0: $dst_arg: Is a directory" >&2 exit 1 fi dstdir=$dst dst=$dstdir/`basename "$src"` dstdir_status=0 else # Prefer dirname, but fall back on a substitute if dirname fails. dstdir=` (dirname "$dst") 2>/dev/null || expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$dst" : 'X\(//\)[^/]' \| \ X"$dst" : 'X\(//\)$' \| \ X"$dst" : 'X\(/\)' \| . 2>/dev/null || echo X"$dst" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q' ` test -d "$dstdir" dstdir_status=$? fi fi obsolete_mkdir_used=false if test $dstdir_status != 0; then case $posix_mkdir in '') # Create intermediate dirs using mode 755 as modified by the umask. # This is like FreeBSD 'install' as of 1997-10-28. umask=`umask` case $stripcmd.$umask in # Optimize common cases. *[2367][2367]) mkdir_umask=$umask;; .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; *[0-7]) mkdir_umask=`expr $umask + 22 \ - $umask % 100 % 40 + $umask % 20 \ - $umask % 10 % 4 + $umask % 2 `;; *) mkdir_umask=$umask,go-w;; esac # With -d, create the new directory with the user-specified mode. # Otherwise, rely on $mkdir_umask. if test -n "$dir_arg"; then mkdir_mode=-m$mode else mkdir_mode= fi posix_mkdir=false case $umask in *[123567][0-7][0-7]) # POSIX mkdir -p sets u+wx bits regardless of umask, which # is incompatible with FreeBSD 'install' when (umask & 300) != 0. ;; *) tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 if (umask $mkdir_umask && exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 then if test -z "$dir_arg" || { # Check for POSIX incompatibilities with -m. # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or # other-writable bit of parent directory when it shouldn't. # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. ls_ld_tmpdir=`ls -ld "$tmpdir"` case $ls_ld_tmpdir in d????-?r-*) different_mode=700;; d????-?--*) different_mode=755;; *) false;; esac && $mkdirprog -m$different_mode -p -- "$tmpdir" && { ls_ld_tmpdir_1=`ls -ld "$tmpdir"` test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" } } then posix_mkdir=: fi rmdir "$tmpdir/d" "$tmpdir" else # Remove any dirs left behind by ancient mkdir implementations. rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null fi trap '' 0;; esac;; esac if $posix_mkdir && ( umask $mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" ) then : else # The umask is ridiculous, or mkdir does not conform to POSIX, # or it failed possibly due to a race condition. Create the # directory the slow way, step by step, checking for races as we go. case $dstdir in /*) prefix='/';; [-=\(\)!]*) prefix='./';; *) prefix='';; esac eval "$initialize_posix_glob" oIFS=$IFS IFS=/ $posix_glob set -f set fnord $dstdir shift $posix_glob set +f IFS=$oIFS prefixes= for d do test X"$d" = X && continue prefix=$prefix$d if test -d "$prefix"; then prefixes= else if $posix_mkdir; then (umask=$mkdir_umask && $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break # Don't fail if two instances are running concurrently. test -d "$prefix" || exit 1 else case $prefix in *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; *) qprefix=$prefix;; esac prefixes="$prefixes '$qprefix'" fi fi prefix=$prefix/ done if test -n "$prefixes"; then # Don't fail if two instances are running concurrently. (umask $mkdir_umask && eval "\$doit_exec \$mkdirprog $prefixes") || test -d "$dstdir" || exit 1 obsolete_mkdir_used=true fi fi fi if test -n "$dir_arg"; then { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 else # Make a couple of temp file names in the proper directory. dsttmp=$dstdir/_inst.$$_ rmtmp=$dstdir/_rm.$$_ # Trap to clean up those temp files at exit. trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 # Copy the file name to the temp name. (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && # and set any options; do chmod last to preserve setuid bits. # # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $cpprog $src $dsttmp" command. # { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && # If -C, don't bother to copy if it wouldn't change the file. if $copy_on_change && old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && eval "$initialize_posix_glob" && $posix_glob set -f && set X $old && old=:$2:$4:$5:$6 && set X $new && new=:$2:$4:$5:$6 && $posix_glob set +f && test "$old" = "$new" && $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 then rm -f "$dsttmp" else # Rename the file to the real destination. $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || # The rename failed, perhaps because mv can't rename something else # to itself, or perhaps because mv is so ancient that it does not # support -f. { # Now remove or move aside any old file at destination location. # We try this two ways since rm can't unlink itself on some # systems and the destination file might be busy for other # reasons. In this case, the final cleanup might fail but the new # file should still install successfully. { test ! -f "$dst" || $doit $rmcmd -f "$dst" 2>/dev/null || { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } } || { echo "$0: cannot unlink or rename $dst" >&2 (exit 1); exit 1 } } && # Now rename the file to the real destination. $doit $mvcmd "$dsttmp" "$dst" } fi || exit 1 trap '' 0 fi done # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC" # time-stamp-end: "; # UTC" # End: coccinelle-1.0.0-rc19/setup/wrapper-ocamlcp.sh0000755000175000017500000000115412247437436020164 0ustar eugeneugen#! /bin/sh -e set -e # this command acts as a replacement for ocamlcp to selectively turn # off profiling for some files. # $1: path to ocamlc # $2: path to ocamlprof OCAMLC="$1" OCAMLPROF="$2" shift 2 noprofile= case "$@" in # skip profiling of files that are already preprocessed. *-pp\ *) noprofile=1 ;; # uses "include" *regexp.ml*) noprofile=1 ;; *pycocci.ml*) noprofile=1 ;; *prepare_ocamlcocci.ml*) noprofile=1 ;; *coccilib.ml*) noprofile=1 ;; esac if test -n "$noprofile"; then exec $OCAMLC "$@" else exec $OCAMLC -pp "$OCAMLPROF -instrument -m a" "$@" fi coccinelle-1.0.0-rc19/setup/pkg.m40000644000175000017500000001302312247437436015552 0ustar eugeneugen# pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- # serial 1 (pkg-config-0.24) # # Copyright © 2004 Scott James Remnant . # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # PKG_PROG_PKG_CONFIG([MIN-VERSION]) # ---------------------------------- AC_DEFUN([PKG_PROG_PKG_CONFIG], [m4_pattern_forbid([^_?PKG_[A-Z_]+$]) m4_pattern_allow([^PKG_CONFIG(_(PATH|LIBDIR|SYSROOT_DIR|ALLOW_SYSTEM_(CFLAGS|LIBS)))?$]) m4_pattern_allow([^PKG_CONFIG_(DISABLE_UNINSTALLED|TOP_BUILD_DIR|DEBUG_SPEW)$]) AC_ARG_VAR([PKG_CONFIG], [path to pkg-config utility]) AC_ARG_VAR([PKG_CONFIG_PATH], [directories to add to pkg-config's search path]) AC_ARG_VAR([PKG_CONFIG_LIBDIR], [path overriding pkg-config's built-in search path]) if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then AC_PATH_TOOL([PKG_CONFIG], [pkg-config]) fi if test -n "$PKG_CONFIG"; then _pkg_min_version=m4_default([$1], [0.9.0]) AC_MSG_CHECKING([pkg-config is at least version $_pkg_min_version]) if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) PKG_CONFIG="" fi fi[]dnl ])# PKG_PROG_PKG_CONFIG # PKG_CHECK_EXISTS(MODULES, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) # # Check to see whether a particular set of modules exists. Similar # to PKG_CHECK_MODULES(), but does not set variables or print errors. # # Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) # only at the first occurence in configure.ac, so if the first place # it's called might be skipped (such as if it is within an "if", you # have to call PKG_CHECK_EXISTS manually # -------------------------------------------------------------- AC_DEFUN([PKG_CHECK_EXISTS], [AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl if test -n "$PKG_CONFIG" && \ AC_RUN_LOG([$PKG_CONFIG --exists --print-errors "$1"]); then m4_default([$2], [:]) m4_ifvaln([$3], [else $3])dnl fi]) # _PKG_CONFIG([VARIABLE], [COMMAND], [MODULES]) # --------------------------------------------- m4_define([_PKG_CONFIG], [if test -n "$$1"; then pkg_cv_[]$1="$$1" elif test -n "$PKG_CONFIG"; then PKG_CHECK_EXISTS([$3], [pkg_cv_[]$1=`$PKG_CONFIG --[]$2 "$3" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes ], [pkg_failed=yes]) else pkg_failed=untried fi[]dnl ])# _PKG_CONFIG # _PKG_SHORT_ERRORS_SUPPORTED # ----------------------------- AC_DEFUN([_PKG_SHORT_ERRORS_SUPPORTED], [AC_REQUIRE([PKG_PROG_PKG_CONFIG]) if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi[]dnl ])# _PKG_SHORT_ERRORS_SUPPORTED # PKG_CHECK_MODULES(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], # [ACTION-IF-NOT-FOUND]) # # # Note that if there is a possibility the first call to # PKG_CHECK_MODULES might not happen, you should be sure to include an # explicit call to PKG_PROG_PKG_CONFIG in your configure.ac # # # -------------------------------------------------------------- AC_DEFUN([PKG_CHECK_MODULES], [AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl AC_ARG_VAR([$1][_CFLAGS], [C compiler flags for $1, overriding pkg-config])dnl AC_ARG_VAR([$1][_LIBS], [linker flags for $1, overriding pkg-config])dnl pkg_failed=no AC_MSG_CHECKING([for $1]) _PKG_CONFIG([$1][_CFLAGS], [cflags], [$2]) _PKG_CONFIG([$1][_LIBS], [libs], [$2]) m4_define([_PKG_TEXT], [Alternatively, you may set the environment variables $1[]_CFLAGS and $1[]_LIBS to avoid the need to call pkg-config. See the pkg-config man page for more details.]) if test $pkg_failed = yes; then AC_MSG_RESULT([no]) _PKG_SHORT_ERRORS_SUPPORTED if test $_pkg_short_errors_supported = yes; then $1[]_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "$2" 2>&1` else $1[]_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "$2" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$$1[]_PKG_ERRORS" >&AS_MESSAGE_LOG_FD m4_default([$4], [AC_MSG_ERROR( [Package requirements ($2) were not met: $$1_PKG_ERRORS Consider adjusting the PKG_CONFIG_PATH environment variable if you installed software in a non-standard prefix. _PKG_TEXT])[]dnl ]) elif test $pkg_failed = untried; then AC_MSG_RESULT([no]) m4_default([$4], [AC_MSG_FAILURE( [The pkg-config script could not be found or is too old. Make sure it is in your PATH or set the PKG_CONFIG environment variable to the full path to pkg-config. _PKG_TEXT To get pkg-config, see .])[]dnl ]) else $1[]_CFLAGS=$pkg_cv_[]$1[]_CFLAGS $1[]_LIBS=$pkg_cv_[]$1[]_LIBS AC_MSG_RESULT([yes]) $3 fi[]dnl ])# PKG_CHECK_MODULES coccinelle-1.0.0-rc19/setup/echo.sh0000755000175000017500000000002312247437436016000 0ustar eugeneugen#!/bin/sh echo $* coccinelle-1.0.0-rc19/setup/fake-pdflatex.sh0000755000175000017500000000103412247437436017600 0ustar eugeneugen#! /bin/sh -e set -e # If you don't have pdflatex installed, but do have the generated pdf files, then # this script provides those pdf files as a substitute for the pdflatex invocation. for arg in "$@"; do base="${arg%.*}" ext="${arg##*.}" if test "x$ext" = xtex; then if test -f "${base}.pdf"; then echo "fake-pdflatex.sh: ${base}.pdf provided as substitute for: $@" touch "${base}.pdf" exit 1 fi fi done echo "error: pdflatex has not been configured, therefore refusing to execute: $@" 1>&2 exit 1 coccinelle-1.0.0-rc19/setup/wrapper-ocamlyacc.sh0000644000175000017500000000056312247437436020501 0ustar eugeneugen#! /bin/sh -e set -e # this command acts as a replacement for ocamlyacc that selectively # runs menhir instead for some files. # $1: path to menhir # $2: path to ocamlyacc MENHIR="$1" OCAMLYACC="$2" shift 2 domenhir= case "$@" in *parsing_cocci_menhir.mly*) domenhir=1 ;; esac if test -n "$domenhir"; then exec $OCAMLC "$@" else exec $OCAMLYACC "$@" fi coccinelle-1.0.0-rc19/setup/log_ocamlfind.sh0000644000175000017500000000023512247437436017661 0ustar eugeneugen#! /bin/sh -e set -e # wrapper around ocaml-findlib that logs its # invocations to ocamlfind.log echo "ocamlfind $@" >> ocamlfind.log exec ocamlfind "$@" coccinelle-1.0.0-rc19/setup/replies.txt0000644000175000017500000000170512247437436016737 0ustar eugeneugenocamlfind query (unix|bigarray|num|dynlink|str|threads) $(ocamllibdir) ocamlfind query camlp4 $(ocamllibdir)/camlp4 pkg-config --atleast-pkgconfig-version pkg-config --exists --print-errors python(-([0-9\\.]+))?\$ s,^pkg-config --exists --print-errors python(-([0-9\\.]+))?\$,\\2, $(pythonexists "${MATCH}") pkg-config --print-errors python(-([0-9\\.]+))?\$ s,^pkg-config --print-errors python(-([0-9\\.]+))?\$,\\2, $(pythonexists "${MATCH}") pkg-config --cflags python(-([0-9\\.]+))?\$ s,^pkg-config --cflags python(-([0-9\\.]+))?\$,\\2, $(pythoncflags "${MATCH}") pkg-config --libs python(-([0-9\\.]+))?\$ s,^pkg-config --libs python(-([0-9\\.]+))?\$,\\2, $(pythonlibs "${MATCH}") pkg-config --exists --print-errors libpcre $(checkpcre) pkg-config --print-errors libpcre $(checkpcre) pkg-config --short-errors --print-errors --cflags --libs libpcre $(checkpcre) pkg-config --cflags libpcre pkg-config --libs libpcre -lpcre coccinelle-1.0.0-rc19/setup/Makefile.in0000644000175000017500000004043212247442575016600 0ustar eugeneugen# Makefile.in generated by automake 1.13.3 from Makefile.am. # @configure_input@ # Copyright (C) 1994-2013 Free Software Foundation, Inc. # This Makefile.in is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. @SET_MAKE@ # This is a makefile that is not used by this project, # except for one purpose only: # # to all automake -ac in the root directory to (re)generate # the files install-sh and missing in the setup subdirectory. # # The following files (with respect to the top directory) # have been included in order not to have a dependency on # automake: # # * setup/{Makefile.am, Makefile.in, install-sh, missing} # * configure # * Makefile.am # # Note: Makefile.in in the top directory is not generated # from Makefile.am in the top directory! That Makefile.in # is the official source file, and that Makefile.am is a # placeholder to fool automake (which we do not really use). VPATH = @srcdir@ am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' am__make_running_with_option = \ case $${target_option-} in \ ?) ;; \ *) echo "am__make_running_with_option: internal error: invalid" \ "target option '$${target_option-}' specified" >&2; \ exit 1;; \ esac; \ has_opt=no; \ sane_makeflags=$$MAKEFLAGS; \ if $(am__is_gnu_make); then \ sane_makeflags=$$MFLAGS; \ else \ case $$MAKEFLAGS in \ *\\[\ \ ]*) \ bs=\\; \ sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ esac; \ fi; \ skip_next=no; \ strip_trailopt () \ { \ flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ }; \ for flg in $$sane_makeflags; do \ test $$skip_next = yes && { skip_next=no; continue; }; \ case $$flg in \ *=*|--*) continue;; \ -*I) strip_trailopt 'I'; skip_next=yes;; \ -*I?*) strip_trailopt 'I';; \ -*O) strip_trailopt 'O'; skip_next=yes;; \ -*O?*) strip_trailopt 'O';; \ -*l) strip_trailopt 'l'; skip_next=yes;; \ -*l?*) strip_trailopt 'l';; \ -[dEDm]) skip_next=yes;; \ -[JT]) skip_next=yes;; \ esac; \ case $$flg in \ *$$target_option*) has_opt=yes; break;; \ esac; \ done; \ test $$has_opt = yes am__make_dryrun = (target_option=n; $(am__make_running_with_option)) am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) pkgdatadir = $(datadir)/@PACKAGE@ pkgincludedir = $(includedir)/@PACKAGE@ pkglibdir = $(libdir)/@PACKAGE@ pkglibexecdir = $(libexecdir)/@PACKAGE@ am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd install_sh_DATA = $(install_sh) -c -m 644 install_sh_PROGRAM = $(install_sh) -c install_sh_SCRIPT = $(install_sh) -c INSTALL_HEADER = $(INSTALL_DATA) transform = $(program_transform_name) NORMAL_INSTALL = : PRE_INSTALL = : POST_INSTALL = : NORMAL_UNINSTALL = : PRE_UNINSTALL = : POST_UNINSTALL = : subdir = setup DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am install-sh \ missing ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/setup/cocci.m4 \ $(top_srcdir)/setup/ocaml.m4 $(top_srcdir)/setup/pkg.m4 \ $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d CONFIG_CLEAN_FILES = CONFIG_CLEAN_VPATH_FILES = AM_V_P = $(am__v_P_@AM_V@) am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) am__v_P_0 = false am__v_P_1 = : AM_V_GEN = $(am__v_GEN_@AM_V@) am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) am__v_GEN_0 = @echo " GEN " $@; am__v_GEN_1 = AM_V_at = $(am__v_at_@AM_V@) am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = SOURCES = DIST_SOURCES = am__can_run_installinfo = \ case $$AM_UPDATE_INFO_DIR in \ n|no|NO) false;; \ *) (install-info --version) >/dev/null 2>&1;; \ esac am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) ACLOCAL = @ACLOCAL@ AMTAR = @AMTAR@ AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ BASH = @BASH@ CAMLP4 = @CAMLP4@ CAMLP4BOOT = @CAMLP4BOOT@ CAMLP4O = @CAMLP4O@ CAMLP4OF = @CAMLP4OF@ CAMLP4OOF = @CAMLP4OOF@ CAMLP4ORF = @CAMLP4ORF@ CAMLP4PROF = @CAMLP4PROF@ CAMLP4R = @CAMLP4R@ CAMLP4RF = @CAMLP4RF@ CC = @CC@ CCDEPMODE = @CCDEPMODE@ CFLAGS = @CFLAGS@ COCCI_OCAML_EXTERNAL = @COCCI_OCAML_EXTERNAL@ COCCI_SRCDIR = @COCCI_SRCDIR@ COCCI_VERSION = @COCCI_VERSION@ CONFIGURE_FLAGS = @CONFIGURE_FLAGS@ CONFVERSION = @CONFVERSION@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CYGPATH_W = @CYGPATH_W@ DATE = @DATE@ DEFS = @DEFS@ DEPDIR = @DEPDIR@ DYNLINK_IS_NATIVE = @DYNLINK_IS_NATIVE@ ECHO = @ECHO@ ECHO_C = @ECHO_C@ ECHO_N = @ECHO_N@ ECHO_T = @ECHO_T@ EXEEXT = @EXEEXT@ FEATURE_OCAML = @FEATURE_OCAML@ FEATURE_OCAMLBUILD = @FEATURE_OCAMLBUILD@ FEATURE_PYTHON = @FEATURE_PYTHON@ FEATURE_camlp4 = @FEATURE_camlp4@ FEATURE_dynlink = @FEATURE_dynlink@ FEATURE_menhirLib = @FEATURE_menhirLib@ FEATURE_pcre = @FEATURE_pcre@ FEATURE_pycaml = @FEATURE_pycaml@ FLAGS_camlp4 = @FLAGS_camlp4@ FLAGS_dynlink = @FLAGS_dynlink@ FLAGS_menhirLib = @FLAGS_menhirLib@ FLAGS_pcre = @FLAGS_pcre@ FLAGS_pycaml = @FLAGS_pycaml@ GIT = @GIT@ GLOBAL_camlp4 = @GLOBAL_camlp4@ GLOBAL_dynlink = @GLOBAL_dynlink@ GLOBAL_menhirLib = @GLOBAL_menhirLib@ GLOBAL_pcre = @GLOBAL_pcre@ GLOBAL_pycaml = @GLOBAL_pycaml@ HAVE_PCRE = @HAVE_PCRE@ HAVE_PYTHON = @HAVE_PYTHON@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ LDFLAGS = @LDFLAGS@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LOCALLIB_camlp4 = @LOCALLIB_camlp4@ LOCALLIB_dynlink = @LOCALLIB_dynlink@ LOCALLIB_menhirLib = @LOCALLIB_menhirLib@ LOCALLIB_pcre = @LOCALLIB_pcre@ LOCALLIB_pycaml = @LOCALLIB_pycaml@ LTLIBOBJS = @LTLIBOBJS@ MAKEINFO = @MAKEINFO@ MAKETARGET_ALL = @MAKETARGET_ALL@ MAKETARGET_SPATCH = @MAKETARGET_SPATCH@ MAKE_camlp4 = @MAKE_camlp4@ MAKE_dynlink = @MAKE_dynlink@ MAKE_menhirLib = @MAKE_menhirLib@ MAKE_pcre = @MAKE_pcre@ MAKE_pycaml = @MAKE_pycaml@ MENHIR = @MENHIR@ MKDIR_P = @MKDIR_P@ MODULESOPT_camlp4 = @MODULESOPT_camlp4@ MODULESOPT_dynlink = @MODULESOPT_dynlink@ MODULESOPT_menhirLib = @MODULESOPT_menhirLib@ MODULESOPT_pcre = @MODULESOPT_pcre@ MODULESOPT_pycaml = @MODULESOPT_pycaml@ MODULES_camlp4 = @MODULES_camlp4@ MODULES_dynlink = @MODULES_dynlink@ MODULES_menhirLib = @MODULES_menhirLib@ MODULES_pcre = @MODULES_pcre@ MODULES_profiling = @MODULES_profiling@ MODULES_pycaml = @MODULES_pycaml@ OBJEXT = @OBJEXT@ OCAML = @OCAML@ OCAMLATLEAST310 = @OCAMLATLEAST310@ OCAMLATLEAST311 = @OCAMLATLEAST311@ OCAMLBEST = @OCAMLBEST@ OCAMLBUILD = @OCAMLBUILD@ OCAMLC = @OCAMLC@ OCAMLCDOTOPT = @OCAMLCDOTOPT@ OCAMLCOCCI_FILE = @OCAMLCOCCI_FILE@ OCAMLCOCCI_MODULE = @OCAMLCOCCI_MODULE@ OCAMLCORIG = @OCAMLCORIG@ OCAMLDEP = @OCAMLDEP@ OCAMLDOC = @OCAMLDOC@ OCAMLFIND = @OCAMLFIND@ OCAMLLEX = @OCAMLLEX@ OCAMLLEXDOTOPT = @OCAMLLEXDOTOPT@ OCAMLLIB = @OCAMLLIB@ OCAMLMKLIB = @OCAMLMKLIB@ OCAMLMKTOP = @OCAMLMKTOP@ OCAMLOPT = @OCAMLOPT@ OCAMLOPTDOTOPT = @OCAMLOPTDOTOPT@ OCAMLPROF = @OCAMLPROF@ OCAMLVERSION = @OCAMLVERSION@ OCAMLYACC = @OCAMLYACC@ OCAML_PKG_bigarray = @OCAML_PKG_bigarray@ OCAML_PKG_camlp4 = @OCAML_PKG_camlp4@ OCAML_PKG_dynlink = @OCAML_PKG_dynlink@ OCAML_PKG_menhirLib = @OCAML_PKG_menhirLib@ OCAML_PKG_num = @OCAML_PKG_num@ OCAML_PKG_pcre = @OCAML_PKG_pcre@ OCAML_PKG_pycaml = @OCAML_PKG_pycaml@ OCAML_PKG_str = @OCAML_PKG_str@ OCAML_PKG_unix = @OCAML_PKG_unix@ OPTFLAGS_camlp4 = @OPTFLAGS_camlp4@ OPTFLAGS_dynlink = @OPTFLAGS_dynlink@ OPTFLAGS_menhirLib = @OPTFLAGS_menhirLib@ OPTFLAGS_pcre = @OPTFLAGS_pcre@ OPTFLAGS_pycaml = @OPTFLAGS_pycaml@ OPTIMIZED_dynlink = @OPTIMIZED_dynlink@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ PACKAGE_STRING = @PACKAGE_STRING@ PACKAGE_TARNAME = @PACKAGE_TARNAME@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATCH = @PATCH@ PATCHELF = @PATCHELF@ PATH_SEPARATOR = @PATH_SEPARATOR@ PATH_bigarray = @PATH_bigarray@ PATH_camlp4 = @PATH_camlp4@ PATH_dynlink = @PATH_dynlink@ PATH_menhirLib = @PATH_menhirLib@ PATH_num = @PATH_num@ PATH_pcre = @PATH_pcre@ PATH_pycaml = @PATH_pycaml@ PATH_str = @PATH_str@ PATH_unix = @PATH_unix@ PCRE_CFLAGS = @PCRE_CFLAGS@ PCRE_LIBS = @PCRE_LIBS@ PDFLATEX = @PDFLATEX@ PKG_CONFIG = @PKG_CONFIG@ PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ PKG_CONFIG_ORIG = @PKG_CONFIG_ORIG@ PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ PYCOCCI_FILE = @PYCOCCI_FILE@ PYCOCCI_MODULE = @PYCOCCI_MODULE@ PYTHON = @PYTHON@ PYTHON_CFLAGS = @PYTHON_CFLAGS@ PYTHON_LIBS = @PYTHON_LIBS@ PYVER = @PYVER@ PYVER_MAJOR = @PYVER_MAJOR@ REGEXP_FILE = @REGEXP_FILE@ REGEXP_MODULE = @REGEXP_MODULE@ RUNTIME_CAMLP4O_CMD = @RUNTIME_CAMLP4O_CMD@ RUNTIME_CAMLP4_CMD = @RUNTIME_CAMLP4_CMD@ RUNTIME_OCAMLC_CMD = @RUNTIME_OCAMLC_CMD@ RUNTIME_OCAMLDEP_CMD = @RUNTIME_OCAMLDEP_CMD@ RUNTIME_OCAMLFIND_CMD = @RUNTIME_OCAMLFIND_CMD@ RUNTIME_OCAMLOPT_CMD = @RUNTIME_OCAMLOPT_CMD@ SET_MAKE = @SET_MAKE@ SHAREDIR = @SHAREDIR@ SHELL = @SHELL@ SPATCHNAME = @SPATCHNAME@ STRIP = @STRIP@ SUBSTITUTED_MENHIR = @SUBSTITUTED_MENHIR@ SUBSTITUTED_OCAMLFIND = @SUBSTITUTED_OCAMLFIND@ SUBSTITUTED_OCAMLLEX = @SUBSTITUTED_OCAMLLEX@ SUBSTITUTED_OCAMLPROF = @SUBSTITUTED_OCAMLPROF@ SUBSTITUTED_OCAMLYACC = @SUBSTITUTED_OCAMLYACC@ SUBSTITUTED_PDFLATEX = @SUBSTITUTED_PDFLATEX@ SUBSTITUTED_PKG_CONFIG = @SUBSTITUTED_PKG_CONFIG@ SUBSTITUTED_PYTHON = @SUBSTITUTED_PYTHON@ TAR = @TAR@ VERSION = @VERSION@ abs_builddir = @abs_builddir@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_CC = @ac_ct_CC@ am__include = @am__include@ am__leading_dot = @am__leading_dot@ am__quote = @am__quote@ am__tar = @am__tar@ am__untar = @am__untar@ bindir = @bindir@ build_alias = @build_alias@ builddir = @builddir@ datadir = @datadir@ datarootdir = @datarootdir@ docdir = @docdir@ dvidir = @dvidir@ enable_camlp4 = @enable_camlp4@ enable_dynlink = @enable_dynlink@ enable_menhirLib = @enable_menhirLib@ enable_ocaml = @enable_ocaml@ enable_opt = @enable_opt@ enable_pcre = @enable_pcre@ enable_pcre_syntax = @enable_pcre_syntax@ enable_pycaml = @enable_pycaml@ enable_python = @enable_python@ enable_release = @enable_release@ exec_prefix = @exec_prefix@ host_alias = @host_alias@ htmldir = @htmldir@ includedir = @includedir@ infodir = @infodir@ install_sh = @install_sh@ libdir = @libdir@ libexecdir = @libexecdir@ localedir = @localedir@ localstatedir = @localstatedir@ mandir = @mandir@ mkdir_p = @mkdir_p@ oldincludedir = @oldincludedir@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ with_MENHIR = @with_MENHIR@ with_OCAMLFIND = @with_OCAMLFIND@ with_OCAMLLEX = @with_OCAMLLEX@ with_OCAMLPROF = @with_OCAMLPROF@ with_OCAMLYACC = @with_OCAMLYACC@ with_PDFLATEX = @with_PDFLATEX@ with_PKG_CONFIG = @with_PKG_CONFIG@ with_PYTHON = @with_PYTHON@ all: all-am .SUFFIXES: $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ && { if test -f $@; then exit 0; else break; fi; }; \ exit 1;; \ esac; \ done; \ echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu setup/Makefile'; \ $(am__cd) $(top_srcdir) && \ $(AUTOMAKE) --gnu setup/Makefile .PRECIOUS: Makefile Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status @case '$?' in \ *config.status*) \ cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ *) \ echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ esac; $(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(top_srcdir)/configure: $(am__configure_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(ACLOCAL_M4): $(am__aclocal_m4_deps) cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh $(am__aclocal_m4_deps): tags TAGS: ctags CTAGS: cscope cscopelist: distdir: $(DISTFILES) @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ list='$(DISTFILES)'; \ dist_files=`for file in $$list; do echo $$file; done | \ sed -e "s|^$$srcdirstrip/||;t" \ -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ case $$dist_files in \ */*) $(MKDIR_P) `echo "$$dist_files" | \ sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ sort -u` ;; \ esac; \ for file in $$dist_files; do \ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ if test -d $$d/$$file; then \ dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ if test -d "$(distdir)/$$file"; then \ find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ fi; \ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ fi; \ cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ else \ test -f "$(distdir)/$$file" \ || cp -p $$d/$$file "$(distdir)/$$file" \ || exit 1; \ fi; \ done check-am: all-am check: check-am all-am: Makefile installdirs: install: install-am install-exec: install-exec-am install-data: install-data-am uninstall: uninstall-am install-am: all-am @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am installcheck: installcheck-am install-strip: if test -z '$(STRIP)'; then \ $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ install; \ else \ $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ fi mostlyclean-generic: clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @echo "it deletes files that may require special tools to rebuild." clean: clean-am clean-am: clean-generic mostlyclean-am distclean: distclean-am -rm -f Makefile distclean-am: clean-am distclean-generic dvi: dvi-am dvi-am: html: html-am html-am: info: info-am info-am: install-data-am: install-dvi: install-dvi-am install-dvi-am: install-exec-am: install-html: install-html-am install-html-am: install-info: install-info-am install-info-am: install-man: install-pdf: install-pdf-am install-pdf-am: install-ps: install-ps-am install-ps-am: installcheck-am: maintainer-clean: maintainer-clean-am -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic mostlyclean: mostlyclean-am mostlyclean-am: mostlyclean-generic pdf: pdf-am pdf-am: ps: ps-am ps-am: uninstall-am: .MAKE: install-am install-strip .PHONY: all all-am check check-am clean clean-generic cscopelist-am \ ctags-am distclean distclean-generic distdir dvi dvi-am html \ html-am info info-am install install-am install-data \ install-data-am install-dvi install-dvi-am install-exec \ install-exec-am install-html install-html-am install-info \ install-info-am install-man install-pdf install-pdf-am \ install-ps install-ps-am install-strip installcheck \ installcheck-am installdirs maintainer-clean \ maintainer-clean-generic mostlyclean mostlyclean-generic pdf \ pdf-am ps ps-am tags-am uninstall uninstall-am all: echo "dummy makefile, do not use" # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: coccinelle-1.0.0-rc19/setup/wrapper-menhir.sh0000755000175000017500000000140612247437436020030 0ustar eugeneugen#! /bin/sh -e set -e # This wrapper is a work-around to fool ocamlbuild to # use menhir but actually using ocamlyacc for some files. # Since this wrapper makes some assumptions about how # ocamlbuild works, it may break in the future. # In particular: the paths to the files may change. # $1: path to menhir # $2: path to ocamlyacc OCAMLYACC="$1" MENHIR="$2" shift 2 case "$@" in # use ocamlyacc for parsing_c/parsing_c.mly *raw-depend*parsing_c/parser_c.mly*) # echo "Notice: using ocamlyacc instead of menhir: skipping apriori dependency generation" 1>&2 ;; *parsing_c/parser_c.mly*) # echo "Notice: invoking ocamlyacc instead of menhir." 1>&2 exec $OCAMLYACC parsing_c/parser_c.mly ;; # execute with menhir *) exec $MENHIR "$@" ;; esac coccinelle-1.0.0-rc19/commons/0000755000175000017500000000000012247442646015042 5ustar eugeneugencoccinelle-1.0.0-rc19/commons/objet.ml0000644000175000017500000000115712247437436016504 0ustar eugeneugenopen Common (* TypeClass via objects. Cf also now interfaces.ml * * todo? get more inspiration from Java to put fundamental interfaces * here ? such as clonable, equaable, showable, debugable, etc *) class virtual objet = object(o:'o) method invariant: unit -> unit = fun () -> raise Todo (* method check: unit -> unit = fun () -> assert(o#invariant()); *) method of_string: string -> unit = raise Todo method to_string: unit -> string = raise Todo method debug: unit -> unit = raise Todo method misc_op_hook: unit -> 'o = raise Todo method misc_op_hook2: unit = () end coccinelle-1.0.0-rc19/commons/ograph_extended.ml0000644000175000017500000002033712247437436020542 0ustar eugeneugenopen Common open Ocollection open Oset open Oassoc (* open Ograph *) open Oassocb open Osetb (* * graph structure: * - node: index -> nodevalue * - arc: (index * index) * edgevalue * * invariant: key in pred is also in succ (completness) and value in * either assoc is a key also. * * How ? matrix ? but no growing array :( * * When need index ? Must have an index when can't just use nodevalue * as a key, cos sometimes may have 2 times the same key, but it must * be 2 different nodes. For instance in program f(); f(); we want 2 * nodes, one per f(); hence the index. If each node is different, * then no problem, can omit index. * * todo?: prend en parametre le type de finitemap et set a prendre * todo?: add_arc doit ramer, car del la key, puis add => better to * have a ref to a set. * * opti: graph with pointers and a tag visited => need keep global value * visited_counter. check(that node is in, ...), display. * opti: when the graph structure is stable, have a method compact, that * transforms that in a matrix (assert that all number between 0 and * free_index are used, or do some defrag-like-move/renaming). * *) type nodei = int class ['a,'b] ograph_extended = let build_assoc () = new oassocb [] in (* opti?: = oassoch *) let build_set () = new osetb Setb.empty in object(o) (* inherit ['a] ograph *) val free_index = 0 val succ = build_assoc() val pred = build_assoc() val nods = build_assoc() method add_node (e: 'a) = let i = free_index in ({< nods = nods#add (i, e); pred = pred#add (i, build_set() ); succ = succ#add (i, build_set() ); free_index = i + 1; >}, i) method add_nodei i (e: 'a) = ({< nods = nods#add (i, e); pred = pred#add (i, build_set() ); succ = succ#add (i, build_set() ); free_index = (max free_index i) + 1; >}, i) method del_node (i) = {< (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise * will have some dangling pointers *) nods = nods#delkey i; pred = pred#delkey i; succ = succ#delkey i; >} method replace_node (i, (e: 'a)) = assert (nods#haskey i); {< nods = nods#replkey (i, e); >} method add_arc ((a,b),(v: 'b)) = {< succ = succ#replkey (a, (succ#find a)#add (b, v)); pred = pred#replkey (b, (pred#find b)#add (a, v)); >} method del_arc ((a,b),v) = {< succ = succ#replkey (a, (succ#find a)#del (b,v)); pred = pred#replkey (b, (pred#find b)#del (a,v)); >} method successors e = succ#find e method predecessors e = pred#find e method nodes = nods method allsuccessors = succ (* method ancestors xs = let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#predecessors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) method children xs = let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#successors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) method brothers x = let parents = o#predecessors x in (parents#fold (fun acc e -> acc $++$ o#successors e) (f2()))#del x *) end class ['a,'b] ograph_mutable = let build_assoc () = new oassocb [] in let build_set () = new osetb Setb.empty in object(o) val mutable free_index = 0 val mutable succ = build_assoc() val mutable pred = build_assoc() val mutable nods = build_assoc() method add_node (e: 'a) = let i = free_index in nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); free_index <- i + 1; i method add_nodei i (e: 'a) = nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); free_index <- (max free_index i) + 1; method del_node (i) = (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise * will have some dangling pointers *) nods <- nods#delkey i; pred <- pred#delkey i; succ <- succ#delkey i; method replace_node (i, (e: 'a)) = assert (nods#haskey i); nods <- nods#replkey (i, e); method add_arc ((a,b),(v: 'b)) = succ <- succ#replkey (a, (succ#find a)#add (b, v)); pred <- pred#replkey (b, (pred#find b)#add (a, v)); method del_arc ((a,b),v) = succ <- succ#replkey (a, (succ#find a)#del (b,v)); pred <- pred#replkey (b, (pred#find b)#del (a,v)); method successors e = succ#find e method predecessors e = pred#find e method nodes = nods method allsuccessors = succ end (* depth first search *) let dfs_iter xi f g = let already = Hashtbl.create 101 in let rec aux_dfs xs = xs +> List.iter (fun xi -> if Hashtbl.mem already xi then () else begin Hashtbl.add already xi true; f xi; let succ = g#successors xi in aux_dfs (succ#tolist +> List.map fst); end ) in aux_dfs [xi] let dfs_iter_with_path xi f g = let already = Hashtbl.create 101 in let rec aux_dfs path xi = if Hashtbl.mem already xi then () else begin Hashtbl.add already xi true; f xi path; let succ = g#successors xi in let succ' = succ#tolist +> List.map fst in succ' +> List.iter (fun yi -> aux_dfs (xi::path) yi ); end in aux_dfs [] xi let generate_ograph_generic g label fnode filename = Common.with_open_outfile filename (fun (pr,_) -> pr "digraph misc {\n" ; pr "size = \"10,10\";\n" ; (match label with None -> () | Some x -> pr (Printf.sprintf "label = \"%s\";\n" x)); let nodes = g#nodes in nodes#iter (fun (k,node) -> let (str,border_color,inner_color) = fnode (k, node) in let color = match inner_color with None -> (match border_color with None -> "" | Some x -> Printf.sprintf ", style=\"setlinewidth(3)\", color = %s" x) | Some x -> (match border_color with None -> Printf.sprintf ", style=\"setlinewidth(3),filled\", fillcolor = %s" x | Some x' -> Printf.sprintf ", style=\"setlinewidth(3),filled\", fillcolor = %s, color = %s" x x') in (* so can see if nodes without arcs were created *) pr (sprintf "%d [label=\"%s [%d]\"%s];\n" k str k color) ); nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (sprintf "%d -> %d;\n" k j); ); ); pr "}\n" ; ); () let generate_ograph_xxx g filename = with_open_outfile filename (fun (pr,_) -> pr "digraph misc {\n" ; pr "size = \"10,10\";\n" ; let nodes = g#nodes in nodes#iter (fun (k,(node, s)) -> (* so can see if nodes without arcs were created *) pr (sprintf "%d [label=\"%s [%d]\"];\n" k s k) ); nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (sprintf "%d -> %d;\n" k j); ); ); pr "}\n" ; ); () let launch_gv_cmd filename = let _status = Unix.system ("dot " ^ filename ^ " -Tps -o " ^ filename ^ ".ps;") in let _status = Unix.system ("gv " ^ filename ^ ".ps &") in (* zarb: I need this when I launch the program via eshell, otherwise gv do not get the chance to be launched *) Unix.sleep 1; () let print_ograph_extended g filename launchgv = generate_ograph_xxx g filename; if launchgv then launch_gv_cmd filename let print_ograph_mutable g filename launchgv = generate_ograph_xxx g filename; if launchgv then launch_gv_cmd filename let print_ograph_mutable_generic g label fnode ~output_file ~launch_gv = generate_ograph_generic g label fnode output_file; if launch_gv then launch_gv_cmd output_file coccinelle-1.0.0-rc19/commons/oarray.ml0000644000175000017500000000166412247437436016701 0ustar eugeneugenopen Common open Osequence (* growing array ? initialise with None, * and generate exception when not defined or have an arraydefault * update: can use dynArray ? *) (* !!take care!!, this is not a pure data structure *) class ['a] oarray n el = object(o: 'o) inherit ['a] osequence val data = Array.make n el method empty = raise Todo method add (i,v) = Array.set data i v; o method iter f = Array.iteri (curry f) data method view = raise Todo method assoc i = Array.get data i method null = raise Todo method nth = raise Todo method mem = raise Todo method last = raise Todo method first = raise Todo method delkey = raise Todo method keys = raise Todo method del = raise Todo method fromlist = raise Todo method length = Array.length data (* method create: int -> 'a -> 'o = raise Todo *) (* method put: make more explicit the fact that array do side effect *) end coccinelle-1.0.0-rc19/commons/parser_combinators.ml0000644000175000017500000002246112247437436021276 0ustar eugeneugen(*****************************************************************************) (* *) (*****************************************************************************) (* src: Jon Harrop. * * "Certain applications are extremely well suited to functional * programming and parsing is one of them. Specifically, the ability to * write functional combinators that allow parsers for everything from * integers up to symbolic expressions to be composed is more general * and provides more opportunity for code reuse than the use of * conventional parser generators such as ocamllex and ocamlyacc. This * article explains how parser combinators may be designed and * implemented in OCaml, using the standard example of a calculator." * * Based on haskell articles I guess like meijer functional pearl or * graham hutton articles. Also maybe based on haskell parsec. * * pad: a few bugfix. I also put more restrictive and descriptive types. * pad: I remember having coded such a library, maybe not in ocaml. * Or maybe it was during a "TP compilation" at INSA ? I remember having * a generic lexer. Or maybe it was genlex ? * * * * * alternatives: genlex + parser extension of ocaml (streams). * cf genlex doc: * * Example: a lexer suitable for a desk calculator is obtained by * let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] * let parse_expr = parser * [< 'Int n >] -> n * | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n * | [< n1 = parse_expr; n2 = parse_remainder n1 >] -> n2 * and parse_remainder n1 = parser * [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2 * | ... * type token = * | Kwd of string * | Ident of string * | Int of int * | Float of float * | String of string * | Char of char * * * Cf also ocaml manual * let rec parse_expr = parser * [< e1 = parse_mult; e = parse_more_adds e1 >] -> e * and parse_more_adds e1 = parser * [< 'Kwd "+"; e2 = parse_mult; e = parse_more_adds (Sum(e1, e2)) >] -> e * | [< 'Kwd "-"; e2 = parse_mult; e = parse_more_adds (Diff(e1, e2)) >] -> e * | [< >] -> e1 * and parse_mult = parser * [< e1 = parse_simple; e = parse_more_mults e1 >] -> e * and parse_more_mults e1 = parser * [< 'Kwd "*"; e2 = parse_simple; e = parse_more_mults (Prod(e1, e2)) >] -> e * | [< 'Kwd "/"; e2 = parse_simple; e = parse_more_mults (Quot(e1, e2)) >] -> e * | [< >] -> e1 * and parse_simple = parser * [< 'Ident s >] -> Var s * | [< 'Int i >] -> Const(float i) * | [< 'Float f >] -> Const f * | [< 'Kwd "("; e = parse_expr; 'Kwd ")" >] -> e;; * But see how they are forced to use a LL(1) grammar which denatures the * grammar "parse_more_xxx" * *) (*****************************************************************************) (* Parser Combinators *) (*****************************************************************************) (* src: Jon Harrop. pad: a few bugfix *) type ('a, 'b) genp = 'a list -> 'b * 'a list let val_of_parser = fst (* lexer = parser of char list *) (* type 'a lexer = (char, 'a) genp *) (* grammer = parser ot tokens *) (* type 'a p = (token, 'a) genp *) (* pad: could also do it by returning a Maybe and use monad *) let ( ||| ) p1 p2 s = try p1 s with Not_found -> p2 s let ( +++ ) p1 p2 s = let e1, s = p1 s in let e2, s = p2 s in (e1, e2), s let rec many p s = try let e, s = p s in let es, s = many p s in e::es, s with Not_found -> [], s let ( >| ) p k i = let e, s = p i in k e, s (* was called 'some', but confusing *) let pred p = function | h::t when p h -> h, t | _ -> raise Not_found let a x = pred (( = ) x) let several p = many (pred p) module Abstr : sig type t val x : t end = struct type t = int let x = 0 end let fin = function | [] as t -> Abstr.x, t | _ -> raise Not_found (*****************************************************************************) (* Lexing *) (*****************************************************************************) (* a generic lexer *) let digit = function | '0'..'9' -> true | _ -> false let alpha = function | 'a'..'z' | 'A'..'Z' -> true | _ -> false let symbol = function | '(' | ')' | '{' | '}' | '[' | ']' | '<' | '>' | '+' | '-' | '*' | '/' | '&' | '|' | '!' | '=' | '~' | '@' -> true | _ -> false let space = function | ' ' | '\t' | '\n' -> true | _ -> false let stringquote = function | '"' -> true | _ -> false let quote = function | '\'' -> true | _ -> false let alphanum c = digit c || alpha c let alphanum_underscore c = digit c || alpha c || (c = '_') let alphanum_minus c = digit c || alpha c || (c = '-') let alphanum_under_minus c = digit c || alpha c || (c = '-') || (c = '_') let (+>) o f = f o let string_of_chars cs = cs +> List.map (String.make 1) +> String.concat "" let collect(h, t) = String.concat "" (List.map (String.make 1) (h::t)) let collectbis(xs) = String.concat "" (List.map (String.make 1) (xs)) let list_of_string string = let list = ref [] in String.iter (fun c -> list := c :: !list) string; List.rev !list (*****************************************************************************) (* still generic *) (*****************************************************************************) type token = | IDENT of string | KWD of string | INT of string | SYM of string | STR of string let string_of_token = function | IDENT string -> "IDENT:" ^ string | KWD string -> "KWD:" ^ string | INT string -> "INT:" ^ string | SYM string -> "SYM:" ^ string | STR string -> "STR:" ^ string type lexer = (char, token) genp let rawnumber = pred digit +++ several digit >| fun x -> INT(collect x) let rawident = pred alpha +++ several alphanum >| fun x -> IDENT(collect x) let rawsymbol = pred symbol +++ several symbol >| fun x -> SYM(collect x) let rawkeyword = let p c = not(space c) && not(digit c) in pred p +++ several p >| fun x -> KWD(collect x) (* todo: handle antislash *) let rawstring = pred stringquote +++ several (fun c -> not (stringquote c)) +++ pred stringquote >| (fun ((c1, cs), c3) -> let s = string_of_chars cs in STR s (* exclude the marker *) ) let lex_gen tokenf str = let alltoks = (many tokenf) +++ fin >| fst in val_of_parser (alltoks (list_of_string str)) let parse_gen tokenf grammarf p string = val_of_parser (grammarf (lex_gen tokenf string)) (*****************************************************************************) (* not generic anymore *) (*****************************************************************************) (* the order is important if some "rules" overlap, as in ocamllex *) let token = (rawident ||| rawnumber ||| rawkeyword) +++ several space >| fst (* pad: bugfix: was not defined in jon harrop article *) let tokens = many token let alltokens = tokens +++ fin >| fst let lex (string : string) = val_of_parser (alltokens (list_of_string string)) let test1 () = Common.example (lex "a x^2 + b x + c" = [IDENT "a"; IDENT "x"; KWD "^"; INT "2"; KWD "+"; IDENT "b"; IDENT "x"; KWD "+"; IDENT "c"] ) (*****************************************************************************) (* Parsing *) (*****************************************************************************) type expr = | Int of int | Var of string | Add of expr * expr | Mul of expr * expr type 'a pparser = (token, 'a) genp (* open Format;; # let rec print_expr ff = function | Int n -> fprintf ff "%d" n | Var x -> fprintf ff "%s" x | Add(f, g) -> fprintf ff "%a + %a" print_expr f print_expr g | Mul(f, g) -> fprintf ff "%a %a" print_mul f print_mul g and print_mul ff = function | Add _ as e -> fprintf ff "(%a)" print_expr e | e -> fprintf ff "%a" print_expr e #install_printer print_expr *) let ident = function | IDENT x :: t -> x, t | _ -> raise Not_found let int = function | INT n :: t -> n, t | _ -> raise Not_found let string = function | STR x :: t -> x, t | _ -> raise Not_found (* src: Jon Harrop * "This style of parsing, known as recursive descent parsing , has one * important caveat. If a rule tries to match itself immediately, even if * that is succeeded by other parsers, then the resulting program will go * into an infinite loops with the parser for that rule calling itself * indefinitely until a stack overflow occurs. Consequently, our * implementation of the factor parser is careful to parse an atom first, * and term calls factor first, to avoid this problem." * * pad: bugfix, added the KWD "*". *) (* pad: I think I remembered you cant eta-factorize the parameter * when you use mutually recursive *) let rec atom s = ( (int >| fun n -> Int(int_of_string n)) ||| (ident >| fun x -> Var x) ||| (a (KWD "(") +++ term +++ a (KWD ")") >| fun ((_, e), _) -> e) ) s and factor s = ( (atom +++ a (KWD "*") +++ factor >| fun ((f, _), g) -> Mul (f,g)) ||| atom ) s and term s = ( (factor +++ a (KWD "+") +++ term >| fun ((f, _), g) -> Add (f,g)) ||| factor ) s let expr = term +++ fin >| fst let parse p string = val_of_parser(p(lex string)) (* parse expr "a x x + b x + c" *) (*****************************************************************************) module Infix = struct let (|||) = (|||) let (+++) = (+++) let (>|) = (>|) end coccinelle-1.0.0-rc19/commons/objet.mli0000644000175000017500000000113612247437436016652 0ustar eugeneugenclass virtual objet : object('o) method invariant: unit -> unit (* method check: unit -> unit *) method of_string: string -> unit method to_string: unit -> string method debug: unit -> unit (* ugly (but convenient): those methods allow to extend an interface without * changing its interface. For instance in oassocbtree I want to * provide a method to commit, but doing so will mean break the interface * of oassoc. But if provide the commit code via a misc_op_hook, then * I will not break the interface. *) method misc_op_hook: unit -> 'o method misc_op_hook2: unit end coccinelle-1.0.0-rc19/commons/ocollection.ml0000644000175000017500000000772012247437436017715 0ustar eugeneugenopen Common (*****************************************************************************) (* Collection *) (*****************************************************************************) (* * The derived classes of collections: * - sequence(next, nth): array, list, stack, queue, and mixed * (fast cons, fast snoc, fast append, cf okasaki) * - set(union): setl, setb, seti, seth * - assoc(find): assocl, mapb, hash, btree, multimap (mais bof, can do * with map of set) * - graph: graph1way, graph2way, graphref, graphmatrix? * * Some features/notes: * - views a la wadler to make it cool (I hate get/set). * - take list in parameters to be able to construct value as is easily * - take the comparison function in parameters (=> functorial set made cool) * make l [], h [], ... as in perl, and pass the func from pervasive * in oo form (list, ...) * - pure/impure: could put 2 interface, with one that show that inpure * by making the operation return unit, but simpler to have one interface. * - the core method and default method (via virtual classes) * better to use virtual than typeclass, virtual play both roles: * an interface and default code * * - pb binary methods: use tosetb tricks, or via (not safe) Obj.magic. * - array/list are both a sequence _and_ a dictionnary, so are both * a collection(a) and a collection(i,a) at the same time. But cannot do that. * So for array, I see it mainly as an assoc => favor assoc, and * for list, I see it mainly as a collection => favor collection * * ??mixins: comparable, iterator, via virtual class in ocaml * ?? kind of haskell class + default value * * ?? persistence, caching, peut prendre en param le type de map qu'il cache, * comme en perl, evite du marshalling kan wrapped = bdb. * * ?? lazy wrapper, how avoid complexity of having to define each time * a hashP, hashC, hashL, hashPCL, ... ? * * ?? I define those classes cos their name are cool, say what is intended to * do with * * todo: cf book on algorithm, a la rivest/sedgewick * todo: recreate collection hierarchy, inspire smalltalk ? haskell ? merd ? * todo: put a clean sequence (inherit collection) and make array a special * class * todo: make ostack (FIFO), oqueue (LIFO) * * * influences: okasaki, merd (pixel), java classes, smalltalk classes *) (*---------------------------------------------------------------------------*) type ('a, 'b) view = Empty | Cons of 'a * 'b class virtual ['a] ocollection = object(o: 'o) inherit Objet.objet method virtual empty: 'o method virtual add: 'a -> 'o method virtual iter: ('a -> unit) -> unit method virtual view: ('a, 'o) view (* no need virtual, but better to redefine for efficiency *) method virtual del: 'a -> 'o (* can do default with: view+iter *) method virtual mem: 'a -> bool (* can do default with: mem(tolist) *) method virtual null: bool (* can do default with: lenght(tolist)= 0 *) method add2: 'a -> unit = fun a -> o#add a +> ignore; () method del2: 'a -> unit = fun a -> o#del a +> ignore; () method clear: unit = o#iter (fun e -> o#del2 e); method fold: 'b. ('b -> 'a -> 'b) -> 'b -> 'b = fun f a -> let a = ref a in o#iter (fun e -> a := f !a e); !a method tolist: 'a list = List.rev (o#fold (fun acc e -> e::acc) []) method fromlist: 'a list -> 'o = fun xs -> xs +> List.fold_left (fun o e -> o#add e) o#empty method length: int = (* oldsimple: o#tolist +> List.length *) (* opti: *) let count = ref 0 in o#iter (fun e -> incr count); !count method exists: ('a -> bool) -> bool = fun f -> o#tolist +> List.exists f method filter: ('a -> bool) -> 'o = fun f -> (* iter and call add from empty, or del *) o#tolist +> List.filter f +> o#fromlist (* forall, fold, map *) method getone: 'a = match o#view with Cons (e,tl) -> e | Empty -> failwith "no head" method others: 'o = match o#view with Cons (e,tl) -> tl | Empty -> failwith "no tail" end coccinelle-1.0.0-rc19/commons/glimpse.ml0000644000175000017500000001167212247437436017044 0ustar eugeneugenopen Common (*****************************************************************************) (* Types *) (*****************************************************************************) (* was first used for LFS, then a little for cocci, and then for aComment *) type glimpse_search = (* -i insensitive search *) | GlimpseCaseInsensitive (* -w match on complete words. But not always good idea, for instance * if file contain chazarain_j then don't work with -w *) | GlimpseWholeWord let default_glimpse_search = [GlimpseWholeWord] let s_of_glimpse_search = function | GlimpseCaseInsensitive -> "-i" | GlimpseWholeWord -> "-w" type glimpsedir = Common.dirname (*****************************************************************************) (* Helpers *) (*****************************************************************************) let check_have_glimpse () = let xs = Common.cmd_to_list ("glimpse -V") +> Common.exclude Common.null_string in (match xs with | ["This is glimpse version 4.18.2, 2006."] -> () | ["This is glimpse version 4.18.5, 2006."] -> () | _ -> failwith "glimpse not found or bad version" ) let s_of_glimpse_options xs = xs +> List.map s_of_glimpse_search +> Common.join " " (*****************************************************************************) (* Indexing *) (*****************************************************************************) (* * note: * - -o or -b for glimpseindex => bigger index, faster search * - no need to use -b with our way to use glimpse * cos we use -l so don't need to know what is the place of the word * in the file * - -f is for incremental indexing. Handle when files are deleted ? * I think that not that bad cos yes certainly in the index there will * have some no-more-valid pointers, but as glimpse actually then do * a real search on the file, he will see that don't exist anymore and * so using -f is slower but very very little slower * - for -z the order is important in .glimpse_filters => put * the case of compressed file first * - -F receive the list of files to index from stdin * - -H target index dir * - -n for indexing numbers as sometimes some glimpse request are looking * for a number * * * Note que glimpseindex index pas forcement tous les fichiers texte. * Si le type texte est trop petit, contient par example un seul mot, * alors il l'indexe pas. Si veut indexer quand meme, il faudrait ajouter * l'option -E * * command2 "echo '*_backup' > glimpse/.glimpse_exclude"; * command2 "echo '*_backup,v' >> glimpse/.glimpse_exclude"; * * ex: glimpseindex -o -H . home * *) let glimpse_cmd s = spf "glimpseindex -o -H %s -n -F" s let glimpseindex ext dir indexdir = check_have_glimpse (); Common.command2(spf "mkdir -p %s" indexdir); Common.command2 (spf "find %s -name \"*.%s\" | %s" dir ext (glimpse_cmd indexdir) ); () let glimpseindex_files files indexdir = check_have_glimpse (); Common.command2(spf "mkdir -p %s" indexdir); let tmpfile = Common.new_temp_file "glimpse" "list" in (* "/tmp/pad_glimpseindex_files.list" *) Common.uncat files tmpfile; Common.command2 (spf "cat %s | %s" tmpfile (glimpse_cmd indexdir)); () (*****************************************************************************) (* Searching *) (*****************************************************************************) (* note: * - -y dont ask for prompt * - -N allow far faster search as it does not actually search the file * => when pdf/ps files no filtering done of them => far faster. * the -N fait pas un grep, donc si file deteled ou modified entre temps, * bah il le voit pas. Ca veut dire aussi que si y'a pas -N, et bien * glimpse fait des grep si le fichier a ete modifié entre temps pour * toujours filer quelque chose de valide (pas de false positive, mais * y'a quand meme peut etre des miss). Est ce qu'il utilise la date du * fichier pour eviter de faire des grep inutile ? * the -N can actually return wrong result. cos a file may * contain "peter norvig" * => better to not use -N at first * * - -N also just show the filename on output * - -l show just the filename too, but the files are still searched so * at least no false positives. * - if use -z for glimpseindex, don't forget the -z too for glimpse * - -W for boolean and queries to not be done on line level but file level * * query langage: good;bad for conjunction. good,bad for disjunction. * * ex: glimpse -y -H . -N -W -w pattern;pattern2 * *) let glimpse query ?(options=default_glimpse_search) dir = let str_options = s_of_glimpse_options options in let res = Common.cmd_to_list (spf "glimpse -y -H %s -N -W %s '%s'" dir str_options query) in res (* grep -i -l -I *) let grep query = raise Todo (* check_have_position_index let glimpseindex_position: string -> ... (filename * int) list let glimpse_position: string -> ... (filename * int) list *) coccinelle-1.0.0-rc19/commons/ocollection/0000755000175000017500000000000012247437555017357 5ustar eugeneugencoccinelle-1.0.0-rc19/commons/ocollection/oassocdbm.ml0000644000175000017500000000460012247437436021661 0ustar eugeneugenopen Common open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc. * * The fv/unv are here to give the opportunity to translate the value * from the ret, before marshalling. This is useful for instance if you * want to store objects such as oset. Indeed we cannot marshall * conveniently functions/closures, and so objects (you can but you can * load them back only from the same binary, which limits the * practicallibity of the approach). You have to translate them to * traditional data structures before marshalling them, and you have * to rebuild the object from the traditional data structure when you * get them from the ret. Hence fv/unv. You can do the same for the key * with fkey/unkey, but as key are usually simple data structures, * there is less need for them, so I have commented them. *) class ['a,'b] oassocdbm xs db (*fkey unkey*) fv unv = object(o) inherit ['a,'b] oassoc val db = db method empty = raise Todo method add (k,v) = (* pr2 (fkey k); *) (* pr2 (debugv v); *) (* try Db.del data None (Marshal.to_string k []) [] with Not_found -> ()); *) let k' = Common.marshal__to_string k [] in let v' = (Common.marshal__to_string (fv v) [(*Common.marshal__Closures*)]) in (try Dbm.add db k' v' with _ -> Dbm.replace db k' v' ); o method iter f = db +> Dbm.iter (fun key data -> let k' = (* unkey *) Common.marshal__from_string key 0 in let v' = unv (Common.marshal__from_string data 0) in f (k', v') ) method view = raise Todo method del (k,v) = raise Todo method mem e = raise Todo method null = raise Todo method assoc k = let k' = Common.marshal__to_string k [] in unv (Common.marshal__from_string (Dbm.find db k') 0) method delkey k = let k' = Common.marshal__to_string k [] in try Dbm.remove db k'; o with Dbm.Dbm_error "dbm_delete" -> raise Not_found method keys = let res = ref [] in db +> Dbm.iter (fun key data -> let k' = (* unkey *) Common.marshal__from_string key 0 in (* let v' = unv (Common.marshal__from_string data 0) in f (k', v') *) Common.push2 k' res; ); !res end let create_dbm metapath dbname = let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in let assoc = new oassocdbm [] x_db id id in x_db, assoc coccinelle-1.0.0-rc19/commons/ocollection/ograph2way.ml0000644000175000017500000000526012247437436021775 0ustar eugeneugenopen Common open Ocollection open Oset open Ograph open Osetb (* graph2way prend en parametre le type de finitemap et set a prendre * todo? add_arc doit ramer, car del la key, puis add => * better to have a ref to a set * todo: efficient graph: with pointers and a tag: visited * => need keep global value visited_counter * check(that node is in, ...), display * * pourrait remettre val nods, a la place de les calculer. mais bon * s'en sert pas vraiment car y'a pas de notion d'identifiant de noeud * et de label. * * invariant: key in pred is also in succ (completness) and value in * either table is a key also *) class ['a] ograph2way asucc apred (*f1*) f2 = object(o) inherit ['a] ograph val succ = asucc (* f1() ## new oassocb [] *) val pred = apred (* f1() ## new oassocb [] *) (* val nods = anodes ##f2() ## new osetb [] *) method empty = raise Todo (*{< succ = f1() ;(* new oassocb []; *) pred = f1(); (* new oassocb []; *) (* nods = f2(); ##new osetb []; *) >}*) method add_node e = {< (* nods = nods#add e; *) pred = pred#add (e, f2() );(* new osetb []); *) succ = succ#add (e, f2() );(* new osetb []); *) >} method del_node e = {< (* nods = nods#del e; *) pred = pred#delkey e; succ = succ#delkey e; >} method add_arc (a,b) = {< succ = succ#replkey (a, (succ#find a)#add b); pred = pred#replkey (b, (pred#find b)#add a); >} method del_arc (a,b) = {< succ = succ#replkey (a, (succ#find a)#del b); pred = pred#replkey (b, (pred#find b)#del a); >} method successors e = succ#find e method predecessors e = pred#find e method nodes = (* nods *) (* could take pred, same *) (* caml typing sux, arrive pas a faire: pred#fold (fun a (k,v) -> a#add k) (new osetb Setb.empty) *) let a = ref (new osetb Setb.empty) in succ#iter (fun (k,v) -> a := !a#add k); !a method ancestors xs = let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#predecessors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) method children xs = let rec aux xs acc = match xs#view with (* could be done with an iter *) | Empty -> acc | Cons(x, xs) -> (acc#add x) +> (fun newacc -> aux (o#successors x) newacc) +> (fun newacc -> aux xs newacc) in aux xs (f2()) (* (new osetb []) *) method brothers x = let parents = o#predecessors x in (parents#fold (fun acc e -> acc $++$ o#successors e) (f2()))#del x end coccinelle-1.0.0-rc19/commons/ocollection/oassoc_buffer.mli0000644000175000017500000000155612247437436022707 0ustar eugeneugen(* !!take care!!: this classe have side effect, not a pure oassoc *) class ['a, 'b] oassoc_buffer : int -> (< add : 'a * 'b -> 'd; assoc : 'a -> 'b; del : 'a * 'b -> 'd; delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; keys: 'a list; clear: unit; .. > as 'd) -> object ('o) inherit ['a,'b] Oassoc.oassoc (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : 'a * 'b -> 'o method iter : ('a * 'b -> unit) -> unit method view : ('a * 'b, 'o) Ocollection.view method del : 'a * 'b -> 'o method mem : 'a * 'b -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : 'a -> 'b method delkey : 'a -> 'o method keys: 'a list (* ugly, from objet class, extension trick *) method private myflush : unit method misc_op_hook2 : unit end coccinelle-1.0.0-rc19/commons/ocollection/oassocbdb_string.ml0000644000175000017500000000771112247437436023242 0ustar eugeneugenopen Common (* specialisation of oassocbdb that avoids some marshaling cost *) open Bdb open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc *) class ['b] oassoc_btree_string db namedb transact = let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in object(o) inherit [string,'b] oassoc val data = db method empty = raise Todo method private addbis (k,v) = let k' = k in let v' = try Common.marshal__to_string v [] with Out_of_memory -> pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb); raise Out_of_memory in (* still clos? *) Db.put data (transact()) k' v' []; o method add x = Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x) (* bugfix: if not tail call (because of a try for instance), * then strange behaviour in native mode *) method private iter2 f = let dbc = Cursor.db_cursor db (transact()) [] in (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *) let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) let key = (fst a) in let valu = (Common.marshal__from_string (snd a) 0) in f (key, valu); true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *) method iter x = Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x) method view = raise Todo method private length2 = let dbc = Cursor.db_cursor db (transact()) [] in let count = ref 0 in let rec aux dbc = if ( try let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in incr count; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc; !count method length = Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2) method del (k,v) = raise Todo method mem e = raise Todo method null = raise Todo method private assoc2 k = try let k' = k in let vget = Db.get data (transact()) k' [] in (* minsky ? Db.get data ~txn:(transact() *) (Common.marshal__from_string vget 0) with Not_found -> log3 ("pb assoc with k = " ^ (k)); raise Not_found method assoc x = Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x) method private delkey2 k = let k' = k in Db.del data (transact()) k' []; o method delkey x = Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x) method keys = let res = ref [] in let dbc = Cursor.db_cursor db (transact()) [] in let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) let key = (fst a) in (* let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); *) Common.push2 key res; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); !res method clear = let dbc = Cursor.db_cursor db (transact()) [] in let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in Db.del data (transact()) (fst a) []; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); () end let create_bdb metapath dbname env transact size_buffer_oassoc_buffer = let db = Bdb.Db.create env [] in Bdb.Db.db_open db (transact()) (spf "%s/%s.db4" metapath dbname) (spf "/%s.db4" dbname) Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0; db, new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer (new oassoc_btree_string db dbname transact) coccinelle-1.0.0-rc19/commons/ocollection/oseti.ml0000644000175000017500000000173412247437436021037 0ustar eugeneugenopen Ocollection open Oset class ['a] oseti xs = object(o) inherit [int] oset val data = xs (* Seti.empty *) method toseti = data method toset = Obj.magic data method empty = {< data = Seti.empty >} method add e = {< data = Seti.add e data >} method iter f = Seti.iter f data method view = if Seti.is_empty data then Empty else let el = Seti.choose data in Cons (el, o#del el) method del e = {< data = Seti.remove e data >} method mem e = Seti.mem e data method null = Seti.is_empty data method tolist = Seti.elements data method length = Seti.cardinal data method union s = {< data = Seti.union data s#toseti >} method inter s = {< data = Seti.inter data s#toseti >} method minus s = {< data = Seti.diff data s#toseti >} method invariant () = Seti.invariant data method to_string () = Seti.string_of_seti data method misc_op_hook () = {< data = Seti.patch3 data >} end coccinelle-1.0.0-rc19/commons/ocollection/osetb.ml0000644000175000017500000000166012247437436021026 0ustar eugeneugenopen Ocollection open Oset let empty = Setb.empty class ['a] osetb xs = object(o) inherit ['a] oset val data = xs (* Setb.empty *) method tosetb = data (* if put [] then no segfault, if [11] then segfault *) method toset = Obj.magic data method empty = {< data = Setb.empty >} method add e = {< data = Setb.add e data >} method iter f = Setb.iter f data method view = if Setb.is_empty data then Empty else let el = Setb.choose data in Cons (el, o#del el) method del e = {< data = Setb.remove e data >} method mem e = Setb.mem e data method null = Setb.is_empty data method tolist = Setb.elements data method length = Setb.cardinal data method union s = {< data = Setb.union data s#tosetb >} method inter s = {< data = Setb.inter data s#tosetb >} method minus s = {< data = Setb.diff data s#tosetb >} (* todo: include, ... *) end coccinelle-1.0.0-rc19/commons/ocollection/osetpt.ml0000644000175000017500000000160512247437436021227 0ustar eugeneugenopen Ocollection open Oset class ['a] osetpt xs = object(o) inherit [int] oset val data = SetPt.empty method tosetpt = data (* if put [] then no segfault, if [11] then segfault *) method toset = Obj.magic data method empty = {< data = SetPt.empty >} method add e = {< data = SetPt.add e data >} method iter f = SetPt.iter f data method view = if SetPt.is_empty data then Empty else let el = SetPt.choose data in Cons (el, o#del el) method del e = {< data = SetPt.remove e data >} method mem e = SetPt.mem e data method null = SetPt.is_empty data method tolist = SetPt.elements data method length = SetPt.cardinal data method union s = {< data = SetPt.union data s#tosetpt >} method inter s = {< data = SetPt.inter data s#tosetpt >} method minus s = {< data = SetPt.diff data s#tosetpt >} end coccinelle-1.0.0-rc19/commons/ocollection/oseth.ml0000644000175000017500000000253412247437436021035 0ustar eugeneugenopen Common open Oset (* !!take care!!: this class does side effect, not a pure oassoc *) class ['a] oseth xs = object(o) inherit ['a] oset val data = Hashtbl.create 100 (* if put [] then no segfault, if [11] then segfault *) method toset = Obj.magic data method empty = {< data = Hashtbl.create 100 >} method add k = Hashtbl.add data k true; o method iter f = Hashtbl.iter (fun k v -> f k) data method view = raise Todo method del k = Hashtbl.remove data k; o method mem k = try (ignore(Hashtbl.find data k); true) with Not_found -> false method null = try (Hashtbl.iter (fun k v -> raise ReturnExn) data; false) with ReturnExn -> true (* TODO method length *) method union s = let v = Hashtbl.create 100 in o#iter (fun k -> Hashtbl.add v k true); s#iter (fun k -> Hashtbl.add v k true); {< data = v >} method inter s = let v = Hashtbl.create 100 in o#iter (fun k -> if s#mem k then Hashtbl.add v k true); {< data = v >} method minus s = let v = Hashtbl.create 100 in o#iter (fun k -> if not(s#mem k) then Hashtbl.add v k true); {< data = v >} (* override default *) method getone = let x = ref None in try ( Hashtbl.iter (fun k _ -> x := Some k; raise ReturnExn) data; raise Not_found ) with ReturnExn -> some !x end coccinelle-1.0.0-rc19/commons/ocollection/oassocbdb.mli0000644000175000017500000000234512247437436022023 0ustar eugeneugen(* !!take care!!: this class does side effect, not a pure oassoc. * * Also can not put structure with ref or mutable field because when * you will modify those refs or fields, you will modify it in the memory, * not in the disk. The only way to modify on the disk is to call * #add or #replace with what you modified. Oassocbdb has no way * to know that you modified it. *) class ['a,'b] oassoc_btree : Bdb.db -> string (* db name, for profiling *) -> (unit -> Bdb.dbtxn option) (* transaction handler *) -> ('b -> 'e) -> ('e -> 'b) (* marshaller/unmarshaller wrappers *) -> object('o) inherit ['a,'b] Oassoc.oassoc (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : 'a * 'b -> 'o method iter : ('a * 'b -> unit) -> unit method view : ('a * 'b, 'o) Ocollection.view method del : 'a * 'b -> 'o method mem : 'a * 'b -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : 'a -> 'b method delkey : 'a -> 'o method keys: 'a list end val create_bdb: string -> string -> Bdb.dbenv -> (unit -> Bdb.dbtxn option) -> ('a -> 'b) * ('c -> 'a) -> int -> Bdb.db * ('d, 'a) Oassoc_buffer.oassoc_buffer coccinelle-1.0.0-rc19/commons/ocollection/ograph2way.mli0000644000175000017500000000161012247437436022141 0ustar eugeneugen class ['a] ograph2way : (< add : 'a * 'a Oset.oset -> 'c; delkey : 'a -> 'c; find : 'a -> 'a Oset.oset; iter : ('a * 'd -> unit) -> 'e; replkey : 'a * 'a Oset.oset -> 'c; .. > as 'c) -> (< add : 'a * 'a Oset.oset -> 'f; delkey : 'a -> 'f; find : 'a -> 'a Oset.oset; replkey : 'a * 'a Oset.oset -> 'f; .. > as 'f) -> (unit -> 'a Oset.oset) -> object ('o) inherit ['a] Ograph.ograph val pred : 'f val succ : 'c (* ograph concrete instantiation of virtual methods *) method empty : 'o method add_node : 'a -> 'o method del_node : 'a -> 'o method add_arc : 'a * 'a -> 'o method del_arc : 'a * 'a -> 'o method nodes : 'a Oset.oset method predecessors : 'a -> 'a Oset.oset method successors : 'a -> 'a Oset.oset method ancestors : 'a Oset.oset -> 'a Oset.oset method brothers : 'a -> 'a Oset.oset method children : 'a Oset.oset -> 'a Oset.oset end coccinelle-1.0.0-rc19/commons/ocollection/oassocbdb.ml0000644000175000017500000001131112247437436021643 0ustar eugeneugenopen Common open Bdb open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc * * The fv/unv are to give the opportunity to translate the value from * the dbm, before marshalling. Cf oassocdbm.mli for more about this. * * Quite similar to oassocdbm.ml. New: Take transact argument. * * How to optimize when using this oassoc is slow ? * - use oassoc_buffer as a front-end of this oassoc * - reduce the size of the key or value *) class ['a,'b] oassoc_btree db namedb transact (*fkey unkey*) fv unv = let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in object(o) inherit ['a,'b] oassoc val data = db method empty = raise Todo method private addbis (k,v) = (* pr2 (fkey k); *) (* pr2 (debugv v); *) (* try Db.del data None (Marshal.to_string k []) [] with Not_found -> ()); *) let k' = Common.marshal__to_string k [] in let v' = try Common.marshal__to_string (fv v) [(*Marshal.Closures*)] with Out_of_memory -> pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb); raise Out_of_memory in (* still clos? *) Db.put data (transact()) k' v' []; (* minsky wrapper ? Db.put data ~txn:(transact()) ~key:k' ~data:v' *) o method add x = Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x) (* bugfix: if not tail call (because of a try for instance), * then strange behaviour in native mode *) method private iter2 f = let dbc = Cursor.db_cursor db (transact()) [] in (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *) let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) let key = (* unkey *) Common.marshal__from_string (fst a) 0 in let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *) method iter x = Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x) method view = raise Todo method private length2 = let dbc = Cursor.db_cursor db (transact()) [] in let count = ref 0 in let rec aux dbc = if ( try let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in incr count; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc; !count method length = Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2) method del (k,v) = raise Todo method mem e = raise Todo method null = raise Todo method private assoc2 k = try let k' = Common.marshal__to_string k [] in let vget = Db.get data (transact()) k' [] in (* minsky ? Db.get data ~txn:(transact() *) unv (Common.marshal__from_string vget 0) with Not_found -> log3 ("pb assoc with k = " ^ (Dumper.dump k)); raise Not_found method assoc x = Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x) method private delkey2 k = let k' = Common.marshal__to_string k [] in Db.del data (transact()) k' []; o method delkey x = Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x) method keys = let res = ref [] in let dbc = Cursor.db_cursor db (transact()) [] in let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in (* minsky ? Cursor.get dbc Cursor.NEXT [] *) let key = (* unkey *) Common.marshal__from_string (fst a) 0 in (* let valu = unv (Common.marshal__from_string (snd a) 0) in f (key, valu); *) Common.push2 key res; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); !res method clear = let dbc = Cursor.db_cursor db (transact()) [] in let rec aux dbc = if (try let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in Db.del data (transact()) (fst a) []; true with Failure "ending" -> false ) then aux dbc else () in aux dbc; Cursor.dbc_close dbc (* minsky Cursor.close dbc *); () end let create_bdb metapath dbname env transact (fv, unv) size_buffer_oassoc_buffer = let db = Bdb.Db.create env [] in Bdb.Db.db_open db (transact()) (spf "%s/%s.db4" metapath dbname) (spf "/%s.db4" dbname) Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0; db, new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer (new oassoc_btree db dbname transact fv unv) coccinelle-1.0.0-rc19/commons/ocollection/oassoch.ml0000644000175000017500000000206712247437436021353 0ustar eugeneugenopen Common open Oassoc (* !!take care!!: this class does side effect, not a pure oassoc *) class ['a,'b] oassoch xs = let h = Common.hash_of_list xs in object(o) inherit ['a,'b] oassoc val data = h method empty = {< data = Hashtbl.create 101 >} method add (k,v) = (Hashtbl.replace data k v; o) (* not add cos add make iter sux *) (* redefine replkey to be more efficient than default. With hash, don't need to delkey before add, replace do both action directly. *) method replkey (k,v) = (Hashtbl.replace data k v; o) method iter f = Hashtbl.iter (curry f) data method view = raise Todo method del (k,v) = (Hashtbl.remove data k; o) method mem e = raise Todo method null = (try (Hashtbl.iter (fun k v -> raise ReturnExn) data; false) with ReturnExn -> true) method assoc k = try Hashtbl.find data k with Not_found -> (log3 ("pb assoc with k = " ^ (Dumper.dump k)); raise Not_found) method delkey k = (Hashtbl.remove data k; o) method keys = List.map fst (o#tolist) end coccinelle-1.0.0-rc19/commons/ocollection/oassocdbm.mli0000644000175000017500000000126212247437436022033 0ustar eugeneugen(* !!take care!!: this class does side effect, not a pure oassoc *) class ['a, 'b] oassocdbm : 'd -> Dbm.t -> ('b -> 'e) -> ('e -> 'b) -> object ('o) inherit ['a,'b] Oassoc.oassoc (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : 'a * 'b -> 'o method iter : ('a * 'b -> unit) -> unit method view : ('a * 'b, 'o) Ocollection.view method del : 'a * 'b -> 'o method mem : 'a * 'b -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : 'a -> 'b method delkey : 'a -> 'o method keys: 'a list end val create_dbm : Common.filename -> string -> Dbm.t * ('a, 'b) oassocdbm coccinelle-1.0.0-rc19/commons/ocollection/oassocid.ml0000644000175000017500000000070012247437436021510 0ustar eugeneugenopen Common open Oassoc (* just a class that behave as fun x -> x *) class ['a] oassoc_id xs = object(o) inherit ['a,'a] oassoc method empty = {< >} method add (k,v) = {< >} method iter f = raise Todo method view = raise Todo method del (k,v) = {< >} method mem e = raise Todo method null = raise Todo method assoc k = k method delkey k = {< >} method keys = List.map fst (o#tolist) end coccinelle-1.0.0-rc19/commons/ocollection/oassoc_cache.mli0000644000175000017500000000155612247437436022501 0ustar eugeneugen(* !!take care!!: this classe have side effect, not a pure oassoc *) class ['a, 'b] oassoc_buffer : int -> (< add : 'a * 'b -> 'd; assoc : 'a -> 'b; del : 'a * 'b -> 'd; delkey : 'a -> 'd; iter : ('a * 'b -> unit) -> unit; length : int; keys: 'a list; clear: unit; .. > as 'd) -> object ('o) inherit ['a,'b] Oassoc.oassoc (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : 'a * 'b -> 'o method iter : ('a * 'b -> unit) -> unit method view : ('a * 'b, 'o) Ocollection.view method del : 'a * 'b -> 'o method mem : 'a * 'b -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : 'a -> 'b method delkey : 'a -> 'o method keys: 'a list (* ugly, from objet class, extension trick *) method private myflush : unit method misc_op_hook2 : unit end coccinelle-1.0.0-rc19/commons/ocollection/oassoc_buffer.ml0000644000175000017500000000733012247437436022532 0ustar eugeneugenopen Common open Oassoc open Oassocb open Osetb (* Take care that must often redefine all function in the original * oassoc.ml because if some methods are not redefined, for instance * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm * redefine #clear, it will not be called, but instead the default * method will be called that internally will call another method. * So better delegate all the methods and override even the method * with a default definition. * * In the same way sometimes an exn can occur at weird time. When * we add an element, sometimes this may raise an exn such as Out_of_memory, * but as we don't add directly but only at flush time, the exn * may happen far later the user added something in this oassoc. * Also in the case of Out_of_memory, even if the entry is not * added in the wrapped, it will still be present in the cache * and so the next flush will still generate an exn that again * may not be cached. So for the moment if Out_of_memory then * do something special and erase the entry in the cache. * * Cf also oassoc_cache.ml which can be even more efficient. *) (* !!take care!!: this class has side effect, not a pure oassoc *) (* can not make it pure, cos the assoc have side effect on the cache *) class ['a,'b] oassoc_buffer max cached = object(o) inherit ['a,'b] oassoc val counter = ref 0 val cache = ref (new oassocb []) val dirty = ref (new osetb Setb.empty) val wrapped = ref cached method private myflush = let has_a_raised = ref false in !dirty#iter (fun k -> try wrapped := !wrapped#add (k, !cache#assoc k) with Out_of_memory -> pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache"; has_a_raised := true; ); dirty := (new osetb Setb.empty); cache := (new oassocb []); counter := 0; if !has_a_raised then raise Out_of_memory method misc_op_hook2 = o#myflush method empty = raise Todo (* what happens in k is already present ? or if add multiple times * the same k ? cache is a oassocb and so the previous binding is * still there, but dirty is a set, and in myflush we iter based * on dirty so we will flush only the last 'k' in the cache. *) method add (k,v) = cache := !cache#add (k,v); dirty := !dirty#add k; incr counter; if !counter > max then o#myflush; o method iter f = o#myflush; (* bugfix: have to flush !!! *) !wrapped#iter f method keys = o#myflush; (* bugfix: have to flush !!! *) !wrapped#keys method clear = o#myflush; (* bugfix: have to flush !!! *) !wrapped#clear method length = o#myflush; !wrapped#length method view = raise Todo method del (k,v) = cache := !cache#del (k,v); (* TODO as for delkey, do a try over wrapped *) wrapped := !wrapped#del (k,v); dirty := !dirty#del k; o method mem e = raise Todo method null = raise Todo method assoc k = try !cache#assoc k with Not_found -> (* may launch Not_found, but this time, don't catch it *) let v = !wrapped#assoc k in begin cache := !cache#add (k,v); (* otherwise can use too much mem *) incr counter; if !counter > max then o#myflush; v end method delkey k = cache := !cache#delkey k; (* sometimes have not yet flushed, so may not be yet in, (could * also flush in place of doing try). * * TODO would be better to see if was in cache (in case mean that * perhaps not flushed and do try and in other case just cos del * (without try) cos forcement flushed ou was an error *) begin try wrapped := !wrapped#delkey k with Not_found -> () end; dirty := !dirty#del k; o end coccinelle-1.0.0-rc19/commons/ocollection/oassocbdb_string.mli0000644000175000017500000000225512247437436023411 0ustar eugeneugen(* !!take care!!: this class does side effect, not a pure oassoc. * * Also can not put structure with ref or mutable field because when * you will modify those refs or fields, you will modify it in the memory, * not in the disk. The only way to modify on the disk is to call * #add or #replace with what you modified. Oassocbdb has no way * to know that you modified it. *) class ['b] oassoc_btree_string : Bdb.db -> string (* db name, for profiling *) -> (unit -> Bdb.dbtxn option) (* transaction handler *) -> object('o) inherit [string,'b] Oassoc.oassoc (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : string * 'b -> 'o method iter : (string * 'b -> unit) -> unit method view : (string * 'b, 'o) Ocollection.view method del : string * 'b -> 'o method mem : string * 'b -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : string -> 'b method delkey : string -> 'o method keys: string list end val create_bdb: string -> string -> Bdb.dbenv -> (unit -> Bdb.dbtxn option) -> int -> Bdb.db * (string, 'a) Oassoc_buffer.oassoc_buffer coccinelle-1.0.0-rc19/commons/ocollection/oassoc_cache.ml0000644000175000017500000001122012247437436022315 0ustar eugeneugenopen Common open Oassoc open Oassocb open Osetb (* todo: gather stat of use per key, so when flush, try keep * entries that are used above a certain threshold, and if after * this step, there is still too much, then erase also those keys. * * todo: limit number of entries, and erase all (then better do a ltu) * * todo: another cache that behave as in lfs1, * every 100 operation do a flush * * todo: choose between oassocb and oassoch ? * * Also take care that must often redefine all function in the original * oassoc.ml because if some methods are not redefined, for instance * #clear, then if do wrapper over a oassocdbm, then even if oassocdbm * redefine #clear, it will not be called, but instead the default * method will be called that internally will call another method. * So better delegate all the methods and override even the method * with a default definition. * * In the same way sometimes an exn can occur at weird time. When * we add an element, sometimes this may raise an exn such as Out_of_memory, * but as we don't add directly but only at flush time, the exn * may happen far later the user added something in this oassoc. * Also in the case of Out_of_memory, even if the entry is not * added in the wrapped, it will still be present in the cache * and so the next flush will still generate an exn that again * may not be cached. So for the moment if Out_of_memory then * do something special and erase the entry in the cache. *) (* !!take care!!: this class has side effect, not a pure oassoc *) (* can not make it pure, cos the assoc have side effect on the cache *) class ['a,'b] oassoc_buffer max cached = object(o) inherit ['a,'b] oassoc val counter = ref 0 val cache = ref (new oassocb []) val dirty = ref (new osetb Setb.empty) val wrapped = ref cached method private myflush = let has_a_raised = ref false in !dirty#iter (fun k -> try wrapped := !wrapped#add (k, !cache#assoc k) with Out_of_memory -> pr2 "PBBBBBB: Out_of_memory in oassoc_buffer, but still empty cache"; has_a_raised := true; ); dirty := (new osetb Setb.empty); cache := (new oassocb []); counter := 0; if !has_a_raised then raise Out_of_memory method misc_op_hook2 = o#myflush method empty = raise Todo (* what happens in k is already present ? or if add multiple times * the same k ? cache is a oassocb and so the previous binding is * still there, but dirty is a set, and in myflush we iter based * on dirty so we will flush only the last 'k' in the cache. *) method add (k,v) = cache := !cache#add (k,v); dirty := !dirty#add k; incr counter; if !counter > max then o#myflush; o method iter f = o#myflush; (* bugfix: have to flush !!! *) !wrapped#iter f method keys = o#myflush; (* bugfix: have to flush !!! *) !wrapped#keys method clear = o#myflush; (* bugfix: have to flush !!! *) !wrapped#clear method length = o#myflush; !wrapped#length method view = raise Todo method del (k,v) = cache := !cache#del (k,v); (* TODO as for delkey, do a try over wrapped *) wrapped := !wrapped#del (k,v); dirty := !dirty#del k; o method mem e = raise Todo method null = raise Todo method assoc k = try !cache#assoc k with Not_found -> (* may launch Not_found, but this time, don't catch it *) let v = !wrapped#assoc k in begin cache := !cache#add (k,v); (* otherwise can use too much mem *) incr counter; if !counter > max then o#myflush; v end method delkey k = cache := !cache#delkey k; (* sometimes have not yet flushed, so may not be yet in, (could * also flush in place of doing try). * * TODO would be better to see if was in cache (in case mean that * perhaps not flushed and do try and in other case just cos del * (without try) cos forcement flushed ou was an error *) begin try wrapped := !wrapped#delkey k with Not_found -> () end; dirty := !dirty#del k; o end (* class ['a,'b] oassoc_cache cache cached max = object(o) inherit ['a,'b] oassoc val full = ref 0 val max = max val cache = cache val cached = cached val lru = TODO val data = Hashtbl.create 100 method empty = raise Todo method add (k,v) = (Hashtbl.add data k v; o) method iter f = cached#iter f method view = raise Todo method del (k,v) = (cache#del (k,v); cached#del (k,v); o) method mem e = raise Todo method null = raise Todo method assoc k = Hashtbl.find data k method delkey k = (cache#delkey (k,v); cached#del (k,v); o) end *) coccinelle-1.0.0-rc19/commons/ocollection/oassocb.ml0000644000175000017500000000120112247437436021332 0ustar eugeneugenopen Common open Oassoc class ['a,'b] oassocb xs = object(o) inherit ['a,'b] oassoc val data = Mapb.empty method empty = {< data = Mapb.empty >} method add (k,v) = {< data = Mapb.add k v data >} method replkey (k,v) = {< data = Mapb.add k v (Mapb.remove k data) >} method iter f = Mapb.iter (curry f) data method view = raise Todo method del (k,v) = {< data = Mapb.remove k data >} method mem e = raise Todo method null = (Mapb.height data =|= 0) method assoc k = Mapb.find k data method delkey k = {< data = Mapb.remove k data >} method keys = List.map fst (o#tolist) end coccinelle-1.0.0-rc19/commons/backtrace_c.c0000644000175000017500000000032512247437436017430 0ustar eugeneugen#include "caml/mlvalues.h" CAMLextern void caml_print_exception_backtrace(void); CAMLprim value print_exception_backtrace_stub(value /*__unused*/ unit) { caml_print_exception_backtrace(); return Val_unit; } coccinelle-1.0.0-rc19/commons/common.ml0000644000175000017500000051570512247437436016702 0ustar eugeneugen(* Yoann Padioleau * * Copyright (C) 2010 INRIA, University of Copenhagen DIKU * Copyright (C) 1998-2009 Yoann Padioleau * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License * version 2.1 as published by the Free Software Foundation, with the * special exception on linking described in file license.txt. * * This library is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file * license.txt for more details. *) (*****************************************************************************) (* Notes *) (*****************************************************************************) (* ---------------------------------------------------------------------- *) (* Maybe could split common.ml and use include tricks as in ofullcommon.ml or * Jane Street core lib. But then harder to bundle simple scripts like my * make_full_linux_kernel.ml because would then need to pass all the files * either to ocamlc or either to some #load. Also as the code of many * functions depends on other functions from this common, it would * be tedious to add those dependencies. Here simpler (have just the * pb of the Prelude, but it's a small problem). * * pixel means code from Pascal Rigaux * julia means code from Julia Lawall *) (* ---------------------------------------------------------------------- *) (*****************************************************************************) (* We use *) (*****************************************************************************) (* * modules: * - Pervasives, of course * - List * - Str * - Hashtbl * - Format * - Buffer * - Unix and Sys * - Arg * * functions: * - =, <=, max min, abs, ... * - List.rev, List.mem, List.partition, * - List.fold*, List.concat, ... * - Str.global_replace * - Filename.is_relative * - String.uppercase, String.lowercase * * * The Format library allows to hide passing an indent_level variable. * You use as usual the print_string function except that there is * this automatic indent_level variable handled for you (and maybe * more services). src: julia in coccinelle unparse_cocci. * * Extra packages * - ocamlbdb * - ocamlgtk, and gtksourceview * - ocamlgl * - ocamlpython * - ocamlagrep * - ocamlfuse * - ocamlmpi * - ocamlcalendar * * - pcre * - sdl * * Many functions in this file were inspired by Haskell or Lisp librairies. *) (*****************************************************************************) (* Prelude *) (*****************************************************************************) (* The following functions should be in their respective sections but * because some functions in some sections use functions in other * sections, and because I don't want to take care of the order of * those sections, of those dependencies, I put the functions causing * dependency problem here. C is better than caml on this with the * ability to declare prototype, enabling some form of forward * reference. *) let (+>) o f = f o let (++) = (@) exception Timeout exception UnixExit of int let rec (do_n: int -> (unit -> unit) -> unit) = fun i f -> if i = 0 then () else (f(); do_n (i-1) f) let rec (foldn: ('a -> int -> 'a) -> 'a -> int -> 'a) = fun f acc i -> if i = 0 then acc else foldn f (f acc i) (i-1) let sum_int = List.fold_left (+) 0 (* could really call it 'for' :) *) let fold_left_with_index f acc = let rec fold_lwi_aux acc n = function | [] -> acc | x::xs -> fold_lwi_aux (f acc x n) (n+1) xs in fold_lwi_aux acc 0 let rec drop n xs = match (n,xs) with | (0,_) -> xs | (_,[]) -> failwith "drop: not enough" | (n,x::xs) -> drop (n-1) xs let rec enum_orig x n = if x = n then [n] else x::enum_orig (x+1) n let enum x n = if not(x <= n) then failwith (Printf.sprintf "bad values in enum, expect %d <= %d" x n); let rec enum_aux acc x n = if x = n then n::acc else enum_aux (x::acc) (x+1) n in List.rev (enum_aux [] x n) let rec take n xs = match (n,xs) with | (0,_) -> [] | (_,[]) -> failwith "take: not enough" | (n,x::xs) -> x::take (n-1) xs let last_n n l = List.rev (take n (List.rev l)) let last l = List.hd (last_n 1 l) let (list_of_string: string -> char list) = function "" -> [] | s -> (enum 0 ((String.length s) - 1) +> List.map (String.get s)) let (lines: string -> string list) = fun s -> let rec lines_aux = function | [] -> [] | [x] -> if x = "" then [] else [x] | x::xs -> x::lines_aux xs in Str.split_delim (Str.regexp "\n") s +> lines_aux let push2 v l = l := v :: !l let null xs = match xs with [] -> true | _ -> false let debugger = ref false let unwind_protect f cleanup = if !debugger then f() else try f () with e -> begin cleanup e; raise e end let finalize f cleanup = if !debugger then f() else try let res = f () in cleanup (); res with e -> cleanup (); raise e let command2 s = ignore(Sys.command s) let (matched: int -> string -> string) = fun i s -> Str.matched_group i s let matched1 = fun s -> matched 1 s let matched2 = fun s -> (matched 1 s, matched 2 s) let matched3 = fun s -> (matched 1 s, matched 2 s, matched 3 s) let matched4 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s) let matched5 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s, matched 5 s) let matched6 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s, matched 5 s, matched 6 s) let matched7 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s, matched 5 s, matched 6 s, matched 7 s) let (with_open_stringbuf: (((string -> unit) * Buffer.t) -> unit) -> string) = fun f -> let buf = Buffer.create 1000 in let pr s = Buffer.add_string buf (s ^ "\n") in f (pr, buf); Buffer.contents buf let foldl1 p = function x::xs -> List.fold_left p x xs | _ -> failwith "foldl1" (*****************************************************************************) (* Debugging/logging *) (*****************************************************************************) (* I used this in coccinelle where the huge logging of stuff ask for * a more organized solution that use more visual indentation hints. * * todo? could maybe use log4j instead ? or use Format module more * consistently ? *) let _tab_level_print = ref 0 let _tab_indent = 5 let _prefix_pr = ref "" let indent_do f = _tab_level_print := !_tab_level_print + _tab_indent; finalize f (fun () -> _tab_level_print := !_tab_level_print - _tab_indent;) let pr s = print_string !_prefix_pr; do_n !_tab_level_print (fun () -> print_string " "); print_string s; print_string "\n"; flush stdout let pr_no_nl s = print_string !_prefix_pr; do_n !_tab_level_print (fun () -> print_string " "); print_string s; flush stdout let _chan_pr2 = ref (None: out_channel option) let out_chan_pr2 ?(newline=true) s = match !_chan_pr2 with | None -> () | Some chan -> output_string chan (s ^ (if newline then "\n" else "")); flush chan let print_to_stderr = ref true let pr2 s = if !print_to_stderr then begin prerr_string !_prefix_pr; do_n !_tab_level_print (fun () -> prerr_string " "); prerr_string s; prerr_string "\n"; flush stderr; out_chan_pr2 s; () end let pr2_no_nl s = if !print_to_stderr then begin prerr_string !_prefix_pr; do_n !_tab_level_print (fun () -> prerr_string " "); prerr_string s; flush stderr; out_chan_pr2 ~newline:false s; () end let pr_xxxxxxxxxxxxxxxxx () = pr "-----------------------------------------------------------------------" let pr2_xxxxxxxxxxxxxxxxx () = pr2 "-----------------------------------------------------------------------" let reset_pr_indent () = _tab_level_print := 0 (* old: * let pr s = (print_string s; print_string "\n"; flush stdout) * let pr2 s = (prerr_string s; prerr_string "\n"; flush stderr) *) (* ---------------------------------------------------------------------- *) (* I can not use the _xxx ref tech that I use for common_extra.ml here because * ocaml don't like the polymorphism of Dumper mixed with refs. * * let (_dump_func : ('a -> string) ref) = ref * (fun x -> failwith "no dump yet, have you included common_extra.cmo?") * let (dump : 'a -> string) = fun x -> * !_dump_func x * * So I have included directly dumper.ml in common.ml. It's more practical * when want to give script that use my common.ml, I just have to give * this file. *) (* don't the code below, use the Dumper module in ocamlextra instead. (* start of dumper.ml *) (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp *) open Printf open Obj let rec dump r = if is_int r then string_of_int (magic r : int) else ( (* Block. *) let rec get_fields acc = function | 0 -> acc | n -> let n = n-1 in get_fields (field r n :: acc) n in let rec is_list r = if is_int r then ( if (magic r : int) = 0 then true (* [] *) else false ) else ( let s = size r and t = tag r in if t = 0 && s = 2 then is_list (field r 1) (* h :: t *) else false ) in let rec get_list r = if is_int r then [] else let h = field r 0 and t = get_list (field r 1) in h :: t in let opaque name = (* XXX In future, print the address of value 'r'. Not possible in * pure OCaml at the moment. *) "<" ^ name ^ ">" in let s = size r and t = tag r in (* From the tag, determine the type of block. *) if is_list r then ( (* List. *) let fields = get_list r in "[" ^ String.concat "; " (List.map dump fields) ^ "]" ) else if t = 0 then ( (* Tuple, array, record. *) let fields = get_fields [] s in "(" ^ String.concat ", " (List.map dump fields) ^ ")" ) (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not * clear if very large constructed values could have the same * tag. XXX *) else if t = lazy_tag then opaque "lazy" else if t = closure_tag then opaque "closure" else if t = object_tag then ( (* Object. *) let fields = get_fields [] s in let clasz, id, slots = match fields with h::h'::t -> h, h', t | _ -> assert false in (* No information on decoding the class (first field). So just print * out the ID and the slots. *) "Object #" ^ dump id ^ " (" ^ String.concat ", " (List.map dump slots) ^ ")" ) else if t = infix_tag then opaque "infix" else if t = forward_tag then opaque "forward" else if t < no_scan_tag then ( (* Constructed value. *) let fields = get_fields [] s in "Tag" ^ string_of_int t ^ " (" ^ String.concat ", " (List.map dump fields) ^ ")" ) else if t = string_tag then ( "\"" ^ String.escaped (magic r : string) ^ "\"" ) else if t = double_tag then ( string_of_float (magic r : float) ) else if t = abstract_tag then opaque "abstract" else if t = custom_tag then opaque "custom" else if t = final_tag then opaque "final" else failwith ("dump: impossible tag (" ^ string_of_int t ^ ")") ) let dump v = dump (repr v) (* end of dumper.ml *) *) (* let (dump : 'a -> string) = fun x -> Dumper.dump x *) (* ---------------------------------------------------------------------- *) let pr2_gen x = pr2 (Dumper.dump x) (* ---------------------------------------------------------------------- *) let _already_printed = Hashtbl.create 101 let disable_pr2_once = ref false let xxx_once f s = if !disable_pr2_once then pr2 s else if not (Hashtbl.mem _already_printed s) then begin Hashtbl.add _already_printed s true; f ("(ONCE) " ^ s); end let pr2_once s = xxx_once pr2 s let clear_pr2_once _ = Hashtbl.clear _already_printed (* ---------------------------------------------------------------------- *) let mk_pr2_wrappers aref = let fpr2 s = if !aref then pr2 s else (* just to the log file *) out_chan_pr2 s in let fpr2_once s = if !aref then pr2_once s else xxx_once out_chan_pr2 s in fpr2, fpr2_once (* ---------------------------------------------------------------------- *) (* could also be in File section *) let redirect_stdout file f = begin let chan = open_out file in let descr = Unix.descr_of_out_channel chan in let saveout = Unix.dup Unix.stdout in Unix.dup2 descr Unix.stdout; flush stdout; let res = f() in flush stdout; Unix.dup2 saveout Unix.stdout; close_out chan; res end let redirect_stdout_opt optfile f = match optfile with | None -> f() | Some outfile -> redirect_stdout outfile f let redirect_stdout_stderr file f = begin let chan = open_out file in let descr = Unix.descr_of_out_channel chan in let saveout = Unix.dup Unix.stdout in let saveerr = Unix.dup Unix.stderr in Unix.dup2 descr Unix.stdout; Unix.dup2 descr Unix.stderr; flush stdout; flush stderr; f(); flush stdout; flush stderr; Unix.dup2 saveout Unix.stdout; Unix.dup2 saveerr Unix.stderr; close_out chan; end let redirect_stdin file f = begin let chan = open_in file in let descr = Unix.descr_of_in_channel chan in let savein = Unix.dup Unix.stdin in Unix.dup2 descr Unix.stdin; let res = f() in Unix.dup2 savein Unix.stdin; close_in chan; res end let redirect_stdin_opt optfile f = match optfile with | None -> f() | Some infile -> redirect_stdin infile f (* cf end let with_pr2_to_string f = *) (* ---------------------------------------------------------------------- *) include Printf (* cf common.mli, fprintf, printf, eprintf, sprintf. * also what is this ? * val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a * val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b *) (* ex of printf: * printf "%02d" i * for padding *) let spf = sprintf (* ---------------------------------------------------------------------- *) let _chan = ref stderr let start_log_file () = let filename = (spf "/tmp/debugml%d:%d" (Unix.getuid()) (Unix.getpid())) in pr2 (spf "now using %s for logging" filename); _chan := open_out filename let dolog s = output_string !_chan (s ^ "\n"); flush !_chan let verbose_level = ref 1 let log s = if !verbose_level >= 1 then dolog s let log2 s = if !verbose_level >= 2 then dolog s let log3 s = if !verbose_level >= 3 then dolog s let log4 s = if !verbose_level >= 4 then dolog s let if_log f = if !verbose_level >= 1 then f() let if_log2 f = if !verbose_level >= 2 then f() let if_log3 f = if !verbose_level >= 3 then f() let if_log4 f = if !verbose_level >= 4 then f() (* ---------------------------------------------------------------------- *) let pause () = (pr2 "pause: type return"; ignore(read_line ())) (* src: from getopt from frish *) let bip () = Printf.printf "\007"; flush stdout let wait () = Unix.sleep 1 (* was used by fix_caml *) let _trace_var = ref 0 let add_var() = incr _trace_var let dec_var() = decr _trace_var let get_var() = !_trace_var let (print_n: int -> string -> unit) = fun i s -> do_n i (fun () -> print_string s) let (printerr_n: int -> string -> unit) = fun i s -> do_n i (fun () -> prerr_string s) let _debug = ref true let debugon () = _debug := true let debugoff () = _debug := false let debug f = if !_debug then f () else () (* now in prelude: * let debugger = ref false *) (*****************************************************************************) (* Profiling *) (*****************************************************************************) let get_mem() = command2("grep VmData /proc/" ^ string_of_int (Unix.getpid()) ^ "/status") let memory_stat () = let stat = Gc.stat() in let conv_mo x = x * 4 / 1000000 in Printf.sprintf "maximal = %d Mo\n" (conv_mo stat.Gc.top_heap_words) ^ Printf.sprintf "current = %d Mo\n" (conv_mo stat.Gc.heap_words) ^ Printf.sprintf "lives = %d Mo\n" (conv_mo stat.Gc.live_words) (* Printf.printf "fragments = %d Mo\n" (conv_mo stat.Gc.fragments); *) let timenow () = "sys:" ^ (string_of_float (Sys.time ())) ^ " seconds" ^ ":real:" ^ (let tm = Unix.time () +> Unix.gmtime in tm.Unix.tm_min +> string_of_int ^ " min:" ^ tm.Unix.tm_sec +> string_of_int ^ ".00 seconds") let _count1 = ref 0 let _count2 = ref 0 let _count3 = ref 0 let _count4 = ref 0 let _count5 = ref 0 let count1 () = incr _count1 let count2 () = incr _count2 let count3 () = incr _count3 let count4 () = incr _count4 let count5 () = incr _count5 let profile_diagnostic_basic () = Printf.sprintf "count1 = %d\ncount2 = %d\ncount3 = %d\ncount4 = %d\ncount5 = %d\n" !_count1 !_count2 !_count3 !_count4 !_count5 let time_func f = (* let _ = Timing () in *) let x = f () in (* let _ = Timing () in *) x (* ---------------------------------------------------------------------- *) type prof = PALL | PNONE | PSOME of string list let profile = ref PNONE let show_trace_profile = ref false let check_profile category = match !profile with PALL -> true | PNONE -> false | PSOME l -> List.mem category l let _profile_table = ref (Hashtbl.create 100) let adjust_profile_entry category difftime = let (xtime, xcount) = (try Hashtbl.find !_profile_table category with Not_found -> let xtime = ref 0.0 in let xcount = ref 0 in Hashtbl.add !_profile_table category (xtime, xcount); (xtime, xcount) ) in xtime := !xtime +. difftime; xcount := !xcount + 1; () let profile_start category = failwith "todo" let profile_end category = failwith "todo" (* subtil: don't forget to give all arguments to f, otherwise partial app * and will profile nothing. * * todo: try also detect when complexity augment each time, so can * detect the situation for a function gets worse and worse ? *) let profile_code category f = if not (check_profile category) then f() else begin if !show_trace_profile then pr2 (spf "p: %s" category); let t = Unix.gettimeofday () in let res, prefix = try Some (f ()), "" with Timeout -> None, "*" in let category = prefix ^ category in (* add a '*' to indicate timeout func *) let t' = Unix.gettimeofday () in adjust_profile_entry category (t' -. t); (match res with | Some res -> res | None -> raise Timeout ); end let _is_in_exclusif = ref (None: string option) let profile_code_exclusif category f = if not (check_profile category) then f() else begin match !_is_in_exclusif with | Some s -> failwith (spf "profile_code_exclusif: %s but already in %s " category s); | None -> _is_in_exclusif := (Some category); finalize (fun () -> profile_code category f ) (fun () -> _is_in_exclusif := None ) end let profile_code_inside_exclusif_ok category f = failwith "Todo" (* todo: also put % ? also add % to see if coherent numbers *) let profile_diagnostic () = if !profile = PNONE then "" else let xs = Hashtbl.fold (fun k v acc -> (k,v)::acc) !_profile_table [] +> List.sort (fun (k1, (t1,n1)) (k2, (t2,n2)) -> compare t2 t1) in with_open_stringbuf (fun (pr,_) -> pr "---------------------"; pr "profiling result"; pr "---------------------"; xs +> List.iter (fun (k, (t,n)) -> pr (sprintf "%-40s : %10.3f sec %10d count" k !t !n) ) ) let report_if_take_time timethreshold s f = let t = Unix.gettimeofday () in let res = f () in let t' = Unix.gettimeofday () in if (t' -. t > float_of_int timethreshold) then pr2 (sprintf "Note: processing took %7.1fs: %s" (t' -. t) s); res let profile_code2 category f = profile_code category (fun () -> if !profile = PALL then pr2 ("starting: " ^ category); let t = Unix.gettimeofday () in let res = f () in let t' = Unix.gettimeofday () in if !profile = PALL then pr2 (spf "ending: %s, %fs" category (t' -. t)); res ) (*****************************************************************************) (* Test *) (*****************************************************************************) let example b = assert b let _ex1 = example (enum 1 4 = [1;2;3;4]) let assert_equal a b = if not (a = b) then failwith ("assert_equal: those 2 values are not equal:\n\t" ^ (Dumper.dump a) ^ "\n\t" ^ (Dumper.dump b) ^ "\n") let (example2: string -> bool -> unit) = fun s b -> try assert b with x -> failwith s (*-------------------------------------------------------------------*) let _list_bool = ref [] let (example3: string -> bool -> unit) = fun s b -> _list_bool := (s,b)::(!_list_bool) (* could introduce a fun () otherwise the calculus is made at compile time * and this can be long. This would require to redefine test_all. * let (example3: string -> (unit -> bool) -> unit) = fun s func -> * _list_bool := (s,func):: (!_list_bool) * * I would like to do as a func that take 2 terms, and make an = over it * avoid to add this ugly fun (), but pb of type, cant do that :( *) let (test_all: unit -> unit) = fun () -> List.iter (fun (s, b) -> Printf.printf "%s: %s\n" s (if b then "passed" else "failed") ) !_list_bool let (test: string -> unit) = fun s -> Printf.printf "%s: %s\n" s (if (List.assoc s (!_list_bool)) then "passed" else "failed") let _ex = example3 "++" ([1;2]++[3;4;5] = [1;2;3;4;5]) (*-------------------------------------------------------------------*) (* Regression testing *) (*-------------------------------------------------------------------*) (* cf end of file. It uses too many other common functions so I * have put the code at the end of this file. *) (* todo? take code from julien signoles in calendar-2.0.2/tests *) (* (* Generic functions used in the tests. *) val reset : unit -> unit val nb_ok : unit -> int val nb_bug : unit -> int val test : bool -> string -> unit val test_exn : 'a Lazy.t -> string -> unit let ok_ref = ref 0 let ok () = incr ok_ref let nb_ok () = !ok_ref let bug_ref = ref 0 let bug () = incr bug_ref let nb_bug () = !bug_ref let reset () = ok_ref := 0; bug_ref := 0 let test x s = if x then ok () else begin Printf.printf "%s\n" s; bug () end;; let test_exn x s = try ignore (Lazy.force x); Printf.printf "%s\n" s; bug () with _ -> ok ();; *) (*****************************************************************************) (* Quickcheck like (sfl) *) (*****************************************************************************) (* Better than quickcheck, cos cant do a test_all_prop in haskell cos * prop were functions, whereas here we have not prop_Unix x = ... but * laws "unit" ... * * How to do without overloading ? objet ? can pass a generator as a * parameter, mais lourd, prefer automatic inferring of the * generator? But at the same time quickcheck does not do better cos * we must explictly type the property. So between a * prop_unit:: [Int] -> [Int] -> bool ... * prop_unit x = reverse [x] == [x] * and * let _ = laws "unit" (fun x -> reverse [x] = [x]) (listg intg) * there is no real differences. * * Yes I define typeg generator but quickcheck too, he must define * class instance. I emulate the context Gen a => Gen [a] by making * listg take as a param a type generator. Moreover I have not the pb of * monad. I can do random independently, so my code is more simple * I think than the haskell code of quickcheck. * * update: apparently Jane Street have copied some of my code for their * Ounit_util.ml and quichcheck.ml in their Core library :) *) (*---------------------------------------------------------------------------*) (* generators *) (*---------------------------------------------------------------------------*) type 'a gen = unit -> 'a let (ig: int gen) = fun () -> Random.int 10 let (lg: ('a gen) -> ('a list) gen) = fun gen () -> foldn (fun acc i -> (gen ())::acc) [] (Random.int 10) let (pg: ('a gen) -> ('b gen) -> ('a * 'b) gen) = fun gen1 gen2 () -> (gen1 (), gen2 ()) let polyg = ig let (ng: (string gen)) = fun () -> "a" ^ (string_of_int (ig ())) let (oneofl: ('a list) -> 'a gen) = fun xs () -> List.nth xs (Random.int (List.length xs)) (* let oneofl l = oneof (List.map always l) *) let (oneof: (('a gen) list) -> 'a gen) = fun xs -> List.nth xs (Random.int (List.length xs)) let (always: 'a -> 'a gen) = fun e () -> e let (frequency: ((int * ('a gen)) list) -> 'a gen) = fun xs -> let sums = sum_int (List.map fst xs) in let i = Random.int sums in let rec freq_aux acc = function | (x,g)::xs -> if i < acc+x then g else freq_aux (acc+x) xs | _ -> failwith "frequency" in freq_aux 0 xs let frequencyl l = frequency (List.map (fun (i,e) -> (i,always e)) l) (* let b = oneof [always true; always false] () let b = frequency [3, always true; 2, always false] () *) (* cannot do this: * let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneofl [[]; lg gen ()] * nor * let rec (lg: ('a gen) -> ('a list) gen) = fun gen -> oneof [always []; lg gen] * * because caml is not as lazy as haskell :( fix the pb by introducing a size * limit. take the bounds/size as parameter. morover this is needed for * more complex type. * * how make a bintreeg ?? we need recursion * * let rec (bintreeg: ('a gen) -> ('a bintree) gen) = fun gen () -> * let rec aux n = * if n = 0 then (Leaf (gen ())) * else frequencyl [1, Leaf (gen ()); 4, Branch ((aux (n / 2)), aux (n / 2))] * () * in aux 20 * *) (*---------------------------------------------------------------------------*) (* property *) (*---------------------------------------------------------------------------*) (* todo: a test_all_laws, better syntax (done already a little with ig in * place of intg. En cas d'erreur, print the arg that not respect * * todo: with monitoring, as in haskell, laws = laws2, no need for 2 func, * but hard i found * * todo classify, collect, forall *) (* return None when good, and Just the_problematic_case when bad *) let (laws: string -> ('a -> bool) -> ('a gen) -> 'a option) = fun s func gen -> let res = foldn (fun acc i -> let n = gen() in (n, func n)::acc) [] 1000 in let res = List.filter (fun (x,b) -> not b) res in if res = [] then None else Some (fst (List.hd res)) let rec (statistic_number: ('a list) -> (int * 'a) list) = function | [] -> [] | x::xs -> let (splitg, splitd) = List.partition (fun y -> y = x) xs in (1+(List.length splitg), x)::(statistic_number splitd) (* in pourcentage *) let (statistic: ('a list) -> (int * 'a) list) = fun xs -> let stat_num = statistic_number xs in let totals = sum_int (List.map fst stat_num) in List.map (fun (i, v) -> ((i * 100) / totals), v) stat_num let (laws2: string -> ('a -> (bool * 'b)) -> ('a gen) -> ('a option * ((int * 'b) list ))) = fun s func gen -> let res = foldn (fun acc i -> let n = gen() in (n, func n)::acc) [] 1000 in let stat = statistic (List.map (fun (x,(b,v)) -> v) res) in let res = List.filter (fun (x,(b,v)) -> not b) res in if res = [] then (None, stat) else (Some (fst (List.hd res)), stat) (* let b = laws "unit" (fun x -> reverse [x] = [x] )ig let b = laws "app " (fun (xs,ys) -> reverse (xs++ys) = reverse ys++reverse xs)(pg (lg ig)(lg ig)) let b = laws "rev " (fun xs -> reverse (reverse xs) = xs )(lg ig) let b = laws "appb" (fun (xs,ys) -> reverse (xs++ys) = reverse xs++reverse ys)(pg (lg ig)(lg ig)) let b = laws "max" (fun (x,y) -> x <= y ==> (max x y = y) )(pg ig ig) let b = laws2 "max" (fun (x,y) -> ((x <= y ==> (max x y = y)), x <= y))(pg ig ig) *) (* todo, do with coarbitrary ?? idea is that given a 'a, generate a 'b * depending of 'a and gen 'b, that is modify gen 'b, what is important is * that each time given the same 'a, we must get the same 'b !!! *) (* let (fg: ('a gen) -> ('b gen) -> ('a -> 'b) gen) = fun gen1 gen2 () -> let b = laws "funs" (fun (f,g,h) -> x <= y ==> (max x y = y) )(pg ig ig) *) (* let one_of xs = List.nth xs (Random.int (List.length xs)) let take_one xs = if empty xs then failwith "Take_one: empty list" else let i = Random.int (List.length xs) in List.nth xs i, filter_index (fun j _ -> i <> j) xs *) (*****************************************************************************) (* Persistence *) (*****************************************************************************) let get_value filename = let chan = open_in filename in let x = input_value chan in (* <=> Marshal.from_channel *) (close_in chan; x) let write_value valu filename = let chan = open_out filename in (output_value chan valu; (* <=> Marshal.to_channel *) (* Marshal.to_channel chan valu [Marshal.Closures]; *) close_out chan) let write_back func filename = write_value (func (get_value filename)) filename let read_value f = get_value f let marshal__to_string2 v flags = Marshal.to_string v flags let marshal__to_string a b = profile_code "Marshalling" (fun () -> marshal__to_string2 a b) let marshal__from_string2 v flags = Marshal.from_string v flags let marshal__from_string a b = profile_code "Marshalling" (fun () -> marshal__from_string2 a b) (*****************************************************************************) (* Counter *) (*****************************************************************************) let _counter = ref 0 let counter () = (_counter := !_counter +1; !_counter) let _counter2 = ref 0 let counter2 () = (_counter2 := !_counter2 +1; !_counter2) let _counter3 = ref 0 let counter3 () = (_counter3 := !_counter3 +1; !_counter3) type timestamp = int (*****************************************************************************) (* String_of *) (*****************************************************************************) (* To work with the macro system autogenerated string_of and print_ function (kind of deriving a la haskell) *) (* int, bool, char, float, ref ?, string *) let string_of_string s = "\"" ^ s "\"" let string_of_list f xs = "[" ^ (xs +> List.map f +> String.concat ";" ) ^ "]" let string_of_unit () = "()" let string_of_array f xs = "[|" ^ (xs +> Array.to_list +> List.map f +> String.concat ";") ^ "|]" let string_of_option f = function | None -> "None " | Some x -> "Some " ^ (f x) let print_bool x = print_string (if x then "True" else "False") let print_option pr = function | None -> print_string "None" | Some x -> print_string "Some ("; pr x; print_string ")" let print_list pr xs = begin print_string "["; List.iter (fun x -> pr x; print_string ",") xs; print_string "]"; end (* specialized let (string_of_list: char list -> string) = List.fold_left (fun acc x -> acc^(Char.escaped x)) "" *) let rec print_between between fn = function | [] -> () | [x] -> fn x | x::xs -> fn x; between(); print_between between fn xs let adjust_pp_with_indent f = Format.open_box !_tab_level_print; (*Format.force_newline();*) f(); Format.close_box (); Format.print_newline() let adjust_pp_with_indent_and_header s f = Format.open_box (!_tab_level_print + String.length s); do_n !_tab_level_print (fun () -> Format.print_string " "); Format.print_string s; f(); Format.close_box (); Format.print_newline() let pp_do_in_box f = Format.open_box 1; f(); Format.close_box () let pp_do_in_zero_box f = Format.open_box 0; f(); Format.close_box () let pp_f_in_box f = Format.open_box 1; let res = f() in Format.close_box (); res let pp s = Format.print_string s let mk_str_func_of_assoc_conv xs = let swap (x,y) = (y,x) in (fun s -> let xs' = List.map swap xs in List.assoc s xs' ), (fun a -> List.assoc a xs ) (* julia: convert something printed using format to print into a string *) (* now at bottom of file let format_to_string f = ... *) (*****************************************************************************) (* Macro *) (*****************************************************************************) (* put your macro in macro.ml4, and you can test it interactivly as in lisp *) let macro_expand s = let c = open_out "/tmp/ttttt.ml" in begin output_string c s; close_out c; command2 (Commands.ocamlc_cmd ^ " -c -pp '" ^ Commands.camlp4o_cmd ^" pa_extend.cmo q_MLast.cmo -impl' " ^ "-I +" ^ Commands.camlp4_cmd ^ " -impl macro.ml4"); command2 (Commands.camlp4o_cmd ^" ./macro.cmo pr_o.cmo /tmp/ttttt.ml"); Unix.unlink "/tmp/ttttt.ml"; end (* let t = macro_expand "{ x + y | (x,y) <- [(1,1);(2,2);(3,3)] and x>2 and y<3}" let x = { x + y | (x,y) <- [(1,1);(2,2);(3,3)] and x > 2 and y < 3} let t = macro_expand "{1 .. 10}" let x = {1 .. 10} +> List.map (fun i -> i) let t = macro_expand "[1;2] to append to [2;4]" let t = macro_expand "{x = 2; x = 3}" let t = macro_expand "type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree)" *) (*****************************************************************************) (* Composition/Control *) (*****************************************************************************) (* I like the obj.func object notation. In OCaml cannot use '.' so I use +> * * update: it seems that F# agrees with me :) but they use |> *) (* now in prelude: * let (+>) o f = f o *) let (+!>) refo f = refo := f !refo (* alternatives: * let ((@): 'a -> ('a -> 'b) -> 'b) = fun a b -> b a * let o f g x = f (g x) *) let ($) f g x = g (f x) let compose f g x = f (g x) (* dont work :( let ( ) f g x = f(g(x)) *) (* trick to have something similar to the 1 `max` 4 haskell infix notation. by Keisuke Nakano on the caml mailing list. > let ( /* ) x y = y x > and ( */ ) x y = x y or let ( <| ) x y = y x and ( |> ) x y = x y > Then we can make an infix operator <| f |> for a binary function f. *) let flip f = fun a b -> f b a let curry f x y = f (x,y) let uncurry f (a,b) = f a b let id = fun x -> x let do_nothing () = () let rec applyn n f o = if n = 0 then o else applyn (n-1) f (f o) let forever f = while true do f(); done class ['a] shared_variable_hook (x:'a) = object(self) val mutable data = x val mutable registered = [] method set x = begin data <- x; pr "refresh registered"; registered +> List.iter (fun f -> f()); end method get = data method modify f = self#set (f self#get) method register f = registered <- f :: registered end (* src: from aop project. was called ptFix *) let rec fixpoint trans elem = let image = trans elem in if (image = elem) then elem (* point fixe *) else fixpoint trans image (* le point fixe pour les objets. was called ptFixForObjetct *) let rec fixpoint_for_object trans elem = let image = trans elem in if (image#equal elem) then elem (* point fixe *) else fixpoint_for_object trans image let (add_hook: ('a -> ('a -> 'b) -> 'b) ref -> ('a -> ('a -> 'b) -> 'b) -> unit) = fun var f -> let oldvar = !var in var := fun arg k -> f arg (fun x -> oldvar x k) let (add_hook_action: ('a -> unit) -> ('a -> unit) list ref -> unit) = fun f hooks -> push2 f hooks let (run_hooks_action: 'a -> ('a -> unit) list ref -> unit) = fun obj hooks -> !hooks +> List.iter (fun f -> try f obj with _ -> ()) type 'a mylazy = (unit -> 'a) (* a la emacs *) let save_excursion reference f = let old = !reference in let res = try f() with e -> reference := old; raise e in reference := old; res let save_excursion_and_disable reference f = save_excursion reference (fun () -> reference := false; f () ) let save_excursion_and_enable reference f = save_excursion reference (fun () -> reference := true; f () ) let memoized h k f = try Hashtbl.find h k with Not_found -> let v = f () in begin Hashtbl.add h k v; v end let cache_in_ref myref f = match !myref with | Some e -> e | None -> let e = f () in myref := Some e; e let once f = let already = ref false in (fun x -> if not !already then begin already := true; f x end ) (* cache_file, cf below *) let before_leaving f x = f x; x (* finalize, cf prelude *) (* cheat *) let rec y f = fun x -> f (y f) x (*****************************************************************************) (* Concurrency *) (*****************************************************************************) (* from http://en.wikipedia.org/wiki/File_locking * * "When using file locks, care must be taken to ensure that operations * are atomic. When creating the lock, the process must verify that it * does not exist and then create it, but without allowing another * process the opportunity to create it in the meantime. Various * schemes are used to implement this, such as taking advantage of * system calls designed for this purpose (but such system calls are * not usually available to shell scripts) or by creating the lock file * under a temporary name and then attempting to move it into place." * * => can't use 'if(not (file_exist xxx)) then create_file xxx' because * file_exist/create_file are not in atomic section (classic problem). * * from man open: * * "O_EXCL When used with O_CREAT, if the file already exists it * is an error and the open() will fail. In this context, a * symbolic link exists, regardless of where it points to. * O_EXCL is broken on NFS file systems; programs which * rely on it for performing locking tasks will contain a * race condition. The solution for performing atomic file * locking using a lockfile is to create a unique file on * the same file system (e.g., incorporating host- name and * pid), use link(2) to make a link to the lockfile. If * link(2) returns 0, the lock is successful. Otherwise, * use stat(2) on the unique file to check if its link * count has increased to 2, in which case the lock is also * successful." *) exception FileAlreadyLocked (* Racy if lock file on NFS!!! But still racy with recent Linux ? *) let acquire_file_lock filename = pr2 ("Locking file: " ^ filename); try let _fd = Unix.openfile filename [Unix.O_CREAT;Unix.O_EXCL] 0o777 in () with Unix.Unix_error (e, fm, argm) -> pr2 (spf "exn Unix_error: %s %s %s\n" (Unix.error_message e) fm argm); raise FileAlreadyLocked let release_file_lock filename = pr2 ("Releasing file: " ^ filename); Unix.unlink filename; () (*****************************************************************************) (* Error management *) (*****************************************************************************) exception Todo exception Impossible of int exception Here exception ReturnExn exception Multi_found (* to be consistent with Not_found *) exception WrongFormat of string (* old: let _TODO () = failwith "TODO", now via fix_caml with raise Todo *) let internal_error s = failwith ("internal error: "^s) let error_cant_have x = internal_error ("cant have this case: " ^(Dumper.dump x)) let myassert cond = if cond then () else failwith "assert error" (* before warning I was forced to do stuff like this: * * let (fixed_int_to_posmap: fixed_int -> posmap) = fun fixed -> * let v = ((fix_to_i fixed) / (power 2 16)) in * let _ = Printf.printf "coord xy = %d\n" v in * v * * The need for printf make me force to name stuff :( * How avoid ? use 'it' special keyword ? * In fact don't have to name it, use +> (fun v -> ...) so when want * erase debug just have to erase one line. *) let warning s v = (pr2 ("Warning: " ^ s ^ "; value = " ^ (Dumper.dump v)); v) let exn_to_s exn = Printexc.to_string exn (* alias *) let string_of_exn exn = exn_to_s exn (* want or of merd, but cannot cos cannot put die ... in b (strict call) *) let (|||) a b = try a with _ -> b (* emacs/lisp inspiration, (vouillon does that too in unison I think) *) (* now in Prelude: * let unwind_protect f cleanup = ... * let finalize f cleanup = ... *) type error = Error of string (* sometimes to get help from ocaml compiler to tell me places where * I should update, we sometimes need to change some type from pair * to triple, hence this kind of fake type. *) type evotype = unit let evoval = () (*****************************************************************************) (* Environment *) (*****************************************************************************) let check_stack = ref true let check_stack_size limit = if !check_stack then begin pr2 "checking stack size (do ulimit -s 50000 if problem)"; let rec aux i = if i = limit then 0 else 1 + aux (i + 1) in assert(aux 0 = limit); () end let test_check_stack_size limit = (* bytecode: 100000000 *) (* native: 10000000 *) check_stack_size (int_of_string limit) (* only relevant in bytecode, in native the stacklimit is the os stacklimit * (adjustable by ulimit -s) *) let _init_gc_stack = Gc.set {(Gc.get ()) with Gc.stack_limit = 100 * 1024 * 1024} (* if process a big set of files then don't want get overflow in the middle * so for this we are ready to spend some extra time at the beginning that * could save far more later. *) let check_stack_nbfiles nbfiles = if nbfiles > 200 then check_stack_size 10000000 (*****************************************************************************) (* Arguments/options and command line (cocci and acomment) *) (*****************************************************************************) (* * Why define wrappers ? Arg not good enough ? Well the Arg.Rest is not that * good and I need a way sometimes to get a list of argument. * * I could define maybe a new Arg.spec such as * | String_list of (string list -> unit), but the action may require * some flags to be set, so better to process this after all flags have * been set by parse_options. So have to split. Otherwise it would impose * an order of the options such as * -verbose_parsing -parse_c file1 file2. and I really like to use bash * history and add just at the end of my command a -profile for instance. * * * Why want a -action arg1 arg2 arg3 ? (which in turn requires this * convulated scheme ...) Why not use Arg.String action such as * "-parse_c", Arg.String (fun file -> ...) ? * I want something that looks like ocaml function but at the UNIX * command line level. So natural to have this scheme instead of * -taxo_file arg2 -sample_file arg3 -parse_c arg1. * * * Why not use the toplevel ? * - because to debug, ocamldebug is far superior to the toplevel * (can go back, can go directly to a specific point, etc). * I want a kind of testing at cmdline level. * - Also I don't have file completion when in the ocaml toplevel. * I have to type "/path/to/xxx" without help. * * * Why having variable flags ? Why use 'if !verbose_parsing then ...' ? * why not use strings and do stuff like the following * 'if (get_config "verbose_parsing") then ...' * Because I want to make the interface for flags easier for the code * that use it. The programmer should not be bothered whether this * flag is set via args cmd line or a config file, so I want to make it * as simple as possible, just use a global plain caml ref variable. * * Same spirit a little for the action. Instead of having function such as * test_parsing_c, I could do it only via string. But I still prefer * to have plain caml test functions. Also it makes it easier to call * those functions from a toplevel for people who prefer the toplevel. * * * So have flag_spec and action_spec. And in flag have debug_xxx flags, * verbose_xxx flags and other flags. * * I would like to not have to separate the -xxx actions spec from the * corresponding actions, but those actions may need more than one argument * and so have to wait for parse_options, which in turn need the options * spec, so circle. * * Also I don't want to mix code with data structures, so it's better that the * options variable contain just a few stuff and have no side effects except * setting global variables. * * Why not have a global variable such as Common.actions that * other modules modify ? No, I prefer to do less stuff behind programmer's * back so better to let the user merge the different options at call * site, but at least make it easier by providing shortcut for set of options. * * * * * todo? isn't unison or scott-mcpeak-lib-in-cil handles that kind of * stuff better ? That is the need to localize command line argument * while still being able to gathering them. Same for logging. * Similar to the type prof = PALL | PNONE | PSOME of string list. * Same spirit of fine grain config in log4j ? * * todo? how mercurial/cvs/git manage command line options ? because they * all have a kind of DSL around arguments with some common options, * specific options, conventions, etc. * * * todo? generate the corresponding noxxx options ? * todo? generate list of options and show their value ? * * todo? make it possible to set this value via a config file ? * * *) type arg_spec_full = Arg.key * Arg.spec * Arg.doc type cmdline_options = arg_spec_full list (* the format is a list of triples: * (title of section * (optional) explanation of sections * options) *) type options_with_title = string * string * arg_spec_full list type cmdline_sections = options_with_title list (* ---------------------------------------------------------------------- *) (* now I use argv as I like at the call sites to show that * this function internally use argv. *) let parse_options options usage_msg argv = let args = ref [] in (try Arg.parse_argv argv options (fun file -> args := file::!args) usage_msg; args := List.rev !args; !args with | Arg.Bad msg -> eprintf "%s" msg; exit 2 | Arg.Help msg -> printf "%s" msg; exit 0 ) let usage usage_msg options = Arg.usage (Arg.align options) usage_msg (* for coccinelle *) (* If you don't want the -help and --help that are appended by Arg.align *) let arg_align2 xs = Arg.align xs +> List.rev +> drop 2 +> List.rev let short_usage usage_msg ~short_opt = usage usage_msg short_opt let long_usage usage_msg ~short_opt ~long_opt = pr usage_msg; pr ""; let all_options_with_title = (("main options", "", short_opt)::long_opt) in all_options_with_title +> List.iter (fun (title, explanations, xs) -> pr title; pr_xxxxxxxxxxxxxxxxx(); if explanations <> "" then begin pr explanations; pr "" end; arg_align2 xs +> List.iter (fun (key,action,s) -> pr (" " ^ key ^ s) ); pr ""; ); () (* copy paste of Arg.parse. Don't want the default -help msg *) let arg_parse2 l msg short_usage_fun = let args = ref [] in let f = (fun file -> args := file::!args) in let l = Arg.align l in (try begin Arg.parse_argv Sys.argv l f msg; args := List.rev !args; !args end with | Arg.Bad msg -> (* eprintf "%s" msg; exit 2; *) let xs = lines msg in (* take only head, it's where the error msg is *) pr2 (List.hd xs); short_usage_fun(); raise (UnixExit (2)) | Arg.Help msg -> (* printf "%s" msg; exit 0; *) raise (Impossible 1) (* -help is specified in speclist *) ) (* ---------------------------------------------------------------------- *) (* kind of unit testing framework, or toplevel like functionnality * at shell command line. I realize than in fact It follows a current trend * to have a main cmdline program where can then select different actions, * as in cvs/hg/git where do hg , and the shell even * use a curried syntax :) * * * Not-perfect-but-basic-feels-right: an action * spec looks like this: * * let actions () = [ * "-parse_taxo", " ", * Common.mk_action_1_arg test_parse_taxo; * ... * ] * * Not-perfect-but-basic-feels-right because for such functionality we * need a way to transform a string into a caml function and pass arguments * and the preceding design does exactly that, even if then the * functions that use this design are not so convenient to use (there * are 2 places where we need to pass those data, in the options and in the * main dispatcher). * * Also it's not too much intrusive. Still have an * action ref variable in the main.ml and can still use the previous * simpler way to do where the match args with in main.ml do the * dispatch. * * Use like this at option place: * (Common.options_of_actions actionref (Test_parsing_c.actions())) ++ * Use like this at dispatch action place: * | xs when List.mem !action (Common.action_list all_actions) -> * Common.do_action !action xs all_actions * *) type flag_spec = Arg.key * Arg.spec * Arg.doc type action_spec = Arg.key * Arg.doc * action_func and action_func = (string list -> unit) type cmdline_actions = action_spec list exception WrongNumberOfArguments let options_of_actions action_ref actions = actions +> List.map (fun (key, doc, _func) -> (key, (Arg.Unit (fun () -> action_ref := key)), doc) ) let (action_list: cmdline_actions -> Arg.key list) = fun xs -> List.map (fun (a,b,c) -> a) xs let (do_action: Arg.key -> string list (* args *) -> cmdline_actions -> unit) = fun key args xs -> let assoc = xs +> List.map (fun (a,b,c) -> (a,c)) in let action_func = List.assoc key assoc in action_func args (* todo? if have a function with default argument ? would like a * mk_action_0_or_1_arg ? *) let mk_action_0_arg f = (function | [] -> f () | _ -> raise WrongNumberOfArguments ) let mk_action_1_arg f = (function | [file] -> f file | _ -> raise WrongNumberOfArguments ) let mk_action_2_arg f = (function | [file1;file2] -> f file1 file2 | _ -> raise WrongNumberOfArguments ) let mk_action_3_arg f = (function | [file1;file2;file3] -> f file1 file2 file3 | _ -> raise WrongNumberOfArguments ) let mk_action_n_arg f = f (*****************************************************************************) (* Equality *) (*****************************************************************************) (* Using the generic (=) is tempting, but it backfires, so better avoid it *) (* To infer all the code that use an equal, and that should be * transformed, is not that easy, because (=) is used by many * functions, such as List.find, List.mem, and so on. So the strategy * is to turn what you were previously using into a function, because * (=) return an exception when applied to a function. Then you simply * use ocamldebug to infer where the code has to be transformed. *) (* src: caml mailing list ? *) let (=|=) : int -> int -> bool = (=) let (=<=) : char -> char -> bool = (=) let (=$=) : string -> string -> bool = (=) let (=:=) : bool -> bool -> bool = (=) (* the evil generic (=). I define another symbol to more easily detect * it, cos the '=' sign is syntactically overloaded in caml. It is also * used to define function. *) let (=*=) = (=) (* if really want to forbid to use '=' let (=) = (=|=) *) let (=) () () = false (*###########################################################################*) (* And now basic types *) (*###########################################################################*) (*****************************************************************************) (* Bool *) (*****************************************************************************) let (==>) b1 b2 = if b1 then b2 else true (* could use too => *) (* superseded by another <=> below let (<=>) a b = if a =*= b then 0 else if a < b then -1 else 1 *) let xor a b = not (a =*= b) (*****************************************************************************) (* Char *) (*****************************************************************************) let string_of_char c = String.make 1 c let is_single = String.contains ",;()[]{}_`" let is_symbol = String.contains "!@#$%&*+./<=>?\\^|:-~" let is_space = String.contains "\n\t " let cbetween min max c = (int_of_char c) <= (int_of_char max) && (int_of_char c) >= (int_of_char min) let is_upper = cbetween 'A' 'Z' let is_lower = cbetween 'a' 'z' let is_alpha c = is_upper c || is_lower c let is_digit = cbetween '0' '9' let string_of_chars cs = cs +> List.map (String.make 1) +> String.concat "" (*****************************************************************************) (* Num *) (*****************************************************************************) (* since 3.08, div by 0 raise Div_by_rezo, and not anymore a hardware trap :)*) let (/!) x y = if y =|= 0 then (log "common.ml: div by 0"; 0) else x / y (* now in prelude * let rec (do_n: int -> (unit -> unit) -> unit) = fun i f -> * if i = 0 then () else (f(); do_n (i-1) f) *) (* now in prelude * let rec (foldn: ('a -> int -> 'a) -> 'a -> int -> 'a) = fun f acc i -> * if i = 0 then acc else foldn f (f acc i) (i-1) *) let sum_float = List.fold_left (+.) 0.0 let sum_int = List.fold_left (+) 0 let pi = 3.14159265358979323846 let pi2 = pi /. 2.0 let pi4 = pi /. 4.0 (* 180 = pi *) let (deg_to_rad: float -> float) = fun deg -> (deg *. pi) /. 180.0 let clampf = function | n when n < 0.0 -> 0.0 | n when n > 1.0 -> 1.0 | n -> n let square x = x *. x let rec power x n = if n =|= 0 then 1 else x * power x (n-1) let between i min max = i > min && i < max let (between_strict: int -> int -> int -> bool) = fun a b c -> a < b && b < c let bitrange x p = let v = power 2 p in between x (-v) v (* descendant *) let (prime1: int -> int option) = fun x -> let rec prime1_aux n = if n =|= 1 then None else if (x / n) * n =|= x then Some n else prime1_aux (n-1) in if x =|= 1 then None else if x < 0 then failwith "negative" else prime1_aux (x-1) (* montant, better *) let (prime: int -> int option) = fun x -> let rec prime_aux n = if n =|= x then None else if (x / n) * n =|= x then Some n else prime_aux (n+1) in if x =|= 1 then None else if x < 0 then failwith "negative" else prime_aux 2 let sum xs = List.fold_left (+) 0 xs let product = List.fold_left ( * ) 1 let decompose x = let rec decompose x = if x =|= 1 then [] else (match prime x with | None -> [x] | Some n -> n::decompose (x / n) ) in assert (product (decompose x) =|= x); decompose x let mysquare x = x * x let sqr a = a *. a type compare = Equal | Inf | Sup let (<=>) a b = if a =*= b then Equal else if a < b then Inf else Sup let (<==>) a b = if a =*= b then 0 else if a < b then -1 else 1 type uint = int let int_of_stringchar s = fold_left_with_index (fun acc e i -> acc + (Char.code e*(power 8 i))) 0 (List.rev (list_of_string s)) let int_of_base s base = fold_left_with_index (fun acc e i -> let j = Char.code e - Char.code '0' in if j >= base then failwith "not in good base" else acc + (j*(power base i)) ) 0 (List.rev (list_of_string s)) let int_of_stringbits s = int_of_base s 2 let _ = example (int_of_stringbits "1011" =|= 1*8 + 1*2 + 1*1) let int_of_octal s = int_of_base s 8 let _ = example (int_of_octal "017" =|= 15) (* let int_of_hex s = int_of_base s 16, NONONONO cos 'A' - '0' does not give 10 !! *) let int_of_all s = if String.length s >= 2 && (String.get s 0 =<= '0') && is_digit (String.get s 1) then int_of_octal s else int_of_string s let (+=) ref v = ref := !ref + v let (-=) ref v = ref := !ref - v let pourcent x total = (x * 100) / total let pourcent_float x total = ((float_of_int x) *. 100.0) /. (float_of_int total) let pourcent_float_of_floats x total = (x *. 100.0) /. total let pourcent_good_bad good bad = (good * 100) / (good + bad) let pourcent_good_bad_float good bad = (float_of_int good *. 100.0) /. (float_of_int good +. float_of_int bad) type 'a max_with_elem = int ref * 'a ref let update_max_with_elem (aref, aelem) ~is_better (newv, newelem) = if is_better newv aref then begin aref := newv; aelem := newelem; end (*****************************************************************************) (* Numeric/overloading *) (*****************************************************************************) type 'a numdict = NumDict of (('a-> 'a -> 'a) * ('a-> 'a -> 'a) * ('a-> 'a -> 'a) * ('a -> 'a));; let add (NumDict(a, m, d, n)) = a;; let mul (NumDict(a, m, d, n)) = m;; let div (NumDict(a, m, d, n)) = d;; let neg (NumDict(a, m, d, n)) = n;; let numd_int = NumDict(( + ),( * ),( / ),( ~- ));; let numd_float = NumDict(( +. ),( *. ), ( /. ),( ~-. ));; let testd dict n = let ( * ) x y = mul dict x y in let ( / ) x y = div dict x y in let ( + ) x y = add dict x y in (* Now you can define all sorts of things in terms of *, /, + *) let f num = (num * num) / (num + num) in f n;; module ArithFloatInfix = struct let (+..) = (+) let (-..) = (-) let (/..) = (/) let ( *.. ) = ( * ) let (+) = (+.) let (-) = (-.) let (/) = (/.) let ( * ) = ( *. ) let (+=) ref v = ref := !ref + v let (-=) ref v = ref := !ref - v end (*****************************************************************************) (* Tuples *) (*****************************************************************************) type 'a pair = 'a * 'a type 'a triple = 'a * 'a * 'a let fst3 (x,_,_) = x let snd3 (_,y,_) = y let thd3 (_,_,z) = z let sndthd (a,b,c) = (b,c) let map_fst f (x, y) = f x, y let map_snd f (x, y) = x, f y let pair f (x,y) = (f x, f y) (* for my ocamlbeautify script *) let snd = snd let fst = fst let double a = a,a let swap (x,y) = (y,x) let tuple_of_list1 = function [a] -> a | _ -> failwith "tuple_of_list1" let tuple_of_list2 = function [a;b] -> a,b | _ -> failwith "tuple_of_list2" let tuple_of_list3 = function [a;b;c] -> a,b,c | _ -> failwith "tuple_of_list3" let tuple_of_list4 = function [a;b;c;d] -> a,b,c,d | _ -> failwith "tuple_of_list4" let tuple_of_list5 = function [a;b;c;d;e] -> a,b,c,d,e | _ -> failwith "tuple_of_list5" let tuple_of_list6 = function [a;b;c;d;e;f] -> a,b,c,d,e,f | _ -> failwith "tuple_of_list6" (*****************************************************************************) (* Maybe *) (*****************************************************************************) (* type 'a maybe = Just of 'a | None *) type ('a,'b) either = Left of 'a | Right of 'b (* with sexp *) type ('a, 'b, 'c) either3 = Left3 of 'a | Middle3 of 'b | Right3 of 'c (* with sexp *) let just = function | (Some x) -> x | _ -> failwith "just: pb" let some = just let fmap f = function | None -> None | Some x -> Some (f x) let map_option = fmap let do_option f = function | None -> () | Some x -> f x let optionise f = try Some (f ()) with Not_found -> None (* pixel *) let some_or = function | None -> id | Some e -> fun _ -> e let partition_either f l = let rec part_either left right = function | [] -> (List.rev left, List.rev right) | x :: l -> (match f x with | Left e -> part_either (e :: left) right l | Right e -> part_either left (e :: right) l) in part_either [] [] l let partition_either3 f l = let rec part_either left middle right = function | [] -> (List.rev left, List.rev middle, List.rev right) | x :: l -> (match f x with | Left3 e -> part_either (e :: left) middle right l | Middle3 e -> part_either left (e :: middle) right l | Right3 e -> part_either left middle (e :: right) l) in part_either [] [] [] l (* pixel *) let rec filter_some = function | [] -> [] | None :: l -> filter_some l | Some e :: l -> e :: filter_some l let map_filter f xs = xs +> List.map f +> filter_some (* avoid recursion *) let tail_map_filter f xs = List.rev (List.fold_left (function prev -> function cur -> match f cur with Some x -> x :: prev | None -> prev) [] xs) let rec find_some p = function | [] -> raise Not_found | x :: l -> match p x with | Some v -> v | None -> find_some p l (* same let map_find f xs = xs +> List.map f +> List.find (function Some x -> true | None -> false) +> (function Some x -> x | None -> raise Impossible) *) let list_to_single_or_exn xs = match xs with | [] -> raise Not_found | x::y::zs -> raise Multi_found | [x] -> x (*****************************************************************************) (* TriBool *) (*****************************************************************************) type bool3 = True3 | False3 | TrueFalsePb3 of string (*****************************************************************************) (* Regexp, can also use PCRE *) (*****************************************************************************) (* Note: OCaml Str regexps are different from Perl regexp: * - The OCaml regexp must match the entire way. * So "testBee" =~ "Bee" is wrong * but "testBee" =~ ".*Bee" is right * Can have the perl behavior if use Str.search_forward instead of * Str.string_match. * - Must add some additional \ in front of some special char. So use * \\( \\| and also \\b * - It does not always handle newlines very well. * - \\b does consider _ but not numbers in indentifiers. * * Note: PCRE regexps are then different from Str regexps ... * - just use '(' ')' for grouping, not '\\)' * - still need \\b for word boundary, but this time it works ... * so can match some word that have some digits in them. * *) (* put before String section because String section use some =~ *) (* let gsubst = global_replace *) let (==~) s re = Str.string_match re s 0 let _memo_compiled_regexp = Hashtbl.create 101 let candidate_match_func s re = (* old: Str.string_match (Str.regexp re) s 0 *) let compile_re = memoized _memo_compiled_regexp re (fun () -> Str.regexp re) in Str.string_match compile_re s 0 let match_func s re = profile_code "Common.=~" (fun () -> candidate_match_func s re) let (=~) s re = match_func s re let string_match_substring re s = try let _i = Str.search_forward re s 0 in true with Not_found -> false let _ = example(string_match_substring (Str.regexp "foo") "a foo b") let _ = example(string_match_substring (Str.regexp "\\bfoo\\b") "a foo b") let _ = example(string_match_substring (Str.regexp "\\bfoo\\b") "a\n\nfoo b") let _ = example(string_match_substring (Str.regexp "\\bfoo_bar\\b") "a\n\nfoo_bar b") (* does not work :( let _ = example(string_match_substring (Str.regexp "\\bfoo_bar2\\b") "a\n\nfoo_bar2 b") *) let (regexp_match: string -> string -> string) = fun s re -> assert(s =~ re); Str.matched_group 1 s (* beurk, side effect code, but hey, it is convenient *) (* now in prelude * let (matched: int -> string -> string) = fun i s -> * Str.matched_group i s * * let matched1 = fun s -> matched 1 s * let matched2 = fun s -> (matched 1 s, matched 2 s) * let matched3 = fun s -> (matched 1 s, matched 2 s, matched 3 s) * let matched4 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s) * let matched5 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s, matched 5 s) * let matched6 = fun s -> (matched 1 s, matched 2 s, matched 3 s, matched 4 s, matched 5 s, matched 6 s) *) let split sep s = Str.split (Str.regexp sep) s let _ = example (split "/" "" =*= []) let join sep xs = String.concat sep xs let _ = example (join "/" ["toto"; "titi"; "tata"] =$= "toto/titi/tata") (* let rec join str = function | [] -> "" | [x] -> x | x::xs -> x ^ str ^ (join str xs) *) let (split_list_regexp: string -> string list -> (string * string list) list) = fun re xs -> let rec split_lr_aux (heading, accu) = function | [] -> [(heading, List.rev accu)] | x::xs -> if x =~ re then (heading, List.rev accu)::split_lr_aux (x, []) xs else split_lr_aux (heading, x::accu) xs in split_lr_aux ("__noheading__", []) xs +> (fun xs -> if (List.hd xs) =*= ("__noheading__",[]) then List.tl xs else xs) let regexp_alpha = Str.regexp "^[a-zA-Z_][A-Za-z_0-9]*$" let all_match re s = let regexp = Str.regexp re in let res = ref [] in let _ = Str.global_substitute regexp (fun _s -> let substr = Str.matched_string s in assert(substr ==~ regexp); (* @Effect: also use it's side effect *) let paren_matched = matched1 substr in push2 paren_matched res; "" (* @Dummy *) ) s in List.rev !res let _ = example (all_match "\\(@[A-Za-z]+\\)" "ca va @Et toi @Comment" =*= ["@Et";"@Comment"]) let global_replace_regexp re f_on_substr s = let regexp = Str.regexp re in Str.global_substitute regexp (fun _wholestr -> let substr = Str.matched_string s in f_on_substr substr ) s let regexp_word_str = "\\([a-zA-Z_][A-Za-z_0-9]*\\)" let regexp_word = Str.regexp regexp_word_str let regular_words s = all_match regexp_word_str s let contain_regular_word s = let xs = regular_words s in List.length xs >= 1 (*****************************************************************************) (* Strings *) (*****************************************************************************) let slength = String.length let concat = String.concat (* ruby *) let i_to_s = string_of_int let s_to_i = int_of_string (* strings take space in memory. Better when can share the space used by similar strings *) let _shareds = Hashtbl.create 100 let (shared_string: string -> string) = fun s -> try Hashtbl.find _shareds s with Not_found -> (Hashtbl.add _shareds s s; s) let chop = function | "" -> "" | s -> String.sub s 0 (String.length s - 1) let chop_dirsymbol = function | s when s =~ "\\(.*\\)/$" -> matched1 s | s -> s let () s (i,j) = String.sub s i (if j < 0 then String.length s - i + j + 1 else j - i) (* let _ = example ( "tototati"(3,-2) = "otat" ) *) let () s i = String.get s i (* pixel *) let rec split_on_char c s = try let sp = String.index s c in String.sub s 0 sp :: split_on_char c (String.sub s (sp+1) (String.length s - sp - 1)) with Not_found -> [s] let lowercase = String.lowercase let quote s = "\"" ^ s ^ "\"" (* easier to have this to be passed as hof, because ocaml don't have * haskell "section" operators *) let null_string s = s =$= "" let is_blank_string s = s =~ "^\\([ \t]\\)*$" (* src: lablgtk2/examples/entrycompletion.ml *) let is_string_prefix s1 s2 = (String.length s1 <= String.length s2) && (String.sub s2 0 (String.length s1) =$= s1) let plural i s = if i =|= 1 then Printf.sprintf "%d %s" i s else Printf.sprintf "%d %ss" i s let showCodeHex xs = List.iter (fun i -> printf "%02x" i) xs let take_string n s = String.sub s 0 (n-1) let take_string_safe n s = if n > String.length s then s else take_string n s (* used by LFS *) let size_mo_ko i = let ko = (i / 1024) mod 1024 in let mo = (i / 1024) / 1024 in (if mo > 0 then sprintf "%dMo%dKo" mo ko else sprintf "%dKo" ko ) let size_ko i = let ko = i / 1024 in sprintf "%dKo" ko (* done in summer 2007 for julia * Reference: P216 of gusfeld book * For two strings S1 and S2, D(i,j) is defined to be the edit distance of S1[1..i] to S2[1..j] * So edit distance of S1 (of length n) and S2 (of length m) is D(n,m) * * Dynamic programming technique * base: * D(i,0) = i for all i (cos to go from S1[1..i] to 0 characters of S2 you have to delete all characters from S1[1..i] * D(0,j) = j for all j (cos j characters must be inserted) * recurrence: * D(i,j) = min([D(i-1, j)+1, D(i, j - 1 + 1), D(i-1, j-1) + t(i,j)]) * where t(i,j) is equal to 1 if S1(i) != S2(j) and 0 if equal * intuition = there is 4 possible action = deletion, insertion, substitution, or match * so Lemma = * * D(i,j) must be one of the three * D(i, j-1) + 1 * D(i-1, j)+1 * D(i-1, j-1) + * t(i,j) * * *) let matrix_distance s1 s2 = let n = (String.length s1) in let m = (String.length s2) in let mat = Array.make_matrix (n+1) (m+1) 0 in let t i j = if String.get s1 (i-1) =<= String.get s2 (j-1) then 0 else 1 in let min3 a b c = min (min a b) c in begin for i = 0 to n do mat.(i).(0) <- i done; for j = 0 to m do mat.(0).(j) <- j; done; for i = 1 to n do for j = 1 to m do mat.(i).(j) <- min3 (mat.(i).(j-1) + 1) (mat.(i-1).(j) + 1) (mat.(i-1).(j-1) + t i j) done done; mat end let edit_distance s1 s2 = (matrix_distance s1 s2).(String.length s1).(String.length s2) let test = edit_distance "vintner" "writers" let _ = assert (edit_distance "winter" "winter" =|= 0) let _ = assert (edit_distance "vintner" "writers" =|= 5) (*****************************************************************************) (* Filenames *) (*****************************************************************************) let dirname = Filename.dirname let basename = Filename.basename type filename = string (* TODO could check that exist :) type sux *) (* with sexp *) type dirname = string (* TODO could check that exist :) type sux *) (* with sexp *) module BasicType = struct type filename = string end let (filesuffix: filename -> string) = fun s -> (try regexp_match s ".+\\.\\([a-zA-Z0-9_]+\\)$" with _ -> "NOEXT") let (fileprefix: filename -> string) = fun s -> (try regexp_match s "\\(.+\\)\\.\\([a-zA-Z0-9_]+\\)?$" with _ -> s) let _ = example (filesuffix "toto.c" =$= "c") let _ = example (fileprefix "toto.c" =$= "toto") (* assert (s = fileprefix s ^ filesuffix s) let withoutExtension s = global_replace (regexp "\\..*$") "" s let () = example "without" (withoutExtension "toto.s.toto" = "toto") *) let adjust_ext_if_needed filename ext = if String.get ext 0 <> '.' then failwith "I need an extension such as .c not just c"; if not (filename =~ (".*\\" ^ ext)) then filename ^ ext else filename let db_of_filename file = dirname file, basename file let filename_of_db (basedir, file) = Filename.concat basedir file let dbe_of_filename file = (* raise Invalid_argument if no ext, so safe to use later the unsafe * fileprefix and filesuffix functions. *) ignore(Filename.chop_extension file); Filename.dirname file, Filename.basename file +> fileprefix, Filename.basename file +> filesuffix let filename_of_dbe (dir, base, ext) = Filename.concat dir (base ^ "." ^ ext) let dbe_of_filename_safe file = try Left (dbe_of_filename file) with Invalid_argument _ -> Right (Filename.dirname file, Filename.basename file) let dbe_of_filename_nodot file = let (d,b,e) = dbe_of_filename file in let d = if d =$= "." then "" else d in d,b,e let replace_ext file oldext newext = let (d,b,e) = dbe_of_filename file in assert(e =$= oldext); filename_of_dbe (d,b,newext) let normalize_path file = let (dir, filename) = Filename.dirname file, Filename.basename file in let xs = split "/" dir in let rec aux acc = function | [] -> List.rev acc | x::xs -> (match x with | "." -> aux acc xs | ".." -> aux (List.tl acc) xs | x -> aux (x::acc) xs ) in let xs' = aux [] xs in Filename.concat (join "/" xs') filename (* let relative_to_absolute s = if Filename.is_relative s then begin let old = Sys.getcwd () in Sys.chdir s; let current = Sys.getcwd () in Sys.chdir old; s end else s *) let relative_to_absolute s = if Filename.is_relative s then Sys.getcwd () ^ "/" ^ s else s let is_relative s = Filename.is_relative s let is_absolute s = not (is_relative s) (* @Pre: prj_path must not contain regexp symbol *) let filename_without_leading_path prj_path s = let prj_path = chop_dirsymbol prj_path in if s =~ ("^" ^ prj_path ^ "/\\(.*\\)$") then matched1 s else failwith (spf "cant find filename_without_project_path: %s %s" prj_path s) (*****************************************************************************) (* i18n *) (*****************************************************************************) type langage = | English | Francais | Deutsch (* gettext ? *) (*****************************************************************************) (* Dates *) (*****************************************************************************) (* maybe I should use ocamlcalendar, but I don't like all those functors ... *) type month = | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec type year = Year of int type day = Day of int type wday = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday type date_dmy = DMY of day * month * year type hour = Hour of int type minute = Min of int type second = Sec of int type time_hms = HMS of hour * minute * second type full_date = date_dmy * time_hms (* intervalle *) type days = Days of int type time_dmy = TimeDMY of day * month * year type float_time = float let check_date_dmy (DMY (day, month, year)) = raise Todo let check_time_dmy (TimeDMY (day, month, year)) = raise Todo let check_time_hms (HMS (x,y,a)) = raise Todo (* ---------------------------------------------------------------------- *) (* older code *) let int_to_month i = assert (i <= 12 && i >= 1); match i with | 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr" | 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug" | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec" (* | 1 -> "January" | 2 -> "February" | 3 -> "March" | 4 -> "April" | 5 -> "May" | 6 -> "June" | 7 -> "July" | 8 -> "August" | 9 -> "September" | 10 -> "October" | 11 -> "November" | 12 -> "December" *) | _ -> raise (Impossible 2) let month_info = [ 1 , Jan, "Jan", "January", 31; 2 , Feb, "Feb", "February", 28; 3 , Mar, "Mar", "March", 31; 4 , Apr, "Apr", "April", 30; 5 , May, "May", "May", 31; 6 , Jun, "Jun", "June", 30; 7 , Jul, "Jul", "July", 31; 8 , Aug, "Aug", "August", 31; 9 , Sep, "Sep", "September", 30; 10 , Oct, "Oct", "October", 31; 11 , Nov, "Nov", "November", 30; 12 , Dec, "Dec", "December", 31; ] let week_day_info = [ 0 , Sunday , "Sun" , "Dim" , "Sunday"; 1 , Monday , "Mon" , "Lun" , "Monday"; 2 , Tuesday , "Tue" , "Mar" , "Tuesday"; 3 , Wednesday , "Wed" , "Mer" , "Wednesday"; 4 , Thursday , "Thu" ,"Jeu" ,"Thursday"; 5 , Friday , "Fri" , "Ven" , "Friday"; 6 , Saturday , "Sat" ,"Sam" , "Saturday"; ] let i_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> i, month) let s_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> monthstr, month) let slong_to_month_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> mlong, month) let month_to_s_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> month, monthstr) let month_to_i_h = month_info +> List.map (fun (i,month,monthstr,mlong,days) -> month, i) let i_to_wday_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> i, day) let wday_to_en_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> day, dayen) let wday_to_fr_h = week_day_info +> List.map (fun (i,day,dayen,dayfr,daylong) -> day, dayfr) let month_of_string s = List.assoc s s_to_month_h let month_of_string_long s = List.assoc s slong_to_month_h let string_of_month s = List.assoc s month_to_s_h let month_of_int i = List.assoc i i_to_month_h let int_of_month m = List.assoc m month_to_i_h let wday_of_int i = List.assoc i i_to_wday_h let string_en_of_wday wday = List.assoc wday wday_to_en_h let string_fr_of_wday wday = List.assoc wday wday_to_fr_h (* ---------------------------------------------------------------------- *) let wday_str_of_int ~langage i = let wday = wday_of_int i in match langage with | English -> string_en_of_wday wday | Francais -> string_fr_of_wday wday | Deutsch -> raise Todo let string_of_date_dmy (DMY (Day n, month, Year y)) = (spf "%02d-%s-%d" n (string_of_month month) y) let string_of_unix_time ?(langage=English) tm = let y = tm.Unix.tm_year + 1900 in let mon = string_of_month (month_of_int (tm.Unix.tm_mon + 1)) in let d = tm.Unix.tm_mday in let h = tm.Unix.tm_hour in let min = tm.Unix.tm_min in let s = tm.Unix.tm_sec in let wday = wday_str_of_int ~langage tm.Unix.tm_wday in spf "%02d/%03s/%04d (%s) %02d:%02d:%02d" d mon y wday h min s (* ex: 21/Jul/2008 (Lun) 21:25:12 *) let unix_time_of_string s = if s =~ ("\\([0-9][0-9]\\)/\\(...\\)/\\([0-9][0-9][0-9][0-9]\\) " ^ "\\(.*\\) \\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)") then let (sday, smonth, syear, _sday, shour, smin, ssec) = matched7 s in let y = s_to_i syear - 1900 in let mon = smonth +> month_of_string +> int_of_month +> (fun i -> i -1) in let tm = Unix.localtime (Unix.time ()) in { tm with Unix.tm_year = y; Unix.tm_mon = mon; Unix.tm_mday = s_to_i sday; Unix.tm_hour = s_to_i shour; Unix.tm_min = s_to_i smin; Unix.tm_sec = s_to_i ssec; } else failwith ("unix_time_of_string: " ^ s) let short_string_of_unix_time ?(langage=English) tm = let y = tm.Unix.tm_year + 1900 in let mon = string_of_month (month_of_int (tm.Unix.tm_mon + 1)) in let d = tm.Unix.tm_mday in let _h = tm.Unix.tm_hour in let _min = tm.Unix.tm_min in let _s = tm.Unix.tm_sec in let wday = wday_str_of_int ~langage tm.Unix.tm_wday in spf "%02d/%03s/%04d (%s)" d mon y wday let string_of_unix_time_lfs time = spf "%02d--%s--%d" time.Unix.tm_mday (int_to_month (time.Unix.tm_mon + 1)) (time.Unix.tm_year + 1900) (* ---------------------------------------------------------------------- *) let string_of_floattime ?langage i = let tm = Unix.localtime i in string_of_unix_time ?langage tm let short_string_of_floattime ?langage i = let tm = Unix.localtime i in short_string_of_unix_time ?langage tm let floattime_of_string s = let tm = unix_time_of_string s in let (sec,_tm) = Unix.mktime tm in sec (* ---------------------------------------------------------------------- *) let days_in_week_of_day day = let tm = Unix.localtime day in let wday = tm.Unix.tm_wday in let wday = if wday =|= 0 then 6 else wday -1 in let mday = tm.Unix.tm_mday in let start_d = mday - wday in let end_d = mday + (6 - wday) in enum start_d end_d +> List.map (fun mday -> Unix.mktime {tm with Unix.tm_mday = mday} +> fst ) let first_day_in_week_of_day day = List.hd (days_in_week_of_day day) let last_day_in_week_of_day day = last (days_in_week_of_day day) (* ---------------------------------------------------------------------- *) (* (modified) copy paste from ocamlcalendar/src/date.ml *) let days_month = [| 0; 31; 59; 90; 120; 151; 181; 212; 243; 273; 304; 334(*; 365*) |] let rough_days_since_jesus (DMY (Day nday, month, Year year)) = let n = nday + (days_month.(int_of_month month -1)) + year * 365 in Days n let is_more_recent d1 d2 = let (Days n1) = rough_days_since_jesus d1 in let (Days n2) = rough_days_since_jesus d2 in (n1 > n2) let max_dmy d1 d2 = if is_more_recent d1 d2 then d1 else d2 let min_dmy d1 d2 = if is_more_recent d1 d2 then d2 else d1 let maximum_dmy ds = foldl1 max_dmy ds let minimum_dmy ds = foldl1 min_dmy ds let rough_days_between_dates d1 d2 = let (Days n1) = rough_days_since_jesus d1 in let (Days n2) = rough_days_since_jesus d2 in Days (n2 - n1) let _ = example (rough_days_between_dates (DMY (Day 7, Jan, Year 1977)) (DMY (Day 13, Jan, Year 1977)) =*= Days 6) (* because of rough days, it is a bit buggy, here it should return 1 *) (* let _ = assert_equal (rough_days_between_dates (DMY (Day 29, Feb, Year 1977)) (DMY (Day 1, Mar , Year 1977))) (Days 1) *) (* from julia, in gitsort.ml *) (* let antimonths = [(1,31);(2,28);(3,31);(4,30);(5,31); (6,6);(7,7);(8,31);(9,30);(10,31); (11,30);(12,31);(0,31)] let normalize (year,month,day,hour,minute,second) = if hour < 0 then let (day,hour) = (day - 1,hour + 24) in if day = 0 then let month = month - 1 in let day = List.assoc month antimonths in let day = if month = 2 && year / 4 * 4 = year && not (year / 100 * 100 = year) then 29 else day in if month = 0 then (year-1,12,day,hour,minute,second) else (year,month,day,hour,minute,second) else (year,month,day,hour,minute,second) else (year,month,day,hour,minute,second) *) let mk_date_dmy day month year = let date = DMY (Day day, month_of_int month, Year year) in (* check_date_dmy date *) date (* ---------------------------------------------------------------------- *) (* conversion to unix.tm *) let dmy_to_unixtime (DMY (Day n, month, Year year)) = let tm = { Unix.tm_sec = 0; (** Seconds 0..60 *) tm_min = 0; (** Minutes 0..59 *) tm_hour = 12; (** Hours 0..23 *) tm_mday = n; (** Day of month 1..31 *) tm_mon = (int_of_month month -1); (** Month of year 0..11 *) tm_year = year - 1900; (** Year - 1900 *) tm_wday = 0; (** Day of week (Sunday is 0) *) tm_yday = 0; (** Day of year 0..365 *) tm_isdst = false; (** Daylight time savings in effect *) } in Unix.mktime tm let unixtime_to_dmy tm = let n = tm.Unix.tm_mday in let month = month_of_int (tm.Unix.tm_mon + 1) in let year = tm.Unix.tm_year + 1900 in DMY (Day n, month, Year year) let unixtime_to_floattime tm = Unix.mktime tm +> fst let floattime_to_unixtime sec = Unix.localtime sec let sec_to_days sec = let minfactor = 60 in let hourfactor = 60 * 60 in let dayfactor = 60 * 60 * 24 in let days = sec / dayfactor in let hours = (sec mod dayfactor) / hourfactor in let mins = (sec mod hourfactor) / minfactor in let sec = (sec mod 60) in (* old: Printf.sprintf "%d days, %d hours, %d minutes" days hours mins *) (if days > 0 then plural days "day" ^ " " else "") ^ (if hours > 0 then plural hours "hour" ^ " " else "") ^ (if mins > 0 then plural mins "min" ^ " " else "") ^ (spf "%dsec" sec) let sec_to_hours sec = let minfactor = 60 in let hourfactor = 60 * 60 in let hours = sec / hourfactor in let mins = (sec mod hourfactor) / minfactor in let sec = (sec mod 60) in (* old: Printf.sprintf "%d days, %d hours, %d minutes" days hours mins *) (if hours > 0 then plural hours "hour" ^ " " else "") ^ (if mins > 0 then plural mins "min" ^ " " else "") ^ (spf "%dsec" sec) let test_date_1 () = let date = DMY (Day 17, Sep, Year 1991) in let float, tm = dmy_to_unixtime date in pr2 (spf "date: %.0f" float); () (* src: ferre in logfun/.../date.ml *) let day_secs : float = 86400. let today : unit -> float = fun () -> (Unix.time () ) let yesterday : unit -> float = fun () -> (Unix.time () -. day_secs) let tomorrow : unit -> float = fun () -> (Unix.time () +. day_secs) let lastweek : unit -> float = fun () -> (Unix.time () -. (7.0 *. day_secs)) let lastmonth : unit -> float = fun () -> (Unix.time () -. (30.0 *. day_secs)) let week_before : float_time -> float_time = fun d -> (d -. (7.0 *. day_secs)) let month_before : float_time -> float_time = fun d -> (d -. (30.0 *. day_secs)) let week_after : float_time -> float_time = fun d -> (d +. (7.0 *. day_secs)) (*****************************************************************************) (* Lines/words/strings *) (*****************************************************************************) (* now in prelude: * let (list_of_string: string -> char list) = fun s -> * (enum 0 ((String.length s) - 1) +> List.map (String.get s)) *) let _ = example (list_of_string "abcd" =*= ['a';'b';'c';'d']) (* let rec (list_of_stream: ('a Stream.t) -> 'a list) = parser | [< 'c ; stream >] -> c :: list_of_stream stream | [<>] -> [] let (list_of_string: string -> char list) = Stream.of_string $ list_of_stream *) (* now in prelude: * let (lines: string -> string list) = fun s -> ... *) let (lines_with_nl: string -> string list) = fun s -> let rec lines_aux = function | [] -> [] | [x] -> if x =$= "" then [] else [x ^ "\n"] (* old: [x] *) | x::xs -> let e = x ^ "\n" in e::lines_aux xs in (time_func (fun () -> Str.split_delim (Str.regexp "\n") s)) +> lines_aux (* in fact better make it return always complete lines, simplify *) (* Str.split, but lines "\n1\n2\n" don't return the \n and forget the first \n => split_delim better than split *) (* +> List.map (fun s -> s ^ "\n") but add an \n even at the end => lines_aux *) (* old: slow let chars = list_of_string s in chars +> List.fold_left (fun (acc, lines) char -> let newacc = acc ^ (String.make 1 char) in if char = '\n' then ("", newacc::lines) else (newacc, lines) ) ("", []) +> (fun (s, lines) -> List.rev (s::lines)) *) (* CHECK: unlines (lines x) = x *) let (unlines: string list -> string) = fun s -> (String.concat "\n" s) ^ "\n" let (words: string -> string list) = fun s -> Str.split (Str.regexp "[ \t()\";]+") s let (unwords: string list -> string) = fun s -> String.concat "" s let (split_space: string -> string list) = fun s -> Str.split (Str.regexp "[ \t\n]+") s (* todo opti ? *) let nblines s = lines s +> List.length let _ = example (nblines "" =|= 0) let _ = example (nblines "toto" =|= 1) let _ = example (nblines "toto\n" =|= 1) let _ = example (nblines "toto\ntata" =|= 2) let _ = example (nblines "toto\ntata\n" =|= 2) (*****************************************************************************) (* Process/Files *) (*****************************************************************************) let cat_orig file = let chan = open_in file in let rec cat_orig_aux () = try (* cannot do input_line chan::aux() cos ocaml eval from right to left ! *) let l = input_line chan in l :: cat_orig_aux () with End_of_file -> [] in cat_orig_aux() (* tail recursive efficient version *) let cat file = let chan = open_in file in let rec cat_aux acc () = (* cannot do input_line chan::aux() cos ocaml eval from right to left ! *) let (b, l) = try (true, input_line chan) with End_of_file -> (false, "") in if b then cat_aux (l::acc) () else acc in cat_aux [] () +> List.rev +> (fun x -> close_in chan; x) let cat_array file = (""::cat file) +> Array.of_list let interpolate str = begin command2 ("printf \"%s\\n\" " ^ str ^ ">/tmp/caml"); cat "/tmp/caml" end (* could do a print_string but printf don't like print_string *) let echo s = printf "%s" s; flush stdout; s let usleep s = for i = 1 to s do () done let sleep_little () = (*old: *) Unix.sleep 1 (*ignore(Sys.command ("usleep " ^ !_sleep_time))*) (* now in prelude: * let command2 s = ignore(Sys.command s) *) let do_in_fork f = let pid = Unix.fork () in if pid =|= 0 then begin (* Unix.setsid(); *) Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> pr2 "being killed"; Unix.kill 0 Sys.sigkill; )); f(); exit 0; end else pid let process_output_to_list2 = fun command -> let chan = Unix.open_process_in command in let res = ref ([] : string list) in let rec process_otl_aux () = let e = input_line chan in res := e::!res; process_otl_aux() in try process_otl_aux () with End_of_file -> let stat = Unix.close_process_in chan in (List.rev !res,stat) let cmd_to_list command = let (l,_) = process_output_to_list2 command in l let process_output_to_list = cmd_to_list let cmd_to_list_and_status = process_output_to_list2 (* now in prelude: * let command2 s = ignore(Sys.command s) *) let _batch_mode = ref false let command2_y_or_no cmd = if !_batch_mode then begin command2 cmd; true end else begin pr2 (cmd ^ " [y/n] ?"); match read_line () with | "y" | "yes" | "Y" -> command2 cmd; true | "n" | "no" | "N" -> false | _ -> failwith "answer by yes or no" end let command2_y_or_no_exit_if_no cmd = let res = command2_y_or_no cmd in if res then () else raise (UnixExit (1)) let mkdir ?(mode=0o770) file = Unix.mkdir file mode let read_file_orig file = cat file +> unlines let read_file file = let ic = open_in file in let size = in_channel_length ic in let buf = String.create size in really_input ic buf 0 size; close_in ic; buf let write_file ~file s = let chan = open_out file in (output_string chan s; close_out chan) let filesize file = (Unix.stat file).Unix.st_size let filemtime file = (Unix.stat file).Unix.st_mtime (* opti? use wc -l ? *) let nblines_file file = cat file +> List.length let lfile_exists filename = try (match (Unix.lstat filename).Unix.st_kind with | (Unix.S_REG | Unix.S_LNK) -> true | _ -> false ) with Unix.Unix_error (Unix.ENOENT, _, _) -> false | Unix.Unix_error (Unix.ENOTDIR, _, _) -> false | Unix.Unix_error (error, _, fl) -> failwith (Printf.sprintf "unexpected error %s for file %s" (Unix.error_message error) fl) let is_directory file = (Unix.stat file).Unix.st_kind =*= Unix.S_DIR (* src: from chailloux et al book *) let capsule_unix f args = try (f args) with Unix.Unix_error (e, fm, argm) -> log (Printf.sprintf "exn Unix_error: %s %s %s\n" (Unix.error_message e) fm argm) let (readdir_to_kind_list: string -> Unix.file_kind -> string list) = fun path kind -> Sys.readdir path +> Array.to_list +> List.filter (fun s -> try let stat = Unix.lstat (path ^ "/" ^ s) in stat.Unix.st_kind =*= kind with e -> pr2 ("EXN pb stating file: " ^ s); false ) let (readdir_to_dir_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_DIR let (readdir_to_file_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_REG let (readdir_to_link_list: string -> string list) = fun path -> readdir_to_kind_list path Unix.S_LNK let (readdir_to_dir_size_list: string -> (string * int) list) = fun path -> Sys.readdir path +> Array.to_list +> map_filter (fun s -> let stat = Unix.lstat (path ^ "/" ^ s) in if stat.Unix.st_kind =*= Unix.S_DIR then Some (s, stat.Unix.st_size) else None ) (* could be in control section too *) (* Why a use_cache argument ? because sometimes want disable it but don't * want put the cache_computation funcall in comment, so just easier to * pass this extra option. *) let cache_computation2 ?(verbose=false) ?(use_cache=true) file ext_cache f = if not use_cache then f () else begin if not (Sys.file_exists file) then failwith ("can't find: " ^ file); let file_cache = (file ^ ext_cache) in if Sys.file_exists file_cache && filemtime file_cache >= filemtime file then begin if verbose then pr2 ("using cache: " ^ file_cache); get_value file_cache end else begin let res = f () in write_value res file_cache; res end end let cache_computation ?verbose ?use_cache a b c = profile_code "Common.cache_computation" (fun () -> cache_computation2 ?verbose ?use_cache a b c) let cache_computation_robust2 dest_dir file ext_cache (need_no_changed_files, need_no_changed_variables) ext_depend f = (if not (Sys.file_exists file) then failwith ("can't find: " ^ file)); let (file_cache,dependencies_cache) = let file_cache = (file ^ ext_cache) in let dependencies_cache = (file ^ ext_depend) in match dest_dir with None -> (file_cache, dependencies_cache) | Some dir -> let file_cache = Filename.concat dir (if String.get file_cache 0 =*= '/' then String.sub file_cache 1 ((String.length file_cache) - 1) else file_cache) in let dependencies_cache = Filename.concat dir (if String.get dependencies_cache 0 =*= '/' then String.sub dependencies_cache 1 ((String.length dependencies_cache) - 1) else dependencies_cache) in let _ = Sys.command (Printf.sprintf "mkdir -p %s" (Filename.dirname file_cache)) in (file_cache,dependencies_cache) in let dependencies = (* could do md5sum too *) ((file::need_no_changed_files) +> List.map (fun f -> f, filemtime f), need_no_changed_variables) in if Sys.file_exists dependencies_cache && get_value dependencies_cache =*= dependencies then (*begin pr2 ("cache computation reuse " ^ file);*) get_value file_cache (*end*) else begin (*pr2 ("cache computation recompute " ^ file);*) let res = f () in write_value dependencies dependencies_cache; write_value res file_cache; res end let cache_computation_robust a b c d e = profile_code "Common.cache_computation_robust" (fun () -> cache_computation_robust2 None a b c d e) let cache_computation_robust_in_dir a b c d e f = profile_code "Common.cache_computation_robust" (fun () -> cache_computation_robust2 a b c d e f) (* don't forget that cmd_to_list call bash and so pattern may contain * '*' symbols that will be expanded, so can do glob "*.c" *) let glob pattern = cmd_to_list ("ls -1 " ^ pattern) (* update: have added the -type f, so normally need less the sanity_check_xxx * function below *) let files_of_dir_or_files ext xs = xs +> List.map (fun x -> if is_directory x then cmd_to_list ("find " ^ x ^" -noleaf -type f -name \"*." ^ext^"\"") else [x] ) +> List.concat let files_of_dir_or_files_no_vcs ext xs = xs +> List.map (fun x -> if is_directory x then cmd_to_list ("find " ^ x ^" -noleaf -type f -name \"*." ^ext^"\"" ^ "| grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/ |grep -v /_darcs/" ) else [x] ) +> List.concat let files_of_dir_or_files_no_vcs_post_filter regex xs = xs +> List.map (fun x -> if is_directory x then cmd_to_list ("find " ^ x ^ " -noleaf -type f | grep -v /.hg/ |grep -v /CVS/ | grep -v /.git/ |grep -v /_darcs/" ) +> List.filter (fun s -> s =~ regex) else [x] ) +> List.concat let sanity_check_files_and_adjust ext files = let files = files +> List.filter (fun file -> if not (file =~ (".*\\."^ext)) then begin pr2 ("warning: seems not a ."^ext^" file"); false end else if is_directory file then begin pr2 (spf "warning: %s is a directory" file); false end else true ) in files (* taken from mlfuse, the predecessor of ocamlfuse *) type rwx = [`R|`W|`X] list let file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm = fun ~u ~g ~o -> let to_oct l = List.fold_left (fun acc p -> acc lor ((function `R -> 4 | `W -> 2 | `X -> 1) p)) 0 l in let perm = ((to_oct u) lsl 6) lor ((to_oct g) lsl 3) lor (to_oct o) in perm (* pixel *) let has_env var = try let _ = Sys.getenv var in true with Not_found -> false (* emacs/lisp inspiration (eric cooper and yaron minsky use that too) *) let (with_open_outfile: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = fun file f -> let chan = open_out file in let pr s = output_string chan s in unwind_protect (fun () -> let res = f (pr, chan) in close_out chan; res) (fun e -> close_out chan) let (with_open_infile: filename -> ((in_channel) -> 'a) -> 'a) = fun file f -> let chan = open_in file in unwind_protect (fun () -> let res = f chan in close_in chan; res) (fun e -> close_in chan) let (with_open_outfile_append: filename -> (((string -> unit) * out_channel) -> 'a) -> 'a) = fun file f -> let chan = open_out_gen [Open_creat;Open_append] 0o666 file in let pr s = output_string chan s in unwind_protect (fun () -> let res = f (pr, chan) in close_out chan; res) (fun e -> close_out chan) (* now in prelude: * exception Timeout *) (* it seems that the toplevel block such signals, even with this explicit * command :( * let _ = Unix.sigprocmask Unix.SIG_UNBLOCK [Sys.sigalrm] *) (* could be in Control section *) (* subtil: have to make sure that timeout is not intercepted before here, so * avoid exn handle such as try (...) with _ -> cos timeout will not bubble up * enough. In such case, add a case before such as * with Timeout -> raise Timeout | _ -> ... * * question: can we have a signal and so exn when in a exn handler ? *) let interval_timer = ref true let timeout_function timeoutval = fun f -> try if !interval_timer then begin Sys.set_signal Sys.sigvtalrm (Sys.Signal_handle (fun _ -> raise Timeout)); ignore (Unix.setitimer Unix.ITIMER_VIRTUAL {Unix.it_interval=float_of_int timeoutval; Unix.it_value =float_of_int timeoutval}); let x = f() in ignore(Unix.alarm 0); x end else begin Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout )); ignore(Unix.alarm timeoutval); let x = f() in ignore(Unix.alarm 0); x end with Timeout -> begin log "timeout (we abort)"; (*pr2 (List.hd(cmd_to_list "free -m | grep Mem"));*) raise Timeout; end | e -> (* subtil: important to disable the alarm before relaunching the exn, * otherwise the alarm is still running. * * robust?: and if alarm launched after the log (...) ? * Maybe signals are disabled when process an exception handler ? *) begin ignore(Unix.alarm 0); (* log ("exn while in transaction (we abort too, even if ...) = " ^ Printexc.to_string e); *) log "exn while in timeout_function"; raise e end let timeout_function_opt timeoutvalopt f = match timeoutvalopt with | None -> f() | Some x -> timeout_function x f (* removes only if the file does not exists *) let remove_file path = if Sys.file_exists path then Sys.remove path else () (* creation of tmp files, a la gcc *) let _temp_files_created = ref ([] : filename list) (* ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c" *) let new_temp_file prefix suffix = let processid = i_to_s (Unix.getpid ()) in let tmp_file = Filename.temp_file (prefix ^ "-" ^ processid ^ "-") suffix in push2 tmp_file _temp_files_created; tmp_file let save_tmp_files = ref false let erase_temp_files () = if not !save_tmp_files then begin !_temp_files_created +> List.iter (fun s -> (* pr2 ("erasing: " ^ s); *) remove_file s ); _temp_files_created := [] end let erase_this_temp_file f = if not !save_tmp_files then begin _temp_files_created := List.filter (function x -> not (x =$= f)) !_temp_files_created; remove_file f end (* now in prelude: exception UnixExit of int *) let exn_to_real_unixexit f = try f() with UnixExit x -> exit x let uncat xs file = with_open_outfile file (fun (pr,_chan) -> xs +> List.iter (fun s -> pr s; pr "\n"); ) (*****************************************************************************) (* List *) (*****************************************************************************) (* pixel *) let uncons l = (List.hd l, List.tl l) (* pixel *) let safe_tl l = try List.tl l with _ -> [] let push l v = l := v :: !l let rec zip xs ys = match (xs,ys) with | ([],[]) -> [] | ([],_) -> failwith "zip: not same length" | (_,[]) -> failwith "zip: not same length" | (x::xs,y::ys) -> (x,y)::zip xs ys let rec zip_safe xs ys = match (xs,ys) with | ([],_) -> [] | (_,[]) -> [] | (x::xs,y::ys) -> (x,y)::zip_safe xs ys let rec unzip zs = List.fold_right (fun e (xs, ys) -> (fst e::xs), (snd e::ys)) zs ([],[]) let map_withkeep f xs = xs +> List.map (fun x -> f x, x) (* now in prelude * let rec take n xs = * match (n,xs) with * | (0,_) -> [] * | (_,[]) -> failwith "take: not enough" * | (n,x::xs) -> x::take (n-1) xs *) let rec take_safe n xs = match (n,xs) with | (0,_) -> [] | (_,[]) -> [] | (n,x::xs) -> x::take_safe (n-1) xs let rec take_until p = function | [] -> [] | x::xs -> if p x then [] else x::(take_until p xs) let take_while p = take_until (p $ not) (* now in prelude: let rec drop n xs = ... *) let _ = example (drop 3 [1;2;3;4] =*= [4]) let rec drop_while p = function | [] -> [] | x::xs -> if p x then drop_while p xs else x::xs let rec drop_until p xs = drop_while (fun x -> not (p x)) xs let _ = example (drop_until (fun x -> x =|= 3) [1;2;3;4;5] =*= [3;4;5]) let span p xs = (take_while p xs, drop_while p xs) let rec (span: ('a -> bool) -> 'a list -> 'a list * 'a list) = fun p -> function | [] -> ([], []) | x::xs -> if p x then let (l1, l2) = span p xs in (x::l1, l2) else ([], x::xs) let _ = example ((span (fun x -> x <= 3) [1;2;3;4;1;2] =*= ([1;2;3],[4;1;2]))) let rec groupBy eq l = match l with | [] -> [] | x::xs -> let (xs1,xs2) = List.partition (fun x' -> eq x x') xs in (x::xs1)::(groupBy eq xs2) let rec group_by_mapped_key fkey l = match l with | [] -> [] | x::xs -> let k = fkey x in let (xs1,xs2) = List.partition (fun x' -> let k2 = fkey x' in k=*=k2) xs in (k, (x::xs1))::(group_by_mapped_key fkey xs2) let (exclude_but_keep_attached: ('a -> bool) -> 'a list -> ('a * 'a list) list)= fun f xs -> let rec aux_filter acc ans = function | [] -> (* drop what was accumulated because nothing to attach to *) List.rev ans | x::xs -> if f x then aux_filter (x::acc) ans xs else aux_filter [] ((x, List.rev acc)::ans) xs in aux_filter [] [] xs let _ = example (exclude_but_keep_attached (fun x -> x =|= 3) [3;3;1;3;2;3;3;3] =*= [(1,[3;3]);(2,[3])]) let (group_by_post: ('a -> bool) -> 'a list -> ('a list * 'a) list * 'a list)= fun f xs -> let rec aux_filter grouped_acc acc = function | [] -> List.rev grouped_acc, List.rev acc | x::xs -> if f x then aux_filter ((List.rev acc,x)::grouped_acc) [] xs else aux_filter grouped_acc (x::acc) xs in aux_filter [] [] xs let _ = example (group_by_post (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= ([([1;1],3);([2],3);[4;5],3], [6;6;6])) let (group_by_pre: ('a -> bool) -> 'a list -> 'a list * ('a * 'a list) list)= fun f xs -> let xs' = List.rev xs in let (ys, unclassified) = group_by_post f xs' in List.rev unclassified, ys +> List.rev +> List.map (fun (xs, x) -> x, List.rev xs ) let _ = example (group_by_pre (fun x -> x =|= 3) [1;1;3;2;3;4;5;3;6;6;6] =*= ([1;1], [(3,[2]); (3,[4;5]); (3,[6;6;6])])) let (split_when: ('a -> bool) -> 'a list -> 'a list * 'a * 'a list) = fun p l -> let rec loop acc = function | [] -> raise Not_found | x::xs -> if p x then List.rev acc, x, xs else loop (x :: acc) xs in loop [] l let _ = example (split_when (fun x -> x =|= 3) [1;2;3;4;1;2] =*= ([1;2],3,[4;1;2])) (* not so easy to come up with ... used in aComment for split_paragraph *) let rec split_gen_when_aux f acc xs = match xs with | [] -> if null acc then [] else [List.rev acc] | (x::xs) -> (match f (x::xs) with | None -> split_gen_when_aux f (x::acc) xs | Some (rest) -> let before = List.rev acc in if null before then split_gen_when_aux f [] rest else before::split_gen_when_aux f [] rest ) (* could avoid introduce extra aux function by using ?(acc = []) *) let split_gen_when f xs = split_gen_when_aux f [] xs (* generate exception (Failure "tl") if there is no element satisfying p *) let rec (skip_until: ('a list -> bool) -> 'a list -> 'a list) = fun p xs -> if p xs then xs else skip_until p (List.tl xs) let _ = example (skip_until (function 1::2::xs -> true | _ -> false) [1;3;4;1;2;4;5] =*= [1;2;4;5]) let rec skipfirst e = function | [] -> [] | e'::l when e =*= e' -> skipfirst e l | l -> l (* now in prelude: * let rec enum x n = ... *) let index_list xs = if null xs then [] (* enum 0 (-1) generate an exception *) else zip xs (enum 0 ((List.length xs) -1)) let index_list_and_total xs = let total = List.length xs in if null xs then [] (* enum 0 (-1) generate an exception *) else zip xs (enum 0 ((List.length xs) -1)) +> List.map (fun (a,b) -> (a,b,total)) let index_list_1 xs = xs +> index_list +> List.map (fun (x,i) -> x, i+1) let or_list = List.fold_left (||) false let and_list = List.fold_left (&&) true let avg_list xs = let sum = sum_int xs in (float_of_int sum) /. (float_of_int (List.length xs)) let snoc x xs = xs @ [x] let cons x xs = x::xs let head_middle_tail xs = match xs with | x::y::xs -> let head = x in let reversed = List.rev (y::xs) in let tail = List.hd reversed in let middle = List.rev (List.tl reversed) in head, middle, tail | _ -> failwith "head_middle_tail, too small list" let _ = assert_equal (head_middle_tail [1;2;3]) (1, [2], 3) let _ = assert_equal (head_middle_tail [1;3]) (1, [], 3) (* now in prelude * let (++) = (@) *) (* let (++) = (@), could do that, but if load many times the common, then pb *) (* let (++) l1 l2 = List.fold_right (fun x acc -> x::acc) l1 l2 *) let remove x xs = let newxs = List.filter (fun y -> y <> x) xs in assert (List.length newxs =|= List.length xs - 1); newxs let exclude p xs = List.filter (fun x -> not (p x)) xs (* now in prelude *) let fold_k f lastk acc xs = let rec fold_k_aux acc = function | [] -> lastk acc | x::xs -> f acc x (fun acc -> fold_k_aux acc xs) in fold_k_aux acc xs let rec list_init = function | [] -> raise Not_found | [x] -> [] | x::y::xs -> x::(list_init (y::xs)) let rec list_last = function | [] -> raise Not_found | [x] -> x | x::y::xs -> list_last (y::xs) (* pixel *) (* now in prelude * let last_n n l = List.rev (take n (List.rev l)) * let last l = List.hd (last_n 1 l) *) let rec join_gen a = function | [] -> [] | [x] -> [x] | x::xs -> x::a::(join_gen a xs) (* todo: foldl, foldr (a more consistent foldr) *) (* start pixel *) let iter_index f l = let rec iter_ n = function | [] -> () | e::l -> f e n ; iter_ (n+1) l in iter_ 0 l let map_index f l = let rec map_ n = function | [] -> [] | e::l -> f e n :: map_ (n+1) l in map_ 0 l (* pixel *) let filter_index f l = let rec filt i = function | [] -> [] | e::l -> if f i e then e :: filt (i+1) l else filt (i+1) l in filt 0 l (* pixel *) let do_withenv doit f env l = let r_env = ref env in let l' = doit (fun e -> let e', env' = f !r_env e in r_env := env' ; e' ) l in l', !r_env (* now in prelude: * let fold_left_with_index f acc = ... *) let map_withenv f env e = do_withenv List.map f env e let rec collect_accu f accu = function | [] -> accu | e::l -> collect_accu f (List.rev_append (f e) accu) l let collect f l = List.rev (collect_accu f [] l) (* cf also List.partition *) let rec fpartition p l = let rec part yes no = function | [] -> (List.rev yes, List.rev no) | x :: l -> (match p x with | None -> part yes (x :: no) l | Some v -> part (v :: yes) no l) in part [] [] l (* end pixel *) let rec removelast = function | [] -> failwith "removelast" | [_] -> [] | e::l -> e :: removelast l let remove x = List.filter (fun y -> y != x) let empty list = null list let rec inits = function | [] -> [[]] | e::l -> [] :: List.map (fun l -> e::l) (inits l) let rec tails = function | [] -> [[]] | (_::xs) as xxs -> xxs :: tails xs let reverse = List.rev let rev = List.rev let nth = List.nth let fold_left = List.fold_left let rev_map = List.rev_map (* pixel *) let rec fold_right1 f = function | [] -> failwith "fold_right1" | [e] -> e | e::l -> f e (fold_right1 f l) let maximum l = foldl1 max l let minimum l = foldl1 min l (* do a map tail recursive, and result is reversed, it is a tail recursive map => efficient *) let map_eff_rev = fun f l -> let rec map_eff_aux acc = function | [] -> acc | x::xs -> map_eff_aux ((f x)::acc) xs in map_eff_aux [] l let acc_map f l = let rec loop acc = function [] -> List.rev acc | x::xs -> loop ((f x)::acc) xs in loop [] l let rec (generate: int -> 'a -> 'a list) = fun i el -> if i =|= 0 then [] else el::(generate (i-1) el) let rec uniq = function | [] -> [] | e::l -> if List.mem e l then uniq l else e :: uniq l let has_no_duplicate xs = List.length xs =|= List.length (uniq xs) let is_set_as_list = has_no_duplicate let rec get_duplicates xs = match xs with | [] -> [] | x::xs -> if List.mem x xs then x::get_duplicates xs (* todo? could x from xs to avoid double dups?*) else get_duplicates xs let rec all_assoc e = function | [] -> [] | (e',v) :: l when e=*=e' -> v :: all_assoc e l | _ :: l -> all_assoc e l let prepare_want_all_assoc l = List.map (fun n -> n, uniq (all_assoc n l)) (uniq (List.map fst l)) let rotate list = List.tl list ++ [(List.hd list)] let or_list = List.fold_left (||) false let and_list = List.fold_left (&&) true let rec (return_when: ('a -> 'b option) -> 'a list -> 'b) = fun p -> function | [] -> raise Not_found | x::xs -> (match p x with None -> return_when p xs | Some b -> b) let rec splitAt n xs = if n =|= 0 then ([],xs) else (match xs with | [] -> ([],[]) | (x::xs) -> let (a,b) = splitAt (n-1) xs in (x::a, b) ) let pack n xs = let rec pack_aux l i = function | [] -> failwith "not on a boundary" | [x] -> if i =|= n then [l++[x]] else failwith "not on a boundary" | x::xs -> if i =|= n then (l++[x])::(pack_aux [] 1 xs) else pack_aux (l++[x]) (i+1) xs in pack_aux [] 1 xs let min_with f = function | [] -> raise Not_found | e :: l -> let rec min_with_ min_val min_elt = function | [] -> min_elt | e::l -> let val_ = f e in if val_ < min_val then min_with_ val_ e l else min_with_ min_val min_elt l in min_with_ (f e) e l let two_mins_with f = function | e1 :: e2 :: l -> let rec min_with_ min_val min_elt min_val2 min_elt2 = function | [] -> min_elt, min_elt2 | e::l -> let val_ = f e in if val_ < min_val2 then if val_ < min_val then min_with_ val_ e min_val min_elt l else min_with_ min_val min_elt val_ e l else min_with_ min_val min_elt min_val2 min_elt2 l in let v1 = f e1 in let v2 = f e2 in if v1 < v2 then min_with_ v1 e1 v2 e2 l else min_with_ v2 e2 v1 e1 l | _ -> raise Not_found let grep_with_previous f = function | [] -> [] | e::l -> let rec grep_with_previous_ previous = function | [] -> [] | e::l -> if f previous e then e :: grep_with_previous_ e l else grep_with_previous_ previous l in e :: grep_with_previous_ e l let iter_with_previous f = function | [] -> () | e::l -> let rec iter_with_previous_ previous = function | [] -> () | e::l -> f previous e ; iter_with_previous_ e l in iter_with_previous_ e l let iter_with_before_after f xs = let rec aux before_rev after = match after with | [] -> () | x::xs -> f before_rev x xs; aux (x::before_rev) xs in aux [] xs (* kind of cartesian product of x*x *) let rec (get_pair: ('a list) -> (('a * 'a) list)) = function | [] -> [] | x::xs -> (List.map (fun y -> (x,y)) xs) ++ (get_pair xs) (* retourne le rang dans une liste d'un element *) let rang elem liste = let rec rang_rec elem accu = function | [] -> raise Not_found | a::l -> if a =*= elem then accu else rang_rec elem (accu+1) l in rang_rec elem 1 liste (* retourne vrai si une liste contient des doubles *) let rec doublon = function | [] -> false | a::l -> if List.mem a l then true else doublon l let rec (insert_in: 'a -> 'a list -> 'a list list) = fun x -> function | [] -> [[x]] | y::ys -> (x::y::ys) :: (List.map (fun xs -> y::xs) (insert_in x ys)) (* insert_in 3 [1;2] = [[3; 1; 2]; [1; 3; 2]; [1; 2; 3]] *) let rec (permutation: 'a list -> 'a list list) = function | [] -> [] | [x] -> [[x]] | x::xs -> List.flatten (List.map (insert_in x) (permutation xs)) (* permutation [1;2;3] = * [[1; 2; 3]; [2; 1; 3]; [2; 3; 1]; [1; 3; 2]; [3; 1; 2]; [3; 2; 1]] *) let rec remove_elem_pos pos xs = match (pos, xs) with | _, [] -> failwith "remove_elem_pos" | 0, x::xs -> xs | n, x::xs -> x::(remove_elem_pos (n-1) xs) let rec insert_elem_pos (e, pos) xs = match (pos, xs) with | 0, xs -> e::xs | n, x::xs -> x::(insert_elem_pos (e, (n-1)) xs) | n, [] -> failwith "insert_elem_pos" let rec uncons_permut xs = let indexed = index_list xs in indexed +> List.map (fun (x, pos) -> (x, pos), remove_elem_pos pos xs) let _ = example (uncons_permut ['a';'b';'c'] =*= [('a', 0), ['b';'c']; ('b', 1), ['a';'c']; ('c', 2), ['a';'b'] ]) let rec uncons_permut_lazy xs = let indexed = index_list xs in indexed +> List.map (fun (x, pos) -> (x, pos), lazy (remove_elem_pos pos xs) ) (* pixel *) let rec map_flatten f l = let rec map_flatten_aux accu = function | [] -> accu | e :: l -> map_flatten_aux (List.rev (f e) ++ accu) l in List.rev (map_flatten_aux [] l) let rec repeat e n = let rec repeat_aux acc = function | 0 -> acc | n when n < 0 -> failwith "repeat" | n -> repeat_aux (e::acc) (n-1) in repeat_aux [] n let rec map2 f = function | [] -> [] | x::xs -> let r = f x in r::map2 f xs let rec map3 f l = let rec map3_aux acc = function | [] -> acc | x::xs -> map3_aux (f x::acc) xs in map3_aux [] l (* let tails2 xs = map rev (inits (rev xs)) let res = tails2 [1;2;3;4] let res = tails [1;2;3;4] let id x = x *) let pack_sorted same xs = let rec pack_s_aux acc xs = match (acc,xs) with | ((cur,rest),[]) -> cur::rest | ((cur,rest), y::ys) -> if same (List.hd cur) y then pack_s_aux (y::cur, rest) ys else pack_s_aux ([y], cur::rest) ys in pack_s_aux ([List.hd xs],[]) (List.tl xs) +> List.rev let test = pack_sorted (=*=) [1;1;1;2;2;3;4] let rec keep_best f = let rec partition e = function | [] -> e, [] | e' :: l -> match f(e,e') with | None -> let (e'', l') = partition e l in e'', e' :: l' | Some e'' -> partition e'' l in function | [] -> [] | e::l -> let (e', l') = partition e l in e' :: keep_best f l' let rec sorted_keep_best f = function | [] -> [] | [a] -> [a] | a :: b :: l -> match f a b with | None -> a :: sorted_keep_best f (b :: l) | Some e -> sorted_keep_best f (e :: l) let (cartesian_product: 'a list -> 'b list -> ('a * 'b) list) = fun xs ys -> xs +> List.map (fun x -> ys +> List.map (fun y -> (x,y))) +> List.flatten let _ = assert_equal (cartesian_product [1;2] ["3";"4";"5"]) [1,"3";1,"4";1,"5"; 2,"3";2,"4";2,"5"] let sort_prof a b = profile_code "Common.sort_by_xxx" (fun () -> List.sort a b) let sort_by_val_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare v2 v1) xs let sort_by_val_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare v1 v2) xs let sort_by_key_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k2 k1) xs let sort_by_key_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k1 k2) xs let _ = example (sort_by_key_lowfirst [4, (); 7,()] =*= [4,(); 7,()]) let _ = example (sort_by_key_highfirst [4,(); 7,()] =*= [7,(); 4,()]) let sortgen_by_key_highfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k2 k1) xs let sortgen_by_key_lowfirst xs = sort_prof (fun (k1,v1) (k2,v2) -> compare k1 k2) xs (*----------------------------------*) (* sur surEnsemble [p1;p2] [[p1;p2;p3] [p1;p2] ....] -> [[p1;p2;p3] ... *) (* mais pas p2;p3 *) (* (aop) *) let surEnsemble liste_el liste_liste_el = List.filter (function liste_elbis -> List.for_all (function el -> List.mem el liste_elbis) liste_el ) liste_liste_el;; (*----------------------------------*) (* combinaison/product/.... (aop) *) (* 123 -> 123 12 13 23 1 2 3 *) let rec realCombinaison = function | [] -> [] | [a] -> [[a]] | a::l -> let res = realCombinaison l in let res2 = List.map (function x -> a::x) res in res2 ++ res ++ [[a]] (* genere toutes les combinaisons possible de paire *) (* par example combinaison [1;2;4] -> [1, 2; 1, 4; 2, 4] *) let rec combinaison = function | [] -> [] | [a] -> [] | [a;b] -> [(a, b)] | a::b::l -> (List.map (function elem -> (a, elem)) (b::l)) ++ (combinaison (b::l)) (*----------------------------------*) (* list of list(aop) *) (* insere elem dans la liste de liste (si elem est deja present dans une de *) (* ces listes, on ne fait rien *) let rec insere elem = function | [] -> [[elem]] | a::l -> if (List.mem elem a) then a::l else a::(insere elem l) let rec insereListeContenant lis el = function | [] -> [el::lis] | a::l -> if List.mem el a then (List.append lis a)::l else a::(insereListeContenant lis el l) (* fusionne les listes contenant et1 et et2 dans la liste de liste*) let rec fusionneListeContenant (et1, et2) = function | [] -> [[et1; et2]] | a::l -> (* si les deux sont deja dedans alors rien faire *) if List.mem et1 a then if List.mem et2 a then a::l else insereListeContenant a et2 l else if List.mem et2 a then insereListeContenant a et1 l else a::(fusionneListeContenant (et1, et2) l) (*****************************************************************************) (* Arrays *) (*****************************************************************************) (* do bound checking ? *) let array_find_index f a = let rec array_find_index_ i = if f i then i else array_find_index_ (i+1) in try array_find_index_ 0 with _ -> raise Not_found let array_find_index_via_elem f a = let rec array_find_index_ i = if f a.(i) then i else array_find_index_ (i+1) in try array_find_index_ 0 with _ -> raise Not_found type idx = Idx of int let next_idx (Idx i) = (Idx (i+1)) let int_of_idx (Idx i) = i let array_find_index_typed f a = let rec array_find_index_ i = if f i then i else array_find_index_ (next_idx i) in try array_find_index_ (Idx 0) with _ -> raise Not_found (*****************************************************************************) (* Matrix *) (*****************************************************************************) type 'a matrix = 'a array array let map_matrix f mat = mat +> Array.map (fun arr -> arr +> Array.map f) let (make_matrix_init: nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix) = fun ~nrow ~ncolumn f -> Array.init nrow (fun i -> Array.init ncolumn (fun j -> f i j ) ) let iter_matrix f m = Array.iteri (fun i e -> Array.iteri (fun j x -> f i j x ) e ) m let nb_rows_matrix m = Array.length m let nb_columns_matrix m = assert(Array.length m > 0); Array.length m.(0) (* check all nested arrays have the same size *) let invariant_matrix m = raise Todo let (rows_of_matrix: 'a matrix -> 'a list list) = fun m -> Array.to_list m +> List.map Array.to_list let (columns_of_matrix: 'a matrix -> 'a list list) = fun m -> let nbcols = nb_columns_matrix m in let nbrows = nb_rows_matrix m in (enum 0 (nbcols -1)) +> List.map (fun j -> (enum 0 (nbrows -1)) +> List.map (fun i -> m.(i).(j) )) let all_elems_matrix_by_row m = rows_of_matrix m +> List.flatten let ex_matrix1 = [| [|0;1;2|]; [|3;4;5|]; [|6;7;8|]; |] let ex_rows1 = [ [0;1;2]; [3;4;5]; [6;7;8]; ] let ex_columns1 = [ [0;3;6]; [1;4;7]; [2;5;8]; ] let _ = example (rows_of_matrix ex_matrix1 =*= ex_rows1) let _ = example (columns_of_matrix ex_matrix1 =*= ex_columns1) (*****************************************************************************) (* Fast array *) (*****************************************************************************) (* module B_Array = Bigarray.Array2 *) (* open B_Array open Bigarray *) (* for the string_of auto generation of camlp4 val b_array_string_of_t : 'a -> 'b -> string val bigarray_string_of_int16_unsigned_elt : 'a -> string val bigarray_string_of_c_layout : 'a -> string let b_array_string_of_t f a = "<>" let bigarray_string_of_int16_unsigned_elt a = "<>" let bigarray_string_of_c_layout a = "<>" *) (*****************************************************************************) (* Set. Have a look too at set*.mli *) (*****************************************************************************) type 'a set = 'a list (* with sexp *) let (empty_set: 'a set) = [] let (insert_set: 'a -> 'a set -> 'a set) = fun x xs -> if List.mem x xs then (* let _ = print_string "warning insert: already exist" in *) xs else x::xs let is_set xs = has_no_duplicate xs let (single_set: 'a -> 'a set) = fun x -> insert_set x empty_set let (set: 'a list -> 'a set) = fun xs -> xs +> List.fold_left (flip insert_set) empty_set let (exists_set: ('a -> bool) -> 'a set -> bool) = List.exists let (forall_set: ('a -> bool) -> 'a set -> bool) = List.for_all let (filter_set: ('a -> bool) -> 'a set -> 'a set) = List.filter let (fold_set: ('a -> 'b -> 'a) -> 'a -> 'b set -> 'a) = List.fold_left let (map_set: ('a -> 'b) -> 'a set -> 'b set) = List.map let (member_set: 'a -> 'a set -> bool) = List.mem let find_set = List.find let sort_set = List.sort let iter_set = List.iter let (top_set: 'a set -> 'a) = List.hd let (inter_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s1 +> fold_set (fun acc x -> if member_set x s2 then insert_set x acc else acc) empty_set let (union_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s2 +> fold_set (fun acc x -> if member_set x s1 then acc else insert_set x acc) s1 let (minus_set: 'a set -> 'a set -> 'a set) = fun s1 s2 -> s1 +> filter_set (fun x -> not (member_set x s2)) let union_all l = List.fold_left union_set [] l let big_union_set f xs = xs +> map_set f +> fold_set union_set empty_set let (card_set: 'a set -> int) = List.length let (include_set: 'a set -> 'a set -> bool) = fun s1 s2 -> (s1 +> forall_set (fun p -> member_set p s2)) let equal_set s1 s2 = include_set s1 s2 && include_set s2 s1 let (include_set_strict: 'a set -> 'a set -> bool) = fun s1 s2 -> (card_set s1 < card_set s2) && (include_set s1 s2) let ($*$) = inter_set let ($+$) = union_set let ($-$) = minus_set let ($?$) a b = profile_code "$?$" (fun () -> member_set a b) let ($<$) = include_set_strict let ($<=$) = include_set let ($=$) = equal_set (* as $+$ but do not check for memberness, allow to have set of func *) let ($@$) = fun a b -> a @ b let rec nub = function [] -> [] | x::xs -> if List.mem x xs then nub xs else x::(nub xs) (*****************************************************************************) (* Set as normal list *) (*****************************************************************************) (* let (union: 'a list -> 'a list -> 'a list) = fun l1 l2 -> List.fold_left (fun acc x -> if List.mem x l1 then acc else x::acc) l1 l2 let insert_normal x xs = union xs [x] (* retourne lis1 - lis2 *) let minus l1 l2 = List.filter (fun x -> not (List.mem x l2)) l1 let inter l1 l2 = List.fold_left (fun acc x -> if List.mem x l2 then x::acc else acc) [] l1 let union_list = List.fold_left union [] let uniq lis = List.fold_left (function acc -> function el -> union [el] acc) [] lis (* pixel *) let rec non_uniq = function | [] -> [] | e::l -> if mem e l then e :: non_uniq l else non_uniq l let rec inclu lis1 lis2 = List.for_all (function el -> List.mem el lis2) lis1 let equivalent lis1 lis2 = (inclu lis1 lis2) && (inclu lis2 lis1) *) (*****************************************************************************) (* Set as sorted list *) (*****************************************************************************) (* liste trie, cos we need to do intersection, and insertion (it is a set cos when introduce has, if we create a new has => must do a recurse_rep and another categ can have to this has => must do an union *) (* let rec insert x = function | [] -> [x] | y::ys -> if x = y then y::ys else (if x < y then x::y::ys else y::(insert x ys)) (* same, suppose sorted list *) let rec intersect x y = match(x,y) with | [], y -> [] | x, [] -> [] | x::xs, y::ys -> if x = y then x::(intersect xs ys) else (if x < y then intersect xs (y::ys) else intersect (x::xs) ys ) (* intersect [1;3;7] [2;3;4;7;8];; *) *) (*****************************************************************************) (* Assoc *) (*****************************************************************************) type ('a,'b) assoc = ('a * 'b) list (* with sexp *) let (assoc_to_function: ('a, 'b) assoc -> ('a -> 'b)) = fun xs -> xs +> List.fold_left (fun acc (k, v) -> (fun k' -> if k =*= k' then v else acc k' )) (fun k -> failwith "no key in this assoc") (* simpler: let (assoc_to_function: ('a, 'b) assoc -> ('a -> 'b)) = fun xs -> fun k -> List.assoc k xs *) let (empty_assoc: ('a, 'b) assoc) = [] let fold_assoc = List.fold_left let insert_assoc = fun x xs -> x::xs let map_assoc = List.map let filter_assoc = List.filter let assoc = List.assoc let keys xs = List.map fst xs let lookup = assoc (* assert unique key ?*) let del_assoc key xs = xs +> List.filter (fun (k,v) -> k <> key) let replace_assoc (key, v) xs = insert_assoc (key, v) (del_assoc key xs) let apply_assoc key f xs = let old = assoc key xs in replace_assoc (key, f old) xs let big_union_assoc f xs = xs +> map_assoc f +> fold_assoc union_set empty_set (* todo: pb normally can suppr fun l -> .... l but if do that, then strange type _a => assoc_map is strange too => equal dont work *) let (assoc_reverse: (('a * 'b) list) -> (('b * 'a) list)) = fun l -> List.map (fun(x,y) -> (y,x)) l let (assoc_map: (('a * 'b) list) -> (('a * 'b) list) -> (('a * 'a) list)) = fun l1 l2 -> let (l1bis, l2bis) = (assoc_reverse l1, assoc_reverse l2) in List.map (fun (x,y) -> (y, List.assoc x l2bis )) l1bis let rec (lookup_list: 'a -> ('a , 'b) assoc list -> 'b) = fun el -> function | [] -> raise Not_found | (xs::xxs) -> try List.assoc el xs with Not_found -> lookup_list el xxs let (lookup_list2: 'a -> ('a , 'b) assoc list -> ('b * int)) = fun el xxs -> let rec lookup_l_aux i = function | [] -> raise Not_found | (xs::xxs) -> try let res = List.assoc el xs in (res,i) with Not_found -> lookup_l_aux (i+1) xxs in lookup_l_aux 0 xxs let _ = example (lookup_list2 "c" [["a",1;"b",2];["a",1;"b",3];["a",1;"c",7]] =*= (7,2)) let assoc_option k l = optionise (fun () -> List.assoc k l) let assoc_with_err_msg k l = try List.assoc k l with Not_found -> pr2 (spf "pb assoc_with_err_msg: %s" (Dumper.dump k)); raise Not_found (*****************************************************************************) (* Assoc int -> xxx with binary tree. Have a look too at Mapb.mli *) (*****************************************************************************) (* ex: type robot_list = robot_info IntMap.t *) module IntMap = Map.Make (struct type t = int let compare = compare end) let intmap_to_list m = IntMap.fold (fun id v acc -> (id, v) :: acc) m [] let intmap_string_of_t f a = "" module IntIntMap = Map.Make (struct type t = int * int let compare = compare end) let intintmap_to_list m = IntIntMap.fold (fun id v acc -> (id, v) :: acc) m [] let intintmap_string_of_t f a = "" (*****************************************************************************) (* Hash *) (*****************************************************************************) (* il parait que better when choose a prime *) let hcreate () = Hashtbl.create 401 let hadd (k,v) h = Hashtbl.add h k v let hmem k h = Hashtbl.mem h k let hfind k h = Hashtbl.find h k let hreplace (k,v) h = Hashtbl.replace h k v let hiter = Hashtbl.iter let hfold = Hashtbl.fold let hremove k h = Hashtbl.remove h k let hash_to_list h = Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] +> List.sort compare let hash_to_list_unsorted h = Hashtbl.fold (fun k v acc -> (k,v)::acc) h [] let hash_of_list xs = let h = Hashtbl.create 101 in begin xs +> List.iter (fun (k, v) -> Hashtbl.add h k v); h end let _ = let h = Hashtbl.create 101 in Hashtbl.add h "toto" 1; Hashtbl.add h "toto" 1; assert(hash_to_list h =*= ["toto",1; "toto",1]) let hfind_default key value_if_not_found h = try Hashtbl.find h key with Not_found -> (Hashtbl.add h key (value_if_not_found ()); Hashtbl.find h key) (* not as easy as Perl $h->{key}++; but still possible *) let hupdate_default key op value_if_not_found h = let old = hfind_default key value_if_not_found h in Hashtbl.replace h key (op old) let hfind_option key h = optionise (fun () -> Hashtbl.find h key) (* see below: let hkeys h = ... *) (*****************************************************************************) (* Hash sets *) (*****************************************************************************) type 'a hashset = ('a, bool) Hashtbl.t (* with sexp *) let hash_hashset_add k e h = match optionise (fun () -> Hashtbl.find h k) with | Some hset -> Hashtbl.replace hset e true | None -> let hset = Hashtbl.create 11 in begin Hashtbl.add h k hset; Hashtbl.replace hset e true; end let hashset_to_set baseset h = h +> hash_to_list +> List.map fst +> (fun xs -> baseset#fromlist xs) let hashset_to_list h = hash_to_list h +> List.map fst let hashset_of_list xs = xs +> List.map (fun x -> x, true) +> hash_of_list let hkeys h = let hkey = Hashtbl.create 101 in h +> Hashtbl.iter (fun k v -> Hashtbl.replace hkey k true); hashset_to_list hkey let group_assoc_bykey_eff2 xs = let h = Hashtbl.create 101 in xs +> List.iter (fun (k, v) -> Hashtbl.add h k v); let keys = hkeys h in keys +> List.map (fun k -> k, Hashtbl.find_all h k) let group_assoc_bykey_eff xs = profile_code2 "Common.group_assoc_bykey_eff" (fun () -> group_assoc_bykey_eff2 xs) let test_group_assoc () = let xs = enum 0 10000 +> List.map (fun i -> i_to_s i, i) in let xs = ("0", 2)::xs in (* let _ys = xs +> Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) *) let ys = xs +> group_assoc_bykey_eff in pr2_gen ys let uniq_eff xs = let h = Hashtbl.create 101 in xs +> List.iter (fun k -> Hashtbl.add h k true ); hkeys h let diff_two_say_set_eff xs1 xs2 = let h1 = hashset_of_list xs1 in let h2 = hashset_of_list xs2 in let hcommon = Hashtbl.create 101 in let honly_in_h1 = Hashtbl.create 101 in let honly_in_h2 = Hashtbl.create 101 in h1 +> Hashtbl.iter (fun k _ -> if Hashtbl.mem h2 k then Hashtbl.replace hcommon k true else Hashtbl.add honly_in_h1 k true ); h2 +> Hashtbl.iter (fun k _ -> if Hashtbl.mem h1 k then Hashtbl.replace hcommon k true else Hashtbl.add honly_in_h2 k true ); hashset_to_list hcommon, hashset_to_list honly_in_h1, hashset_to_list honly_in_h2 (*****************************************************************************) (* Stack *) (*****************************************************************************) type 'a stack = 'a list (* with sexp *) let (empty_stack: 'a stack) = [] let (push: 'a -> 'a stack -> 'a stack) = fun x xs -> x::xs let (top: 'a stack -> 'a) = List.hd let (pop: 'a stack -> 'a stack) = List.tl let top_option = function | [] -> None | x::xs -> Some x (* now in prelude: * let push2 v l = l := v :: !l *) let pop2 l = let v = List.hd !l in begin l := List.tl !l; v end (*****************************************************************************) (* Undoable Stack *) (*****************************************************************************) (* Okasaki use such structure also for having efficient data structure * supporting fast append. *) type 'a undo_stack = 'a list * 'a list (* redo *) let (empty_undo_stack: 'a undo_stack) = [], [] (* push erase the possible redo *) let (push_undo: 'a -> 'a undo_stack -> 'a undo_stack) = fun x (undo,redo) -> x::undo, [] let (top_undo: 'a undo_stack -> 'a) = fun (undo, redo) -> List.hd undo let (pop_undo: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> match undo with | [] -> failwith "empty undo stack" | x::xs -> xs, x::redo let (undo_pop: 'a undo_stack -> 'a undo_stack) = fun (undo, redo) -> match redo with | [] -> failwith "empty redo, nothing to redo" | x::xs -> x::undo, xs let redo_undo x = undo_pop x let top_undo_option = fun (undo, redo) -> match undo with | [] -> None | x::xs -> Some x (*****************************************************************************) (* Binary tree *) (*****************************************************************************) type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree) (*****************************************************************************) (* N-ary tree *) (*****************************************************************************) (* no empty tree, must have one root at list *) type 'a tree = Tree of 'a * ('a tree) list let rec (tree_iter: ('a -> unit) -> 'a tree -> unit) = fun f tree -> match tree with | Tree (node, xs) -> f node; xs +> List.iter (tree_iter f) (*****************************************************************************) (* N-ary tree with updatable childrens *) (*****************************************************************************) (* no empty tree, must have one root at list *) type 'a treeref = | NodeRef of 'a * 'a treeref list ref let treeref_children_ref tree = match tree with | NodeRef (n, x) -> x let rec (treeref_node_iter: (* (('a * ('a, 'b) treeref list ref) -> unit) -> ('a, 'b) treeref -> unit *) 'a) = fun f tree -> match tree with (* | LeafRef _ -> ()*) | NodeRef (n, xs) -> f (n, xs); !xs +> List.iter (treeref_node_iter f) let find_treeref f tree = let res = ref [] in tree +> treeref_node_iter (fun (n, xs) -> if f (n,xs) then push2 (n, xs) res; ); match !res with | [n,xs] -> NodeRef (n, xs) | [] -> raise Not_found | x::y::zs -> raise Multi_found let rec (treeref_node_iter_with_parents: (* (('a * ('a, 'b) treeref list ref) -> ('a list) -> unit) -> ('a, 'b) treeref -> unit) *) 'a) = fun f tree -> let rec aux acc tree = match tree with (* | LeafRef _ -> ()*) | NodeRef (n, xs) -> f (n, xs) acc ; !xs +> List.iter (aux (n::acc)) in aux [] tree (* ---------------------------------------------------------------------- *) (* Leaf can seem redundant, but sometimes want to directly see if * a children is a leaf without looking if the list is empty. *) type ('a, 'b) treeref2 = | NodeRef2 of 'a * ('a, 'b) treeref2 list ref | LeafRef2 of 'b let treeref2_children_ref tree = match tree with | LeafRef2 _ -> failwith "treeref_tail: leaf" | NodeRef2 (n, x) -> x let rec (treeref_node_iter2: (('a * ('a, 'b) treeref2 list ref) -> unit) -> ('a, 'b) treeref2 -> unit) = fun f tree -> match tree with | LeafRef2 _ -> () | NodeRef2 (n, xs) -> f (n, xs); !xs +> List.iter (treeref_node_iter2 f) let find_treeref2 f tree = let res = ref [] in tree +> treeref_node_iter2 (fun (n, xs) -> if f (n,xs) then push2 (n, xs) res; ); match !res with | [n,xs] -> NodeRef2 (n, xs) | [] -> raise Not_found | x::y::zs -> raise Multi_found let rec (treeref_node_iter_with_parents2: (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> ('a, 'b) treeref2 -> unit) = fun f tree -> let rec aux acc tree = match tree with | LeafRef2 _ -> () | NodeRef2 (n, xs) -> f (n, xs) acc ; !xs +> List.iter (aux (n::acc)) in aux [] tree let find_treeref_with_parents_some f tree = let res = ref [] in tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> match f (n,xs) parents with | Some v -> push2 v res; | None -> () ); match !res with | [v] -> v | [] -> raise Not_found | x::y::zs -> raise Multi_found let find_multi_treeref_with_parents_some f tree = let res = ref [] in tree +> treeref_node_iter_with_parents (fun (n, xs) parents -> match f (n,xs) parents with | Some v -> push2 v res; | None -> () ); match !res with | [v] -> !res | [] -> raise Not_found | x::y::zs -> !res (*****************************************************************************) (* Graph. Have a look too at Ograph_*.mli *) (*****************************************************************************) (* todo: generalise to put in common (need 'edge (and 'c ?), * and take in param a display func, cos caml sux, no overloading of show :( * Simple impelemntation. Can do also matrix, or adjacent list, or pointer(ref) * todo: do some check (dont exist already, ...) *) type 'node graph = ('node set) * (('node * 'node) set) let (add_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> (node::nodes, arcs) let (del_node: 'a -> 'a graph -> 'a graph) = fun node (nodes, arcs) -> (nodes $-$ set [node], arcs) (* could do more job: let _ = assert (successors node (nodes, arcs) = empty) in +> List.filter (fun (src, dst) -> dst != node)) *) let (add_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> (nodes, set [arc] $+$ arcs) let (del_arc: ('a * 'a) -> 'a graph -> 'a graph) = fun arc (nodes, arcs) -> (nodes, arcs +> List.filter (fun a -> not (arc =*= a))) let (successors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> arcs +> List.filter (fun (src, dst) -> src =*= x) +> List.map snd let (predecessors: 'a -> 'a graph -> 'a set) = fun x (nodes, arcs) -> arcs +> List.filter (fun (src, dst) -> dst =*= x) +> List.map fst let (nodes: 'a graph -> 'a set) = fun (nodes, arcs) -> nodes (* pre: no cycle *) let rec (fold_upward: ('b -> 'a -> 'b) -> 'a set -> 'b -> 'a graph -> 'b) = fun f xs acc graph -> match xs with | [] -> acc | x::xs -> (f acc x) +> (fun newacc -> fold_upward f (graph +> predecessors x) newacc graph) +> (fun newacc -> fold_upward f xs newacc graph) (* TODO avoid already visited *) let empty_graph = ([], []) (* let (add_arcs_toward: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> function (nodes, arcs) -> (nodes, (List.map (fun j -> (j,i) ) xs)++arcs) let (del_arcs_toward: int -> (int list) -> 'a graph -> 'a graph)= fun i xs g -> List.fold_left (fun acc el -> del_arc (el, i) acc) g xs let (add_arcs_from: int -> (int list) -> 'a graph -> 'a graph) = fun i xs -> function (nodes, arcs) -> (nodes, (List.map (fun j -> (i,j) ) xs)++arcs) let (del_node: (int * 'node) -> 'node graph -> 'node graph) = fun node -> function (nodes, arcs) -> let newnodes = List.filter (fun a -> not (node = a)) nodes in if newnodes = nodes then (raise Not_found) else (newnodes, arcs) let (replace_node: int -> 'node -> 'node graph -> 'node graph) = fun i n -> function (nodes, arcs) -> let newnodes = List.filter (fun (j,_) -> not (i = j)) nodes in ((i,n)::newnodes, arcs) let (get_node: int -> 'node graph -> 'node) = fun i -> function (nodes, arcs) -> List.assoc i nodes let (get_free: 'a graph -> int) = function (nodes, arcs) -> (maximum (List.map fst nodes))+1 (* require no cycle !! TODO if cycle check that we have already visited a node *) let rec (succ_all: int -> 'a graph -> (int list)) = fun i -> function (nodes, arcs) as g -> let direct = succ i g in union direct (union_list (List.map (fun i -> succ_all i g) direct)) let rec (pred_all: int -> 'a graph -> (int list)) = fun i -> function (nodes, arcs) as g -> let direct = pred i g in union direct (union_list (List.map (fun i -> pred_all i g) direct)) (* require that the nodes are different !! *) let rec (equal: 'a graph -> 'a graph -> bool) = fun g1 g2 -> let ((nodes1, arcs1),(nodes2, arcs2)) = (g1,g2) in try (* do 2 things, check same length and to assoc *) let conv = assoc_map nodes1 nodes2 in List.for_all (fun (i1,i2) -> List.mem (List.assoc i1 conv, List.assoc i2 conv) arcs2) arcs1 && (List.length arcs1 = List.length arcs2) (* could think that only forall is needed, but need check same length too*) with _ -> false let (display: 'a graph -> ('a -> unit) -> unit) = fun g display_func -> let rec aux depth i = print_n depth " "; print_int i; print_string "->"; display_func (get_node i g); print_string "\n"; List.iter (aux (depth+2)) (succ i g) in aux 0 1 let (display_dot: 'a graph -> ('a -> string) -> unit)= fun (nodes,arcs) func -> let file = open_out "test.dot" in output_string file "digraph misc {\n" ; List.iter (fun (n, node) -> output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes; List.iter (fun (i1,i2) -> output_int file i1 ; output_string file " -> " ; output_int file i2 ; output_string file " ;\n"; ) arcs; output_string file "}\n" ; close_out file; let status = Unix.system "viewdot test.dot" in () (* todo: faire = graphe (int can change !!! => cannot make simply =) reassign number first !! *) (* todo: mettre diff(modulo = !!) en rouge *) let (display_dot2: 'a graph -> 'a graph -> ('a -> string) -> unit) = fun (nodes1, arcs1) (nodes2, arcs2) func -> let file = open_out "test.dot" in output_string file "digraph misc {\n" ; output_string file "rotate = 90;\n"; List.iter (fun (n, node) -> output_string file "100"; output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes1; List.iter (fun (n, node) -> output_string file "200"; output_int file n; output_string file " [label=\""; output_string file (func node); output_string file " \"];\n"; ) nodes2; List.iter (fun (i1,i2) -> output_string file "100"; output_int file i1 ; output_string file " -> " ; output_string file "100"; output_int file i2 ; output_string file " ;\n"; ) arcs1; List.iter (fun (i1,i2) -> output_string file "200"; output_int file i1 ; output_string file " -> " ; output_string file "200"; output_int file i2 ; output_string file " ;\n"; ) arcs2; (* output_string file "500 -> 1001; 500 -> 2001}\n" ; *) output_string file "}\n" ; close_out file; let status = Unix.system "viewdot test.dot" in () *) (*****************************************************************************) (* Generic op *) (*****************************************************************************) (* overloading *) let map = List.map (* note: really really slow, use rev_map if possible *) let filter = List.filter let fold = List.fold_left let member = List.mem let iter = List.iter let find = List.find let exists = List.exists let forall = List.for_all let big_union f xs = xs +> map f +> fold union_set empty_set (* let empty = [] *) let empty_list = [] let sort = List.sort let length = List.length (* in prelude now: let null xs = match xs with [] -> true | _ -> false *) let head = List.hd let tail = List.tl let is_singleton = fun xs -> List.length xs =|= 1 let tail_map f l = (* tail recursive map, using rev *) let rec loop acc = function [] -> acc | x::xs -> loop ((f x) :: acc) xs in List.rev(loop [] l) (*****************************************************************************) (* Geometry (raytracer) *) (*****************************************************************************) type vector = (float * float * float) type point = vector type color = vector (* color(0-1) *) (* todo: factorise *) let (dotproduct: vector * vector -> float) = fun ((x1,y1,z1),(x2,y2,z2)) -> (x1*.x2 +. y1*.y2 +. z1*.z2) let (vector_length: vector -> float) = fun (x,y,z) -> sqrt (square x +. square y +. square z) let (minus_point: point * point -> vector) = fun ((x1,y1,z1),(x2,y2,z2)) -> ((x1 -. x2),(y1 -. y2),(z1 -. z2)) let (distance: point * point -> float) = fun (x1, x2) -> vector_length (minus_point (x2,x1)) let (normalise: vector -> vector) = fun (x,y,z) -> let len = vector_length (x,y,z) in (x /. len, y /. len, z /. len) let (mult_coeff: vector -> float -> vector) = fun (x,y,z) c -> (x *. c, y *. c, z *. c) let (add_vector: vector -> vector -> vector) = fun v1 v2 -> let ((x1,y1,z1),(x2,y2,z2)) = (v1,v2) in (x1+.x2, y1+.y2, z1+.z2) let (mult_vector: vector -> vector -> vector) = fun v1 v2 -> let ((x1,y1,z1),(x2,y2,z2)) = (v1,v2) in (x1*.x2, y1*.y2, z1*.z2) let sum_vector = List.fold_left add_vector (0.0,0.0,0.0) (*****************************************************************************) (* Pics (raytracer) *) (*****************************************************************************) type pixel = (int * int * int) (* RGB *) (* required pixel list in row major order, line after line *) let (write_ppm: int -> int -> (pixel list) -> string -> unit) = fun width height xs filename -> let chan = open_out filename in begin output_string chan "P6\n"; output_string chan ((string_of_int width) ^ "\n"); output_string chan ((string_of_int height) ^ "\n"); output_string chan "255\n"; List.iter (fun (r,g,b) -> List.iter (fun byt -> output_byte chan byt) [r;g;b] ) xs; close_out chan end let test_ppm1 () = write_ppm 100 100 ((generate (50*100) (1,45,100)) ++ (generate (50*100) (1,1,100))) "img.ppm" (*****************************************************************************) (* Diff (lfs) *) (*****************************************************************************) type diff = Match | BnotinA | AnotinB let (diff: (int -> int -> diff -> unit)-> (string list * string list) -> unit)= fun f (xs,ys) -> let file1 = "/tmp/diff1-" ^ (string_of_int (Unix.getuid ())) in let file2 = "/tmp/diff2-" ^ (string_of_int (Unix.getuid ())) in let fileresult = "/tmp/diffresult-" ^ (string_of_int (Unix.getuid ())) in write_file file1 (unwords xs); write_file file2 (unwords ys); command2 ("diff --side-by-side -W 1 " ^ file1 ^ " " ^ file2 ^ " > " ^ fileresult); let res = cat fileresult in let a = ref 0 in let b = ref 0 in res +> List.iter (fun s -> match s with | ("" | " ") -> f !a !b Match; incr a; incr b; | ">" -> f !a !b BnotinA; incr b; | ("|" | "/" | "\\" ) -> f !a !b BnotinA; f !a !b AnotinB; incr a; incr b; | "<" -> f !a !b AnotinB; incr a; | _ -> raise (Impossible 3) ) (* let _ = diff ["0";"a";"b";"c";"d"; "f";"g";"h";"j";"q"; "z"] [ "a";"b";"c";"d";"e";"f";"g";"i";"j";"k";"r";"x";"y";"z"] (fun x y -> pr "match") (fun x y -> pr "a_not_in_b") (fun x y -> pr "b_not_in_a") *) let (diff2: (int -> int -> diff -> unit) -> (string * string) -> unit) = fun f (xstr,ystr) -> write_file "/tmp/diff1" xstr; write_file "/tmp/diff2" ystr; command2 ("diff --side-by-side --left-column -W 1 " ^ "/tmp/diff1 /tmp/diff2 > /tmp/diffresult"); let res = cat "/tmp/diffresult" in let a = ref 0 in let b = ref 0 in res +> List.iter (fun s -> match s with | "(" -> f !a !b Match; incr a; incr b; | ">" -> f !a !b BnotinA; incr b; | "|" -> f !a !b BnotinA; f !a !b AnotinB; incr a; incr b; | "<" -> f !a !b AnotinB; incr a; | _ -> raise (Impossible 4) ) (*****************************************************************************) (* Parsers (aop-colcombet) *) (*****************************************************************************) let parserCommon lexbuf parserer lexer = try let result = parserer lexer lexbuf in result with Parsing.Parse_error -> print_string "buf: "; print_string lexbuf.Lexing.lex_buffer; print_string "\n"; print_string "current: "; print_int lexbuf.Lexing.lex_curr_pos; print_string "\n"; raise Parsing.Parse_error (* marche pas ca neuneu *) (* let getDoubleParser parserer lexer string = let lexbuf1 = Lexing.from_string string in let chan = open_in string in let lexbuf2 = Lexing.from_channel chan in (parserCommon lexbuf1 parserer lexer , parserCommon lexbuf2 parserer lexer ) *) let getDoubleParser parserer lexer = ( (function string -> let lexbuf1 = Lexing.from_string string in parserCommon lexbuf1 parserer lexer ), (function string -> let chan = open_in string in let lexbuf2 = Lexing.from_channel chan in parserCommon lexbuf2 parserer lexer )) (*****************************************************************************) (* parser combinators *) (*****************************************************************************) (* cf parser_combinators.ml * * Could also use ocaml stream. but not backtrack and forced to do LL, * so combinators are better. * *) (*****************************************************************************) (* Parser related (cocci) *) (*****************************************************************************) type parse_info = { str: string; charpos: int; line: int; column: int; file: filename; } (* with sexp *) let fake_parse_info = { charpos = -1; str = ""; line = -1; column = -1; file = ""; } let string_of_parse_info x = spf "%s at %s:%d:%d" x.str x.file x.line x.column let string_of_parse_info_bis x = spf "%s:%d:%d" x.file x.line x.column let (info_from_charpos2: int -> filename -> (int * int * string)) = fun charpos filename -> (* Currently lexing.ml does not handle the line number position. * Even if there is some fields in the lexing structure, they are not * maintained by the lexing engine :( So the following code does not work: * let pos = Lexing.lexeme_end_p lexbuf in * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum * (pos.pos_cnum - pos.pos_bol) in * Hence this function to overcome the previous limitation. *) let chan = open_in filename in let linen = ref 0 in let posl = ref 0 in let rec charpos_to_pos_aux last_valid = let s = try Some (input_line chan) with End_of_file when charpos =|= last_valid -> None in incr linen; match s with Some s -> let s = s ^ "\n" in if (!posl + slength s > charpos) then begin close_in chan; (!linen, charpos - !posl, s) end else begin posl := !posl + slength s; charpos_to_pos_aux !posl; end | None -> (!linen, charpos - !posl, "\n") in let res = charpos_to_pos_aux 0 in close_in chan; res let info_from_charpos a b = profile_code "Common.info_from_charpos" (fun () -> info_from_charpos2 a b) let full_charpos_to_pos2 = fun filename -> let size = (filesize filename + 2) in let arr = Array.create size (0,0) in let chan = open_in filename in let charpos = ref 0 in let line = ref 0 in let rec full_charpos_to_pos_aux () = try let s = (input_line chan) in incr line; (* '... +1 do' cos input_line dont return the trailing \n *) for i = 0 to (slength s - 1) + 1 do arr.(!charpos + i) <- (!line, i); done; charpos := !charpos + slength s + 1; full_charpos_to_pos_aux(); with End_of_file -> for i = !charpos to Array.length arr - 1 do arr.(i) <- (!line, 0); done; (); in begin full_charpos_to_pos_aux (); close_in chan; arr end let full_charpos_to_pos a = profile_code "Common.full_charpos_to_pos" (fun () -> full_charpos_to_pos2 a) let test_charpos file = full_charpos_to_pos file +> Dumper.dump +> pr2 let complete_parse_info filename table x = { x with file = filename; line = fst (table.(x.charpos)); column = snd (table.(x.charpos)); } let full_charpos_to_pos_large2 = fun filename -> let size = (filesize filename + 2) in (* old: let arr = Array.create size (0,0) in *) let arr1 = Bigarray.Array1.create Bigarray.int Bigarray.c_layout size in let arr2 = Bigarray.Array1.create Bigarray.int Bigarray.c_layout size in Bigarray.Array1.fill arr1 0; Bigarray.Array1.fill arr2 0; let chan = open_in filename in let charpos = ref 0 in let line = ref 0 in let rec full_charpos_to_pos_aux () = let s = (input_line chan) in incr line; (* '... +1 do' cos input_line dont return the trailing \n *) for i = 0 to (slength s - 1) + 1 do (* old: arr.(!charpos + i) <- (!line, i); *) arr1.{!charpos + i} <- (!line); arr2.{!charpos + i} <- i; done; charpos := !charpos + slength s + 1; full_charpos_to_pos_aux() in begin (try full_charpos_to_pos_aux (); with End_of_file -> for i = !charpos to (* old: Array.length arr *) Bigarray.Array1.dim arr1 - 1 do (* old: arr.(i) <- (!line, 0); *) arr1.{i} <- !line; arr2.{i} <- 0; done; ()); close_in chan; (fun i -> arr1.{i}, arr2.{i}) end let full_charpos_to_pos_large a = profile_code "Common.full_charpos_to_pos_large" (fun () -> full_charpos_to_pos_large2 a) let complete_parse_info_large filename table x = { x with file = filename; line = fst (table (x.charpos)); column = snd (table (x.charpos)); } (*---------------------------------------------------------------------------*) (* Decalage is here to handle stuff such as cpp which include file and who * can make shift. *) let (error_messagebis: filename -> (string * int) -> int -> string)= fun filename (lexeme, lexstart) decalage -> let charpos = lexstart + decalage in let tok = lexeme in let (line, pos, linecontent) = info_from_charpos charpos filename in sprintf "File \"%s\", line %d, column %d, charpos = %d around = '%s', whole content = %s" filename line pos charpos tok (chop linecontent) let error_message = fun filename (lexeme, lexstart) -> try error_messagebis filename (lexeme, lexstart) 0 with End_of_file -> ("PB in Common.error_message, position " ^ i_to_s lexstart ^ " given out of file:" ^ filename) let error_message_short = fun filename (lexeme, lexstart) -> try let charpos = lexstart in let (line, pos, linecontent) = info_from_charpos charpos filename in sprintf "File \"%s\", line %d" filename line with End_of_file -> begin ("PB in Common.error_message, position " ^ i_to_s lexstart ^ " given out of file:" ^ filename); end (*****************************************************************************) (* Regression testing bis (cocci) *) (*****************************************************************************) (* todo: keep also size of file, compute md5sum ? cos maybe the file * has changed!. * * todo: could also compute the date, or some version info of the program, * can record the first date when was found a OK, the last date where * was ok, and then first date when found fail. So the * Common.Ok would have more information that would be passed * to the Common.Pb of date * date * date * string peut etre. * * todo? maybe use plain text file instead of marshalling. *) type score_result = Ok | Pb of string (* with sexp *) type score = (string (* usually a filename *), score_result) Hashtbl.t (* with sexp *) type score_list = (string (* usually a filename *) * score_result) list (* with sexp *) let empty_score () = (Hashtbl.create 101 : score) let save_score score path = write_value score path let load_score path () = read_value path let regression_testing_vs newscore bestscore = let newbestscore = empty_score () in let allres = (hash_to_list newscore +> List.map fst) $+$ (hash_to_list bestscore +> List.map fst) in begin allres +> List.iter (fun res -> match optionise (fun () -> Hashtbl.find newscore res), optionise (fun () -> Hashtbl.find bestscore res) with | None, None -> raise (Impossible 5) | Some x, None -> Printf.printf "new test file appeared: %s\n" res; Hashtbl.add newbestscore res x; | None, Some x -> Printf.printf "old test file disappeared: %s\n" res; | Some newone, Some bestone -> (match newone, bestone with | Ok, Ok -> Hashtbl.add newbestscore res Ok | Pb x, Ok -> Printf.printf "PBBBBBBBB: a test file does not work anymore!!! : %s\n" res; Printf.printf "Error : %s\n" x; Hashtbl.add newbestscore res Ok | Ok, Pb x -> Printf.printf "Great: a test file now works: %s\n" res; Hashtbl.add newbestscore res Ok | Pb x, Pb y -> Hashtbl.add newbestscore res (Pb x); if not (x =$= y) then begin Printf.printf "Semipb: still error but not same error : %s\n" res; Printf.printf "%s\n" (chop ("Old error: " ^ y)); Printf.printf "New error: %s\n" x; end ) ); flush stdout; flush stderr; newbestscore end let regression_testing newscore best_score_file = pr2 ("regression file: "^ best_score_file); let (bestscore : score) = if not (Sys.file_exists best_score_file) then write_value (empty_score()) best_score_file; get_value best_score_file in let newbestscore = regression_testing_vs newscore bestscore in write_value newbestscore (best_score_file ^ ".old"); write_value newbestscore best_score_file; () let string_of_score_result v = match v with | Ok -> "Ok" | Pb s -> "Pb: " ^ s let total_scores score = let total = hash_to_list score +> List.length in let good = hash_to_list score +> List.filter (fun (s, v) -> v =*= Ok) +> List.length in good, total let print_total_score score = pr2 "--------------------------------"; pr2 "total score"; pr2 "--------------------------------"; let (good, total) = total_scores score in pr2 (sprintf "good = %d/%d" good total) let print_score score = score +> hash_to_list +> List.iter (fun (k, v) -> pr2 (sprintf "% s --> %s" k (string_of_score_result v)) ); print_total_score score; () (*****************************************************************************) (* Scope managment (cocci) *) (*****************************************************************************) (* could also make a function Common.make_scope_functions that return * the new_scope, del_scope, do_in_scope, add_env. Kind of functor :) *) type ('a, 'b) scoped_env = ('a, 'b) assoc list (* let rec lookup_env f env = match env with | [] -> raise Not_found | []::zs -> lookup_env f zs | (x::xs)::zs -> match f x with | None -> lookup_env f (xs::zs) | Some y -> y let member_env_key k env = try let _ = lookup_env (fun (k',v) -> if k = k' then Some v else None) env in true with Not_found -> false *) let rec lookup_env k env = match env with | [] -> raise Not_found | []::zs -> lookup_env k zs | ((k',v)::xs)::zs -> if k =*= k' then v else lookup_env k (xs::zs) let member_env_key k env = match optionise (fun () -> lookup_env k env) with | None -> false | Some _ -> true let new_scope scoped_env = scoped_env := []::!scoped_env let del_scope scoped_env = scoped_env := List.tl !scoped_env let do_in_new_scope scoped_env f = begin new_scope scoped_env; let res = f() in del_scope scoped_env; res end let add_in_scope scoped_env def = let (current, older) = uncons !scoped_env in scoped_env := (def::current)::older (* note that ocaml hashtbl store also old value of a binding when add * add a newbinding; that's why del_scope works *) type ('a, 'b) scoped_h_env = { scoped_h : ('a, 'b) Hashtbl.t; scoped_list : ('a, 'b) assoc list; } let empty_scoped_h_env () = { scoped_h = Hashtbl.create 101; scoped_list = [[]]; } let clone_scoped_h_env x = { scoped_h = Hashtbl.copy x.scoped_h; scoped_list = x.scoped_list; } let rec lookup_h_env k env = Hashtbl.find env.scoped_h k let member_h_env_key k env = match optionise (fun () -> lookup_h_env k env) with | None -> false | Some _ -> true let new_scope_h scoped_env = scoped_env := {!scoped_env with scoped_list = []::!scoped_env.scoped_list} let del_scope_h scoped_env = begin List.hd !scoped_env.scoped_list +> List.iter (fun (k, v) -> Hashtbl.remove !scoped_env.scoped_h k ); scoped_env := {!scoped_env with scoped_list = List.tl !scoped_env.scoped_list } end let clean_scope_h scoped_env = (* keep only top level (last scope) *) let rec loop _ = match (!scoped_env).scoped_list with [] | [_] -> () | _::_ -> del_scope_h scoped_env; loop () in loop() let do_in_new_scope_h scoped_env f = begin new_scope_h scoped_env; let res = f() in del_scope_h scoped_env; res end (* let add_in_scope scoped_env def = let (current, older) = uncons !scoped_env in scoped_env := (def::current)::older *) let add_in_scope_h x (k,v) = begin Hashtbl.add !x.scoped_h k v; x := { !x with scoped_list = ((k,v)::(List.hd !x.scoped_list))::(List.tl !x.scoped_list); }; end (*****************************************************************************) (* Terminal *) (*****************************************************************************) (* let ansi_terminal = ref true *) let (_execute_and_show_progress_func: (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref) = ref (fun a b -> failwith "no execute yet, have you included common_extra.cmo?" ) let execute_and_show_progress len f = !_execute_and_show_progress_func len f (* now in common_extra.ml: * let execute_and_show_progress len f = ... *) (*****************************************************************************) (* Random *) (*****************************************************************************) let _init_random = Random.self_init () (* let random_insert i l = let p = Random.int (length l +1) in let rec insert i p l = if (p = 0) then i::l else (hd l)::insert i (p-1) (tl l) in insert i p l let rec randomize_list = function [] -> [] | a::l -> random_insert a (randomize_list l) *) let random_list xs = List.nth xs (Random.int (length xs)) (* todo_opti: use fisher/yates algorithm. * ref: http://en.wikipedia.org/wiki/Knuth_shuffle * * public static void shuffle (int[] array) * { * Random rng = new Random (); * int n = array.length; * while (--n > 0) * { * int k = rng.nextInt(n + 1); // 0 <= k <= n (!) * int temp = array[n]; * array[n] = array[k]; * array[k] = temp; * } * } *) let randomize_list xs = let permut = permutation xs in random_list permut let random_subset_of_list num xs = let array = Array.of_list xs in let len = Array.length array in let h = Hashtbl.create 101 in let cnt = ref num in while !cnt > 0 do let x = Random.int len in if not (Hashtbl.mem h (array.(x))) (* bugfix2: not just x :) *) then begin Hashtbl.add h (array.(x)) true; (* bugfix1: not just x :) *) decr cnt; end done; let objs = hash_to_list h +> List.map fst in objs (*****************************************************************************) (* Flags and actions *) (*****************************************************************************) (* I put it inside a func as it can help to give a chance to * change the globals before getting the options as some * options sometimes may want to show the default value. *) let cmdline_flags_devel () = [ "-debugger", Arg.Set debugger , " option to set if launched inside ocamldebug"; "-profile", Arg.Unit (fun () -> profile := PALL), " gather timing information about important functions"; ] let cmdline_flags_verbose () = [ "-verbose_level", Arg.Set_int verbose_level, " guess what"; "-disable_pr2_once", Arg.Set disable_pr2_once, " to print more messages"; "-show_trace_profile", Arg.Set show_trace_profile, " show trace"; ] let cmdline_flags_other () = [ "-nocheck_stack", Arg.Clear check_stack, " "; "-batch_mode", Arg.Set _batch_mode, " no interactivity" ] (* potentially other common options but not yet integrated: "-timeout", Arg.Set_int timeout, " interrupt LFS or buggy external plugins"; (* can't be factorized because of the $ cvs stuff, we want the date * of the main.ml file, not common.ml *) "-version", Arg.Unit (fun () -> pr2 "version: _dollar_Date: 2008/06/14 00:54:22 _dollar_"; raise (Common.UnixExit 0) ), " guess what"; "-shorthelp", Arg.Unit (fun () -> !short_usage_func(); raise (Common.UnixExit 0) ), " see short list of options"; "-longhelp", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), "-help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " "; "--help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " "; *) let cmdline_actions () = [ "-test_check_stack", " ", mk_action_1_arg test_check_stack_size; ] (*****************************************************************************) (* Postlude *) (*****************************************************************************) (* stuff put here cos of of forward definition limitation of ocaml *) (* Infix trick, seen in jane street lib and harrop's code, and maybe in GMP *) module Infix = struct let (+>) = (+>) let (==~) = (==~) let (=~) = (=~) end let main_boilerplate f = if not (!Sys.interactive) then exn_to_real_unixexit (fun () -> Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> pr2 "C-c intercepted, will do some cleaning before exiting"; (* But if do some try ... with e -> and if do not reraise the exn, * the bubble never goes at top and so I cannot really C-c. * * A solution would be to not raise, but do the erase_temp_file in the * syshandler, here, and then exit. * The current solution is to not do some wild try ... with e * by having in the exn handler a case: UnixExit x -> raise ... | e -> *) Sys.set_signal Sys.sigint Sys.Signal_default; raise (UnixExit (-1)) )); (* The finalize below makes it tedious to go back to exn when use * 'back' in the debugger. Hence this special case. But the * Common.debugger will be set in main(), so too late, so * have to be quicker *) if Sys.argv +> Array.to_list +> List.exists (fun x -> x =$= "-debugger") then debugger := true; finalize (fun ()-> pp_do_in_zero_box (fun () -> f(); (* <---- here it is *) )) (fun()-> if !profile <> PNONE then pr2 (profile_diagnostic ()); erase_temp_files (); clear_pr2_once() ) ) (* let _ = if not !Sys.interactive then (main ()) *) (* based on code found in cameleon from maxence guesdon *) let md5sum_of_string s = let com = spf "echo %s | md5sum | cut -d\" \" -f 1" (Filename.quote s) in match cmd_to_list com with | [s] -> (*pr2 s;*) s | _ -> failwith "md5sum_of_string wrong output" let with_pr2_to_string f = let file = new_temp_file "pr2" "out" in redirect_stdout_stderr file f; cat file (* julia: convert something printed using format to print into a string *) let format_to_string f = let (nm,o) = Filename.open_temp_file "format_to_s" ".out" in Format.set_formatter_out_channel o; let _ = f() in Format.print_newline(); Format.print_flush(); Format.set_formatter_out_channel stdout; close_out o; let i = open_in nm in let lines = ref [] in let rec loop _ = let cur = input_line i in lines := cur :: !lines; loop() in (try loop() with End_of_file -> ()); close_in i; command2 ("rm -f " ^ nm); String.concat "\n" (List.rev !lines) (*****************************************************************************) (* Misc/test *) (*****************************************************************************) let (generic_print: 'a -> string -> string) = fun v typ -> write_value v "/tmp/generic_print"; command2 ("printf 'let (v:" ^ typ ^ ")= Common.get_value \"/tmp/generic_print\" " ^ " in v;;' " ^ " | calc.top > /tmp/result_generic_print"); cat "/tmp/result_generic_print" +> drop_while (fun e -> not (e =~ "^#.*")) +> tail +> unlines +> (fun s -> if (s =~ ".*= \\(.+\\)") then matched1 s else "error in generic_print, not good format:" ^ s) (* let main () = pr (generic_print [1;2;3;4] "int list") *) class ['a] olist (ys: 'a list) = object(o) val xs = ys method view = xs (* method fold f a = List.fold_left f a xs *) method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b = fun f accu -> List.fold_left f accu xs end (* let _ = write_value ((new setb[])#add 1) "/tmp/test" *) let typing_sux_test () = let x = Obj.magic [1;2;3] in let f1 xs = List.iter print_int xs in let f2 xs = List.iter print_string xs in (f1 x; f2 x) (* let (test: 'a osetb -> 'a ocollection) = fun o -> (o :> 'a ocollection) *) (* let _ = test (new osetb (Setb.empty)) *) coccinelle-1.0.0-rc19/commons/osequence.mli0000644000175000017500000000025212247437436017534 0ustar eugeneugenclass virtual ['a] osequence : object ('o) inherit [int, 'a] Oassoc.oassoc method virtual nth : int -> 'a method virtual first : 'a method virtual last : 'a end coccinelle-1.0.0-rc19/commons/parser_combinators.mli0000644000175000017500000001065612247437436021452 0ustar eugeneugen(*****************************************************************************) (* src: Jon Harrop. * * "Certain applications are extremely well suited to functional * programming and parsing is one of them. Specifically, the ability to * write functional combinators that allow parsers for everything from * integers up to symbolic expressions to be composed is more general * and provides more opportunity for code reuse than the use of * conventional parser generators such as ocamllex and ocamlyacc. This * article explains how parser combinators may be designed and * implemented in OCaml, using the standard example of a calculator." * * pad: a few bugfixes. I also put more restrictive and descriptive types. * *) (*****************************************************************************) (* A generic parser takes a list of stuff (either char for lexical * parser or tokens for grammar parser) and return something and the * remaining list of stuff. *) type ('a, 'b) genp = 'a list -> 'b * 'a list val val_of_parser : 'b * 'a list -> 'b (* lexer = parser of char list *) (* type 'a lexer = (char, 'a) genp *) (* grammar = parser ot tokens *) (* type 'a pparser = (token, 'a) genp *) val ( ||| ) : ('a, 'b) genp -> ('a, 'b) genp -> ('a, 'b) genp (* ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b *) val ( +++ ) : ('a, 'b) genp -> ('a, 'c) genp -> ('a, 'b * 'c) genp (* ('a -> 'b * 'c) -> ('c -> 'd * 'e) -> 'a -> ('b * 'd) * 'e *) val many : ('a, 'b) genp -> ('a, 'b list) genp (* ('a -> 'b * 'a) -> 'a -> 'b list * 'a *) val ( >| ) : ('a, 'b) genp -> ('b -> 'c) -> ('a, 'c) genp (* ('a -> 'b * 'c) -> ('b -> 'd) -> 'a -> 'd * 'c *) (* was called 'some', but confusing *) val pred : ('a -> bool) -> ('a, 'a) genp (* ('a -> bool) -> 'a list -> 'a * 'a list *) val a : 'a -> ('a, 'a) genp (* 'a -> 'a list -> 'a * 'a list *) val several : ('a -> bool) -> ('a, 'a list) genp (* ('a -> bool) -> 'a list -> 'a list * 'a list *) module Abstr : sig type t val x : t end val fin : ('a, Abstr.t) genp (* 'a list -> Abstr.t * 'b list *) val digit : char -> bool val alpha : char -> bool val symbol : char -> bool val alphanum : char -> bool val space : char -> bool val alphanum_underscore : char -> bool val alphanum_minus : char -> bool val alphanum_under_minus : char -> bool val collect : char * char list -> string val list_of_string : string -> char list (*****************************************************************************) type token = | IDENT of string | KWD of string | INT of string | SYM of string | STR of string val string_of_token : token -> string type lexer = (char, token) genp val rawident : lexer (* char list -> token * char list *) val rawnumber : lexer (* char list -> token * char list *) val rawsymbol : lexer (* not space, not digit *) val rawkeyword : lexer (* char list -> token * char list *) val rawstring : lexer val lex_gen : lexer -> string -> token list (*****************************************************************************) val token : lexer (* char list -> token * char list *) val tokens : (char, token list) genp (* char list -> token list * char list *) val alltokens : (char, token list) genp (* char list -> token list * 'a list *) val lex : string -> token list (*****************************************************************************) (* cannot use parser as it's a reseverd word *) type 'a pparser = (token, 'a) genp val ident : string pparser (* token list -> string * token list *) val int : string pparser (* token list -> string * token list *) val string : string pparser type expr = | Int of int | Var of string | Add of expr * expr | Mul of expr * expr val atom : expr pparser (* token list -> expr * token list *) val factor : expr pparser (* token list -> expr * token list *) val term : expr pparser (* token list -> expr * token list *) val expr : expr pparser (* token list -> expr * 'a list *) val parse : 'a pparser -> string -> 'a (* (token list -> 'a * 'b) -> string -> 'a *) (*****************************************************************************) module Infix : sig val ( ||| ) : ('a, 'b) genp -> ('a, 'b) genp -> ('a, 'b) genp (* ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b *) val ( +++ ) : ('a, 'b) genp -> ('a, 'c) genp -> ('a, 'b * 'c) genp (* ('a -> 'b * 'c) -> ('c -> 'd * 'e) -> 'a -> ('b * 'd) * 'e *) val ( >| ) : ('a, 'b) genp -> ('b -> 'c) -> ('a, 'c) genp (* ('a -> 'b * 'c) -> ('b -> 'd) -> 'a -> 'd * 'c *) end coccinelle-1.0.0-rc19/commons/common_extra.ml0000644000175000017500000000231312247437436020067 0ustar eugeneugen(* I put those functions here and not in common.ml to try to avoid * as much as possible dependencies in common.ml so I can more easily * make ocaml script that just do a load common.ml without the need * to load many other files (like dumper.ml, or ANSITerminal.ml and * other recursive dependencies). * * Note that you can still use the functions below from an open Common. * You don't need to do a 'open Common_extra'; loading the commons.cma is * enough to make the connexions. *) (* how to use it ? ex in LFS: * Common.execute_and_show_progress (w.prop_iprop#length) (fun k -> * w.prop_iprop#iter (fun (p, ip) -> * k (); * ... * )); * *) let execute_and_show_progress len f = let _count = ref 0 in (* kind of continuation passed to f *) let continue_pourcentage () = incr _count; ANSITerminal.set_cursor 1 (-1); ANSITerminal.printf [] "%d / %d" !_count len; flush stdout; in let nothing () = () in ANSITerminal.printf [] "0 / %d" len; flush stdout; if !Common._batch_mode then f nothing else f continue_pourcentage ; Common.pr2 "" let set_link () = Common._execute_and_show_progress_func := execute_and_show_progress let _init_execute = set_link () coccinelle-1.0.0-rc19/commons/oset.ml0000644000175000017500000000271712247437436016356 0ustar eugeneugenopen Common open Ocollection class virtual ['a] oset = object(o: 'o) inherit ['a] ocollection (* no need virtual, but better to redefine (efficiency) *) method virtual union: 'o -> 'o method virtual inter: 'o -> 'o method virtual minus: 'o -> 'o (* allow binary methods tricks, generate exception when not good type *) method tosetb: 'a Setb.t = raise (Impossible 10) method tosetpt: SetPt.t = raise (Impossible 11) method toseti: Seti.seti = raise (Impossible 12) method virtual toset: 'b. 'b (* generic (not safe) tricks *) (* is_intersect, equal, subset *) method is_subset_of: 'o -> bool = fun o2 -> ((o2#minus o)#cardinal >= 0) && ((o#minus o2)#cardinal =|= 0) method is_equal: 'o -> bool = fun o2 -> ((o2#minus o)#cardinal =|= 0) && ((o#minus o2)#cardinal =|= 0) method is_singleton: bool = (* can be short circuited *) o#length =|= 1 method cardinal: int = (* just to keep naming conventions *) o#length (* don't work: method big_union: 'b. ('a -> 'b oset) -> 'b oset = fun f -> todo() *) end let ($??$) e xs = xs#mem e let ($++$) xs ys = xs#union ys let ($**$) xs ys = xs#inter ys let ($--$) xs ys = xs#minus ys let ($<<=$) xs ys = xs#is_subset_of ys let ($==$) xs ys = xs#is_equal ys (* todo: pas beau le seed. I don't put the type otherwise have to * put explicit :> *) let (mapo: ('a -> 'b) -> 'b oset -> 'a oset -> 'b oset) = fun f seed xs -> xs#fold (fun acc x -> acc#add (f x)) seed coccinelle-1.0.0-rc19/commons/oassoc.mli0000644000175000017500000000112112247437436017030 0ustar eugeneugen class virtual ['a, 'b] oassoc : object ('o) inherit ['a * 'b] Ocollection.ocollection method virtual assoc : 'a -> 'b method virtual delkey : 'a -> 'o (* may raise NotFound *) method find : 'a -> 'b method find_opt: 'a -> 'b option method haskey : 'a -> bool method replkey : 'a * 'b -> 'o (* better to implement it yourself *) method virtual keys: 'a list method apply : 'a -> ('b -> 'b) -> 'o method apply_with_default : 'a -> ('b -> 'b) -> (unit -> 'b) -> 'o (* effect version *) method apply_with_default2 : 'a -> ('b -> 'b) -> (unit -> 'b) -> unit end coccinelle-1.0.0-rc19/commons/ograph.ml0000644000175000017500000000142712247437436016661 0ustar eugeneugenopen Common (* todo: * invariant succesors/predecessors * see c++ library, GTL ... * (cf paper from ASTL, cf paper from jfla05 on ocamlgraph) *) class virtual ['a] ograph = object(o: 'o) method virtual empty: 'o method virtual add_node: 'a -> 'o method virtual del_node: 'a -> 'o method virtual add_arc: ('a * 'a) -> 'o method virtual del_arc: ('a * 'a) -> 'o method virtual successors: 'a -> 'a Oset.oset method virtual predecessors: 'a -> 'a Oset.oset method virtual nodes: 'a Oset.oset method virtual ancestors: 'a Oset.oset -> 'a Oset.oset method virtual children: 'a Oset.oset -> 'a Oset.oset method virtual brothers: 'a -> 'a Oset.oset method mydebug: ('a * 'a list) list = (o#nodes)#tolist +> map (fun a -> (a, (o#successors a)#tolist)) end coccinelle-1.0.0-rc19/commons/ograph_simple.mli0000644000175000017500000000162612247437436020404 0ustar eugeneugenopen Common (* essentially a convenient way to access a hash and its reverse hash *) class ['key, 'node, 'edge] ograph_mutable : object ('o) method add_node : 'key -> 'node -> unit method del_node : 'key -> unit method replace_node : 'key -> 'node -> unit method add_arc : ('key * 'key) -> 'edge -> unit method del_arc : ('key * 'key) -> 'edge -> unit method nodes : ('key, 'node) Oassoc.oassoc method successors : 'key -> ('key * 'edge) Oset.oset method predecessors : 'key -> ('key * 'edge) Oset.oset method allsuccessors : ('key, ('key * 'edge) Oset.oset) Oassoc.oassoc method del_leaf_node_and_its_edges : 'key -> unit method ancestors : 'key -> 'key Oset.oset method leaf_nodes : unit -> 'key Oset.oset end val print_ograph_generic: str_of_key:('key -> string) -> str_of_node:('key -> 'node -> string) -> Common.filename -> ('key, 'node,'edge) ograph_mutable -> unit coccinelle-1.0.0-rc19/commons/license.txt0000644000175000017500000006546712247437436017250 0ustar eugeneugenThe Library is distributed under the terms of the GNU Lesser General Public License version 2.1 (included below). As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Lesser General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by the authors, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Lesser General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Lesser General Public License. --------------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! coccinelle-1.0.0-rc19/commons/ocollection.mli0000644000175000017500000000141512247437436020061 0ustar eugeneugentype ('a, 'b) view = | Empty | Cons of 'a * 'b class virtual ['a] ocollection : object ('o) inherit Objet.objet method virtual empty : 'o method virtual add : 'a -> 'o method virtual iter : ('a -> unit) -> unit method virtual view : ('a, 'o) view (* no need virtual, but better to force redefine for efficiency *) method virtual del : 'a -> 'o method virtual mem : 'a -> bool method virtual null : bool (* effect version *) method add2: 'a -> unit method del2: 'a -> unit method clear: unit method fold : ('c -> 'a -> 'c) -> 'c -> 'c method fromlist : 'a list -> 'o method tolist : 'a list method exists : ('a -> bool) -> bool method filter : ('a -> bool) -> 'o method length : int method getone : 'a method others : 'o end coccinelle-1.0.0-rc19/commons/oassoc.ml0000644000175000017500000000234712247437436016672 0ustar eugeneugenopen Common open Ocollection (* assoc, also called map or dictionnary *) class virtual ['a,'b] oassoc = object(o: 'o) inherit ['a * 'b] ocollection method virtual assoc: 'a -> 'b method virtual delkey: 'a -> 'o (* pre: must be in *) method replkey: ('a * 'b) -> 'o = fun (k,v) -> o#add (k,v) (* pre: must not be in *) (* method add: ('a * 'b) -> 'o = *) (* method keys = List.map fst (o#tolist) *) method virtual keys: 'a list (* or 'a oset ? *) method find: 'a -> 'b = fun k -> o#assoc k method find_opt: 'a -> 'b option = fun k -> try let res = o#assoc k in Some res with Not_found -> None method haskey: 'a -> bool = fun k -> try (ignore(o#assoc k); true) with Not_found -> false method apply: 'a -> ('b -> 'b) -> 'o = fun k f -> let old = o#assoc k in o#replkey (k, f old) (* apply default, assoc_default, take in class parameters a default value *) method apply_with_default: 'a -> ('b -> 'b) -> (unit -> 'b) -> 'o = fun k f default -> let old = try o#assoc k with Not_found -> default () in o#replkey (k, f old) method apply_with_default2 = fun k f default -> o#apply_with_default k f default +> ignore end coccinelle-1.0.0-rc19/commons/obsolete/0000755000175000017500000000000012247437436016657 5ustar eugeneugencoccinelle-1.0.0-rc19/commons/obsolete/ofullcommon.ml0000644000175000017500000000111512247437436021541 0ustar eugeneugen(* Do a 'open Fullcommon' to access most of the functions in commons/ * without needing to qualify them. * * update: Jane Street use a similar trick, to have a more complete * Pervasives, but for far more. They can define a module Std that * correspond to old std lib and a module Std_internal that instead * include all their extensions over the standard lib (a more complete * List module, Arg, etc) *) include Common include Oset include Oassoc include Oarray include Ograph include Osetb include Oassoch include Oassocb include Oseti include Ograph2way include Oassoc_buffer coccinelle-1.0.0-rc19/commons/copyright.txt0000644000175000017500000000143512247437436017617 0ustar eugeneugenCopyright (C) 2010 INRIA, University of Copenhagen DIKU Copyright (C) 1998-2009 Yoann Padioleau This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License (LGPL) version 2.1 as published by the Free Software Foundation, with the special exception on linking described in file license.txt. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file license.txt for more details. The contents of some files in this directory was derived from external sources with compatible licenses. The original copyright and license notice was preserved in the affected files. coccinelle-1.0.0-rc19/commons/ograph_simple.ml0000644000175000017500000000636612247437436020241 0ustar eugeneugenopen Common open Ocollection open Oset open Oassoc (* open Ograph *) open Oassocb open Osetb (* Difference with ograph_extended ? why not share code ? could, but * in ograph_extended we don't force the user to have a key and we * generate those keys as he add nodes. Here we assume the user already * have an idea of what kind of key he wants to use (a string, a * filename, a, int, whatever) *) class ['key, 'a,'b] ograph_mutable = let build_assoc () = new oassocb [] in let build_set () = new osetb Setb.empty in object(o) val mutable succ = build_assoc() val mutable pred = build_assoc() val mutable nods = (build_assoc() : ('key, 'a) Oassocb.oassocb) method add_node i (e: 'a) = nods <- nods#add (i, e); pred <- pred#add (i, build_set() ); succ <- succ#add (i, build_set() ); method del_node (i) = (* check: e is effectively the index associated with e, and check that already in *) (* todo: assert that have no pred and succ, otherwise * will have some dangling pointers *) nods <- nods#delkey i; pred <- pred#delkey i; succ <- succ#delkey i; method del_leaf_node_and_its_edges (i) = let succ = o#successors i in if not (succ#null) then failwith "del_leaf_node_and_its_edges: have some successors" else begin let pred = o#predecessors i in pred#tolist +> List.iter (fun (k, edge) -> o#del_arc (k,i) edge; ); o#del_node i end method leaf_nodes () = let (set : 'key Oset.oset) = build_set () in o#nodes#tolist +> List.fold_left (fun acc (k,v) -> if (o#successors k)#null then acc#add k else acc ) set method replace_node i (e: 'a) = assert (nods#haskey i); nods <- nods#replkey (i, e); method add_arc (a,b) (v: 'b) = succ <- succ#replkey (a, (succ#find a)#add (b, v)); pred <- pred#replkey (b, (pred#find b)#add (a, v)); method del_arc (a,b) v = succ <- succ#replkey (a, (succ#find a)#del (b,v)); pred <- pred#replkey (b, (pred#find b)#del (a,v)); method successors e = succ#find e method predecessors e = pred#find e method nodes = nods method allsuccessors = succ (* detect if no loop ? *) method ancestors k = let empty_set = build_set() in let rec aux acc x = if acc#mem x then (* bugfix: have_loop := true; ? not, not necessarally. * if you got a diamon, seeing a second time the same * x does not mean we are in a loop *) acc else let acc = acc#add x in let prefs = o#predecessors x in let prefs = prefs#tolist +> List.map fst in prefs +> List.fold_left (fun acc x -> aux acc x) acc in let set = aux empty_set k in let set = set#del k in set end let print_ograph_generic ~str_of_key ~str_of_node filename g = Common.with_open_outfile filename (fun (pr,_) -> pr "digraph misc {\n" ; pr "size = \"10,10\";\n" ; let nodes = g#nodes in nodes#iter (fun (k,node) -> pr (spf "%s [label=\"%s\"];\n" (str_of_key k) (str_of_node k node)) ); nodes#iter (fun (k,node) -> let succ = g#successors k in succ#iter (fun (j,edge) -> pr (spf "%s -> %s;\n" (str_of_key k) (str_of_key j)); ); ); pr "}\n" ; ); () coccinelle-1.0.0-rc19/commons/features.ml.cpp0000644000175000017500000000225312247437436017776 0ustar eugeneugen(* yes sometimes cpp is useful *) (* old: note: in addition to Makefile.config, globals/config.ml is also modified by configure features.ml: features.ml.cpp Makefile.config cpp -DFEATURE_GUI=$(FEATURE_GUI) \ -DFEATURE_MPI=$(FEATURE_MPI) \ -DFEATURE_PCRE=$(FEATURE_PCRE) \ features.ml.cpp > features.ml clean:: rm -f features.ml beforedepend:: features.ml *) #if FEATURE_MPI==1 module Distribution = struct let under_mpirun () = Distribution.under_mpirun() let mpi_main2 ?debug_mpi map_ex reduce_ex fxs = Distribution.mpi_main2 debug_mpi map_ex reduce_ex fxs let mpi_adjust_argv argv = Distribution.mpi_adjust_argv argv end #else module Distribution = struct let under_mpirun () = false let mpi_main2 ?debug_mpi map_ex reduce_ex fxs = let res = List.map map_ex (fxs()) in reduce_ex res let mpi_adjust_argv argv = argv end #endif #if FEATURE_REGEXP_PCRE==1 #else #endif #if FEATURE_BACKTRACE==1 module Backtrace = struct let print () = Backtrace.print () end #else module Backtrace = struct let print () = print_string "no backtrace support, use configure --with-backtrace\n" end #endif coccinelle-1.0.0-rc19/commons/readme.txt0000644000175000017500000000323012247437436017037 0ustar eugeneugen This directory builds a common.cma library and also optionally multiple commons_xxx.cma small libraries. The reason not to just build a single one is that some functionnalities require external libraries (like Berkeley DB, MPI, etc) or special version of OCaml (like for the backtrace support) and I don't want to penalize the user by forcing him to install all those libs before being able to use some of my common helper functions. So, common.ml and other files offer convenient helpers that do not require to install anything. In some case I have directly included the code of those external libs when there are simple such as for ANSITerminal in ocamlextra/, and for dumper.ml I have even be further by inlining its code in common.ml so one can just do a open Common and have everything. Then if the user wants to, he can also leverage the other commons_xxx libraries by explicitly building them after he has installed the necessary external files. For many configurable things we can use some flags in ml files, and have some -xxx command line argument to set them or not, but for other things flags are not enough as they will not remove the header and linker dependencies in Makefiles. A solution is to use cpp and pre-process many files that have such configuration issue. Another solution is to centralize all the cpp issue in one file, features.ml.cpp, that acts as a generic wrapper for other librairies and depending on the configuration actually call the external library or provide a fake empty services indicating that the service is not present. So you should have a ../configure that call cpp on features.ml.cpp to set those linking-related configuration settings. coccinelle-1.0.0-rc19/commons/oarray.mli0000644000175000017500000000127212247437436017045 0ustar eugeneugen(* !!take care!!, this is not a pure data structure *) class ['a] oarray : int -> 'a -> object ('o) inherit ['a] Osequence.osequence (* ocollection concrete instantiation of virtual methods *) method empty : 'o method add : (int * 'a) -> 'o method iter : (int * 'a -> unit) -> unit method view : (int * 'a, 'o) Ocollection.view method del : (int * 'a) -> 'o method mem : int * 'a -> bool method null : bool (* oassoc concrete instantiation of virtual methods *) method assoc : int -> 'a method delkey : int -> 'o method keys: int list (* osequence concrete instantiation of virtual methods *) method first : 'a method last : 'a method nth : int -> 'a end coccinelle-1.0.0-rc19/commons/commands.ml.in0000644000175000017500000000044312247437436017604 0ustar eugeneugen(* configured default commands *) let ocamlfind_cmd = "@RUNTIME_OCAMLFIND_CMD@" let ocamlc_cmd = "@RUNTIME_OCAMLC_CMD@" let ocamlopt_cmd = "@RUNTIME_OCAMLOPT_CMD@" let ocamldep_cmd = "@RUNTIME_OCAMLDEP_CMD@" let camlp4_cmd = "@RUNTIME_CAMLP4_CMD@" let camlp4o_cmd = "@RUNTIME_CAMLP4O_CMD@" coccinelle-1.0.0-rc19/commons/oset.mli0000644000175000017500000000145412247437436016524 0ustar eugeneugenclass virtual ['a] oset : object ('o) inherit ['a] Ocollection.ocollection method cardinal : int method virtual inter : 'o -> 'o method virtual minus : 'o -> 'o method virtual union : 'o -> 'o method is_singleton : bool method is_subset_of : 'o -> bool method is_equal : 'o -> bool method virtual toset : 'd method tosetb : 'a Setb.t method toseti : Seti.seti method tosetpt : SetPt.t end val ( $??$ ) : 'a -> < mem : 'a -> bool; .. > -> bool val ( $++$ ) : < union : 'a -> 'o; .. > -> 'a -> 'o val ( $**$ ) : < inter : 'a -> 'o; .. > -> 'a -> 'o val ( $--$ ) : < minus : 'a -> 'o; .. > -> 'a -> 'o val ( $<<=$ ) : < is_subset_of : 'a -> bool; .. > -> 'a -> bool val ( $==$ ) : < is_equal : 'a -> bool; .. > -> 'a -> bool val mapo : ('a -> 'o) -> 'o oset -> 'a oset -> 'o oset coccinelle-1.0.0-rc19/commons/commons.mldylib0000644000175000017500000000050212247437436020071 0ustar eugeneugenDumper ANSITerminal Setb Mapb SetPt Commands Common Common_extra Interfaces Objet Ocollection Seti Oset Oassoc Osequence Ograph Oseti Oseth Osetb Osetpt Oassocb Oassoch Oassoc_buffer Oassoc_cache Oassocid Oarray Ograph2way Ograph_simple Ograph_extended Glimpse Parser_combinators Enum DynArray Suffix_tree Suffix_tree_ext coccinelle-1.0.0-rc19/commons/credits.txt0000644000175000017500000000037712247437436017250 0ustar eugeneugen Thanks to - Richard Jones for his dumper module, - Brian Hurt and Nicolas Cannasse for their dynArray module, - Christophe Troestler for his ANSITerminal module, - Sebastien ferre for his suffix tree module - Jane Street for the backtrace module coccinelle-1.0.0-rc19/commons/authors.txt0000644000175000017500000000022212247437436017265 0ustar eugeneugenYoann Padioleau Maybe a few code was borrowed from Pixel (Pascal Rigaux) and Julia Lawall may have written a few helpers. See also credits.txt. coccinelle-1.0.0-rc19/commons/ocamlextra/0000755000175000017500000000000012247437555017204 5ustar eugeneugencoccinelle-1.0.0-rc19/commons/ocamlextra/mapb.ml0000644000175000017500000001112012247437436020446 0ustar eugeneugen(*pad: same than for Setb, module Make(Ord: OrderedType) = struct *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) (* *) (***********************************************************************) (* map.ml 1.15 2004/04/23 10:01:33 xleroy Exp *) (* type key = Ord.t type 'a t = Empty | Node of 'a t * key * 'a * 'a t * int *) type ('key, 'v) t = Empty | Node of ('key, 'v) t * 'key * 'v * ('key, 'v) t * int let empty = Empty let height = function Empty -> 0 | Node(_,_,_,_,h) -> h let create l x d r = let hl = height l and hr = height r in Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) let bal l x d r = let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in if hl > hr + 2 then begin match l with Empty -> invalid_arg "Map.bal" | Node(ll, lv, ld, lr, _) -> if height ll >= height lr then create ll lv ld (create lr x d r) else begin match lr with Empty -> invalid_arg "Map.bal" | Node(lrl, lrv, lrd, lrr, _)-> create (create ll lv ld lrl) lrv lrd (create lrr x d r) end end else if hr > hl + 2 then begin match r with Empty -> invalid_arg "Map.bal" | Node(rl, rv, rd, rr, _) -> if height rr >= height rl then create (create l x d rl) rv rd rr else begin match rl with Empty -> invalid_arg "Map.bal" | Node(rll, rlv, rld, rlr, _) -> create (create l x d rll) rlv rld (create rlr rv rd rr) end end else Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) let rec add x data = function Empty -> Node(Empty, x, data, Empty, 1) | Node(l, v, d, r, h) -> let c = compare x v in if c = 0 then Node(l, x, data, r, h) else if c < 0 then bal (add x data l) v d r else bal l v d (add x data r) let rec find x = function Empty -> raise Not_found | Node(l, v, d, r, _) -> let c = compare x v in if c = 0 then d else find x (if c < 0 then l else r) let rec mem x = function Empty -> false | Node(l, v, d, r, _) -> let c = compare x v in c = 0 || mem x (if c < 0 then l else r) let rec min_binding = function Empty -> raise Not_found | Node(Empty, x, d, r, _) -> (x, d) | Node(l, x, d, r, _) -> min_binding l let rec remove_min_binding = function Empty -> invalid_arg "Map.remove_min_elt" | Node(Empty, x, d, r, _) -> r | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r let merge t1 t2 = match (t1, t2) with (Empty, t) -> t | (t, Empty) -> t | (_, _) -> let (x, d) = min_binding t2 in bal t1 x d (remove_min_binding t2) let rec remove x = function Empty -> Empty | Node(l, v, d, r, h) -> let c = compare x v in if c = 0 then merge l r else if c < 0 then bal (remove x l) v d r else bal l v d (remove x r) let rec iter f = function Empty -> () | Node(l, v, d, r, _) -> iter f l; f v d; iter f r let rec map f = function Empty -> Empty | Node(l, v, d, r, h) -> Node(map f l, v, f d, map f r, h) let rec mapi f = function Empty -> Empty | Node(l, v, d, r, h) -> Node(mapi f l, v, f v d, mapi f r, h) let rec fold f m accu = match m with Empty -> accu | Node(l, v, d, r, _) -> fold f l (f v d (fold f r accu)) coccinelle-1.0.0-rc19/commons/ocamlextra/setPt.ml0000644000175000017500000002711312247437436020637 0ustar eugeneugen(* * Ptset: Sets of integers implemented as Patricia trees. * Copyright (C) 2000 Jean-Christophe FILLIATRE * * This software is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License version 2, as published by the Free Software Foundation. * * This software is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * See the GNU Library General Public License version 2 for more details * (enclosed in the file LGPL). *) (*i ptset.ml 1.8 2001/06/28 07:05:55 filliatr Exp i*) (*s Sets of integers implemented as Patricia trees, following Chris Okasaki and Andrew Gill's paper {\em Fast Mergeable Integer Maps} ({\tt\small http://www.cs.columbia.edu/\~{}cdo/papers.html\#ml98maps}). Patricia trees provide faster operations than standard library's module [Set], and especially very fast [union], [subset], [inter] and [diff] operations. *) (*s The idea behind Patricia trees is to build a {\em trie} on the binary digits of the elements, and to compact the representation by branching only one the relevant bits (i.e. the ones for which there is at least on element in each subtree). We implement here {\em little-endian} Patricia trees: bits are processed from least-significant to most-significant. The trie is implemented by the following type [t]. [Empty] stands for the empty trie, and [Leaf k] for the singleton [k]. (Note that [k] is the actual element.) [Branch (m,p,l,r)] represents a branching, where [p] is the prefix (from the root of the trie) and [m] is the branching bit (a power of 2). [l] and [r] contain the subsets for which the branching bit is respectively 0 and 1. Invariant: the trees [l] and [r] are not empty. *) (*i*) type elt = int (*i*) type t = | Empty | Leaf of int | Branch of int * int * t * t (*s Example: the representation of the set $\{1,4,5\}$ is $$\mathtt{Branch~(0,~1,~Leaf~4,~Branch~(1,~4,~Leaf~1,~Leaf~5))}$$ The first branching bit is the bit 0 (and the corresponding prefix is [0b0], not of use here), with $\{4\}$ on the left and $\{1,5\}$ on the right. Then the right subtree branches on bit 2 (and so has a branching value of $2^2 = 4$), with prefix [0b01 = 1]. *) (*s Empty set and singletons. *) let empty = Empty let is_empty = function Empty -> true | _ -> false let singleton k = Leaf k (*s Testing the occurrence of a value is similar to the search in a binary search tree, where the branching bit is used to select the appropriate subtree. *) let zero_bit k m = (k land m) == 0 let rec mem k = function | Empty -> false | Leaf j -> k == j | Branch (_, m, l, r) -> mem k (if zero_bit k m then l else r) (*s The following operation [join] will be used in both insertion and union. Given two non-empty trees [t0] and [t1] with longest common prefixes [p0] and [p1] respectively, which are supposed to disagree, it creates the union of [t0] and [t1]. For this, it computes the first bit [m] where [p0] and [p1] disagree and create a branching node on that bit. Depending on the value of that bit in [p0], [t0] will be the left subtree and [t1] the right one, or the converse. Computing the first branching bit of [p0] and [p1] uses a nice property of twos-complement representation of integers. *) let lowest_bit x = x land (-x) let branching_bit p0 p1 = lowest_bit (p0 lxor p1) let mask p m = p land (m-1) let join (p0,t0,p1,t1) = let m = branching_bit p0 p1 in if zero_bit p0 m then Branch (mask p0 m, m, t0, t1) else Branch (mask p0 m, m, t1, t0) (*s Then the insertion of value [k] in set [t] is easily implemented using [join]. Insertion in a singleton is just the identity or a call to [join], depending on the value of [k]. When inserting in a branching tree, we first check if the value to insert [k] matches the prefix [p]: if not, [join] will take care of creating the above branching; if so, we just insert [k] in the appropriate subtree, depending of the branching bit. *) let match_prefix k p m = (mask k m) == p let add k t = let rec ins = function | Empty -> Leaf k | Leaf j as t -> if j == k then t else join (k, Leaf k, j, t) | Branch (p,m,t0,t1) as t -> if match_prefix k p m then if zero_bit k m then Branch (p, m, ins t0, t1) else Branch (p, m, t0, ins t1) else join (k, Leaf k, p, t) in ins t (*s The code to remove an element is basically similar to the code of insertion. But since we have to maintain the invariant that both subtrees of a [Branch] node are non-empty, we use here the ``smart constructor'' [branch] instead of [Branch]. *) let branch = function | (_,_,Empty,t) -> t | (_,_,t,Empty) -> t | (p,m,t0,t1) -> Branch (p,m,t0,t1) let remove k t = let rec rmv = function | Empty -> Empty | Leaf j as t -> if k == j then Empty else t | Branch (p,m,t0,t1) as t -> if match_prefix k p m then if zero_bit k m then branch (p, m, rmv t0, t1) else branch (p, m, t0, rmv t1) else t in rmv t (*s One nice property of Patricia trees is to support a fast union operation (and also fast subset, difference and intersection operations). When merging two branching trees we examine the following four cases: (1) the trees have exactly the same prefix; (2/3) one prefix contains the other one; and (4) the prefixes disagree. In cases (1), (2) and (3) the recursion is immediate; in case (4) the function [join] creates the appropriate branching. *) let rec merge = function | Empty, t -> t | t, Empty -> t | Leaf k, t -> add k t | t, Leaf k -> add k t | (Branch (p,m,s0,s1) as s), (Branch (q,n,t0,t1) as t) -> if m == n && match_prefix q p m then (* The trees have the same prefix. Merge the subtrees. *) Branch (p, m, merge (s0,t0), merge (s1,t1)) else if m < n && match_prefix q p m then (* [q] contains [p]. Merge [t] with a subtree of [s]. *) if zero_bit q m then Branch (p, m, merge (s0,t), s1) else Branch (p, m, s0, merge (s1,t)) else if m > n && match_prefix p q n then (* [p] contains [q]. Merge [s] with a subtree of [t]. *) if zero_bit p n then Branch (q, n, merge (s,t0), t1) else Branch (q, n, t0, merge (s,t1)) else (* The prefixes disagree. *) join (p, s, q, t) let union s t = merge (s,t) (*s When checking if [s1] is a subset of [s2] only two of the above four cases are relevant: when the prefixes are the same and when the prefix of [s1] contains the one of [s2], and then the recursion is obvious. In the other two cases, the result is [false]. *) let rec subset s1 s2 = match (s1,s2) with | Empty, _ -> true | _, Empty -> false | Leaf k1, _ -> mem k1 s2 | Branch _, Leaf _ -> false | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> if m1 == m2 && p1 == p2 then subset l1 l2 && subset r1 r2 else if m1 > m2 && match_prefix p1 p2 m2 then if zero_bit p1 m2 then subset l1 l2 && subset r1 l2 else subset l1 r2 && subset r1 r2 else false (*s To compute the intersection and the difference of two sets, we still examine the same four cases as in [merge]. The recursion is then obvious. *) let rec inter s1 s2 = match (s1,s2) with | Empty, _ -> Empty | _, Empty -> Empty | Leaf k1, _ -> if mem k1 s2 then s1 else Empty | _, Leaf k2 -> if mem k2 s1 then s2 else Empty | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> if m1 == m2 && p1 == p2 then merge (inter l1 l2, inter r1 r2) else if m1 < m2 && match_prefix p2 p1 m1 then inter (if zero_bit p2 m1 then l1 else r1) s2 else if m1 > m2 && match_prefix p1 p2 m2 then inter s1 (if zero_bit p1 m2 then l2 else r2) else Empty let rec diff s1 s2 = match (s1,s2) with | Empty, _ -> Empty | _, Empty -> s1 | Leaf k1, _ -> if mem k1 s2 then Empty else s1 | _, Leaf k2 -> remove k2 s1 | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> if m1 == m2 && p1 == p2 then merge (diff l1 l2, diff r1 r2) else if m1 < m2 && match_prefix p2 p1 m1 then if zero_bit p2 m1 then merge (diff l1 s2, r1) else merge (l1, diff r1 s2) else if m1 > m2 && match_prefix p1 p2 m2 then if zero_bit p1 m2 then diff s1 l2 else diff s1 r2 else s1 (*s All the following operations ([cardinal], [iter], [fold], [for_all], [exists], [filter], [partition], [choose], [elements]) are implemented as for any other kind of binary trees. *) let rec cardinal = function | Empty -> 0 | Leaf _ -> 1 | Branch (_,_,t0,t1) -> cardinal t0 + cardinal t1 let rec iter f = function | Empty -> () | Leaf k -> f k | Branch (_,_,t0,t1) -> iter f t0; iter f t1 let rec fold f s accu = match s with | Empty -> accu | Leaf k -> f k accu | Branch (_,_,t0,t1) -> fold f t0 (fold f t1 accu) let rec for_all p = function | Empty -> true | Leaf k -> p k | Branch (_,_,t0,t1) -> for_all p t0 && for_all p t1 let rec exists p = function | Empty -> false | Leaf k -> p k | Branch (_,_,t0,t1) -> exists p t0 || exists p t1 let filter p s = let rec filt acc = function | Empty -> acc | Leaf k -> if p k then add k acc else acc | Branch (_,_,t0,t1) -> filt (filt acc t0) t1 in filt Empty s let partition p s = let rec part (t,f as acc) = function | Empty -> acc | Leaf k -> if p k then (add k t, f) else (t, add k f) | Branch (_,_,t0,t1) -> part (part acc t0) t1 in part (Empty, Empty) s let rec choose = function | Empty -> raise Not_found | Leaf k -> k | Branch (_, _,t0,_) -> choose t0 (* we know that [t0] is non-empty *) let elements s = let rec elements_aux acc = function | Empty -> acc | Leaf k -> k :: acc | Branch (_,_,l,r) -> elements_aux (elements_aux acc l) r in elements_aux [] s (*s There is no way to give an efficient implementation of [min_elt] and [max_elt], as with binary search trees. The following implementation is a traversal of all elements, barely more efficient than [fold min t (choose t)] (resp. [fold max t (choose t)]). Note that we use the fact that there is no constructor [Empty] under [Branch] and therefore always a minimal (resp. maximal) element there. *) let rec min_elt = function | Empty -> raise Not_found | Leaf k -> k | Branch (_,_,s,t) -> min (min_elt s) (min_elt t) let rec max_elt = function | Empty -> raise Not_found | Leaf k -> k | Branch (_,_,s,t) -> max (max_elt s) (max_elt t) (*s Another nice property of Patricia trees is to be independent of the order of insertion. As a consequence, two Patricia trees have the same elements if and only if they are structurally equal. *) let equal = (=) let compare = compare (*i*) let make l = List.fold_right add l empty (*i*) (*s Additional functions w.r.t to [Set.S]. *) let rec intersect s1 s2 = match (s1,s2) with | Empty, _ -> false | _, Empty -> false | Leaf k1, _ -> mem k1 s2 | _, Leaf k2 -> mem k2 s1 | Branch (p1,m1,l1,r1), Branch (p2,m2,l2,r2) -> if m1 == m2 && p1 == p2 then intersect l1 l2 || intersect r1 r2 else if m1 < m2 && match_prefix p2 p1 m1 then intersect (if zero_bit p2 m1 then l1 else r1) s2 else if m1 > m2 && match_prefix p1 p2 m2 then intersect s1 (if zero_bit p1 m2 then l2 else r2) else false coccinelle-1.0.0-rc19/commons/ocamlextra/ANSITerminal.mli0000644000175000017500000000771012247437436022140 0ustar eugeneugen(* File: ANSITerminal.mli Copyright 2004 Troestler Christophe Christophe.Troestler(at)umh.ac.be This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation, with the special exception on linking described in file LICENSE. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) (** This module offers basic control of ANSI compliant terminals. @author Christophe Troestler @version 0.3 *) (** {2 Color} *) type color = | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default (** Default color of the terminal *) (** Various styles for the text. [Blink] and [Hidden] may not work on every terminal. *) type style = | Reset | Bold | Underlined | Blink | Inverse | Hidden | Foreground of color | Background of color val black : style (** Shortcut for [Foreground Black] *) val red : style (** Shortcut for [Foreground Red] *) val green : style (** Shortcut for [Foreground Green] *) val yellow : style (** Shortcut for [Foreground Yellow] *) val blue : style (** Shortcut for [Foreground Blue] *) val magenta : style (** Shortcut for [Foreground Magenta] *) val cyan : style (** Shortcut for [Foreground Cyan] *) val white : style (** Shortcut for [Foreground White] *) val default : style (** Shortcut for [Foreground Default] *) val on_black : style (** Shortcut for [Background Black] *) val on_red : style (** Shortcut for [Background Red] *) val on_green : style (** Shortcut for [Background Green] *) val on_yellow : style (** Shortcut for [Background Yellow] *) val on_blue : style (** Shortcut for [Background Blue] *) val on_magenta : style (** Shortcut for [Background Magenta] *) val on_cyan : style (** Shortcut for [Background Cyan] *) val on_white : style (** Shortcut for [Background White] *) val on_default : style (** Shortcut for [Background Default] *) val set_autoreset : bool -> unit (** Turns the autoreset feature on and off. It defaults to on. *) val print_string : style list -> string -> unit (** [print_string attr txt] prints the string [txt] with the attributes [attr]. After printing, the attributes are automatically reset to the defaults, unless autoreset is turned off. *) val printf : style list -> ('a, unit, string, unit) format4 -> 'a (** [printf attr format arg1 ... argN] prints the arguments [arg1],...,[argN] according to [format] with the attributes [attr]. After printing, the attributes are automatically reset to the defaults, unless autoreset is turned off. *) (** {2 Erasing} *) type loc = Above | Below | Screen val erase : loc -> unit (** [erase Above] erases everything before the position of the cursor. [erase Below] erases everything after the position of the cursor. [erase Screen] erases the whole screen. *) (** {2 Cursor} *) val set_cursor : int -> int -> unit (** [set_cursor x y] puts the cursor at position [(x,y)], [x] indicating the column (the leftmost one being 1) and [y] being the line (the topmost one being 1). If [x <= 0], the [x] coordinate is unchanged; if [y <= 0], the [y] coordinate is unchanged. *) val move_cursor : int -> int -> unit (** [move_cursor x y] moves the cursor by [x] columns (to the right if [x > 0], to the left if [x < 0]) and by [y] lines (downwards if [y > 0] and upwards if [y < 0]). *) val save_cursor : unit -> unit (** [save_cursor()] saves the current position of the cursor. *) val restore_cursor : unit -> unit (** [restore_cursor()] replaces the cursor to the position saved with [save_cursor()]. *) (** {2 Scrolling} *) val scroll : int -> unit (** [scroll n] scrolls the terminal by [n] lines, up (creating new lines at the bottom) if [n > 0] and down if [n < 0]. *) coccinelle-1.0.0-rc19/commons/ocamlextra/setb.mli0000644000175000017500000001425312247437436020647 0ustar eugeneugen(*pad: taken from set.ml from stdlib ocaml, functor sux: module Make(Ord: OrderedType) = *) (* with some addons such as from list *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) (* *) (***********************************************************************) (* set.mli 1.32 2004/04/23 10:01:54 xleroy Exp $ *) (** Sets over ordered types. This module implements the set data structure, given a total ordering function over the set elements. All operations over sets are purely applicative (no side-effects). The implementation uses balanced binary trees, and is therefore reasonably efficient: insertion and membership take time logarithmic in the size of the set, for instance. *) (* pad: module type OrderedType = sig type t (** The type of the set elements. *) val compare : t -> t -> int (** A total ordering function over the set elements. This is a two-argument function [f] such that [f e1 e2] is zero if the elements [e1] and [e2] are equal, [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural comparison function {!Pervasives.compare}. *) end (** Input signature of the functor {!Set.Make}. *) *) (* module type S = sig *) (* type elt *) (** The type of the set elements. *) type 'elt t (** The type of sets. *) val empty: 'elt t (** The empty set. *) val is_empty: 'elt t -> bool (** Test whether a set is empty or not. *) val mem: 'elt -> 'elt t -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) val add: 'elt -> 'elt t -> 'elt t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) val singleton: 'elt -> 'elt t (** [singleton x] returns the one-element set containing only [x]. *) val remove: 'elt -> 'elt t -> 'elt t (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) val union: 'elt t -> 'elt t -> 'elt t (** Set union. *) val inter: 'elt t -> 'elt t -> 'elt t (** Set intersection. *) (** Set difference. *) val diff: 'elt t -> 'elt t -> 'elt t val compare: 'elt t -> 'elt t -> int (** Total ordering between sets. Can be used as the ordering function for doing sets of sets. *) val equal: 'elt t -> 'elt t -> bool (** [equal s1 s2] tests whether the sets [s1] and [s2] are equal, that is, contain equal elements. *) val subset: 'elt t -> 'elt t -> bool (** [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) val iter: ('elt -> unit) -> 'elt t -> unit (** [iter f s] applies [f] in turn to all elements of [s]. The elements of [s] are presented to [f] in increasing order with respect to the ordering over the type of the elements. *) val fold: ('elt -> 'a -> 'a) -> 'elt t -> 'a -> 'a (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], where [x1 ... xN] are the elements of [s], in increasing order. *) val for_all: ('elt -> bool) -> 'elt t -> bool (** [for_all p s] checks if all elements of the set satisfy the predicate [p]. *) val exists: ('elt -> bool) -> 'elt t -> bool (** [exists p s] checks if at least one element of the set satisfies the predicate [p]. *) val filter: ('elt -> bool) -> 'elt t -> 'elt t (** [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. *) val partition: ('elt -> bool) -> 'elt t -> 'elt t * 'elt t (** [partition p s] returns a pair of sets [(s1, s2)], where [s1] is the set of all the elements of [s] that satisfy the predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) val cardinal: 'elt t -> int (** Return the number of elements of a set. *) val elements: 'elt t -> 'elt list (** Return the list of all elements of the given set. The returned list is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Set.Make}. *) val min_elt: 'elt t -> 'elt (** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or raise [Not_found] if the set is empty. *) val max_elt: 'elt t -> 'elt (** Same as {!Set.S.min_elt}, but returns the largest element of the given set. *) val choose: 'elt t -> 'elt (** Return one element of the given set, or raise [Not_found] if the set is empty. Which element is chosen is unspecified, but equal elements will be chosen for equal sets. *) val split: 'elt -> 'elt t -> 'elt t * bool * 'elt t (** [split x s] returns a triple [(l, present, r)], where [l] is the set of elements of [s] that are strictly less than [x]; [r] is the set of elements of [s] that are strictly greater than [x]; [present] is [false] if [s] contains no element equal to [x], or [true] if [s] contains an element equal to [x]. *) (* end (** Output signature of the functor {!Set.Make}. *) module Make (Ord : OrderedType) : S with type elt = Ord.t (** Functor building an implementation of the set structure given a totally ordered type. *) *) coccinelle-1.0.0-rc19/commons/ocamlextra/suffix_tree_ext.ml0000644000175000017500000003045212247437436022743 0ustar eugeneugen(* made by Sebastien Ferre *) (* type of nodes in suffix trees *) type node = { seqid : int; (* sequence index in which the positions start and final are defined *) mutable start : int; (* start and final position of the word labelling the node *) final : int ref; mutable link : node; (* suffix link *) v : node_value } and node_value = | Children of (char,node) Hashtbl.t (* for non-leaves: children nodes *) (* for the key '\000', all values are relevant (use Hashtbl.find_all) *) | Index of int (* for leaves: position of recognized suffix *) (* type of suffix trees *) type t = string DynArray.t * node (* the initial root node *) let empty : unit -> node = fun () -> let rec root = {seqid= -1; start=0; final=ref (-1); link=root; v=Children (Hashtbl.create 2)} in root (* -------------------------------------------------------------------------------- Operations on substrings of sequences -------------------------------------------------------------------------------- *) type subseq = string * int * int (* (seq, pos, len) *) let subseq_empty = ("",0,0) (* non-significant subseq *) let subseq_is_empty (s,pos,len) = len = 0 let subseq_get (s,pos,len) i = s.[pos+i] let subseq_length (s,pos,len) = len let subseq_sub (s,pos,len) pos' len' = (s,pos+pos',len') let subseq_extend (s,pos,len) = (s,pos,len+1) (* ------------------------------------------------------------------------------- Operations on implicit nodes (explicit, implicit, child : node * subseq * node) the snd node [child] is significant only when [implicit] is not the empty string, and is the child that recognizes [implicit] starting from [explicit]. [implicit] is defined by a sequence, a start and a length. ------------------------------------------------------------------------------- *) let eq_char c1 c2 = c1<>'\000' & c1=c2 (* ensures that 2 terminal symbols '\000' are pairwise different (for GST only, not necessary for ST) *) (* returns the child node that recognizes [implicit] from the node [explicit] *) let get_child seqar (explicit,implicit) = if subseq_is_empty implicit then explicit else let c = subseq_get implicit 0 in if c = '\000' then raise Not_found else match explicit.v with | Children h -> Hashtbl.find h c | Index _ -> raise Not_found (* List.find (fun child -> eq_char seqar.(child.seqid).[child.start] c) explicit.children *) (* ensures that implicit does not span over another node below [explicit] *) let rec canonical seqar (explicit,implicit,child) = if subseq_is_empty implicit then (explicit,implicit,child) else let l = !(child.final) - child.start + 1 in let a = subseq_length implicit in if a < l then (explicit,implicit,child) else let implicit' = subseq_sub implicit l (a-l) in canonical seqar (child, implicit', get_child seqar (child,implicit')) (* test whether an implicit node is the root node *) let is_root root (explicit,implicit,_) = explicit == root & subseq_is_empty implicit (* test whether the extension of an implicit node by [seqar.(k).[i]] is still recognized in the GST, and if yes, returns the implicit node extended by 1 position, otherwise returns [None]. *) let has_child seqar (explicit,implicit,child) (k,i) = let a = subseq_length implicit in if a <> 0 then if eq_char (DynArray.get seqar (child.seqid)).[child.start+a] (DynArray.get seqar k).[i] then Some (explicit, subseq_extend implicit, child) else None else try let implicit' = ((DynArray.get seqar k),i,1) in Some (explicit, implicit', get_child seqar (explicit,implicit')) with Not_found -> None (* -------------------------------- creation of new nodes and leaves -------------------------------- *) let add_leaf (seqar,root) node seqid start final_ref index = match node.v with | Children h -> Hashtbl.add h (DynArray.get seqar (seqid)).[start] {seqid=seqid; start=start; final=final_ref; link=root; v=(Index index)} | Index _ -> raise (Invalid_argument "Suffix_tree.add_leaf: 2nd argument must not be a leaf") (* make explicit an implicit node by inserting a new node between [explicit] and [child] *) let insert_node (seqar,root) (explicit,implicit,child) = let a = subseq_length implicit in if a = 0 then explicit else match explicit.v with | Children h -> let c_child_old = (DynArray.get seqar (child.seqid)).[child.start] in let c_child_new = (DynArray.get seqar (child.seqid)).[child.start+a] in let n' = { seqid = child.seqid; start = child.start; final = ref (child.start+a-1); link = root; v = Children (let h' = Hashtbl.create (Hashtbl.length h) in Hashtbl.add h' c_child_new child; h') } in child.start <- child.start+a; Hashtbl.replace h c_child_old n'; n' | Index _ -> raise (Invalid_argument "Suffix_tree.insert_node: first part of 2nd argument must not be a leaf") (* add a suffix link from [pred_opt] (if defined) to [explicit] *) let add_link root pred_opt explicit = (*if explicit != root then*) (* create a new suffix link *) match pred_opt with | Some n -> (*if n.link = None then*) n.link <- explicit | None -> () (* ------------ suffix links ------------ *) (* get the node referred by the suffix link at [n] *) (* let suffix_link (root : node) (n : node) : node = match n.link with | None -> root (* by default, the suffix link points to the root node *) | Some n' -> n' *) (* extend suffix_link for implicit nodes *) let link (seqar,root) = function (* TODO *) | (explicit,implicit,_) when subseq_is_empty implicit -> let explicit' = explicit.link (*suffix_link root explicit*) in (explicit', subseq_empty, explicit') | (explicit,implicit,_) -> if explicit == root then let implicit' = subseq_sub implicit 1 (subseq_length implicit - 1) in canonical seqar (root, implicit', get_child seqar (root,implicit')) else let explicit' = explicit.link (*suffix_link root explicit*) in canonical seqar (explicit', implicit, get_child seqar (explicit',implicit)) (* -------------------------------------------------------------- GST update for the new character c at position i in sequence k -------------------------------------------------------------- *) (* state for 'update' *) type res = { terminal : int ref; mutable startj : int; mutable startnode : node * subseq * node } let rec update (seqar,root) (k,i) res pred_opt = (* c = seqar.(k).[i] *) match has_child seqar res.startnode (k,i) with | Some extended_startnode -> (* startnode can be extended by [c] *) let explicit, implicit, _ = res.startnode in assert (pred_opt = None or subseq_is_empty implicit); (* if a link has been followed after node creation, then we are on an explicit node *) add_link root pred_opt explicit; res.startnode <- canonical seqar extended_startnode | None -> (* startnode cannot be extended by [c] ... *) let n' = insert_node (seqar,root) res.startnode in (* ... so we insert a new node ... *) add_link root pred_opt n'; (* ... a suffix link from the last created node (if defined) ... *) if (DynArray.get seqar (k)).[res.startj] <> '\000' then add_leaf (seqar,root) n' k i res.terminal res.startj; (* ... and a new leaf for the suffix at position [res.startj] *) res.startj <- res.startj + 1; (* prepare for the next suffix *) if not (is_root root res.startnode) then begin (* while [res.startnode] is not the root, and cannot be extended by [c] ... *) res.startnode <- link (seqar,root) res.startnode; (* ... follow the suffix link to find the next suffix ... *) update (seqar,root) (k,i) res (Some n') end (* ... and loop on [update] *) (* ------------------------------- implementing the .mli interface ------------------------------- *) let make : string list -> t = fun l_seq -> let l = List.length l_seq in let seqar = Array.make l "" in let seqar = DynArray.of_array seqar in let root = empty () in let st = (seqar, root) in ignore (List.fold_left (fun k seq -> (* for every sequence/string [seq], numbered [k] ... *) DynArray.set seqar k (seq ^ String.make 1 '\000'); let res = {terminal=ref (-1); startj=0; startnode=(root,subseq_empty,root)} in (* initialize for [update] ... *) for i = 0 to String.length (DynArray.get seqar k) - 1 do (* for every position [i] in the sequence ... *) incr res.terminal; (* increment the leaves final position ... *) update st (k,i) res None (* call [update] for updating the suffix tree with the character at position [i] *) done; k+1) 0 l_seq); st let add (s: string) (seqar,root : t) = let k = DynArray.length seqar in DynArray.add seqar s; let st = (seqar, root) in let seq = s in begin DynArray.set seqar k (seq ^ String.make 1 '\000'); let res = {terminal=ref (-1); startj=0; startnode=(root,subseq_empty,root)} in (* initialize for [update] ... *) for i = 0 to String.length (DynArray.get seqar k) - 1 do (* for every position [i] in the sequence ... *) incr res.terminal; (* increment the leaves final position ... *) update st (k,i) res None (* call [update] for updating the suffix tree with the character at position [i] *) done; end let string (seqar,root : t) (k : int) = let seq = (DynArray.get seqar (k)) in String.sub seq 0 (String.length seq - 1) (* removing the terminal symbol *) let string_list (seqar,root : t) = List.map (fun seq -> String.sub seq 0 (String.length seq - 1)) (DynArray.to_list seqar) let root (seq,root : t) = root let word (seqar,root) node = if node == root then "" else String.sub (DynArray.get seqar (node.seqid)) node.start (!(node.final) - node.start + (match node.v with Children _ -> 1 | Index _ -> 0)) let children (gst : t) node = match node.v with | Children h -> Hashtbl.fold (fun c n l -> n::l) h [] | Index _ -> [] let index (seq,root) node : int * int = match node.v with | Children _ -> raise (Invalid_argument "Suffix_tree.index: 2nd argument must be a leaf") | Index i -> (node.seqid, i) let linked_node (seqar,root : t) (n : node) : node = n.link (*suffix_link root n*) let rec implicit_node (seqar,node : t) (word : string) = let (explicit, (s,i,len), child) = implicit_node_aux (seqar,node) (word,0,String.length word) in (explicit, String.sub s i len, child) and implicit_node_aux (seqar,node) implicit = let w = subseq_length implicit in let child = get_child seqar (node,implicit) in let l = !(child.final) - child.start + 1 in let a = ref 1 in while !a < l & !a < w & eq_char (DynArray.get seqar (child.seqid)).[child.start + !a] (subseq_get implicit !a) do incr a done; (* [!a] is the first mismatch position, or the length of [child] label *) if !a < w then if !a < l then raise Not_found else implicit_node_aux (seqar,child) (subseq_sub implicit !a (w - !a)) else (node,implicit,child) (* let rec synthesized (seqar,root : t) (f : 'a list -> node -> 'a) = synthesized_node (seqar,root) f root and synthesized_node st f node = f (List.map (synthesized_node st f) (children st node)) node *) (* general fold *) let rec fold : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> 's = fun gst f h s init -> fold_node gst f h s init (root gst) and fold_node gst f h s h_node node = s (List.map (fun child -> fold_node gst f h s (h h_node child) child) (List.filter (f h_node) (children gst node))) h_node node (* synthesized attributes only *) let fold_s_node gst s node = fold_node gst (fun _ _ -> true) (fun _ _ -> ()) (fun l _ n -> s l n) () node let fold_s gst s = fold_s_node gst s (root gst) (* filtering and synthesizing, no inheritance *) let fold_fs gst f s = fold gst (fun _ n -> f n) (fun _ _ -> ()) (fun l _ n -> s l n) () type tree = Node of string * tree list | Leaf of string * (int * int) let readable gst = fold_s gst (fun l n -> let w = word gst n in if l=[] then Leaf (w, index gst n) else Node (w, l)) (* applications of suffix trees *) let exact_matches : t -> string -> (int * int) list = fun gst word -> try let explicit, implicit, child = implicit_node gst word in fold_s_node gst (fun l n -> if l=[] then [index gst n] else List.concat l) child with Not_found -> [] let contained_string gst word = List.map (fun (i,j) -> DynArray.get (fst gst) i) (exact_matches gst word) coccinelle-1.0.0-rc19/commons/ocamlextra/suffix_tree_ext.mli0000644000175000017500000001107412247437436023113 0ustar eugeneugen(** Generalized suffix trees (GSTs). Computes generalized suffix trees from list of strings. A terminal symbol is implicitly added to them, but is not returned in the word labeling nodes and leaves. This should allow a rather transparent handling of GSTs. Node-based accesses are provided (sequences, root, children, suffix links, node labels, index), as well as a functional for synthesizing attributes from a GST. A readable representation of GSTs is derived from the later. *) (* made by Sebastien Ferre *) (* extension by Yoann Padioleau: the function add, allowing to extend a gst (internally use now a DynArray instead of an Array) *) type node (** Type of nodes in GSTs. *) type t (** Type of GSTs. *) val make : string list -> t (** [make l_str] computes a GST based on the set of strings given in [l_str]. *) val add : string -> t -> unit (** [add l_str gst] add a new string in the GST. Does it via a side effect. *) val string_list : t -> string list (** [string_list gst] returns the list of strings from which [gst] was computed. *) val string : t -> int -> string (** [string gst k] returns the sequence number [k] (starting from 0). *) val root : t -> node (** [root gst] returns the root node of the gst. *) val word : t -> node -> string (** [word gst n] returns the word labeling node [n] in [gst]. *) val children : t -> node -> node list (** [children gst n] returns a list of the children nodes of [n] in [gst]. *) val linked_node : t -> node -> node (** [linked_node gst n] returns the node pointed by the suffix link from [n] in [gst]. *) val index : t -> node -> int * int (** [index gst n] returns the index of a leaf [n] in [gst]. This index is a pair [(k,i)], where [k] is the number of the sequence (as used by [string]), and [i] is the position of the related suffix (starting from [0] as usual in strings). @raise Invalid_argument "Suffix_tree.index: not a leaf" if [n] is not a leaf (has some child). *) val implicit_node : t -> string -> node * string * node (** [implicit_node gst word] returns an implicit_node [(node,word',child)], where [node] is the lowest node in the suffix tre such that the concatenation of the word recognized by [node] and [word'] is equal to [word], if [word'] is not the empty string, then [child] is the child node of [node], whose label has [word'] as a prefix. @raise Not_found when [word] is not a substring of [string_list gst]. *) val fold : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> 's (** [fold gst filter herit synth init] computes some attribute(s) over a GST by using the 3 functions [filter], [herit], [synth], and the initial value [init] inherited by the root node. ['h] is the type of inherited attributes, and ['s] is the type of synthesized attributes, and so the type of the result. The meaning of 3 functions is as follows: - [filter h child] returns [true] if the node [child] must be explored given the inherited value of the current node (parent of [child]), - [herit h child] returns the value inherited by [child] given the inherited value of the current node (parent of [child]), - [synth l h node] returns the synthesized value of the current node, given its inherited value [h], and the list [l] of synthesized values of explored children of [node] (according to [filter]). *) val fold_node : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> node -> 's (** Same as [fold], except the computation starts and finishes at the last argument node. *) val fold_s : t -> ('s list -> node -> 's) -> 's (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and no inherited values: purely synthetic. *) val fold_s_node : t -> ('s list -> node -> 's) -> node -> 's (** Same as [fold_s], except the computation starts and finishes at the last argument node. *) val fold_fs : t -> (node -> bool) -> ('s list -> node -> 's) -> 's (** [fold_fs gst filter synth] is equivalent to [fold gst filter herit synth init], where there is no inherited values. *) type tree = Node of string * tree list | Leaf of string * (int * int) val readable : t -> tree (** [readable gst] returns a (more) readable representation of [gst]. Each node and leaf is decorated by its word label, and leaves are also decorated by their index. *) val exact_matches : t -> string -> (int * int) list coccinelle-1.0.0-rc19/commons/ocamlextra/enum.ml0000644000175000017500000001555212247437436020510 0ustar eugeneugen(* * Enum - Enumeration over abstract collection of elements. * Copyright (C) 2003 Nicolas Cannasse * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type 'a t = { mutable count : unit -> int; mutable next : unit -> 'a; mutable clone : unit -> 'a t; mutable fast : bool; } (* raised by 'next' functions, should NOT go outside the API *) exception No_more_elements let _dummy () = assert false let make ~next ~count ~clone = { count = count; next = next; clone = clone; fast = true; } let rec init n f = if n < 0 then invalid_arg "Enum.init"; let count = ref n in { count = (fun () -> !count); next = (fun () -> match !count with | 0 -> raise No_more_elements | _ -> decr count; f (n - 1 - !count)); clone = (fun () -> init !count f); fast = true; } let rec empty () = { count = (fun () -> 0); next = (fun () -> raise No_more_elements); clone = (fun () -> empty()); fast = true; } type 'a _mut_list = { hd : 'a; mutable tl : 'a _mut_list; } let force t = let rec clone enum count = let enum = ref !enum and count = ref !count in { count = (fun () -> !count); next = (fun () -> match !enum with | [] -> raise No_more_elements | h :: t -> decr count; enum := t; h); clone = (fun () -> let enum = ref !enum and count = ref !count in clone enum count); fast = true; } in let count = ref 0 in let _empty = Obj.magic [] in let rec loop dst = let x = { hd = t.next(); tl = _empty } in incr count; dst.tl <- x; loop x in let enum = ref _empty in (try enum := { hd = t.next(); tl = _empty }; incr count; loop !enum; with No_more_elements -> ()); let tc = clone (Obj.magic enum) count in t.clone <- tc.clone; t.next <- tc.next; t.count <- tc.count; t.fast <- true let from f = let e = { next = f; count = _dummy; clone = _dummy; fast = false; } in e.count <- (fun () -> force e; e.count()); e.clone <- (fun () -> force e; e.clone()); e let from2 next clone = let e = { next = next; count = _dummy; clone = clone; fast = false; } in e.count <- (fun () -> force e; e.count()); e let get t = try Some (t.next()) with No_more_elements -> None let push t e = let rec make t = let fnext = t.next in let fcount = t.count in let fclone = t.clone in let next_called = ref false in t.next <- (fun () -> next_called := true; t.next <- fnext; t.count <- fcount; t.clone <- fclone; e); t.count <- (fun () -> let n = fcount() in if !next_called then n else n+1); t.clone <- (fun () -> let tc = fclone() in if not !next_called then make tc; tc); in make t let peek t = match get t with | None -> None | Some x -> push t x; Some x let junk t = try ignore(t.next()) with No_more_elements -> () let is_empty t = if t.fast then t.count() = 0 else peek t = None let count t = t.count() let fast_count t = t.fast let clone t = t.clone() let iter f t = let rec loop () = f (t.next()); loop(); in try loop(); with No_more_elements -> () let iteri f t = let rec loop idx = f idx (t.next()); loop (idx+1); in try loop 0; with No_more_elements -> () let iter2 f t u = let push_t = ref None in let rec loop () = push_t := None; let e = t.next() in push_t := Some e; f e (u.next()); loop () in try loop () with No_more_elements -> match !push_t with | None -> () | Some e -> push t e let iter2i f t u = let push_t = ref None in let rec loop idx = push_t := None; let e = t.next() in push_t := Some e; f idx e (u.next()); loop (idx + 1) in try loop 0 with No_more_elements -> match !push_t with | None -> () | Some e -> push t e let fold f init t = let acc = ref init in let rec loop() = acc := f (t.next()) !acc; loop() in try loop() with No_more_elements -> !acc let foldi f init t = let acc = ref init in let rec loop idx = acc := f idx (t.next()) !acc; loop (idx + 1) in try loop 0 with No_more_elements -> !acc let fold2 f init t u = let acc = ref init in let push_t = ref None in let rec loop() = push_t := None; let e = t.next() in push_t := Some e; acc := f e (u.next()) !acc; loop() in try loop() with No_more_elements -> match !push_t with | None -> !acc | Some e -> push t e; !acc let fold2i f init t u = let acc = ref init in let push_t = ref None in let rec loop idx = push_t := None; let e = t.next() in push_t := Some e; acc := f idx e (u.next()) !acc; loop (idx + 1) in try loop 0 with No_more_elements -> match !push_t with | None -> !acc | Some e -> push t e; !acc let find f t = let rec loop () = let x = t.next() in if f x then x else loop() in try loop() with No_more_elements -> raise Not_found let rec map f t = { count = t.count; next = (fun () -> f (t.next())); clone = (fun () -> map f (t.clone())); fast = t.fast; } let rec mapi f t = let idx = ref (-1) in { count = t.count; next = (fun () -> incr idx; f !idx (t.next())); clone = (fun () -> mapi f (t.clone())); fast = t.fast; } let rec filter f t = let rec next() = let x = t.next() in if f x then x else next() in from2 next (fun () -> filter f (t.clone())) let rec filter_map f t = let rec next () = match f (t.next()) with | None -> next() | Some x -> x in from2 next (fun () -> filter_map f (t.clone())) let rec append ta tb = let t = { count = (fun () -> ta.count() + tb.count()); next = _dummy; clone = (fun () -> append (ta.clone()) (tb.clone())); fast = ta.fast && tb.fast; } in t.next <- (fun () -> try ta.next() with No_more_elements -> (* add one indirection because tb can mute *) t.next <- (fun () -> tb.next()); t.count <- (fun () -> tb.count()); t.clone <- (fun () -> tb.clone()); t.fast <- tb.fast; t.next() ); t let rec concat t = let concat_ref = ref _dummy in let rec concat_next() = let tn = t.next() in concat_ref := (fun () -> try tn.next() with No_more_elements -> concat_next()); !concat_ref () in concat_ref := concat_next; from2 (fun () -> !concat_ref ()) (fun () -> concat (t.clone())) coccinelle-1.0.0-rc19/commons/ocamlextra/enum.mli0000644000175000017500000001743112247437436020657 0ustar eugeneugen(* * Enum - enumeration over abstract collection of elements. * Copyright (C) 2003 Nicolas Cannasse * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Enumeration over abstract collection of elements. Enumerations are entirely functional and most of the operations do not actually require the allocation of data structures. Using enumerations to manipulate data is therefore efficient and simple. All data structures in ExtLib such as lists, arrays, etc. have support to convert from and to enumerations. *) type 'a t (** {6 Final functions} These functions consume the enumeration until it ends or an exception is raised by the first argument function. *) val iter : ('a -> unit) -> 'a t -> unit (** [iter f e] calls the function [f] with each elements of [e] in turn. *) val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit (** [iter2 f e1 e2] calls the function [f] with the next elements of [e] and [e2] repeatedly until one of the two enumerations ends. *) val fold : ('a -> 'b -> 'b) -> 'b -> 'a t -> 'b (** [fold f v e] returns v if e is empty, otherwise [f (... (f (f v a1) a2) ...) aN] where a1..N are the elements of [e]. *) val fold2 : ('a -> 'b -> 'c -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** [fold2] is similar to [fold] but will fold over two enumerations at the same time until one of the two enumerations ends. *) (** Indexed functions : these functions are similar to previous ones except that they call the function with one additional argument which is an index starting at 0 and incremented after each call to the function. *) val iteri : (int -> 'a -> unit) -> 'a t -> unit val iter2i : ( int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit val foldi : (int -> 'a -> 'b -> 'b) -> 'b -> 'a t -> 'b val fold2i : (int -> 'a -> 'b -> 'c -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** {6 Useful functions} *) val find : ('a -> bool) -> 'a t -> 'a (** [find f e] returns the first element [x] of [e] such that [f x] returns [true], consuming the enumeration up to and including the found element, or, raises [Not_found] if no such element exists in the enumeration, consuming the whole enumeration in the search. Since [find] consumes a prefix of the enumeration, it can be used several times on the same enumeration to find the next element. *) val is_empty : 'a t -> bool (** [is_empty e] returns true if [e] does not contains any element. *) val peek : 'a t -> 'a option (** [peek e] returns [None] if [e] is empty or [Some x] where [x] is the next element of [e]. The element is not removed from the enumeration. *) val get : 'a t -> 'a option (** [get e] returns [None] if [e] is empty or [Some x] where [x] is the next element of [e], in which case the element is removed from the enumeration. *) val push : 'a t -> 'a -> unit (** [push e x] will add [x] at the beginning of [e]. *) val junk : 'a t -> unit (** [junk e] removes the first element from the enumeration, if any. *) val clone : 'a t -> 'a t (** [clone e] creates a new enumeration that is copy of [e]. If [e] is consumed by later operations, the clone will not get affected. *) val force : 'a t -> unit (** [force e] forces the application of all lazy functions and the enumeration of all elements, exhausting the enumeration. An efficient intermediate data structure of enumerated elements is constructed and [e] will now enumerate over that data structure. *) (** {6 Lazy constructors} These functions are lazy which means that they will create a new modified enumeration without actually enumerating any element until they are asked to do so by the programmer (using one of the functions above). When the resulting enumerations of these functions are consumed, the underlying enumerations they were created from are also consumed. *) val map : ('a -> 'b) -> 'a t -> 'b t (** [map f e] returns an enumeration over [(f a1, f a2, ... , f aN)] where a1...N are the elements of [e]. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** [mapi] is similar to [map] except that [f] is passed one extra argument which is the index of the element in the enumeration, starting from 0. *) val filter : ('a -> bool) -> 'a t -> 'a t (** [filter f e] returns an enumeration over all elements [x] of [e] such as [f x] returns [true]. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** [filter_map f e] returns an enumeration over all elements [x] such as [f y] returns [Some x] , where [y] is an element of [e]. *) val append : 'a t -> 'a t -> 'a t (** [append e1 e2] returns an enumeration that will enumerate over all elements of [e1] followed by all elements of [e2]. *) val concat : 'a t t -> 'a t (** [concat e] returns an enumeration over all elements of all enumerations of [e]. *) (** {6 Constructors} In this section the word {i shall} denotes a semantic requirement. The correct operation of the functions in this interface are conditional on the client meeting these requirements. *) exception No_more_elements (** This exception {i shall} be raised by the [next] function of [make] or [from] when no more elements can be enumerated, it {i shall not} be raised by any function which is an argument to any other function specified in the interface. *) val empty : unit -> 'a t (** The empty enumeration : contains no element *) val make : next:(unit -> 'a) -> count:(unit -> int) -> clone:(unit -> 'a t) -> 'a t (** This function creates a fully defined enumeration. {ul {li the [next] function {i shall} return the next element of the enumeration or raise [No_more_elements] if the underlying data structure does not have any more elements to enumerate.} {li the [count] function {i shall} return the actual number of remaining elements in the enumeration.} {li the [clone] function {i shall} create a clone of the enumeration such as operations on the original enumeration will not affect the clone. }} For some samples on how to correctly use [make], you can have a look at implementation of [ExtList.enum]. *) val from : (unit -> 'a) -> 'a t (** [from next] creates an enumeration from the [next] function. [next] {i shall} return the next element of the enumeration or raise [No_more_elements] when no more elements can be enumerated. Since the enumeration definition is incomplete, a call to [clone] or [count] will result in a call to [force] that will enumerate all elements in order to return a correct value. *) val init : int -> (int -> 'a) -> 'a t (** [init n f] creates a new enumeration over elements [f 0, f 1, ..., f (n-1)] *) (** {6 Counting} *) val count : 'a t -> int (** [count e] returns the number of remaining elements in [e] without consuming the enumeration. Depending of the underlying data structure that is implementing the enumeration functions, the count operation can be costly, and even sometimes can cause a call to [force]. *) val fast_count : 'a t -> bool (** For users worried about the speed of [count] you can call the [fast_count] function that will give an hint about [count] implementation. Basically, if the enumeration has been created with [make] or [init] or if [force] has been called on it, then [fast_count] will return true. *) coccinelle-1.0.0-rc19/commons/ocamlextra/ANSITerminal.ml0000644000175000017500000001467412247437436021776 0ustar eugeneugen(* File: ANSITerminal.ml Allow colors, cursor movements, erasing,... under Unix and DOS shells. ********************************************************************* Copyright 2004 by Troestler Christophe Christophe.Troestler(at)umh.ac.be This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation, with the special exception on linking described in file LICENSE. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file LICENSE for more details. *) (** See the file ctlseqs.html (unix) and (for DOS) http://www.ka.net/jmenees/Dos/Ansi.htm *) open Printf (* Erasing *) type loc = Above | Below | Screen let erase = function | Above -> print_string "\027[1J" | Below -> print_string "\027[0J" | Screen -> print_string "\027[2J" (* Cursor *) let set_cursor x y = if x <= 0 then (if y > 0 then printf "\027[%id" y) else (* x > 0 *) if y <= 0 then printf "\027[%iG" x else printf "\027[%i;%iH" y x let move_cursor x y = if x > 0 then printf "\027[%iC" x else if x < 0 then printf "\027[%iD" (-x); if y > 0 then printf "\027[%iB" y else if y < 0 then printf "\027[%iA" (-y) let save_cursor () = print_string "\027[s" let restore_cursor () = print_string "\027[u" (* Scrolling *) let scroll lines = if lines > 0 then printf "\027[%iS" lines else if lines < 0 then printf "\027[%iT" (- lines) (* Colors *) let autoreset = ref true let set_autoreset b = autoreset := b type color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default type style = | Reset | Bold | Underlined | Blink | Inverse | Hidden | Foreground of color | Background of color let black = Foreground Black let red = Foreground Red let green = Foreground Green let yellow = Foreground Yellow let blue = Foreground Blue let magenta = Foreground Magenta let cyan = Foreground Cyan let white = Foreground White let default = Foreground Default let on_black = Background Black let on_red = Background Red let on_green = Background Green let on_yellow = Background Yellow let on_blue = Background Blue let on_magenta = Background Magenta let on_cyan = Background Cyan let on_white = Background White let on_default = Background Default let style_to_string = function | Reset -> "0" | Bold -> "1" | Underlined -> "4" | Blink -> "5" | Inverse -> "7" | Hidden -> "8" | Foreground Black -> "30" | Foreground Red -> "31" | Foreground Green -> "32" | Foreground Yellow -> "33" | Foreground Blue -> "34" | Foreground Magenta -> "35" | Foreground Cyan -> "36" | Foreground White -> "37" | Foreground Default -> "39" | Background Black -> "40" | Background Red -> "41" | Background Green -> "42" | Background Yellow -> "43" | Background Blue -> "44" | Background Magenta -> "45" | Background Cyan -> "46" | Background White -> "47" | Background Default -> "49" let print_string style txt = print_string "\027["; let s = String.concat ";" (List.map style_to_string style) in print_string s; print_string "m"; print_string txt; if !autoreset then print_string "\027[0m" let printf style = kprintf (print_string style) (* On DOS & windows, to enable the ANSI sequences, ANSI.SYS should be loaded in C:\CONFIG.SYS with a line of the type DEVICE = C:\DOS\ANSI.SYS DEVICEHIGH=C:\WINDOWS\COMMAND\ANSI.SYS This routine checks whether the line is present and, if not, it inserts it and tells the user to reboot. On WINNT, one will create a ANSI.NT in the user dir and a command.com link on the desktop (with Configfilename = our ANSI.NT) and tell the user to use it. REM: that does NOT work under winxp because OCaml programs are not considered to run in DOS mode only... http://support.microsoft.com/default.aspx?scid=kb;en-us;816179 http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/console_functions.asp *) (* let is_readable file = *) (* try close_in(open_in file); true *) (* with Sys_error _ -> false *) (* let config_sys = "C:\\CONFIG.SYS" *) (* exception OK *) (* let win9x () = *) (* (\* Locate ANSI.SYS *\) *) (* let ansi_sys = List.find is_readable [ *) (* "C:\\DOS\\ANSI.SYS"; *) (* "C:\\WINDOWS\\COMMAND\\ANSI.SYS"; ] in *) (* (\* Parse CONFIG.SYS to see whether it has the right line *\) *) (* try *) (* let re = Str.regexp_case_fold *) (* ("^DEVICE\\(HIGH\\)?[ \t]*=[ \t]*" ^ ansi_sys ^ "[ \t]*$") in *) (* let fh = open_in config_sys in *) (* begin try *) (* while true do *) (* if Str.string_match re (input_line fh) 0 then raise OK *) (* done *) (* with *) (* | End_of_file -> *) (* (\* Correct line not found: add it *\) *) (* close_in fh; *) (* raise(Sys_error "win9x") *) (* | OK -> close_in fh (\* Correct line found, keep going *\) *) (* end *) (* with Sys_error _ -> *) (* (\* config_sys not does not exists or does not contain the right line. *\) *) (* let fh = open_out_gen [Open_wronly; Open_append; Open_creat; Open_text] *) (* 0x777 config_sys in *) (* output_string fh ("DEVICEHIGH=" ^ ansi_sys ^ "\n"); *) (* close_out fh; *) (* prerr_endline "Please restart your computer and rerun the program."; *) (* exit 1 *) (* let winnt home = *) (* (\* Locate ANSI.SYS *\) *) (* let system = *) (* try Sys.getenv "SystemRoot" *) (* with Not_found -> "C:\\WINDOWS" in *) (* let ansi_sys = *) (* List.find is_readable (List.map (fun s -> Filename.concat system s) *) (* [ "SYSTEM32\\ANSI.SYS"; ]) in *) (* (\* Create an ANSI.SYS file in the user dir *\) *) (* let ansi_nt = Filename.concat home "ANSI.NT" in *) (* let fh = open_out ansi_nt in *) (* output_string fh "dosonly\ndevice="; *) (* output_string fh ansi_sys; *) (* output_string fh "\ndevice=%SystemRoot%\\system32\\himem.sys *) (* files=40 *) (* dos=high, umb *) (* " ; *) (* close_out fh; *) (* (\* Make a command.com link on the desktop *\) *) (* let fh = open_out (Filename.concat home "command.lnk") in *) (* close_out fh *) (* let () = *) (* if Sys.os_type = "Win32" then begin *) (* try winnt(Sys.getenv "USERPROFILE") (\* WinNT, Win2000, WinXP *\) *) (* with Not_found -> win9x() (\* Win9x *\) *) (* end *) coccinelle-1.0.0-rc19/commons/ocamlextra/suffix_tree.mli0000644000175000017500000001050212247437436022226 0ustar eugeneugen(** Generalized suffix trees (GSTs). Computes generalized suffix trees from list of strings. A terminal symbol is implicitly added to them, but is not returned in the word labeling nodes and leaves. This should allow a rather transparent handling of GSTs. Node-based accesses are provided (sequences, root, children, suffix links, node labels, index), as well as a functional for synthesizing attributes from a GST. A readable representation of GSTs is derived from the later. *) (* made by Sebastien Ferre *) type node (** Type of nodes in GSTs. *) type t (** Type of GSTs. *) val make : string list -> t (** [make l_str] computes a GST based on the set of strings given in [l_str]. *) val string_list : t -> string list (** [string_list gst] returns the list of strings from which [gst] was computed. *) val string : t -> int -> string (** [string gst k] returns the sequence number [k] (starting from 0). *) val root : t -> node (** [root gst] returns the root node of the gst. *) val word : t -> node -> string (** [word gst n] returns the word labeling node [n] in [gst]. *) val children : t -> node -> node list (** [children gst n] returns a list of the children nodes of [n] in [gst]. *) val linked_node : t -> node -> node (** [linked_node gst n] returns the node pointed by the suffix link from [n] in [gst]. *) val index : t -> node -> int * int (** [index gst n] returns the index of a leaf [n] in [gst]. This index is a pair [(k,i)], where [k] is the number of the sequence (as used by [string]), and [i] is the position of the related suffix (starting from [0] as usual in strings). @raise Invalid_argument "Suffix_tree.index: not a leaf" if [n] is not a leaf (has some child). *) val implicit_node : t -> string -> node * string * node (** [implicit_node gst word] returns an implicit_node [(node,word',child)], where [node] is the lowest node in the suffix tre such that the concatenation of the word recognized by [node] and [word'] is equal to [word], if [word'] is not the empty string, then [child] is the child node of [node], whose label has [word'] as a prefix. @raise Not_found when [word] is not a substring of [string_list gst]. *) val fold : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> 's (** [fold gst filter herit synth init] computes some attribute(s) over a GST by using the 3 functions [filter], [herit], [synth], and the initial value [init] inherited by the root node. ['h] is the type of inherited attributes, and ['s] is the type of synthesized attributes, and so the type of the result. The meaning of 3 functions is as follows: - [filter h child] returns [true] if the node [child] must be explored given the inherited value of the current node (parent of [child]), - [herit h child] returns the value inherited by [child] given the inherited value of the current node (parent of [child]), - [synth l h node] returns the synthesized value of the current node, given its inherited value [h], and the list [l] of synthesized values of explored children of [node] (according to [filter]). *) val fold_node : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> node -> 's (** Same as [fold], except the computation starts and finishes at the last argument node. *) val fold_s : t -> ('s list -> node -> 's) -> 's (** [fold_s gst synth] is equivalent to [fold gst filter herit synth init], where there is no filtering, and no inherited values: purely synthetic. *) val fold_s_node : t -> ('s list -> node -> 's) -> node -> 's (** Same as [fold_s], except the computation starts and finishes at the last argument node. *) val fold_fs : t -> (node -> bool) -> ('s list -> node -> 's) -> 's (** [fold_fs gst filter synth] is equivalent to [fold gst filter herit synth init], where there is no inherited values. *) type tree = Node of string * tree list | Leaf of string * (int * int) val readable : t -> tree (** [readable gst] returns a (more) readable representation of [gst]. Each node and leaf is decorated by its word label, and leaves are also decorated by their index. *) val exact_matches : t -> string -> (int * int) list coccinelle-1.0.0-rc19/commons/ocamlextra/dumper.ml0000644000175000017500000000514512247437436021035 0ustar eugeneugen(* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp *) open Printf open Obj let rec dump r = if is_int r then string_of_int (magic r : int) else ( (* Block. *) let rec get_fields acc = function | 0 -> acc | n -> let n = n-1 in get_fields (field r n :: acc) n in let rec is_list r = if is_int r then ( if (magic r : int) = 0 then true (* [] *) else false ) else ( let s = size r and t = tag r in if t = 0 && s = 2 then is_list (field r 1) (* h :: t *) else false ) in let rec get_list r = if is_int r then [] else let h = field r 0 and t = get_list (field r 1) in h :: t in let opaque name = (* XXX In future, print the address of value 'r'. Not possible in * pure OCaml at the moment. *) "<" ^ name ^ ">" in let s = size r and t = tag r in (* From the tag, determine the type of block. *) if is_list r then ( (* List. *) let fields = get_list r in "[" ^ String.concat "; " (List.map dump fields) ^ "]" ) else if t = 0 then ( (* Tuple, array, record. *) let fields = get_fields [] s in "(" ^ String.concat ", " (List.map dump fields) ^ ")" ) (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not * clear if very large constructed values could have the same * tag. XXX *) else if t = lazy_tag then opaque "lazy" else if t = closure_tag then opaque "closure" else if t = object_tag then ( (* Object. *) let fields = get_fields [] s in let clasz, id, slots = match fields with h::h'::t -> h, h', t | _ -> assert false in (* No information on decoding the class (first field). So just print * out the ID and the slots. *) "Object #" ^ dump id ^ " (" ^ String.concat ", " (List.map dump slots) ^ ")" ) else if t = infix_tag then opaque "infix" else if t = forward_tag then opaque "forward" else if t < no_scan_tag then ( (* Constructed value. *) let fields = get_fields [] s in "Tag" ^ string_of_int t ^ " (" ^ String.concat ", " (List.map dump fields) ^ ")" ) else if t = string_tag then ( "\"" ^ String.escaped (magic r : string) ^ "\"" ) else if t = double_tag then ( string_of_float (magic r : float) ) else if t = abstract_tag then opaque "abstract" else if t = custom_tag then opaque "custom" else if t = final_tag then opaque "final" else failwith ("dump: impossible tag (" ^ string_of_int t ^ ")") ) let dump v = dump (repr v) coccinelle-1.0.0-rc19/commons/ocamlextra/dynArray.mli0000644000175000017500000002634012247437436021503 0ustar eugeneugen(* * DynArray - Resizeable Ocaml arrays * Copyright (C) 2003 Brian Hurt * Copyright (C) 2003 Nicolas Cannasse * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (** Dynamic arrays. A dynamic array is equivalent to a OCaml array that will resize itself when elements are added or removed, except that floats are boxed and that no initialization element is required. *) type 'a t exception Invalid_arg of int * string * string (** When an operation on an array fails, [Invalid_arg] is raised. The integer is the value that made the operation fail, the first string contains the function name that has been called and the second string contains the parameter name that made the operation fail. *) (** {6 Array creation} *) val create : unit -> 'a t (** [create()] returns a new empty dynamic array. *) val make : int -> 'a t (** [make count] returns an array with some memory already allocated so up to [count] elements can be stored into it without resizing. *) val init : int -> (int -> 'a) -> 'a t (** [init n f] returns an array of [n] elements filled with values returned by [f 0 , f 1, ... f (n-1)]. *) (** {6 Array manipulation functions} *) val empty : 'a t -> bool (** Return true if the number of elements in the array is 0. *) val length : 'a t -> int (** Return the number of elements in the array. *) val get : 'a t -> int -> 'a (** [get darr idx] gets the element in [darr] at index [idx]. If [darr] has [len] elements in it, then the valid indexes range from [0] to [len-1]. *) val last : 'a t -> 'a (** [last darr] returns the last element of [darr]. *) val set : 'a t -> int -> 'a -> unit (** [set darr idx v] sets the element of [darr] at index [idx] to value [v]. The previous value is overwritten. *) val insert : 'a t -> int -> 'a -> unit (** [insert darr idx v] inserts [v] into [darr] at index [idx]. All elements of [darr] with an index greater than or equal to [idx] have their index incremented (are moved up one place) to make room for the new element. *) val add : 'a t -> 'a -> unit (** [add darr v] appends [v] onto [darr]. [v] becomes the new last element of [darr]. *) val append : 'a t -> 'a t -> unit (** [append src dst] adds all elements of [src] to the end of [dst]. *) val delete : 'a t -> int -> unit (** [delete darr idx] deletes the element of [darr] at [idx]. All elements with an index greater than [idx] have their index decremented (are moved down one place) to fill in the hole. *) val delete_last : 'a t -> unit (** [delete_last darr] deletes the last element of [darr]. This is equivalent of doing [delete darr ((length darr) - 1)]. *) val delete_range : 'a t -> int -> int -> unit (** [delete_range darr p len] deletes [len] elements starting at index [p]. All elements with an index greater than [p+len] are moved to fill in the hole. *) val clear : 'a t -> unit (** remove all elements from the array and resize it to 0. *) val blit : 'a t -> int -> 'a t -> int -> int -> unit (** [blit src srcidx dst dstidx len] copies [len] elements from [src] starting with index [srcidx] to [dst] starting at [dstidx]. *) val compact : 'a t -> unit (** [compact darr] ensures that the space allocated by the array is minimal.*) (** {6 Array copy and conversion} *) val to_list : 'a t -> 'a list (** [to_list darr] returns the elements of [darr] in order as a list. *) val to_array : 'a t -> 'a array (** [to_array darr] returns the elements of [darr] in order as an array. *) val enum : 'a t -> 'a Enum.t (** [enum darr] returns the enumeration of [darr] elements. *) val of_list : 'a list -> 'a t (** [of_list lst] returns a dynamic array with the elements of [lst] in it in order. *) val of_array : 'a array -> 'a t (** [of_array arr] returns an array with the elements of [arr] in it in order. *) val of_enum : 'a Enum.t -> 'a t (** [of_enum e] returns an array that holds, in order, the elements of [e]. *) val copy : 'a t -> 'a t (** [copy src] returns a fresh copy of [src], such that no modification of [src] affects the copy, or vice versa (all new memory is allocated for the copy). *) val sub : 'a t -> int -> int -> 'a t (** [sub darr start len] returns an array holding the subset of [len] elements from [darr] starting with the element at index [idx]. *) (** {6 Array functional support} *) val iter : ('a -> unit) -> 'a t -> unit (** [iter f darr] calls the function [f] on every element of [darr]. It is equivalent to [for i = 0 to length darr - 1 do f (get darr i) done;] *) val iteri : (int -> 'a -> unit) -> 'a t -> unit (** [iter f darr] calls the function [f] on every element of [darr]. It is equivalent to [for i = 0 to length darr - 1 do f i (get darr i) done;] *) val map : ('a -> 'b) -> 'a t -> 'b t (** [map f darr] applies the function [f] to every element of [darr] and creates a dynamic array from the results - similar to [List.map] or [Array.map]. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** [mapi f darr] applies the function [f] to every element of [darr] and creates a dynamic array from the results - similar to [List.mapi] or [Array.mapi]. *) val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a (** [fold_left f x darr] computes [f ( ... ( f ( f (get darr 0) x) (get darr 1) ) ... ) (get darr n-1)], similar to [Array.fold_left] or [List.fold_left]. *) val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** [fold_right f darr x] computes [ f (get darr 0) (f (get darr 1) ( ... ( f (get darr n-1) x ) ... ) ) ] similar to [Array.fold_right] or [List.fold_right]. *) val index_of : ('a -> bool) -> 'a t -> int (** [index_of f darr] returns the index of the first element [x] in darr such as [f x] returns [true] or raise [Not_found] if not found. *) val filter : ('a -> bool) -> 'a t -> unit (** {6 Array resizers} *) type resizer_t = currslots:int -> oldlength:int -> newlength:int -> int (** The type of a resizer function. Resizer functions are called whenever elements are added to or removed from the dynamic array to determine what the current number of storage spaces in the array should be. The three named arguments passed to a resizer are the current number of storage spaces in the array, the length of the array before the elements are added or removed, and the length the array will be after the elements are added or removed. If elements are being added, newlength will be larger than oldlength, if elements are being removed, newlength will be smaller than oldlength. If the resizer function returns exactly oldlength, the size of the array is only changed when adding an element while there is not enough space for it. By default, all dynamic arrays are created with the [default_resizer]. When a dynamic array is created from another dynamic array (using [copy], [map] , etc. ) the resizer of the copy will be the same as the original dynamic array resizer. To change the resizer, use the [set_resizer] function. *) val set_resizer : 'a t -> resizer_t -> unit (** Change the resizer for this array. *) val get_resizer : 'a t -> resizer_t (** Get the current resizer function for a given array *) val default_resizer : resizer_t (** The default resizer function the library is using - in this version of DynArray, this is the [exponential_resizer] but should change in next versions. *) val exponential_resizer : resizer_t (** The exponential resizer- The default resizer except when the resizer is being copied from some other darray. [exponential_resizer] works by doubling or halving the number of slots until they "fit". If the number of slots is less than the new length, the number of slots is doubled until it is greater than the new length (or Sys.max_array_size is reached). If the number of slots is more than four times the new length, the number of slots is halved until it is less than four times the new length. Allowing darrays to fall below 25% utilization before shrinking them prevents "thrashing". Consider the case where the caller is constantly adding a few elements, and then removing a few elements, causing the length to constantly cross above and below a power of two. Shrinking the array when it falls below 50% would causing the underlying array to be constantly allocated and deallocated. A few elements would be added, causing the array to be reallocated and have a usage of just above 50%. Then a few elements would be remove, and the array would fall below 50% utilization and be reallocated yet again. The bulk of the array, untouched, would be copied and copied again. By setting the threshold at 25% instead, such "thrashing" only occurs with wild swings- adding and removing huge numbers of elements (more than half of the elements in the array). [exponential_resizer] is a good performing resizer for most applications. A list allocates 2 words for every element, while an array (with large numbers of elements) allocates only 1 word per element (ignoring unboxed floats). On insert, [exponential_resizer] keeps the amount of wasted "extra" array elements below 50%, meaning that less than 2 words per element are used. Even on removals where the amount of wasted space is allowed to rise to 75%, that only means that darray is using 4 words per element. This is generally not a significant overhead. Furthermore, [exponential_resizer] minimizes the number of copies needed- appending n elements into an empty darray with initial size 0 requires between n and 2n elements of the array be copied- O(n) work, or O(1) work per element (on average). A similar argument can be made that deletes from the end of the array are O(1) as well (obviously deletes from anywhere else are O(n) work- you have to move the n or so elements above the deleted element down). *) val step_resizer : int -> resizer_t (** The stepwise resizer- another example of a resizer function, this time of a parametrized resizer. The resizer returned by [step_resizer step] returns the smallest multiple of [step] larger than [newlength] if [currslots] is less then [newlength]-[step] or greater than [newlength]. For example, to make an darray with a step of 10, a length of len, and a null of null, you would do: [make] ~resizer:([step_resizer] 10) len null *) val conservative_exponential_resizer : resizer_t (** [conservative_exponential_resizer] is an example resizer function which uses the oldlength parameter. It only shrinks the array on inserts- no deletes shrink the array, only inserts. It does this by comparing the oldlength and newlength parameters. Other than that, it acts like [exponential_resizer]. *) (** {6 Unsafe operations} **) val unsafe_get : 'a t -> int -> 'a val unsafe_set : 'a t -> int -> 'a -> unit coccinelle-1.0.0-rc19/commons/ocamlextra/suffix_tree.ml0000644000175000017500000002676212247437436022074 0ustar eugeneugen(* made by Sebastien Ferre *) (* type of nodes in suffix trees *) type node = { seqid : int; (* sequence index in which the positions start and final are defined *) mutable start : int; (* start and final position of the word labelling the node *) final : int ref; mutable link : node; (* suffix link *) v : node_value } and node_value = | Children of (char,node) Hashtbl.t (* for non-leaves: children nodes *) (* for the key '\000', all values are relevant (use Hashtbl.find_all) *) | Index of int (* for leaves: position of recognized suffix *) (* type of suffix trees *) type t = string array * node (* the initial root node *) let empty : unit -> node = fun () -> let rec root = {seqid= -1; start=0; final=ref (-1); link=root; v=Children (Hashtbl.create 2)} in root (* -------------------------------------------------------------------------------- Operations on substrings of sequences -------------------------------------------------------------------------------- *) type subseq = string * int * int (* (seq, pos, len) *) let subseq_empty = ("",0,0) (* non-significant subseq *) let subseq_is_empty (s,pos,len) = len = 0 let subseq_get (s,pos,len) i = s.[pos+i] let subseq_length (s,pos,len) = len let subseq_sub (s,pos,len) pos' len' = (s,pos+pos',len') let subseq_extend (s,pos,len) = (s,pos,len+1) (* ------------------------------------------------------------------------------- Operations on implicit nodes (explicit, implicit, child : node * subseq * node) the snd node [child] is significant only when [implicit] is not the empty string, and is the child that recognizes [implicit] starting from [explicit]. [implicit] is defined by a sequence, a start and a length. ------------------------------------------------------------------------------- *) let eq_char c1 c2 = c1<>'\000' & c1=c2 (* ensures that 2 terminal symbols '\000' are pairwise different (for GST only, not necessary for ST) *) (* returns the child node that recognizes [implicit] from the node [explicit] *) let get_child seqar (explicit,implicit) = if subseq_is_empty implicit then explicit else let c = subseq_get implicit 0 in if c = '\000' then raise Not_found else match explicit.v with | Children h -> Hashtbl.find h c | Index _ -> raise Not_found (* List.find (fun child -> eq_char seqar.(child.seqid).[child.start] c) explicit.children *) (* ensures that implicit does not span over another node below [explicit] *) let rec canonical seqar (explicit,implicit,child) = if subseq_is_empty implicit then (explicit,implicit,child) else let l = !(child.final) - child.start + 1 in let a = subseq_length implicit in if a < l then (explicit,implicit,child) else let implicit' = subseq_sub implicit l (a-l) in canonical seqar (child, implicit', get_child seqar (child,implicit')) (* test whether an implicit node is the root node *) let is_root root (explicit,implicit,_) = explicit == root & subseq_is_empty implicit (* test whether the extension of an implicit node by [seqar.(k).[i]] is still recognized in the GST, and if yes, returns the implicit node extended by 1 position, otherwise returns [None]. *) let has_child seqar (explicit,implicit,child) (k,i) = let a = subseq_length implicit in if a <> 0 then if eq_char seqar.(child.seqid).[child.start+a] seqar.(k).[i] then Some (explicit, subseq_extend implicit, child) else None else try let implicit' = (seqar.(k),i,1) in Some (explicit, implicit', get_child seqar (explicit,implicit')) with Not_found -> None (* -------------------------------- creation of new nodes and leaves -------------------------------- *) let add_leaf (seqar,root) node seqid start final_ref index = match node.v with | Children h -> Hashtbl.add h seqar.(seqid).[start] {seqid=seqid; start=start; final=final_ref; link=root; v=(Index index)} | Index _ -> raise (Invalid_argument "Suffix_tree.add_leaf: 2nd argument must not be a leaf") (* make explicit an implicit node by inserting a new node between [explicit] and [child] *) let insert_node (seqar,root) (explicit,implicit,child) = let a = subseq_length implicit in if a = 0 then explicit else match explicit.v with | Children h -> let c_child_old = seqar.(child.seqid).[child.start] in let c_child_new = seqar.(child.seqid).[child.start+a] in let n' = { seqid = child.seqid; start = child.start; final = ref (child.start+a-1); link = root; v = Children (let h' = Hashtbl.create (Hashtbl.length h) in Hashtbl.add h' c_child_new child; h') } in child.start <- child.start+a; Hashtbl.replace h c_child_old n'; n' | Index _ -> raise (Invalid_argument "Suffix_tree.insert_node: first part of 2nd argument must not be a leaf") (* add a suffix link from [pred_opt] (if defined) to [explicit] *) let add_link root pred_opt explicit = (*if explicit != root then*) (* create a new suffix link *) match pred_opt with | Some n -> (*if n.link = None then*) n.link <- explicit | None -> () (* ------------ suffix links ------------ *) (* get the node referred by the suffix link at [n] *) (* let suffix_link (root : node) (n : node) : node = match n.link with | None -> root (* by default, the suffix link points to the root node *) | Some n' -> n' *) (* extend suffix_link for implicit nodes *) let link (seqar,root) = function (* TODO *) | (explicit,implicit,_) when subseq_is_empty implicit -> let explicit' = explicit.link (*suffix_link root explicit*) in (explicit', subseq_empty, explicit') | (explicit,implicit,_) -> if explicit == root then let implicit' = subseq_sub implicit 1 (subseq_length implicit - 1) in canonical seqar (root, implicit', get_child seqar (root,implicit')) else let explicit' = explicit.link (*suffix_link root explicit*) in canonical seqar (explicit', implicit, get_child seqar (explicit',implicit)) (* -------------------------------------------------------------- GST update for the new character c at position i in sequence k -------------------------------------------------------------- *) (* state for 'update' *) type res = { terminal : int ref; mutable startj : int; mutable startnode : node * subseq * node } let rec update (seqar,root) (k,i) res pred_opt = (* c = seqar.(k).[i] *) match has_child seqar res.startnode (k,i) with | Some extended_startnode -> (* startnode can be extended by [c] *) let explicit, implicit, _ = res.startnode in assert (pred_opt = None or subseq_is_empty implicit); (* if a link has been followed after node creation, then we are on an explicit node *) add_link root pred_opt explicit; res.startnode <- canonical seqar extended_startnode | None -> (* startnode cannot be extended by [c] ... *) let n' = insert_node (seqar,root) res.startnode in (* ... so we insert a new node ... *) add_link root pred_opt n'; (* ... a suffix link from the last created node (if defined) ... *) if seqar.(k).[res.startj] <> '\000' then add_leaf (seqar,root) n' k i res.terminal res.startj; (* ... and a new leaf for the suffix at position [res.startj] *) res.startj <- res.startj + 1; (* prepare for the next suffix *) if not (is_root root res.startnode) then begin (* while [res.startnode] is not the root, and cannot be extended by [c] ... *) res.startnode <- link (seqar,root) res.startnode; (* ... follow the suffix link to find the next suffix ... *) update (seqar,root) (k,i) res (Some n') end (* ... and loop on [update] *) (* ------------------------------- implementing the .mli interface ------------------------------- *) let make : string list -> t = fun l_seq -> let l = List.length l_seq in let seqar = Array.make l "" in let root = empty () in let st = (seqar, root) in ignore (List.fold_left (fun k seq -> (* for every sequence/string [seq], numbered [k] ... *) seqar.(k) <- seq ^ String.make 1 '\000'; (* add a terminal symbol ... *) let res = {terminal=ref (-1); startj=0; startnode=(root,subseq_empty,root)} in (* initialize for [update] ... *) for i = 0 to String.length seqar.(k) - 1 do (* for every position [i] in the sequence ... *) incr res.terminal; (* increment the leaves final position ... *) update st (k,i) res None (* call [update] for updating the suffix tree with the character at position [i] *) done; k+1) 0 l_seq); st let string (seqar,root : t) (k : int) = let seq = seqar.(k) in String.sub seq 0 (String.length seq - 1) (* removing the terminal symbol *) let string_list (seqar,root : t) = List.map (fun seq -> String.sub seq 0 (String.length seq - 1)) (Array.to_list seqar) let root (seq,root : t) = root let word (seqar,root) node = if node == root then "" else String.sub seqar.(node.seqid) node.start (!(node.final) - node.start + (match node.v with Children _ -> 1 | Index _ -> 0)) let children (gst : t) node = match node.v with | Children h -> Hashtbl.fold (fun c n l -> n::l) h [] | Index _ -> [] let index (seq,root) node : int * int = match node.v with | Children _ -> raise (Invalid_argument "Suffix_tree.index: 2nd argument must be a leaf") | Index i -> (node.seqid, i) let linked_node (seqar,root : t) (n : node) : node = n.link (*suffix_link root n*) let rec implicit_node (seqar,node : t) (word : string) = let (explicit, (s,i,len), child) = implicit_node_aux (seqar,node) (word,0,String.length word) in (explicit, String.sub s i len, child) and implicit_node_aux (seqar,node) implicit = let w = subseq_length implicit in let child = get_child seqar (node,implicit) in let l = !(child.final) - child.start + 1 in let a = ref 1 in while !a < l & !a < w & eq_char seqar.(child.seqid).[child.start + !a] (subseq_get implicit !a) do incr a done; (* [!a] is the first mismatch position, or the length of [child] label *) if !a < w then if !a < l then raise Not_found else implicit_node_aux (seqar,child) (subseq_sub implicit !a (w - !a)) else (node,implicit,child) (* let rec synthesized (seqar,root : t) (f : 'a list -> node -> 'a) = synthesized_node (seqar,root) f root and synthesized_node st f node = f (List.map (synthesized_node st f) (children st node)) node *) (* general fold *) let rec fold : t -> ('h -> node -> bool) -> ('h -> node -> 'h) -> ('s list -> 'h -> node -> 's) -> 'h -> 's = fun gst f h s init -> fold_node gst f h s init (root gst) and fold_node gst f h s h_node node = s (List.map (fun child -> fold_node gst f h s (h h_node child) child) (List.filter (f h_node) (children gst node))) h_node node (* synthesized attributes only *) let fold_s_node gst s node = fold_node gst (fun _ _ -> true) (fun _ _ -> ()) (fun l _ n -> s l n) () node let fold_s gst s = fold_s_node gst s (root gst) (* filtering and synthesizing, no inheritance *) let fold_fs gst f s = fold gst (fun _ n -> f n) (fun _ _ -> ()) (fun l _ n -> s l n) () type tree = Node of string * tree list | Leaf of string * (int * int) let readable gst = fold_s gst (fun l n -> let w = word gst n in if l=[] then Leaf (w, index gst n) else Node (w, l)) (* applications of suffix trees *) let exact_matches : t -> string -> (int * int) list = fun gst word -> try let explicit, implicit, child = implicit_node gst word in fold_s_node gst (fun l n -> if l=[] then [index gst n] else List.concat l) child with Not_found -> [] let contained_string gst word = List.map (fun (i,j) -> Array.get (fst gst) i) (exact_matches gst word) coccinelle-1.0.0-rc19/commons/ocamlextra/dumper.mli0000644000175000017500000000025112247437436021177 0ustar eugeneugen(* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). * dumper.mli 1.1 2005/02/03 23:07:47 rich Exp *) val dump : 'a -> string coccinelle-1.0.0-rc19/commons/ocamlextra/setb.ml0000644000175000017500000002347012247437436020477 0ustar eugeneugen(*pad: taken from set.ml from stdlib ocaml, functor sux: module Make(Ord: OrderedType) = *) (* with some addons such as from list *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) (* *) (***********************************************************************) (* set.ml 1.18.4.1 2004/11/03 21:19:49 doligez Exp *) (* Sets over ordered types *) (* pad: type elt = Ord.t type t = Empty | Node of t * elt * t * int and subst all Ord.compare with just compare *) type 'elt t = Empty | Node of 'elt t * 'elt * 'elt t * int (* Sets are represented by balanced binary trees (the heights of the children differ by at most 2 *) let height = function Empty -> 0 | Node(_, _, _, h) -> h (* Creates a new node with left son l, value v and right son r. We must have all elements of l < v < all elements of r. l and r must be balanced and | height l - height r | <= 2. Inline expansion of height for better speed. *) let create l v r = let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1)) (* Same as create, but performs one step of rebalancing if necessary. Assumes l and r balanced and | height l - height r | <= 3. Inline expansion of create for better speed in the most frequent case where no rebalancing is required. *) let bal l v r = let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in if hl > hr + 2 then begin match l with Empty -> invalid_arg "Set.bal" | Node(ll, lv, lr, _) -> if height ll >= height lr then create ll lv (create lr v r) else begin match lr with Empty -> invalid_arg "Set.bal" | Node(lrl, lrv, lrr, _)-> create (create ll lv lrl) lrv (create lrr v r) end end else if hr > hl + 2 then begin match r with Empty -> invalid_arg "Set.bal" | Node(rl, rv, rr, _) -> if height rr >= height rl then create (create l v rl) rv rr else begin match rl with Empty -> invalid_arg "Set.bal" | Node(rll, rlv, rlr, _) -> create (create l v rll) rlv (create rlr rv rr) end end else Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1)) (* Insertion of one element *) let rec add x = function Empty -> Node(Empty, x, Empty, 1) | Node(l, v, r, _) as t -> let c = compare x v in if c = 0 then t else if c < 0 then bal (add x l) v r else bal l v (add x r) (* Same as create and bal, but no assumptions are made on the relative heights of l and r. *) let rec join l v r = match (l, r) with (Empty, _) -> add v r | (_, Empty) -> add v l | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) -> if lh > rh + 2 then bal ll lv (join lr v r) else if rh > lh + 2 then bal (join l v rl) rv rr else create l v r (* Smallest and greatest element of a set *) let rec min_elt = function Empty -> raise Not_found | Node(Empty, v, r, _) -> v | Node(l, v, r, _) -> min_elt l let rec max_elt = function Empty -> raise Not_found | Node(l, v, Empty, _) -> v | Node(l, v, r, _) -> max_elt r (* Remove the smallest element of the given set *) let rec remove_min_elt = function Empty -> invalid_arg "Set.remove_min_elt" | Node(Empty, v, r, _) -> r | Node(l, v, r, _) -> bal (remove_min_elt l) v r (* Merge two trees l and r into one. All elements of l must precede the elements of r. Assume | height l - height r | <= 2. *) let merge t1 t2 = match (t1, t2) with (Empty, t) -> t | (t, Empty) -> t | (_, _) -> bal t1 (min_elt t2) (remove_min_elt t2) (* Merge two trees l and r into one. All elements of l must precede the elements of r. No assumption on the heights of l and r. *) let concat t1 t2 = match (t1, t2) with (Empty, t) -> t | (t, Empty) -> t | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2) (* Splitting. split x s returns a triple (l, present, r) where - l is the set of elements of s that are < x - r is the set of elements of s that are > x - present is false if s contains no element equal to x, or true if s contains an element equal to x. *) let rec split x = function Empty -> (Empty, false, Empty) | Node(l, v, r, _) -> let c = compare x v in if c = 0 then (l, true, r) else if c < 0 then let (ll, pres, rl) = split x l in (ll, pres, join rl v r) else let (lr, pres, rr) = split x r in (join l v lr, pres, rr) (* Implementation of the set operations *) let empty = Empty let is_empty = function Empty -> true | _ -> false let rec mem x = function Empty -> false | Node(l, v, r, _) -> let c = compare x v in c = 0 || mem x (if c < 0 then l else r) let singleton x = Node(Empty, x, Empty, 1) let rec remove x = function Empty -> Empty | Node(l, v, r, _) -> let c = compare x v in if c = 0 then merge l r else if c < 0 then bal (remove x l) v r else bal l v (remove x r) let rec union s1 s2 = match (s1, s2) with (Empty, t2) -> t2 | (t1, Empty) -> t1 | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> if h1 >= h2 then if h2 = 1 then add v2 s1 else begin let (l2, _, r2) = split v1 s2 in join (union l1 l2) v1 (union r1 r2) end else if h1 = 1 then add v1 s2 else begin let (l1, _, r1) = split v2 s1 in join (union l1 l2) v2 (union r1 r2) end let rec inter s1 s2 = match (s1, s2) with (Empty, t2) -> Empty | (t1, Empty) -> Empty | (Node(l1, v1, r1, _), t2) -> match split v1 t2 with (l2, false, r2) -> concat (inter l1 l2) (inter r1 r2) | (l2, true, r2) -> join (inter l1 l2) v1 (inter r1 r2) let rec diff s1 s2 = match (s1, s2) with (Empty, t2) -> Empty | (t1, Empty) -> t1 | (Node(l1, v1, r1, _), t2) -> match split v1 t2 with (l2, false, r2) -> join (diff l1 l2) v1 (diff r1 r2) | (l2, true, r2) -> concat (diff l1 l2) (diff r1 r2) let rec compare_aux l1 l2 = match (l1, l2) with ([], []) -> 0 | ([], _) -> -1 | (_, []) -> 1 | (Empty :: t1, Empty :: t2) -> compare_aux t1 t2 | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) -> let c = compare v1 v2 in if c <> 0 then c else compare_aux (r1::t1) (r2::t2) | (Node(l1, v1, r1, _) :: t1, t2) -> compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2 | (t1, Node(l2, v2, r2, _) :: t2) -> compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2) let compare s1 s2 = compare_aux [s1] [s2] let equal s1 s2 = compare s1 s2 = 0 let rec subset s1 s2 = match (s1, s2) with Empty, _ -> true | _, Empty -> false | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) -> let c = Pervasives.compare v1 v2 in if c = 0 then subset l1 l2 && subset r1 r2 else if c < 0 then subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2 else subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2 let rec iter f = function Empty -> () | Node(l, v, r, _) -> iter f l; f v; iter f r let rec fold f s accu = match s with Empty -> accu | Node(l, v, r, _) -> fold f l (f v (fold f r accu)) let rec for_all p = function Empty -> true | Node(l, v, r, _) -> p v && for_all p l && for_all p r let rec exists p = function Empty -> false | Node(l, v, r, _) -> p v || exists p l || exists p r let filter p s = let rec filt accu = function | Empty -> accu | Node(l, v, r, _) -> filt (filt (if p v then add v accu else accu) l) r in filt Empty s let partition p s = let rec part (t, f as accu) = function | Empty -> accu | Node(l, v, r, _) -> part (part (if p v then (add v t, f) else (t, add v f)) l) r in part (Empty, Empty) s let rec cardinal = function Empty -> 0 | Node(l, v, r, _) -> cardinal l + 1 + cardinal r let rec elements_aux accu = function Empty -> accu | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l let elements s = elements_aux [] s let choose = min_elt (* pad: *) let (from_list: 'a list -> 'a t) = fun xs -> List.fold_left (fun a e -> add e a) empty xs coccinelle-1.0.0-rc19/commons/ocamlextra/dynArray.ml0000644000175000017500000002454212247437436021334 0ustar eugeneugen(* * DynArray - Resizeable Ocaml arrays * Copyright (C) 2003 Brian Hurt * Copyright (C) 2003 Nicolas Cannasse * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version, * with the special exception on linking described in file LICENSE. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type resizer_t = currslots:int -> oldlength:int -> newlength:int -> int type 'a intern external ilen : 'a intern -> int = "%obj_size" let idup (x : 'a intern) = if ilen x = 0 then x else (Obj.magic (Obj.dup (Obj.repr x)) : 'a intern) let imake tag len = (Obj.magic (Obj.new_block tag len) : 'a intern) external iget : 'a intern -> int -> 'a = "%obj_field" external iset : 'a intern -> int -> 'a -> unit = "%obj_set_field" type 'a t = { mutable arr : 'a intern; mutable len : int; mutable resize: resizer_t; } exception Invalid_arg of int * string * string let invalid_arg n f p = raise (Invalid_arg (n,f,p)) let length d = d.len let exponential_resizer ~currslots ~oldlength ~newlength = let rec doubler x = if x >= newlength then x else doubler (x * 2) in let rec halfer x = if x / 2 < newlength then x else halfer (x / 2) in if newlength = 1 then 1 else if currslots = 0 then doubler 1 else if currslots < newlength then doubler currslots else halfer currslots let step_resizer step = if step <= 0 then invalid_arg step "step_resizer" "step"; (fun ~currslots ~oldlength ~newlength -> if currslots < newlength || newlength < (currslots - step) then (newlength + step - (newlength mod step)) else currslots) let conservative_exponential_resizer ~currslots ~oldlength ~newlength = let rec doubler x = if x >= newlength then x else doubler (x * 2) in let rec halfer x = if x / 2 < newlength then x else halfer (x / 2) in if currslots < newlength then begin if newlength = 1 then 1 else if currslots = 0 then doubler 1 else doubler currslots end else if oldlength < newlength then halfer currslots else currslots let default_resizer = conservative_exponential_resizer let changelen (d : 'a t) newlen = let oldsize = ilen d.arr in let r = d.resize ~currslots:oldsize ~oldlength:d.len ~newlength:newlen in (* We require the size to be at least large enough to hold the number * of elements we know we need! *) let newsize = if r < newlen then newlen else r in if newsize <> oldsize then begin let newarr = imake 0 newsize in let cpylen = (if newlen < d.len then newlen else d.len) in for i = 0 to cpylen - 1 do iset newarr i (iget d.arr i); done; d.arr <- newarr; end; d.len <- newlen let compact d = if d.len <> ilen d.arr then begin let newarr = imake 0 d.len in for i = 0 to d.len - 1 do iset newarr i (iget d.arr i) done; d.arr <- newarr; end let create() = { resize = default_resizer; len = 0; arr = imake 0 0; } let make initsize = if initsize < 0 then invalid_arg initsize "make" "size"; { resize = default_resizer; len = 0; arr = imake 0 initsize; } let init initlen f = if initlen < 0 then invalid_arg initlen "init" "len"; let arr = imake 0 initlen in for i = 0 to initlen-1 do iset arr i (f i) done; { resize = default_resizer; len = initlen; arr = arr; } let set_resizer d resizer = d.resize <- resizer let get_resizer d = d.resize let empty d = d.len = 0 let get d idx = if idx < 0 || idx >= d.len then invalid_arg idx "get" "index"; iget d.arr idx let last d = if d.len = 0 then invalid_arg 0 "last" ""; iget d.arr (d.len - 1) let set d idx v = if idx < 0 || idx >= d.len then invalid_arg idx "set" "index"; iset d.arr idx v let insert d idx v = if idx < 0 || idx > d.len then invalid_arg idx "insert" "index"; if d.len = ilen d.arr then changelen d (d.len + 1) else d.len <- d.len + 1; if idx < d.len - 1 then begin for i = d.len - 1 downto idx do iset d.arr (i+1) (iget d.arr i) done; end; iset d.arr idx v let add d v = if d.len = ilen d.arr then changelen d (d.len + 1) else d.len <- d.len + 1; iset d.arr (d.len - 1) v let delete d idx = if idx < 0 || idx >= d.len then invalid_arg idx "delete" "index"; let oldsize = ilen d.arr in (* we don't call changelen because we want to blit *) let r = d.resize ~currslots:oldsize ~oldlength:d.len ~newlength:(d.len - 1) in let newsize = (if r < d.len - 1 then d.len - 1 else r) in if oldsize <> newsize then begin let newarr = imake 0 newsize in for i = 0 to idx - 1 do iset newarr i (iget d.arr i); done; for i = idx to d.len - 2 do iset newarr i (iget d.arr (i+1)); done; d.arr <- newarr; end else begin for i = idx to d.len - 2 do iset d.arr i (iget d.arr (i+1)); done; iset d.arr (d.len - 1) (Obj.magic 0) end; d.len <- d.len - 1 let delete_range d idx len = if len < 0 then invalid_arg len "delete_range" "length"; if idx < 0 || idx + len > d.len then invalid_arg idx "delete_range" "index"; let oldsize = ilen d.arr in (* we don't call changelen because we want to blit *) let r = d.resize ~currslots:oldsize ~oldlength:d.len ~newlength:(d.len - len) in let newsize = (if r < d.len - len then d.len - len else r) in if oldsize <> newsize then begin let newarr = imake 0 newsize in for i = 0 to idx - 1 do iset newarr i (iget d.arr i); done; for i = idx to d.len - len - 1 do iset newarr i (iget d.arr (i+len)); done; d.arr <- newarr; end else begin for i = idx to d.len - len - 1 do iset d.arr i (iget d.arr (i+len)); done; for i = d.len - len to d.len - 1 do iset d.arr i (Obj.magic 0) done; end; d.len <- d.len - len let clear d = d.len <- 0; d.arr <- imake 0 0 let delete_last d = if d.len <= 0 then invalid_arg 0 "delete_last" ""; (* erase for GC, in case changelen don't resize our array *) iset d.arr (d.len - 1) (Obj.magic 0); changelen d (d.len - 1) let rec blit src srcidx dst dstidx len = if len < 0 then invalid_arg len "blit" "len"; if srcidx < 0 || srcidx + len > src.len then invalid_arg srcidx "blit" "source index"; if dstidx < 0 || dstidx > dst.len then invalid_arg dstidx "blit" "dest index"; let newlen = dstidx + len in if newlen > ilen dst.arr then begin (* this case could be inlined so we don't blit on just-copied elements *) changelen dst newlen end else begin if newlen > dst.len then dst.len <- newlen; end; (* same array ! we need to copy in reverse order *) if src.arr == dst.arr && dstidx > srcidx then for i = len - 1 downto 0 do iset dst.arr (dstidx+i) (iget src.arr (srcidx+i)); done else for i = 0 to len - 1 do iset dst.arr (dstidx+i) (iget src.arr (srcidx+i)); done let append src dst = blit src 0 dst dst.len src.len let to_list d = let rec loop idx accum = if idx < 0 then accum else loop (idx - 1) (iget d.arr idx :: accum) in loop (d.len - 1) [] let to_array d = if d.len = 0 then begin (* since the empty array is an atom, we don't care if float or not *) [||] end else begin let arr = Array.make d.len (iget d.arr 0) in for i = 1 to d.len - 1 do Array.unsafe_set arr i (iget d.arr i) done; arr; end let of_list lst = let size = List.length lst in let arr = imake 0 size in let rec loop idx = function | h :: t -> iset arr idx h; loop (idx + 1) t | [] -> () in loop 0 lst; { resize = default_resizer; len = size; arr = arr; } let of_array src = let size = Array.length src in let is_float = Obj.tag (Obj.repr src) = Obj.double_array_tag in let arr = (if is_float then begin let arr = imake 0 size in for i = 0 to size - 1 do iset arr i (Array.unsafe_get src i); done; arr end else (* copy the fields *) idup (Obj.magic src : 'a intern)) in { resize = default_resizer; len = size; arr = arr; } let copy src = { resize = src.resize; len = src.len; arr = idup src.arr; } let sub src start len = if len < 0 then invalid_arg len "sub" "len"; if start < 0 || start + len > src.len then invalid_arg start "sub" "start"; let arr = imake 0 len in for i = 0 to len - 1 do iset arr i (iget src.arr (i+start)); done; { resize = src.resize; len = len; arr = arr; } let iter f d = for i = 0 to d.len - 1 do f (iget d.arr i) done let iteri f d = for i = 0 to d.len - 1 do f i (iget d.arr i) done let filter f d = let l = d.len in let a = imake 0 l in let a2 = d.arr in let p = ref 0 in for i = 0 to l - 1 do let x = iget a2 i in if f x then begin iset a !p x; incr p; end; done; d.len <- !p; d.arr <- a let index_of f d = let rec loop i = if i >= d.len then raise Not_found else if f (iget d.arr i) then i else loop (i+1) in loop 0 let map f src = let arr = imake 0 src.len in for i = 0 to src.len - 1 do iset arr i (f (iget src.arr i)) done; { resize = src.resize; len = src.len; arr = arr; } let mapi f src = let arr = imake 0 src.len in for i = 0 to src.len - 1 do iset arr i (f i (iget src.arr i)) done; { resize = src.resize; len = src.len; arr = arr; } let fold_left f x a = let rec loop idx x = if idx >= a.len then x else loop (idx + 1) (f x (iget a.arr idx)) in loop 0 x let fold_right f a x = let rec loop idx x = if idx < 0 then x else loop (idx - 1) (f (iget a.arr idx) x) in loop (a.len - 1) x let enum d = let rec make start = let idxref = ref 0 in let next () = if !idxref >= d.len then raise Enum.No_more_elements else let retval = iget d.arr !idxref in incr idxref; retval and count () = if !idxref >= d.len then 0 else d.len - !idxref and clone () = make !idxref in Enum.make ~next:next ~count:count ~clone:clone in make 0 let of_enum e = if Enum.fast_count e then begin let c = Enum.count e in let arr = imake 0 c in Enum.iteri (fun i x -> iset arr i x) e; { resize = default_resizer; len = c; arr = arr; } end else let d = make 0 in Enum.iter (add d) e; d let unsafe_get a n = iget a.arr n let unsafe_set a n x = iset a.arr n x coccinelle-1.0.0-rc19/commons/Makefile0000644000175000017500000002210212247437436016500 0ustar eugeneugen############################################################################## # Variables ############################################################################## # The main library ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=commons # note: if you add a file (a .mli or .ml), dont forget to redo a 'make depend' MYSRC= commands.ml \ common.ml common_extra.ml \ interfaces.ml objet.ml \ ocollection.ml \ seti.ml \ oset.ml oassoc.ml osequence.ml ograph.ml \ ocollection/oseti.ml \ ocollection/oseth.ml \ ocollection/osetb.ml \ ocollection/osetpt.ml \ ocollection/oassocb.ml \ ocollection/oassoch.ml \ ocollection/oassoc_buffer.ml \ ocollection/oassoc_cache.ml \ ocollection/oassocid.ml \ oarray.ml \ ocollection/ograph2way.ml \ ograph_simple.ml ograph_extended.ml \ glimpse.ml parser_combinators.ml # src from other authors, got from the web or caml hump SRC=ocamlextra/dumper.ml SRC+=ocamlextra/ANSITerminal.ml SRC+=ocamlextra/setb.ml ocamlextra/mapb.ml # defunctorized version of standard set/map SRC+=ocamlextra/setPt.ml SRC+=$(MYSRC) SRC+=ocamlextra/enum.ml ocamlextra/dynArray.ml SRC+=ocamlextra/suffix_tree.ml ocamlextra/suffix_tree_ext.ml SYSLIBS=str.cma bigarray.cma unix.cma INCLUDEDIRS=ocamlextra ocollection SUBDIRS=ocamlextra ocollection #----------------------------------------------------------------------------- # Other common (thin wrapper) libraries #----------------------------------------------------------------------------- #format: XXXSRC, XXXINCLUDE, XXXSYSLIBS #gdbm MYGDBMSRC=ocollection/oassocdbm.ml GDBMSYSLIBS=dbm.cma #berkeley db (ocamlbdb) MYBDBSRC=ocollection/oassocbdb.ml ocollection/oassocbdb_string.ml BDBINCLUDES=-I ../ocamlbdb BDBSYSLIBS=bdb.cma #lablgtk (ocamlgtk) MYGUISRC=gui.ml GUIINCLUDES=-I +lablgtk2 -I +lablgtksourceview -I ../ocamlgtk/src GUISYSLIBS=lablgtk.cma lablgtksourceview.cma #pycaml (ocamlpython) MYPYSRC=python.ml PYINCLUDES=-I ../ocamlpython -I ../../ocamlpython PYSYSLIBS=python.cma #ocamlmpi MYMPISRC=distribution.ml MPIINCLUDES=-I ../ocamlmpi -I ../../ocamlmpi -I +ocamlmpi MPISYSLIBS=mpi.cma #binprot MYBINSRC=bin_common.ml BININCLUDES=-I ../ocamltarzan/lib-binprot -I ../../ocamltarzan/lib-binprot #----------------------------------------------------------------------------- # Other stuff #----------------------------------------------------------------------------- #backtrace MYBACKTRACESRC=backtrace.ml BACKTRACEINCLUDES=-I $(shell $(OCAMLC) -where) ############################################################################## # Generic variables ############################################################################## INCLUDES=$(INCLUDEDIRS:%=-I %) $(INCLUDESEXTRA) ############################################################################## # Generic ocaml variables ############################################################################## # This flag can also be used in subdirectories so don't change its name here. # For profiling use: -p -inline 0 OCAMLCFLAGS ?= -g OPTFLAGS ?= -g # The OPTBIN variable is here to allow to use ocamlc.opt instead of # ocaml, when it is available, which speeds up compilation. So # if you want the fast version of the ocaml chain tools, set this var # or setenv it to ".opt" in your startup script. OPTBIN ?= #.opt # The OCaml tools. OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) ############################################################################## # Top rules ############################################################################## LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(LIB) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes opt: all.opt top: $(TARGET).top $(LIB): $(OBJS) $(OCAMLC_CMD) -a -o $@ $^ $(OPTLIB): $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $@ $^ $(TARGET).top: $(OBJS) $(OCAMLMKTOP_CMD) -o $@ $(SYSLIBS) $^ clean:: rm -f $(TARGET).top else all: cd .. && $(OCAMLBUILD) commons/commons.cma all.opt: cd .. && $(OCAMLBUILD) commons/commons.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif ############################################################################## # Other commons libs target ############################################################################## all_libs: gdbm bdb gui mpi backtrace #----------------------------------------------------------------------------- gdbm: commons_gdbm.cma gdbm.opt: commons_gdbm.cmxa commons_gdbm.cma: $(MYGDBMSRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_gdbm.cmxa: $(MYGDBMSRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ #----------------------------------------------------------------------------- bdb: $(MAKE) INCLUDESEXTRA="$(BDBINCLUDES)" commons_bdb.cma bdb.opt: $(MAKE) INCLUDESEXTRA="$(BDBINCLUDES)" commons_bdb.cmxa commons_bdb.cma: $(MYBDBSRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_bdb.cmxa: $(MYBDBSRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ #----------------------------------------------------------------------------- gui: $(MAKE) INCLUDESEXTRA="$(GUIINCLUDES)" commons_gui.cma gui.opt: $(MAKE) INCLUDESEXTRA="$(GUIINCLUDES)" commons_gui.cmxa commons_gui.cma: $(MYGUISRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_gui.cmxa: $(MYGUISRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ #----------------------------------------------------------------------------- mpi: $(MAKE) INCLUDESEXTRA="$(MPIINCLUDES)" commons_mpi.cma mpi.opt: $(MAKE) INCLUDESEXTRA="$(MPIINCLUDES)" commons_mpi.cmxa commons_mpi.cma: $(MYMPISRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_mpi.cmxa: $(MYMPISRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ #alias distribution: mpi distribution.opt: mpi.opt #----------------------------------------------------------------------------- python: $(MAKE) INCLUDESEXTRA="$(PYINCLUDES)" commons_python.cma python.opt: $(MAKE) INCLUDESEXTRA="$(PYINCLUDES)" commons_python.cmxa commons_python.cma: $(MYPYSRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_python.cmxa: $(MYPYSRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ #----------------------------------------------------------------------------- backtrace: commons_backtrace.cma backtrace.opt: commons_backtrace.cmxa backtrace_c.o: backtrace_c.c $(CC) $(BACKTRACEINCLUDES) -c $^ commons_backtrace.cma: $(MYBACKTRACESRC:.ml=.cmo) backtrace_c.o $(OCAMLMKLIB) -o commons_backtrace $^ commons_backtrace.cmxa: $(MYBACKTRACESRC:.ml=.cmx) backtrace_c.o $(OCAMLMKLIB) -o commons_backtrace $^ clean:: rm -f dllcommons_backtrace.so #----------------------------------------------------------------------------- binprot: $(MAKE) INCLUDESEXTRA="$(BININCLUDES)" commons_bin.cma binprot.opt: $(MAKE) INCLUDESEXTRA="$(BININCLUDES)" commons_bin.cmxa commons_bin.cma: $(MYBINSRC:.ml=.cmo) $(OCAMLC_CMD) -a -o $@ $^ commons_bin.cmxa: $(MYBINSRC:.ml=.cmx) $(OCAMLOPT_CMD) -a -o $@ $^ ############################################################################## # The global "features" lib wrapper ############################################################################## features: commons_features.cma features.opt: commons_features.cmxa commons_features.cma: features.cmo $(OCAMLC_CMD) -a -o $@ $^ commons_features.cmxa: features.cmx $(OCAMLOPT_CMD) -a -o $@ $^ ############################################################################## # Developer rules ############################################################################## tags: otags -no-mli-tags -r . clean:: rm -f gmon.out forprofiling: $(MAKE) OPTFLAGS="-p -inline 0 " opt dependencygraph: ocamldep *.mli *.ml > /tmp/dependfull.depend ocamldot -fullgraph /tmp/dependfull.depend > /tmp/dependfull.dot dot -Tps /tmp/dependfull.dot > /tmp/dependfull.ps dependencygraph2: find -name "*.ml" |grep -v "scripts" | xargs ocamldep -I commons -I globals -I ctl -I parsing_cocci -I parsing_c -I engine -I popl -I extra > /tmp/dependfull.depend ocamldot -fullgraph /tmp/dependfull.depend > /tmp/dependfull.dot dot -Tps /tmp/dependfull.dot > /tmp/dependfull.ps ############################################################################## # Generic rules ############################################################################## .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< clean:: rm -f *.cm[iox] *.o *.a *.cma *.cmxa *.annot rm -f *~ .*~ #*# clean:: for i in $(SUBDIRS); do (cd $$i; \ rm -f *.cm[iox] *.o *.a *.cma *.cmxa *.annot *~ .*~ ; \ cd ..; ) \ done rm -f .depend distclean: clean rm -f commands.ml .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend for i in $(SUBDIRS); do $(OCAMLDEP_CMD) $$i/*.ml $$i/*.mli >> .depend; done ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/commons/backtrace.ml0000644000175000017500000000167012247437436017320 0ustar eugeneugenopen Common (* This function is especially useful with lablgtk which intercepts * the exception and forbid them to reach the toplevel, or with LFS * where I can not allow any exception to stop mount.lfs. * * src: Jane Street Core library. * update: Normally no more needed in OCaml 3.11 as part of the * default runtime. *) external print : unit -> unit = "print_exception_backtrace_stub" "noalloc" (* ---------------------------------------------------------------------- *) (* testing *) (* ---------------------------------------------------------------------- *) exception MyNot_Found let foo1 () = if 1=1 then raise MyNot_Found else 2 let foo2 () = foo1 () + 2 let test_backtrace () = (try ignore(foo2 ()) with exn -> pr2 (Common.exn_to_s exn); print(); failwith "other exn" ); print_string "ok cool\n"; () let actions () = [ "-test_backtrace", " ", Common.mk_action_0_arg test_backtrace; ] coccinelle-1.0.0-rc19/commons/common.mli0000644000175000017500000017416312247437436017052 0ustar eugeneugen(*###########################################################################*) (* Globals *) (*###########################################################################*) (* Some conventions: * * When I have some _xxx variables before some functions, it's * because I want to show that those functions internally use a global * variable. That does not mean I want people to modify this global. * In fact they are kind of private, but I still want to show them. * Maybe one day OCaml will have an effect type system so I don't need this. * * The variables that are called _init_xxx show the internal init * side effect of the module (like static var trick used in C/C++) * * Why not split the functionnalities of this file in different files ? * Because when I write ocaml script I want simply to load one * file, common.ml, and that's it. Cf common_extra.ml for more on this. *) (*****************************************************************************) (* Flags *) (*****************************************************************************) (* see the corresponding section for the use of those flags. See also * the "Flags and actions" section at the end of this file. *) (* if set then will not do certain finalize so faster to go back in replay *) val debugger : bool ref type prof = PALL | PNONE | PSOME of string list val profile : prof ref val show_trace_profile : bool ref val verbose_level : int ref (* forbid pr2_once to do the once "optimisation" *) val disable_pr2_once : bool ref (* works with new_temp_file *) val save_tmp_files : bool ref (*****************************************************************************) (* Module side effect *) (*****************************************************************************) (* * I define a few unit tests via some let _ = example (... = ...). * I also initialize the random seed, cf _init_random . * I also set Gc.stack_size, cf _init_gc_stack . *) (*****************************************************************************) (* Semi globals *) (*****************************************************************************) (* cf the _xxx variables in this file *) (*###########################################################################*) (* Basic features *) (*###########################################################################*) type filename = string type dirname = string (* Trick in case you don't want to do an 'open Common' while still wanting * more pervasive types than the one in Pervasives. Just do the selective * open Common.BasicType. *) module BasicType : sig type filename = string end (* Same spirit. Trick found in Jane Street core lib, but originated somewhere * else I think: the ability to open nested modules. *) module Infix : sig val ( +> ) : 'a -> ('a -> 'b) -> 'b val ( =~ ) : string -> string -> bool val ( ==~ ) : string -> Str.regexp -> bool end (* * Another related trick, found via Jon Harrop to have an extended standard * lib is to do something like * * module List = struct * include List * val map2 : ... * end * * And then can put this "module extension" somewhere to open it. *) (* This module defines the Timeout and UnixExit exceptions. * You have to make sure that those exn are not intercepted. So * avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up * enough. In such case, add a case before such as * with Timeout -> raise Timeout | _ -> ... * The same is true for UnixExit (see below). *) (*****************************************************************************) (* Debugging/logging *) (*****************************************************************************) val _tab_level_print: int ref val indent_do : (unit -> 'a) -> 'a val reset_pr_indent : unit -> unit (* The following functions first indent _tab_level_print spaces. * They also add the _prefix_pr, for instance used in MPI to show which * worker is talking. * update: for pr2, it can also print into a log file. * * The use of 2 in pr2 is because 2 is under UNIX the second descriptor * which corresponds to stderr. *) val _prefix_pr : string ref val pr : string -> unit val pr_no_nl : string -> unit val pr_xxxxxxxxxxxxxxxxx : unit -> unit (* pr2 print on stderr, but can also in addition print into a file *) val _chan_pr2: out_channel option ref val print_to_stderr : bool ref val pr2 : string -> unit val pr2_no_nl : string -> unit val pr2_xxxxxxxxxxxxxxxxx : unit -> unit (* use Dumper.dump *) val pr2_gen: 'a -> unit (* val dump: 'a -> string *) (* see flag: val disable_pr2_once : bool ref *) val _already_printed : (string, bool) Hashtbl.t val pr2_once : string -> unit val clear_pr2_once : unit -> unit val mk_pr2_wrappers: bool ref -> (string -> unit) * (string -> unit) val redirect_stdout_opt : filename option -> (unit -> 'a) -> 'a val redirect_stdout_stderr : filename -> (unit -> unit) -> unit val redirect_stdin : filename -> (unit -> 'a) -> 'a val redirect_stdin_opt : filename option -> (unit -> 'a) -> 'a val with_pr2_to_string: (unit -> unit) -> string list val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a val printf : ('a, out_channel, unit) format -> 'a val eprintf : ('a, out_channel, unit) format -> 'a val sprintf : ('a, unit, string) format -> 'a (* alias *) val spf : ('a, unit, string) format -> 'a (* default = stderr *) val _chan : out_channel ref (* generate & use a /tmp/debugml-xxx file *) val start_log_file : unit -> unit (* see flag: val verbose_level : int ref *) val log : string -> unit val log2 : string -> unit val log3 : string -> unit val log4 : string -> unit val if_log : (unit -> unit) -> unit val if_log2 : (unit -> unit) -> unit val if_log3 : (unit -> unit) -> unit val if_log4 : (unit -> unit) -> unit val pause : unit -> unit (* was used by fix_caml *) val _trace_var : int ref val add_var : unit -> unit val dec_var : unit -> unit val get_var : unit -> int val print_n : int -> string -> unit val printerr_n : int -> string -> unit val _debug : bool ref val debugon : unit -> unit val debugoff : unit -> unit val debug : (unit -> unit) -> unit (* see flag: val debugger : bool ref *) (*****************************************************************************) (* Profiling (cpu/mem) *) (*****************************************************************************) val get_mem : unit -> unit val memory_stat : unit -> string val timenow : unit -> string val _count1 : int ref val _count2 : int ref val _count3 : int ref val _count4 : int ref val _count5 : int ref val count1 : unit -> unit val count2 : unit -> unit val count3 : unit -> unit val count4 : unit -> unit val count5 : unit -> unit val profile_diagnostic_basic : unit -> string val time_func : (unit -> 'a) -> 'a (* see flag: type prof = PALL | PNONE | PSOME of string list *) (* see flag: val profile : prof ref *) val _profile_table : (string, (float ref * int ref)) Hashtbl.t ref val profile_code : string -> (unit -> 'a) -> 'a val profile_diagnostic : unit -> string val profile_code_exclusif : string -> (unit -> 'a) -> 'a val profile_code_inside_exclusif_ok : string -> (unit -> 'a) -> 'a val report_if_take_time : int -> string -> (unit -> 'a) -> 'a (* similar to profile_code but print some information during execution too *) val profile_code2 : string -> (unit -> 'a) -> 'a (*****************************************************************************) (* Test *) (*****************************************************************************) val example : bool -> unit (* generate failwith when pb *) val example2 : string -> bool -> unit (* use Dumper to report when pb *) val assert_equal : 'a -> 'a -> unit val _list_bool : (string * bool) list ref val example3 : string -> bool -> unit val test_all : unit -> unit (* regression testing *) type score_result = Ok | Pb of string type score = (string (* usually a filename *), score_result) Hashtbl.t type score_list = (string (* usually a filename *) * score_result) list val empty_score : unit -> score val load_score : string -> unit -> score val save_score : score -> string -> unit val regression_testing : score -> filename (* old score file on disk (usually in /tmp) *) -> unit val regression_testing_vs: score -> score -> score val total_scores : score -> int (* good *) * int (* total *) val print_score : score -> unit val print_total_score: score -> unit (* quickcheck spirit *) type 'a gen = unit -> 'a (* quickcheck random generators *) val ig : int gen val lg : 'a gen -> 'a list gen val pg : 'a gen -> 'b gen -> ('a * 'b) gen val polyg : int gen val ng : string gen val oneofl : 'a list -> 'a gen val oneof : 'a gen list -> 'a gen val always : 'a -> 'a gen val frequency : (int * 'a gen) list -> 'a gen val frequencyl : (int * 'a) list -> 'a gen val laws : string -> ('a -> bool) -> 'a gen -> 'a option (* example of use: * let b = laws "unit" (fun x -> reverse [x] = [x]) ig *) val statistic_number : 'a list -> (int * 'a) list val statistic : 'a list -> (int * 'a) list val laws2 : string -> ('a -> bool * 'b) -> 'a gen -> 'a option * (int * 'b) list (*****************************************************************************) (* Persistence *) (*****************************************************************************) (* just wrappers around Marshal *) val get_value : filename -> 'a val read_value : filename -> 'a (* alias *) val write_value : 'a -> filename -> unit val write_back : ('a -> 'b) -> filename -> unit (* wrappers that also use profile_code *) val marshal__to_string: 'a -> Marshal.extern_flags list -> string val marshal__from_string: string -> int -> 'a (*****************************************************************************) (* Counter *) (*****************************************************************************) val _counter : int ref val _counter2 : int ref val _counter3 : int ref val counter : unit -> int val counter2 : unit -> int val counter3 : unit -> int type timestamp = int (*****************************************************************************) (* String_of and (pretty) printing *) (*****************************************************************************) val string_of_string : (string -> string) -> string val string_of_list : ('a -> string) -> 'a list -> string val string_of_unit : unit -> string val string_of_array : ('a -> string) -> 'a array -> string val string_of_option : ('a -> string) -> 'a option -> string val print_bool : bool -> unit val print_option : ('a -> 'b) -> 'a option -> unit val print_list : ('a -> 'b) -> 'a list -> unit val print_between : (unit -> unit) -> ('a -> unit) -> 'a list -> unit (* use Format internally *) val pp_do_in_box : (unit -> unit) -> unit val pp_f_in_box : (unit -> 'a) -> 'a val pp_do_in_zero_box : (unit -> unit) -> unit val pp : string -> unit (* convert something printed using Format to print into a string *) val format_to_string : (unit -> unit) (* printer *) -> string (* works with _tab_level_print enabling to mix some calls to pp, pr2 * and indent_do to sometimes use advanced indentation pretty printing * (with the pp* functions) and sometimes explicit and simple indendation * printing (with pr* and indent_do) *) val adjust_pp_with_indent : (unit -> unit) -> unit val adjust_pp_with_indent_and_header : string -> (unit -> unit) -> unit val mk_str_func_of_assoc_conv: ('a * string) list -> (string -> 'a) * ('a -> string) (*****************************************************************************) (* Macro *) (*****************************************************************************) (* was working with my macro.ml4 *) val macro_expand : string -> unit (*****************************************************************************) (* Composition/Control *) (*****************************************************************************) val ( +> ) : 'a -> ('a -> 'b) -> 'b val ( +!> ) : 'a ref -> ('a -> 'a) -> unit val ( $ ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c val id : 'a -> 'a val do_nothing : unit -> unit val forever : (unit -> unit) -> unit val applyn : int -> ('a -> 'a) -> 'a -> 'a class ['a] shared_variable_hook : 'a -> object val mutable data : 'a val mutable registered : (unit -> unit) list method get : 'a method modify : ('a -> 'a) -> unit method register : (unit -> unit) -> unit method set : 'a -> unit end val fixpoint : ('a -> 'a) -> 'a -> 'a val fixpoint_for_object : ((< equal : 'a -> bool; .. > as 'a) -> 'a) -> 'a -> 'a val add_hook : ('a -> ('a -> 'b) -> 'b) ref -> ('a -> ('a -> 'b) -> 'b) -> unit val add_hook_action : ('a -> unit) -> ('a -> unit) list ref -> unit val run_hooks_action : 'a -> ('a -> unit) list ref -> unit type 'a mylazy = (unit -> 'a) (* emacs spirit *) val save_excursion : 'a ref -> (unit -> 'b) -> 'b val save_excursion_and_disable : bool ref -> (unit -> 'b) -> 'b val save_excursion_and_enable : bool ref -> (unit -> 'b) -> 'b (* emacs spirit *) val unwind_protect : (unit -> 'a) -> (exn -> 'b) -> 'a (* java spirit *) val finalize : (unit -> 'a) -> (unit -> 'b) -> 'a val memoized : ('a, 'b) Hashtbl.t -> 'a -> (unit -> 'b) -> 'b val cache_in_ref : 'a option ref -> (unit -> 'a) -> 'a (* take file from which computation is done, an extension, and the function * and will compute the function only once and then save result in * file ^ extension *) val cache_computation : ?verbose:bool -> ?use_cache:bool -> filename -> string (* extension *) -> (unit -> 'a) -> 'a (* a more robust version where the client describes the dependencies of the * computation so it will relaunch the computation in 'f' if needed. *) val cache_computation_robust : filename -> string (* extension for marshaled object *) -> (filename list * 'x) -> string (* extension for marshalled dependencies *) -> (unit -> 'a) -> 'a val cache_computation_robust_in_dir : string option (* destination directory *) -> filename -> string (* extension for marshalled object *) -> (filename list * 'x) -> string (* extension for marshaled dependencies *) -> (unit -> 'a) -> 'a val once : ('a -> unit) -> ('a -> unit) val before_leaving : ('a -> unit) -> 'a -> 'a (* do some finalize, signal handling, unix exit conversion, etc *) val main_boilerplate : (unit -> unit) -> unit (* cf also the timeout function below that are control related too *) (*****************************************************************************) (* Concurrency *) (*****************************************************************************) (* how ensure really atomic file creation ? hehe :) *) exception FileAlreadyLocked val acquire_file_lock : filename -> unit val release_file_lock : filename -> unit (*****************************************************************************) (* Error managment *) (*****************************************************************************) exception Todo exception Impossible of int exception Here exception ReturnExn exception Multi_found exception WrongFormat of string val internal_error : string -> 'a val myassert : bool -> unit val warning : string -> 'a -> 'a val error_cant_have : 'a -> 'b val exn_to_s : exn -> string (* alias *) val string_of_exn : exn -> string type error = Error of string type evotype = unit val evoval : evotype (*****************************************************************************) (* Environment *) (*****************************************************************************) val check_stack_size: int -> unit val check_stack_nbfiles: int -> unit (* internally common.ml set Gc. parameters *) val _init_gc_stack : unit (*****************************************************************************) (* Arguments and command line *) (*****************************************************************************) type arg_spec_full = Arg.key * Arg.spec * Arg.doc type cmdline_options = arg_spec_full list type options_with_title = string * string * arg_spec_full list type cmdline_sections = options_with_title list (* A wrapper around Arg modules that have more logical argument order, * and returns the remaining args. *) val parse_options : cmdline_options -> Arg.usage_msg -> string array -> string list (* Another wrapper that does Arg.align automatically *) val usage : Arg.usage_msg -> cmdline_options -> unit (* Work with the options_with_title type way to organize a long * list of command line switches. *) val short_usage : Arg.usage_msg -> short_opt:cmdline_options -> unit val long_usage : Arg.usage_msg -> short_opt:cmdline_options -> long_opt:cmdline_sections -> unit (* With the options_with_title way, we don't want the default -help and --help * so need adapter of Arg module, not just wrapper. *) val arg_align2 : cmdline_options -> cmdline_options val arg_parse2 : cmdline_options -> Arg.usage_msg -> (unit -> unit) (* short_usage func *) -> string list (* The action lib. Useful to debug supart of your system. cf some of * my main.ml for example of use. *) type flag_spec = Arg.key * Arg.spec * Arg.doc type action_spec = Arg.key * Arg.doc * action_func and action_func = (string list -> unit) type cmdline_actions = action_spec list exception WrongNumberOfArguments val mk_action_0_arg : (unit -> unit) -> action_func val mk_action_1_arg : (string -> unit) -> action_func val mk_action_2_arg : (string -> string -> unit) -> action_func val mk_action_3_arg : (string -> string -> string -> unit) -> action_func val mk_action_n_arg : (string list -> unit) -> action_func val options_of_actions: string ref (* the action ref *) -> cmdline_actions -> cmdline_options val action_list: cmdline_actions -> Arg.key list val do_action: Arg.key -> string list (* args *) -> cmdline_actions -> unit (*****************************************************************************) (* Equality *) (*****************************************************************************) (* Using the generic (=) is tempting, but it backfires, so better avoid it *) (* To infer all the code that use an equal, and that should be * transformed, is not that easy, because (=) is used by many * functions, such as List.find, List.mem, and so on. The strategy to find * them is to turn what you were previously using into a function, because * (=) return an exception when applied to a function, then you simply * use ocamldebug to detect where the code has to be transformed by * finding where the exception was launched from. *) val (=|=) : int -> int -> bool val (=<=) : char -> char -> bool val (=$=) : string -> string -> bool val (=:=) : bool -> bool -> bool val (=*=): 'a -> 'a -> bool (* if want to restrict the use of '=', uncomment this: * * val (=): unit -> unit -> bool * * But it will not forbid you to use caml functions like List.find, List.mem * which internally use this convenient but evolution-unfriendly (=) *) (*###########################################################################*) (* And now basic types *) (*###########################################################################*) (*****************************************************************************) (* Bool *) (*****************************************************************************) val ( ||| ) : 'a -> 'a -> 'a val ( ==> ) : bool -> bool -> bool val xor : 'a -> 'a -> bool (*****************************************************************************) (* Char *) (*****************************************************************************) val string_of_char : char -> string val string_of_chars : char list -> string val is_single : char -> bool val is_symbol : char -> bool val is_space : char -> bool val is_upper : char -> bool val is_lower : char -> bool val is_alpha : char -> bool val is_digit : char -> bool val cbetween : char -> char -> char -> bool (*****************************************************************************) (* Num *) (*****************************************************************************) val ( /! ) : int -> int -> int val do_n : int -> (unit -> unit) -> unit val foldn : ('a -> int -> 'a) -> 'a -> int -> 'a val pi : float val pi2 : float val pi4 : float val deg_to_rad : float -> float val clampf : float -> float val square : float -> float val power : int -> int -> int val between : 'a -> 'a -> 'a -> bool val between_strict : int -> int -> int -> bool val bitrange : int -> int -> bool val prime1 : int -> int option val prime : int -> int option val sum : int list -> int val product : int list -> int val decompose : int -> int list val mysquare : int -> int val sqr : float -> float type compare = Equal | Inf | Sup val ( <=> ) : 'a -> 'a -> compare val ( <==> ) : 'a -> 'a -> int type uint = int val int_of_stringchar : string -> int val int_of_base : string -> int -> int val int_of_stringbits : string -> int val int_of_octal : string -> int val int_of_all : string -> int (* useful but sometimes when want grep for all places where do modif, * easier to have just code using ':=' and '<-' to do some modifications. * In the same way avoid using {contents = xxx} to build some ref. *) val ( += ) : int ref -> int -> unit val ( -= ) : int ref -> int -> unit val pourcent: int -> int -> int val pourcent_float: int -> int -> float val pourcent_float_of_floats: float -> float -> float val pourcent_good_bad: int -> int -> int val pourcent_good_bad_float: int -> int -> float type 'a max_with_elem = int ref * 'a ref val update_max_with_elem: 'a max_with_elem -> is_better:(int -> int ref -> bool) -> int * 'a -> unit (*****************************************************************************) (* Numeric/overloading *) (*****************************************************************************) type 'a numdict = NumDict of (('a -> 'a -> 'a) * ('a -> 'a -> 'a) * ('a -> 'a -> 'a) * ('a -> 'a)) val add : 'a numdict -> 'a -> 'a -> 'a val mul : 'a numdict -> 'a -> 'a -> 'a val div : 'a numdict -> 'a -> 'a -> 'a val neg : 'a numdict -> 'a -> 'a val numd_int : int numdict val numd_float : float numdict val testd : 'a numdict -> 'a -> 'a module ArithFloatInfix : sig val (+) : float -> float -> float val (-) : float -> float -> float val (/) : float -> float -> float val ( * ) : float -> float -> float val (+..) : int -> int -> int val (-..) : int -> int -> int val (/..) : int -> int -> int val ( *..) : int -> int -> int val (+=) : float ref -> float -> unit end (*****************************************************************************) (* Random *) (*****************************************************************************) val _init_random : unit val random_list : 'a list -> 'a val randomize_list : 'a list -> 'a list val random_subset_of_list : int -> 'a list -> 'a list (*****************************************************************************) (* Tuples *) (*****************************************************************************) type 'a pair = 'a * 'a type 'a triple = 'a * 'a * 'a val fst3 : 'a * 'b * 'c -> 'a val snd3 : 'a * 'b * 'c -> 'b val thd3 : 'a * 'b * 'c -> 'c val sndthd : 'a * 'b * 'c -> 'b * 'c val map_fst : ('a -> 'b) -> 'a * 'c -> 'b * 'c val map_snd : ('a -> 'b) -> 'c * 'a -> 'c * 'b val pair : ('a -> 'b) -> 'a * 'a -> 'b * 'b val snd : 'a * 'b -> 'b (* alias *) val fst : 'a * 'b -> 'a (* alias *) val double : 'a -> 'a * 'a val swap : 'a * 'b -> 'b * 'a (* maybe a sign of bad programming if use those functions :) *) val tuple_of_list1 : 'a list -> 'a val tuple_of_list2 : 'a list -> 'a * 'a val tuple_of_list3 : 'a list -> 'a * 'a * 'a val tuple_of_list4 : 'a list -> 'a * 'a * 'a * 'a val tuple_of_list5 : 'a list -> 'a * 'a * 'a * 'a * 'a val tuple_of_list6 : 'a list -> 'a * 'a * 'a * 'a * 'a * 'a (*****************************************************************************) (* Maybe *) (*****************************************************************************) type ('a, 'b) either = Left of 'a | Right of 'b type ('a, 'b, 'c) either3 = Left3 of 'a | Middle3 of 'b | Right3 of 'c val just : 'a option -> 'a val some : 'a option -> 'a (* alias *) val fmap : ('a -> 'b) -> 'a option -> 'b option val map_option : ('a -> 'b) -> 'a option -> 'b option (* alias *) val do_option : ('a -> unit) -> 'a option -> unit val optionise : (unit -> 'a) -> 'a option val some_or : 'a option -> 'a -> 'a val partition_either : ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list val partition_either3 : ('a -> ('b, 'c, 'd) either3) -> 'a list -> 'b list * 'c list * 'd list val filter_some : 'a option list -> 'a list val map_filter : ('a -> 'b option) -> 'a list -> 'b list val tail_map_filter : ('a -> 'b option) -> 'a list -> 'b list val find_some : ('a -> 'b option) -> 'a list -> 'b val list_to_single_or_exn: 'a list -> 'a (*****************************************************************************) (* TriBool *) (*****************************************************************************) type bool3 = True3 | False3 | TrueFalsePb3 of string (*****************************************************************************) (* Strings *) (*****************************************************************************) val slength : string -> int (* alias *) val concat : string -> string list -> string (* alias *) val i_to_s : int -> string val s_to_i : string -> int (* strings take space in memory. Better when can share the space used by * similar strings. *) val _shareds : (string, string) Hashtbl.t val shared_string : string -> string val chop : string -> string val chop_dirsymbol : string -> string val ( ) : string -> int * int -> string val ( ) : string -> int -> char val take_string: int -> string -> string val take_string_safe: int -> string -> string val split_on_char : char -> string -> string list val lowercase : string -> string val quote : string -> string val null_string : string -> bool val is_blank_string : string -> bool val is_string_prefix : string -> string -> bool val plural : int -> string -> string val showCodeHex : int list -> unit val size_mo_ko : int -> string val size_ko : int -> string val edit_distance: string -> string -> int val md5sum_of_string : string -> string (*****************************************************************************) (* Regexp *) (*****************************************************************************) val regexp_alpha : Str.regexp val regexp_word : Str.regexp val _memo_compiled_regexp : (string, Str.regexp) Hashtbl.t val ( =~ ) : string -> string -> bool val ( ==~ ) : string -> Str.regexp -> bool val regexp_match : string -> string -> string val matched : int -> string -> string (* not yet politypic functions in ocaml *) val matched1 : string -> string val matched2 : string -> string * string val matched3 : string -> string * string * string val matched4 : string -> string * string * string * string val matched5 : string -> string * string * string * string * string val matched6 : string -> string * string * string * string * string * string val matched7 : string -> string * string * string * string * string * string * string val string_match_substring : Str.regexp -> string -> bool val split : string (* sep regexp *) -> string -> string list val join : string (* sep *) -> string list -> string val split_list_regexp : string -> string list -> (string * string list) list val all_match : string (* regexp *) -> string -> string list val global_replace_regexp : string (* regexp *) -> (string -> string) -> string -> string val regular_words: string -> string list val contain_regular_word: string -> bool (*****************************************************************************) (* Filenames *) (*****************************************************************************) (* now at beginning of this file: type filename = string *) val dirname : string -> string val basename : string -> string val filesuffix : filename -> string val fileprefix : filename -> string val adjust_ext_if_needed : filename -> string -> filename (* db for dir, base *) val db_of_filename : filename -> (string * filename) val filename_of_db : (string * filename) -> filename (* dbe for dir, base, ext *) val dbe_of_filename : filename -> string * string * string val dbe_of_filename_nodot : filename -> string * string * string (* Left (d,b,e) | Right (d,b) if file has no extension *) val dbe_of_filename_safe : filename -> (string * string * string, string * string) either val filename_of_dbe : string * string * string -> filename (* ex: replace_ext "toto.c" "c" "var" *) val replace_ext: filename -> string -> string -> filename (* remove the ., .. *) val normalize_path : filename -> filename val relative_to_absolute : filename -> filename val is_relative: filename -> bool val is_absolute: filename -> bool val filename_without_leading_path : string -> filename -> filename (*****************************************************************************) (* i18n *) (*****************************************************************************) type langage = | English | Francais | Deutsch (*****************************************************************************) (* Dates *) (*****************************************************************************) (* can also use ocamlcalendar, but heavier, use many modules ... *) type month = | Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec type year = Year of int type day = Day of int type date_dmy = DMY of day * month * year type hour = Hour of int type minute = Min of int type second = Sec of int type time_hms = HMS of hour * minute * second type full_date = date_dmy * time_hms (* intervalle *) type days = Days of int type time_dmy = TimeDMY of day * month * year (* from Unix *) type float_time = float val mk_date_dmy : int -> int -> int -> date_dmy val check_date_dmy : date_dmy -> unit val check_time_dmy : time_dmy -> unit val check_time_hms : time_hms -> unit val int_to_month : int -> string val int_of_month : month -> int val month_of_string : string -> month val month_of_string_long : string -> month val string_of_month : month -> string val string_of_date_dmy : date_dmy -> string val string_of_unix_time : ?langage:langage -> Unix.tm -> string val short_string_of_unix_time : ?langage:langage -> Unix.tm -> string val string_of_floattime: ?langage:langage -> float_time -> string val short_string_of_floattime: ?langage:langage -> float_time -> string val floattime_of_string: string -> float_time val dmy_to_unixtime: date_dmy -> float_time * Unix.tm val unixtime_to_dmy: Unix.tm -> date_dmy val unixtime_to_floattime: Unix.tm -> float_time val floattime_to_unixtime: float_time -> Unix.tm val sec_to_days : int -> string val sec_to_hours : int -> string val today : unit -> float_time val yesterday : unit -> float_time val tomorrow : unit -> float_time val lastweek : unit -> float_time val lastmonth : unit -> float_time val week_before: float_time -> float_time val month_before: float_time -> float_time val week_after: float_time -> float_time val days_in_week_of_day : float_time -> float_time list val first_day_in_week_of_day : float_time -> float_time val last_day_in_week_of_day : float_time -> float_time val day_secs: float_time val rough_days_since_jesus : date_dmy -> days val rough_days_between_dates : date_dmy -> date_dmy -> days val string_of_unix_time_lfs : Unix.tm -> string val is_more_recent : date_dmy -> date_dmy -> bool val max_dmy : date_dmy -> date_dmy -> date_dmy val min_dmy : date_dmy -> date_dmy -> date_dmy val maximum_dmy : date_dmy list -> date_dmy val minimum_dmy : date_dmy list -> date_dmy (*****************************************************************************) (* Lines/Words/Strings *) (*****************************************************************************) val list_of_string : string -> char list val lines : string -> string list val unlines : string list -> string val words : string -> string list val unwords : string list -> string val split_space : string -> string list val lines_with_nl : string -> string list val nblines : string -> int (*****************************************************************************) (* Process/Files *) (*****************************************************************************) val cat : filename -> string list val cat_orig : filename -> string list val cat_array: filename -> string array val uncat: string list -> filename -> unit val interpolate : string -> string list val echo : string -> string val usleep : int -> unit val process_output_to_list : string -> string list val cmd_to_list : string -> string list (* alias *) val cmd_to_list_and_status : string -> string list * Unix.process_status val command2 : string -> unit val _batch_mode: bool ref val command2_y_or_no : string -> bool val command2_y_or_no_exit_if_no : string -> unit val do_in_fork : (unit -> unit) -> int val mkdir: ?mode:Unix.file_perm -> string -> unit val read_file : filename -> string val write_file : file:filename -> string -> unit val filesize : filename -> int val filemtime : filename -> float val nblines_file : filename -> int val lfile_exists : filename -> bool val is_directory : filename -> bool val capsule_unix : ('a -> unit) -> 'a -> unit val readdir_to_kind_list : string -> Unix.file_kind -> string list val readdir_to_dir_list : string -> string list val readdir_to_file_list : string -> string list val readdir_to_link_list : string -> string list val readdir_to_dir_size_list : string -> (string * int) list val glob : string -> filename list val files_of_dir_or_files : string (* ext *) -> string list -> filename list val files_of_dir_or_files_no_vcs : string (* ext *) -> string list -> filename list (* use a post filter =~ for the ext filtering *) val files_of_dir_or_files_no_vcs_post_filter : string (* regexp *) -> string list -> filename list val sanity_check_files_and_adjust : string (* ext *) -> string list -> filename list type rwx = [ `R | `W | `X ] list val file_perm_of : u:rwx -> g:rwx -> o:rwx -> Unix.file_perm val has_env : string -> bool (* scheme spirit. do a finalize so no leak. *) val with_open_outfile : filename -> ((string -> unit) * out_channel -> 'a) -> 'a val with_open_infile : filename -> (in_channel -> 'a) -> 'a val with_open_outfile_append : filename -> ((string -> unit) * out_channel -> 'a) -> 'a val with_open_stringbuf : (((string -> unit) * Buffer.t) -> unit) -> string exception Timeout (* subtil: have to make sure that Timeout is not intercepted before here. So * avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up * enough. In such case, add a case before such as * with Timeout -> raise Timeout | _ -> ... * * The same is true for UnixExit (see below). *) val timeout_function : int -> (unit -> 'a) -> 'a val timeout_function_opt : int option -> (unit -> 'a) -> 'a val remove_file : string -> unit (* creation of /tmp files, a la gcc * ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c" *) val _temp_files_created : string list ref (* see flag: val save_tmp_files : bool ref *) val new_temp_file : string (* prefix *) -> string (* suffix *) -> filename val erase_temp_files : unit -> unit val erase_this_temp_file : filename -> unit (* If the user use some exit 0 in his code, then no one can intercept this * exit and do something before exiting. There is exn handler for exit 0 * so better never use exit 0 but instead use an exception and just at * the very toplevel transform this exn in a unix exit code. * * subtil: same problem than with Timeout. Do not intercept such exception * with some blind try (...) with _ -> ... *) exception UnixExit of int val exn_to_real_unixexit : (unit -> 'a) -> 'a (*###########################################################################*) (* And now collection-like types. See also ocollection.mli *) (*###########################################################################*) (*****************************************************************************) (* List *) (*****************************************************************************) (* tail recursive efficient map (but that also reverse the element!) *) val map_eff_rev : ('a -> 'b) -> 'a list -> 'b list (* tail recursive efficient map, use accumulator *) val acc_map : ('a -> 'b) -> 'a list -> 'b list val zip : 'a list -> 'b list -> ('a * 'b) list val zip_safe : 'a list -> 'b list -> ('a * 'b) list val unzip : ('a * 'b) list -> 'a list * 'b list val take : int -> 'a list -> 'a list val take_safe : int -> 'a list -> 'a list val take_until : ('a -> bool) -> 'a list -> 'a list val take_while : ('a -> bool) -> 'a list -> 'a list val drop : int -> 'a list -> 'a list val drop_while : ('a -> bool) -> 'a list -> 'a list val drop_until : ('a -> bool) -> 'a list -> 'a list val span : ('a -> bool) -> 'a list -> 'a list * 'a list val skip_until : ('a list -> bool) -> 'a list -> 'a list val skipfirst : (* Eq a *) 'a -> 'a list -> 'a list (* cf also List.partition *) val fpartition : ('a -> 'b option) -> 'a list -> 'b list * 'a list val groupBy : ('a -> 'a -> bool) -> 'a list -> 'a list list val exclude_but_keep_attached: ('a -> bool) -> 'a list -> ('a * 'a list) list val group_by_post: ('a -> bool) -> 'a list -> ('a list * 'a) list * 'a list val group_by_pre: ('a -> bool) -> 'a list -> 'a list * ('a * 'a list) list val group_by_mapped_key: ('a -> 'b) -> 'a list -> ('b * 'a list) list (* Use hash internally to not be in O(n2). If you want to use it on a * simple list, then first do a List.map to generate a key, for instance the * first char of the element, and then use this function. *) val group_assoc_bykey_eff : ('a * 'b) list -> ('a * 'b list) list val splitAt : int -> 'a list -> 'a list * 'a list val split_when: ('a -> bool) -> 'a list -> 'a list * 'a * 'a list val split_gen_when: ('a list -> 'a list option) -> 'a list -> 'a list list val pack : int -> 'a list -> 'a list list val enum : int -> int -> int list val repeat : 'a -> int -> 'a list val generate : int -> 'a -> 'a list val index_list : 'a list -> ('a * int) list val index_list_1 : 'a list -> ('a * int) list val index_list_and_total : 'a list -> ('a * int * int) list val iter_index : ('a -> int -> 'b) -> 'a list -> unit val map_index : ('a -> int -> 'b) -> 'a list -> 'b list val filter_index : (int -> 'a -> bool) -> 'a list -> 'a list val fold_left_with_index : ('a -> 'b -> int -> 'a) -> 'a -> 'b list -> 'a val nth : 'a list -> int -> 'a val rang : (* Eq a *) 'a -> 'a list -> int val last_n : int -> 'a list -> 'a list val snoc : 'a -> 'a list -> 'a list val cons : 'a -> 'a list -> 'a list val uncons : 'a list -> 'a * 'a list val safe_tl : 'a list -> 'a list val head_middle_tail : 'a list -> 'a * 'a list * 'a val last : 'a list -> 'a val list_init : 'a list -> 'a list val list_last : 'a list -> 'a val removelast : 'a list -> 'a list val inits : 'a list -> 'a list list val tails : 'a list -> 'a list list val ( ++ ) : 'a list -> 'a list -> 'a list val foldl1 : ('a -> 'a -> 'a) -> 'a list -> 'a val fold_k : ('a -> 'b -> ('a -> 'a) -> 'a) -> ('a -> 'a) -> 'a -> 'b list -> 'a val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val rev_map : ('a -> 'b) -> 'a list -> 'b list val join_gen : 'a -> 'a list -> 'a list val do_withenv : (('a -> 'b) -> 'c -> 'd) -> ('e -> 'a -> 'b * 'e) -> 'e -> 'c -> 'd * 'e val map_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b list -> 'c list * 'a val map_withkeep: ('a -> 'b) -> 'a list -> ('b * 'a) list val collect_accu : ('a -> 'b list) -> 'b list -> 'a list -> 'b list val collect : ('a -> 'b list) -> 'a list -> 'b list val remove : 'a -> 'a list -> 'a list val exclude : ('a -> bool) -> 'a list -> 'a list (* Not like unix uniq command line tool that only delete contiguous repeated * line. Here we delete any repeated line (here list element). *) val uniq : 'a list -> 'a list val uniq_eff: 'a list -> 'a list val has_no_duplicate: 'a list -> bool val is_set_as_list: 'a list -> bool val get_duplicates: 'a list -> 'a list val doublon : 'a list -> bool val reverse : 'a list -> 'a list (* alias *) val rev : 'a list -> 'a list (* alias *) val rotate : 'a list -> 'a list val map_flatten : ('a -> 'b list) -> 'a list -> 'b list val map2 : ('a -> 'b) -> 'a list -> 'b list val map3 : ('a -> 'b) -> 'a list -> 'b list val maximum : 'a list -> 'a val minimum : 'a list -> 'a val min_with : ('a -> 'b) -> 'a list -> 'a val two_mins_with : ('a -> 'b) -> 'a list -> 'a * 'a val all_assoc : (* Eq a *) 'a -> ('a * 'b) list -> 'b list val prepare_want_all_assoc : ('a * 'b) list -> ('a * 'b list) list val or_list : bool list -> bool val and_list : bool list -> bool val sum_float : float list -> float val sum_int : int list -> int val avg_list: int list -> float val return_when : ('a -> 'b option) -> 'a list -> 'b val grep_with_previous : ('a -> 'a -> bool) -> 'a list -> 'a list val iter_with_previous : ('a -> 'a -> 'b) -> 'a list -> unit val iter_with_before_after : ('a list -> 'a -> 'a list -> unit) -> 'a list -> unit val get_pair : 'a list -> ('a * 'a) list val permutation : 'a list -> 'a list list val remove_elem_pos : int -> 'a list -> 'a list val insert_elem_pos : ('a * int) -> 'a list -> 'a list val uncons_permut : 'a list -> (('a * int) * 'a list) list val uncons_permut_lazy : 'a list -> (('a * int) * 'a list Lazy.t) list val pack_sorted : ('a -> 'a -> bool) -> 'a list -> 'a list list val keep_best : ('a * 'a -> 'a option) -> 'a list -> 'a list val sorted_keep_best : ('a -> 'a -> 'a option) -> 'a list -> 'a list val cartesian_product : 'a list -> 'b list -> ('a * 'b) list (* old stuff *) val surEnsemble : 'a list -> 'a list list -> 'a list list val realCombinaison : 'a list -> 'a list list val combinaison : 'a list -> ('a * 'a) list val insere : 'a -> 'a list list -> 'a list list val insereListeContenant : 'a list -> 'a -> 'a list list -> 'a list list val fusionneListeContenant : 'a * 'a -> 'a list list -> 'a list list (*****************************************************************************) (* Arrays *) (*****************************************************************************) val array_find_index : (int -> bool) -> 'a array -> int val array_find_index_via_elem : ('a -> bool) -> 'a array -> int (* for better type checking, as sometimes when have an 'int array', can * easily mess up the index from the value. *) type idx = Idx of int val next_idx: idx -> idx val int_of_idx: idx -> int val array_find_index_typed : (idx -> bool) -> 'a array -> idx (*****************************************************************************) (* Matrix *) (*****************************************************************************) type 'a matrix = 'a array array val map_matrix : ('a -> 'b) -> 'a matrix -> 'b matrix val make_matrix_init: nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix val iter_matrix: (int -> int -> 'a -> unit) -> 'a matrix -> unit val nb_rows_matrix: 'a matrix -> int val nb_columns_matrix: 'a matrix -> int val rows_of_matrix: 'a matrix -> 'a list list val columns_of_matrix: 'a matrix -> 'a list list val all_elems_matrix_by_row: 'a matrix -> 'a list (*****************************************************************************) (* Fast array *) (*****************************************************************************) (* ?? *) (*****************************************************************************) (* Set. But have a look too at set*.mli; it's better. Or use Hashtbl. *) (*****************************************************************************) type 'a set = 'a list val empty_set : 'a set val insert_set : 'a -> 'a set -> 'a set val single_set : 'a -> 'a set val set : 'a list -> 'a set val is_set: 'a list -> bool val exists_set : ('a -> bool) -> 'a set -> bool val forall_set : ('a -> bool) -> 'a set -> bool val filter_set : ('a -> bool) -> 'a set -> 'a set val fold_set : ('a -> 'b -> 'a) -> 'a -> 'b set -> 'a val map_set : ('a -> 'b) -> 'a set -> 'b set val member_set : 'a -> 'a set -> bool val find_set : ('a -> bool) -> 'a list -> 'a val sort_set : ('a -> 'a -> int) -> 'a list -> 'a list val iter_set : ('a -> unit) -> 'a list -> unit val top_set : 'a set -> 'a val inter_set : 'a set -> 'a set -> 'a set val union_set : 'a set -> 'a set -> 'a set val minus_set : 'a set -> 'a set -> 'a set val union_all : ('a set) list -> 'a set val big_union_set : ('a -> 'b set) -> 'a set -> 'b set val card_set : 'a set -> int val include_set : 'a set -> 'a set -> bool val equal_set : 'a set -> 'a set -> bool val include_set_strict : 'a set -> 'a set -> bool (* could put them in Common.Infix *) val ( $*$ ) : 'a set -> 'a set -> 'a set val ( $+$ ) : 'a set -> 'a set -> 'a set val ( $-$ ) : 'a set -> 'a set -> 'a set val ( $?$ ) : 'a -> 'a set -> bool val ( $<$ ) : 'a set -> 'a set -> bool val ( $<=$ ) : 'a set -> 'a set -> bool val ( $=$ ) : 'a set -> 'a set -> bool val ( $@$ ) : 'a list -> 'a list -> 'a list val nub : 'a list -> 'a list (* use internally a hash and return * - the common part, * - part only in a, * - part only in b *) val diff_two_say_set_eff : 'a list -> 'a list -> 'a list * 'a list * 'a list (*****************************************************************************) (* Set as normal list *) (*****************************************************************************) (* cf above *) (*****************************************************************************) (* Set as sorted list *) (*****************************************************************************) (*****************************************************************************) (* Sets specialized *) (*****************************************************************************) (* module StringSet = Set.Make(struct type t = string let compare = compare end) *) (*****************************************************************************) (* Assoc. But have a look too at Mapb.mli; it's better. Or use Hashtbl. *) (*****************************************************************************) type ('a, 'b) assoc = ('a * 'b) list val assoc_to_function : (* Eq a *) ('a, 'b) assoc -> ('a -> 'b) val empty_assoc : ('a, 'b) assoc val fold_assoc : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val insert_assoc : 'a -> 'a list -> 'a list val map_assoc : ('a -> 'b) -> 'a list -> 'b list val filter_assoc : ('a -> bool) -> 'a list -> 'a list val assoc : 'a -> ('a * 'b) list -> 'b val keys : ('a * 'b) list -> 'a list val lookup : 'a -> ('a * 'b) list -> 'b val del_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list val replace_assoc : 'a * 'b -> ('a * 'b) list -> ('a * 'b) list val apply_assoc : 'a -> ('b -> 'b) -> ('a * 'b) list -> ('a * 'b) list val big_union_assoc : ('a -> 'b set) -> 'a list -> 'b set val assoc_reverse : ('a * 'b) list -> ('b * 'a) list val assoc_map : ('a * 'b) list -> ('a * 'b) list -> ('a * 'a) list val lookup_list : 'a -> ('a, 'b) assoc list -> 'b val lookup_list2 : 'a -> ('a, 'b) assoc list -> 'b * int val assoc_option : 'a -> ('a, 'b) assoc -> 'b option val assoc_with_err_msg : 'a -> ('a, 'b) assoc -> 'b val sort_by_val_lowfirst: ('a,'b) assoc -> ('a * 'b) list val sort_by_val_highfirst: ('a,'b) assoc -> ('a * 'b) list val sort_by_key_lowfirst: (int,'b) assoc -> (int * 'b) list val sort_by_key_highfirst: (int,'b) assoc -> (int * 'b) list val sortgen_by_key_lowfirst: ('a,'b) assoc -> ('a * 'b) list val sortgen_by_key_highfirst: ('a,'b) assoc -> ('a * 'b) list (*****************************************************************************) (* Assoc, specialized. *) (*****************************************************************************) module IntMap : sig type key = int type +'a t val empty : 'a t val is_empty : 'a t -> bool val add : key -> 'a -> 'a t -> 'a t val find : key -> 'a t -> 'a val remove : key -> 'a t -> 'a t val mem : key -> 'a t -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool end val intmap_to_list : 'a IntMap.t -> (IntMap.key * 'a) list val intmap_string_of_t : 'a -> 'b -> string module IntIntMap : sig type key = int * int type +'a t val empty : 'a t val is_empty : 'a t -> bool val add : key -> 'a -> 'a t -> 'a t val find : key -> 'a t -> 'a val remove : key -> 'a t -> 'a t val mem : key -> 'a t -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool end val intintmap_to_list : 'a IntIntMap.t -> (IntIntMap.key * 'a) list val intintmap_string_of_t : 'a -> 'b -> string (*****************************************************************************) (* Hash *) (*****************************************************************************) (* Note that Hashtbl keep old binding to a key so if want a hash * of a list, then can use the Hashtbl as is. Use Hashtbl.find_all then * to get the list of bindings * * Note that Hashtbl module use different convention :( the object is * the first argument, not last as for List or Map. *) (* obsolete: can use directly the Hashtbl module *) val hcreate : unit -> ('a, 'b) Hashtbl.t val hadd : 'a * 'b -> ('a, 'b) Hashtbl.t -> unit val hmem : 'a -> ('a, 'b) Hashtbl.t -> bool val hfind : 'a -> ('a, 'b) Hashtbl.t -> 'b val hreplace : 'a * 'b -> ('a, 'b) Hashtbl.t -> unit val hiter : ('a -> 'b -> unit) -> ('a, 'b) Hashtbl.t -> unit val hfold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) Hashtbl.t -> 'c -> 'c val hremove : 'a -> ('a, 'b) Hashtbl.t -> unit val hfind_default : 'a -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> 'b val hfind_option : 'a -> ('a, 'b) Hashtbl.t -> 'b option val hupdate_default : 'a -> ('b -> 'b) -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> unit val hash_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list val hash_to_list_unsorted : ('a, 'b) Hashtbl.t -> ('a * 'b) list val hash_of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t val hkeys : ('a, 'b) Hashtbl.t -> 'a list (*****************************************************************************) (* Hash sets *) (*****************************************************************************) type 'a hashset = ('a, bool) Hashtbl.t (* common use of hashset, in a hash of hash *) val hash_hashset_add : 'a -> 'b -> ('a, 'b hashset) Hashtbl.t -> unit val hashset_to_set : < fromlist : ('a ) list -> 'c; .. > -> ('a, 'b) Hashtbl.t -> 'c val hashset_to_list : 'a hashset -> 'a list val hashset_of_list : 'a list -> 'a hashset (*****************************************************************************) (* Stack *) (*****************************************************************************) type 'a stack = 'a list val empty_stack : 'a stack val push : 'a -> 'a stack -> 'a stack val top : 'a stack -> 'a val pop : 'a stack -> 'a stack val top_option: 'a stack -> 'a option val push2 : 'a -> 'a stack ref -> unit val pop2: 'a stack ref -> 'a (*****************************************************************************) (* Stack with undo/redo support *) (*****************************************************************************) type 'a undo_stack = 'a list * 'a list val empty_undo_stack : 'a undo_stack val push_undo : 'a -> 'a undo_stack -> 'a undo_stack val top_undo : 'a undo_stack -> 'a val pop_undo : 'a undo_stack -> 'a undo_stack val redo_undo: 'a undo_stack -> 'a undo_stack val undo_pop: 'a undo_stack -> 'a undo_stack val top_undo_option: 'a undo_stack -> 'a option (*****************************************************************************) (* Binary tree *) (*****************************************************************************) type 'a bintree = Leaf of 'a | Branch of ('a bintree * 'a bintree) (*****************************************************************************) (* N-ary tree *) (*****************************************************************************) (* no empty tree, must have one root at least *) type 'a tree = Tree of 'a * ('a tree) list val tree_iter : ('a -> unit) -> 'a tree -> unit (*****************************************************************************) (* N-ary tree with updatable children *) (*****************************************************************************) (* no empty tree, must have one root at least *) type 'a treeref = | NodeRef of 'a * 'a treeref list ref val treeref_node_iter: (('a * 'a treeref list ref) -> unit) -> 'a treeref -> unit val treeref_node_iter_with_parents: (('a * 'a treeref list ref) -> ('a list) -> unit) -> 'a treeref -> unit val find_treeref: (('a * 'a treeref list ref) -> bool) -> 'a treeref -> 'a treeref val treeref_children_ref: 'a treeref -> 'a treeref list ref val find_treeref_with_parents_some: ('a * 'a treeref list ref -> 'a list -> 'c option) -> 'a treeref -> 'c val find_multi_treeref_with_parents_some: ('a * 'a treeref list ref -> 'a list -> 'c option) -> 'a treeref -> 'c list (* Leaf can seem redundant, but sometimes want to directly see if * a children is a leaf without looking if the list is empty. *) type ('a, 'b) treeref2 = | NodeRef2 of 'a * ('a, 'b) treeref2 list ref | LeafRef2 of 'b val find_treeref2: (('a * ('a, 'b) treeref2 list ref) -> bool) -> ('a, 'b) treeref2 -> ('a, 'b) treeref2 val treeref_node_iter_with_parents2: (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) -> ('a, 'b) treeref2 -> unit val treeref_node_iter2: (('a * ('a, 'b) treeref2 list ref) -> unit) -> ('a, 'b) treeref2 -> unit (* val treeref_children_ref: ('a, 'b) treeref -> ('a, 'b) treeref list ref val find_treeref_with_parents_some: ('a * ('a, 'b) treeref list ref -> 'a list -> 'c option) -> ('a, 'b) treeref -> 'c val find_multi_treeref_with_parents_some: ('a * ('a, 'b) treeref list ref -> 'a list -> 'c option) -> ('a, 'b) treeref -> 'c list *) (*****************************************************************************) (* Graph. But have a look too at Ograph_*.mli; it's better *) (*****************************************************************************) type 'a graph = 'a set * ('a * 'a) set val add_node : 'a -> 'a graph -> 'a graph val del_node : 'a -> 'a graph -> 'a graph val add_arc : 'a * 'a -> 'a graph -> 'a graph val del_arc : 'a * 'a -> 'a graph -> 'a graph val successors : 'a -> 'a graph -> 'a set val predecessors : 'a -> 'a graph -> 'a set val nodes : 'a graph -> 'a set val fold_upward : ('a -> 'b -> 'a) -> 'b set -> 'a -> 'b graph -> 'a val empty_graph : 'a list * 'b list (*****************************************************************************) (* Generic op *) (*****************************************************************************) (* mostly alias to functions in List *) val map : ('a -> 'b) -> 'a list -> 'b list val tail_map : ('a -> 'b) -> 'a list -> 'b list val filter : ('a -> bool) -> 'a list -> 'a list val fold : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val member : 'a -> 'a list -> bool val iter : ('a -> unit) -> 'a list -> unit val find : ('a -> bool) -> 'a list -> 'a val exists : ('a -> bool) -> 'a list -> bool val forall : ('a -> bool) -> 'a list -> bool val big_union : ('a -> 'b set) -> 'a list -> 'b set (* same than [] but easier to search for, because [] can also be a pattern *) val empty_list : 'a list val sort : ('a -> 'a -> int) -> 'a list -> 'a list val length : 'a list -> int val null : 'a list -> bool val head : 'a list -> 'a val tail : 'a list -> 'a list val is_singleton : 'a list -> bool (*###########################################################################*) (* And now misc functions *) (*###########################################################################*) (*****************************************************************************) (* DB (LFS) *) (*****************************************************************************) (* cf oassocbdb.ml or oassocdbm.ml *) (*****************************************************************************) (* GUI (LFS, CComment, otimetracker) *) (*****************************************************************************) (* cf ocamlgtk and my gui.ml *) (*****************************************************************************) (* Graphics (otimetracker) *) (*****************************************************************************) (* cf ocamlgl and my opengl.ml *) (*****************************************************************************) (* Geometry (ICFP raytracer) *) (*****************************************************************************) type vector = float * float * float type point = vector type color = vector val dotproduct : vector * vector -> float val vector_length : vector -> float val minus_point : point * point -> vector val distance : point * point -> float val normalise : vector -> vector val mult_coeff : vector -> float -> vector val add_vector : vector -> vector -> vector val mult_vector : vector -> vector -> vector val sum_vector : vector list -> vector (*****************************************************************************) (* Pics (ICFP raytracer) *) (*****************************************************************************) type pixel = int * int * int val write_ppm : int -> int -> pixel list -> filename -> unit val test_ppm1 : unit -> unit (*****************************************************************************) (* Diff (LFS) *) (*****************************************************************************) type diff = Match | BnotinA | AnotinB val diff : (int -> int -> diff -> unit) -> string list * string list -> unit val diff2 : (int -> int -> diff -> unit) -> string * string -> unit (*****************************************************************************) (* Parsers (aop-colcombet) *) (*****************************************************************************) val parserCommon : Lexing.lexbuf -> ('a -> Lexing.lexbuf -> 'b) -> 'a -> 'b val getDoubleParser : ('a -> Lexing.lexbuf -> 'b) -> 'a -> (string -> 'b) * (string -> 'b) (*****************************************************************************) (* Parsers (cocci) *) (*****************************************************************************) (* Currently lexing.ml does not handle the line number position. * Even if there is some fields in the lexing structure, they are not * maintained by the lexing engine :( So the following code does not work: * * let pos = Lexing.lexeme_end_p lexbuf in * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum * (pos.pos_cnum - pos.pos_bol) in * * Hence those functions to overcome the previous limitation. *) type parse_info = { str: string; charpos: int; line: int; column: int; file: filename; } val fake_parse_info : parse_info val string_of_parse_info : parse_info -> string val string_of_parse_info_bis : parse_info -> string (* array[i] will contain the (line x col) of the i char position *) val full_charpos_to_pos : filename -> (int * int) array (* fill in the line and column field of parse_info that were not set * during lexing because of limitations of ocamllex. *) val complete_parse_info : filename -> (int * int) array -> parse_info -> parse_info val full_charpos_to_pos_large: filename -> (int -> (int * int)) val complete_parse_info_large : filename -> (int -> (int * int)) -> parse_info -> parse_info (* return line x col x str_line from a charpos. This function is quite * expensive so don't use it to get the line x col from every token in * a file. Instead use full_charpos_to_pos. *) val info_from_charpos : int -> filename -> (int * int * string) val error_message : filename -> (string * int) -> string val error_message_short : filename -> (string * int) -> string (* add a 'decalage/shift' argument to handle stuff such as cpp which includes * files and who can make shift. *) val error_messagebis : filename -> (string * int) -> int -> string (*****************************************************************************) (* Scope management (cocci) *) (*****************************************************************************) (* for example of use, see the code used in coccinelle *) type ('a, 'b) scoped_env = ('a, 'b) assoc list val lookup_env : (* Eq a *) 'a -> ('a, 'b) scoped_env -> 'b val member_env_key : 'a -> ('a, 'b) scoped_env -> bool val new_scope : ('a, 'b) scoped_env ref -> unit val del_scope : ('a, 'b) scoped_env ref -> unit val do_in_new_scope : ('a, 'b) scoped_env ref -> (unit -> unit) -> unit val add_in_scope : ('a, 'b) scoped_env ref -> 'a * 'b -> unit (* for example of use, see the code used in coccinelle *) type ('a, 'b) scoped_h_env = { scoped_h : ('a, 'b) Hashtbl.t; scoped_list : ('a, 'b) assoc list; } val empty_scoped_h_env : unit -> ('a, 'b) scoped_h_env val clone_scoped_h_env : ('a, 'b) scoped_h_env -> ('a, 'b) scoped_h_env val lookup_h_env : 'a -> ('a, 'b) scoped_h_env -> 'b val member_h_env_key : 'a -> ('a, 'b) scoped_h_env -> bool val new_scope_h : ('a, 'b) scoped_h_env ref -> unit val del_scope_h : ('a, 'b) scoped_h_env ref -> unit val clean_scope_h : ('a, 'b) scoped_h_env ref -> unit val do_in_new_scope_h : ('a, 'b) scoped_h_env ref -> (unit -> unit) -> unit val add_in_scope_h : ('a, 'b) scoped_h_env ref -> 'a * 'b -> unit (*****************************************************************************) (* Terminal (LFS) *) (*****************************************************************************) (* don't forget to call Common_extra.set_link () *) val _execute_and_show_progress_func : (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref val execute_and_show_progress : int (* length *) -> ((unit -> unit) -> unit) -> unit (*****************************************************************************) (* Flags and actions *) (*****************************************************************************) val cmdline_flags_devel : unit -> cmdline_options val cmdline_flags_verbose : unit -> cmdline_options val cmdline_flags_other : unit -> cmdline_options (*****************************************************************************) (* Misc/test *) (*****************************************************************************) val generic_print : 'a -> string -> string class ['a] olist : 'a list -> object val xs : 'a list method fold : ('b -> 'a -> 'b) -> 'b -> 'b method view : 'a list end val typing_sux_test : unit -> unit coccinelle-1.0.0-rc19/commons/sexp_common.ml0000644000175000017500000002670312247437436017734 0ustar eugeneugen(* automatically generated by ocamltarzan *) open Common open Sexplib let either_of_sexp__ = let _loc = "Xxx.either" in fun _of_a _of_b -> function | (Sexp.List (Sexp.Atom (("left" | "Left" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = _of_a v1 in Left v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.List (Sexp.Atom (("right" | "Right" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = _of_b v1 in Right v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.Atom ("left" | "Left") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.Atom ("right" | "Right") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.List (Sexp.List _ :: _) as sexp) -> Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp let either_of_sexp _of_a _of_b sexp = either_of_sexp__ _of_a _of_b sexp let sexp_of_either _of_a _of_b = function | Left v1 -> let v1 = _of_a v1 in Sexp.List [ Sexp.Atom "Left"; v1 ] | Right v1 -> let v1 = _of_b v1 in Sexp.List [ Sexp.Atom "Right"; v1 ] let either3_of_sexp__ = let _loc = "Xxx.either3" in fun _of_a _of_b _of_c -> function | (Sexp.List (Sexp.Atom (("left3" | "Left3" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = _of_a v1 in Left3 v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.List (Sexp.Atom (("middle3" | "Middle3" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = _of_b v1 in Middle3 v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.List (Sexp.Atom (("right3" | "Right3" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = _of_c v1 in Right3 v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.Atom ("left3" | "Left3") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.Atom ("middle3" | "Middle3") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.Atom ("right3" | "Right3") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.List (Sexp.List _ :: _) as sexp) -> Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp let either3_of_sexp _of_a _of_b _of_c sexp = either3_of_sexp__ _of_a _of_b _of_c sexp let sexp_of_either3 _of_a _of_b _of_c = function | Left3 v1 -> let v1 = _of_a v1 in Sexp.List [ Sexp.Atom "Left3"; v1 ] | Middle3 v1 -> let v1 = _of_b v1 in Sexp.List [ Sexp.Atom "Middle3"; v1 ] | Right3 v1 -> let v1 = _of_c v1 in Sexp.List [ Sexp.Atom "Right3"; v1 ] let filename_of_sexp__ = let _loc = "Xxx.filename" in fun sexp -> Conv.string_of_sexp sexp let filename_of_sexp sexp = try filename_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_filename v = Conv.sexp_of_string v let dirname_of_sexp__ = let _loc = "Xxx.dirname" in fun sexp -> Conv.string_of_sexp sexp let dirname_of_sexp sexp = try dirname_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_dirname v = Conv.sexp_of_string v let set_of_sexp__ = let _loc = "Xxx.set" in fun _of_a -> Conv.list_of_sexp _of_a let set_of_sexp _of_a sexp = try set_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_set _of_a = Conv.sexp_of_list _of_a let assoc_of_sexp__ = let _loc = "Xxx.assoc" in fun _of_a _of_b -> Conv.list_of_sexp (function | Sexp.List ([ v1; v2 ]) -> let v1 = _of_a v1 and v2 = _of_b v2 in (v1, v2) | sexp -> Conv_error.tuple_of_size_n_expected _loc 2 sexp) let assoc_of_sexp _of_a _of_b sexp = try assoc_of_sexp__ _of_a _of_b sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_assoc _of_a _of_b = Conv.sexp_of_list (fun (v1, v2) -> let v1 = _of_a v1 and v2 = _of_b v2 in Sexp.List [ v1; v2 ]) (* let hashset_of_sexp__ = let _loc = "Xxx.hashset" in fun _of_a -> Conv.hashtbl_of_sexp _of_a Conv.bool_of_sexp let hashset_of_sexp _of_a sexp = try hashset_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_hashset _of_a = Conv.sexp_of_hashtbl _of_a Conv.sexp_of_bool *) let stack_of_sexp__ = let _loc = "Xxx.stack" in fun _of_a -> Conv.list_of_sexp _of_a let stack_of_sexp _of_a sexp = try stack_of_sexp__ _of_a sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_stack _of_a = Conv.sexp_of_list _of_a let parse_info_of_sexp__ = let _loc = "Xxx.parse_info" in function | (Sexp.List field_sexps as sexp) -> let str_field = ref None and charpos_field = ref None and line_field = ref None and column_field = ref None and file_field = ref None and duplicates = ref [] and extra = ref [] in let rec iter = (function | Sexp.List ([ Sexp.Atom field_name; field_sexp ]) :: tail -> ((match field_name with | "str" -> (match !str_field with | None -> let fvalue = Conv.string_of_sexp field_sexp in str_field := Some fvalue | Some _ -> duplicates := field_name :: !duplicates) | "charpos" -> (match !charpos_field with | None -> let fvalue = Conv.int_of_sexp field_sexp in charpos_field := Some fvalue | Some _ -> duplicates := field_name :: !duplicates) | "line" -> (match !line_field with | None -> let fvalue = Conv.int_of_sexp field_sexp in line_field := Some fvalue | Some _ -> duplicates := field_name :: !duplicates) | "column" -> (match !column_field with | None -> let fvalue = Conv.int_of_sexp field_sexp in column_field := Some fvalue | Some _ -> duplicates := field_name :: !duplicates) | "file" -> (match !file_field with | None -> let fvalue = filename_of_sexp field_sexp in file_field := Some fvalue | Some _ -> duplicates := field_name :: !duplicates) | _ -> if !Conv.record_check_extra_fields then extra := field_name :: !extra else ()); iter tail) | sexp :: _ -> Conv_error.record_only_pairs_expected _loc sexp | [] -> ()) in (iter field_sexps; if !duplicates <> [] then Conv_error.record_duplicate_fields _loc !duplicates sexp else if !extra <> [] then Conv_error.record_extra_fields _loc !extra sexp else (match ((!str_field), (!charpos_field), (!line_field), (!column_field), (!file_field)) with | (Some str_value, Some charpos_value, Some line_value, Some column_value, Some file_value) -> { str = str_value; charpos = charpos_value; line = line_value; column = column_value; file = file_value; } | _ -> Conv_error.record_undefined_elements _loc sexp [ ((!str_field = None), "str"); ((!charpos_field = None), "charpos"); ((!line_field = None), "line"); ((!column_field = None), "column"); ((!file_field = None), "file") ])) | (Sexp.Atom _ as sexp) -> Conv_error.record_list_instead_atom _loc sexp let parse_info_of_sexp sexp = parse_info_of_sexp__ sexp let sexp_of_parse_info { str = v_str; charpos = v_charpos; line = v_line; column = v_column; file = v_file } = let bnds = [] in let arg = sexp_of_filename v_file in let bnd = Sexp.List [ Sexp.Atom "file"; arg ] in let bnds = bnd :: bnds in let arg = Conv.sexp_of_int v_column in let bnd = Sexp.List [ Sexp.Atom "column"; arg ] in let bnds = bnd :: bnds in let arg = Conv.sexp_of_int v_line in let bnd = Sexp.List [ Sexp.Atom "line"; arg ] in let bnds = bnd :: bnds in let arg = Conv.sexp_of_int v_charpos in let bnd = Sexp.List [ Sexp.Atom "charpos"; arg ] in let bnds = bnd :: bnds in let arg = Conv.sexp_of_string v_str in let bnd = Sexp.List [ Sexp.Atom "str"; arg ] in let bnds = bnd :: bnds in Sexp.List bnds let score_result_of_sexp__ = let _loc = "Xxx.score_result" in function | Sexp.Atom ("ok" | "Ok") -> Ok | (Sexp.List (Sexp.Atom (("pb" | "Pb" as tag)) :: sexp_args) as sexp) -> (match sexp_args with | [ v1 ] -> let v1 = Conv.string_of_sexp v1 in Pb v1 | _ -> Conv_error.stag_incorrect_n_args _loc tag sexp) | (Sexp.List (Sexp.Atom ("ok" | "Ok") :: _) as sexp) -> Conv_error.stag_no_args _loc sexp | (Sexp.Atom ("pb" | "Pb") as sexp) -> Conv_error.stag_takes_args _loc sexp | (Sexp.List (Sexp.List _ :: _) as sexp) -> Conv_error.nested_list_invalid_sum _loc sexp | (Sexp.List [] as sexp) -> Conv_error.empty_list_invalid_sum _loc sexp | sexp -> Conv_error.unexpected_stag _loc sexp let score_result_of_sexp sexp = score_result_of_sexp__ sexp let sexp_of_score_result = function | Ok -> Sexp.Atom "Ok" | Pb v1 -> let v1 = Conv.sexp_of_string v1 in Sexp.List [ Sexp.Atom "Pb"; v1 ] let score_of_sexp__ = let _loc = "Xxx.score" in fun sexp -> Conv.hashtbl_of_sexp Conv.string_of_sexp score_result_of_sexp sexp let score_of_sexp sexp = try score_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_score v = Conv.sexp_of_hashtbl Conv.sexp_of_string sexp_of_score_result v let score_list_of_sexp__ = let _loc = "Xxx.score_list" in fun sexp -> Conv.list_of_sexp (function | Sexp.List ([ v1; v2 ]) -> let v1 = Conv.string_of_sexp v1 and v2 = score_result_of_sexp v2 in (v1, v2) | sexp -> Conv_error.tuple_of_size_n_expected _loc 2 sexp) sexp let score_list_of_sexp sexp = try score_list_of_sexp__ sexp with | Conv_error.No_variant_match ((msg, sexp)) -> Conv.of_sexp_error msg sexp let sexp_of_score_list v = Conv.sexp_of_list (fun (v1, v2) -> let v1 = Conv.sexp_of_string v1 and v2 = sexp_of_score_result v2 in Sexp.List [ v1; v2 ]) v coccinelle-1.0.0-rc19/commons/ograph_extended.mli0000644000175000017500000000452712247437436020716 0ustar eugeneugenopen Common type nodei = int (* graph structure: * - node: index -> nodevalue * - arc: (index * index) * edgevalue * * How ? matrix ? but no growing array :( * * When need index ? Must have an index when can't just use the nodevalue * as a key, cos sometimes may have 2 times the same key, but it must * be 2 different nodes. For instance in a C program 'f(); f();' we want 2 * nodes, one per 'f();' hence the index. If each node is different, then * no problem, can omit index. *) class ['node, 'edge] ograph_extended : object ('o) method add_node : 'node -> 'o * nodei method add_nodei : nodei -> 'node -> 'o * nodei method replace_node : nodei * 'node -> 'o method del_node : nodei -> 'o method add_arc : (nodei * nodei) * 'edge -> 'o method del_arc : (nodei * nodei) * 'edge -> 'o method nodes : (nodei, 'node) Oassoc.oassoc method successors : nodei -> (nodei * 'edge) Oset.oset method predecessors : nodei -> (nodei * 'edge) Oset.oset method allsuccessors : (nodei, (nodei * 'edge) Oset.oset) Oassoc.oassoc end class ['node, 'edge] ograph_mutable : object ('o) method add_node : 'node -> nodei method add_nodei : nodei -> 'node -> unit method replace_node : nodei * 'node -> unit method del_node : nodei -> unit method add_arc : (nodei * nodei) * 'edge -> unit method del_arc : (nodei * nodei) * 'edge -> unit method nodes : (nodei, 'node) Oassoc.oassoc method successors : nodei -> (nodei * 'edge) Oset.oset method predecessors : nodei -> (nodei * 'edge) Oset.oset method allsuccessors : (nodei, (nodei * 'edge) Oset.oset) Oassoc.oassoc end val dfs_iter : nodei -> (nodei -> unit) -> ('node, 'edge) ograph_mutable -> unit val dfs_iter_with_path : nodei -> (nodei -> nodei list -> unit) -> ('node, 'edge) ograph_mutable -> unit val print_ograph_mutable_generic : ('node, 'edge) ograph_mutable -> string option -> (* label for the entire graph *) (* what string to print for a node and how to color it *) ((nodei * 'node) -> (string * string option * string option)) -> output_file:filename -> launch_gv:bool -> unit val print_ograph_extended : ('node * string, 'edge) ograph_extended -> filename (* output file *) -> bool (* launch gv ? *) -> unit val print_ograph_mutable : ('node * string, 'edge) ograph_mutable -> filename (* output file *) -> bool (* launch gv ? *) -> unit coccinelle-1.0.0-rc19/commons/ograph.mli0000644000175000017500000000107512247437436017031 0ustar eugeneugenclass virtual ['a] ograph : object ('o) method virtual empty : 'o method virtual add_node : 'a -> 'o method virtual del_node : 'a -> 'o method virtual add_arc : 'a * 'a -> 'o method virtual del_arc : 'a * 'a -> 'o method virtual nodes : 'a Oset.oset method virtual predecessors : 'a -> 'a Oset.oset method virtual successors : 'a -> 'a Oset.oset method virtual ancestors : 'a Oset.oset -> 'a Oset.oset method virtual brothers : 'a -> 'a Oset.oset method virtual children : 'a Oset.oset -> 'a Oset.oset method mydebug : ('a * 'a list) list end coccinelle-1.0.0-rc19/commons/seti.ml0000644000175000017500000003042412247437436016344 0ustar eugeneugenopen Common (*****************************************************************************) (* coded for LFS *) (* todo: could take an incr/decr func in param, to make it generic * opti: remember the min/max (optimisation to have intersect biggest x -> x) * opti: avoid all those rev, and avoid the intervise * (but yes the algorithm are then more complex :) * opti: balanced set intervalle *) (*****************************************************************************) type seti = elt list (* last elements is in first pos, ordered reverse *) and elt = Exact of int | Interv of int * int (* invariant= ordered list, no incoherent interv (one elem or zero elem), * merged (intervalle are separated) *) let invariant xs = let rec aux min xs = xs +> List.fold_left (fun min e -> match e with | Exact i -> if i <= min then pr2 (sprintf "i = %d, min = %d" i min); (* todo: should be even stronger, should be i > min+1 *) assert (i > min); i | Interv (i,j) -> assert (i > min); assert (j > i); j ) min in ignore(aux min_int (List.rev xs)); () let string_of_seti xs = "[" ^ join "," (xs +> List.rev +> map (function | (Exact i) -> string_of_int i | (Interv (i,j)) -> Printf.sprintf "%d - %d" i j)) ^ "]" (*****************************************************************************) let empty = [] let pack newi j = function | [] -> [Interv (newi,j)] | (Exact z)::xs -> (Interv (newi, j))::(if newi =|= z then xs else (Exact z)::xs) | (Interv (i', j'))::xs -> if newi =|= j' then (Interv (i', j))::xs (* merge *) else (Interv (newi, j))::(Interv (i', j'))::xs (* the only possible merges are when x = i-1, otherwise, the job is done before *) let rec (add2: int -> seti -> seti) = fun x -> function | [] -> [Exact x] | (Exact i)::xs when x > i+1 -> (Exact x)::(Exact i)::xs | (Interv (i,j)::xs) when x > j+1 -> (Exact x)::(Interv (i,j))::xs | (Interv (i,j)::xs) when x =|= j+1 -> (Interv (i,x))::xs | (Exact i)::xs when x =|= i+1 -> (Interv (i,x))::xs | (Exact i)::xs when i =|= x -> (Exact i)::xs | (Interv (i,j)::xs) when x <= j && x >= i -> (Interv (i,j))::xs | other -> (* let _ = log "Cache miss" in *) let _ = count2 () in (match other with | (Exact i)::xs when x =|= i-1 -> pack x i xs | (Exact i)::xs when x < i-1 -> (Exact i)::add x xs | (Interv (i,j)::xs) when x =|= i-1 -> pack x j xs | (Interv (i,j)::xs) when x < i-1 -> (Interv (i,j))::add x xs | _ -> raise (Impossible 6) ) and add x y = let _ = count5 () in add2 x y let rec tolist2 = function | [] -> [] | (Exact i)::xs -> i::tolist2 xs | (Interv (i,j))::xs -> enum i j @ tolist2 xs let rec tolist xs = List.rev (tolist2 xs) let rec fromlist = function xs -> List.fold_left (fun a e -> add e a) empty xs let intervise = function | Exact x -> Interv (x,x) | y -> y let exactize = function | Interv (i,j) when i =|= j -> Exact i | y -> y let exactize2 x y = if x =|= y then Exact x else Interv (x,y) let rec (remove: int -> seti -> seti) = fun x xs -> match xs with | [] -> [] (* pb, not in *) | (Exact z)::zs -> (match x <=> z with | Equal -> zs | Sup -> xs (* pb, not in *) | Inf -> (Exact z)::remove x zs ) | (Interv (i,j)::zs) -> if x > j then xs (* pb not in *) else if x >= i && x <= j then ( let _ = assert (j > i) in (* otherwise can lead to construct seti such as [7,6] when removing 6 from [6,6] *) match () with | _ when x =|= i -> [exactize2 (i+1) j] | _ when x =|= j -> [exactize2 i (j-1)] | _ -> [exactize2 (x+1) j; exactize2 i (x-1)] ) @ zs else (Interv (i,j))::remove x zs (* let _ = Example (remove 635 [Interv (3, 635)] = [Interv (3, 634)]) *) (* let _ = Example (remove 2 [Interv (6, 7); Interv(1,4)] = [Interv (6,7); Interv (3,4); Exact 1]) *) (* let _ = Example (remove 6 [Interv (6, 7); Interv(1,4)] = [Exact 7; Interv (1,4)]) *) (* let _ = Example (remove 1 [Interv (6, 7); Interv(1,2)] = [Interv (6,7); Exact 2]) *) (* let _ = Example (remove 3 [Interv (1, 7)] = [Interv (4,7); Interv (1,2)]) *) let _ = assert_equal (remove 3 [Interv (1, 7)]) [Interv (4,7); Interv (1,2)] let _ = assert_equal (remove 4 [Interv (3, 4)]) [Exact (3);] (* let _ = example (try (ignore(remove 6 [Interv (6, 6)] = []); false) with _ -> true) *) let rec mem e = function | [] -> false | (Exact x)::xs -> (match e <=> x with | Equal -> true | Sup -> false | Inf -> mem e xs ) | (Interv (i,j)::xs) -> if e > j then false else if e >= i && e <= j then true else mem e xs let iter f xs = xs +> List.iter (function | Exact i -> f i | Interv (i, j) -> for k = i to j do f k done ) let is_empty xs = xs =*= [] let choose = function | [] -> failwith "not supposed to be called with empty set" | (Exact i)::xs -> i | (Interv (i,j))::xs -> i let elements xs = tolist xs let rec cardinal = function | [] -> 0 | (Exact _)::xs -> 1+cardinal xs | (Interv (i,j)::xs) -> (j-i) +1 + cardinal xs (*****************************************************************************) (* TODO: could return corresponding osetb ? *) let rec inter xs ys = let rec aux = fun xs ys -> match (xs, ys) with | (_, []) -> [] | ([],_) -> [] | (x::xs, y::ys) -> (match (x, y) with | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with | Equal -> (match j1 <=> j2 with | Equal -> (Interv (i1,j1))::aux xs ys (* [ ] *) (* [ ] *) | Inf -> (Interv (i1, j1))::aux xs ((Interv (j1+1, j2))::ys) (* [ ] [ TODO? could have [ so cannot englobe right now, but would be better *) (* [ ] *) | Sup -> (Interv (i1, j2))::aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] [ same *) ) | Inf -> if j1 < i2 then aux xs (y::ys) (* need order ? *) (* [ ] *) (* [ ] *) else (match j1 <=> j2 with | Equal -> (Interv (i2, j1))::aux xs ys (* [ ] *) (* [ ] *) | Inf -> (Interv (i2, j1))::aux xs ((Interv (j1+1, j2))::ys) (* [ ] [ same *) (* [ ] *) | Sup -> (Interv (i2, j2))::aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] [ same *) ) | Sup -> aux (y::ys) (x::xs) (* can cos commutative *) ) | _ -> raise (Impossible 7) (* intervise *) ) in (* TODO avoid the rev rev, but aux good ? need order ? *) List.rev_map exactize (aux (List.rev_map intervise xs) (List.rev_map intervise ys)) let union xs ys = let rec aux = fun xs ys -> match (xs, ys) with | (vs, []) -> vs | ([],vs) -> vs | (x::xs, y::ys) -> (match (x, y) with | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with | Equal -> (match j1 <=> j2 with | Equal -> (Interv (i1,j1))::aux xs ys (* [ ] *) (* [ ] *) | Inf -> (Interv (i1, j1))::aux xs ((Interv (j1+1, j2))::ys) (* [ ] [ TODO? could have [ so cannot englobe right now, but would be better *) (* [ ] *) | Sup -> (Interv (i1, j2))::aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] [ same *) ) | Inf -> if j1 < i2 then Interv (i1, j1):: aux xs (y::ys) (* [ ] *) (* [ ] *) else (match j1 <=> j2 with | Equal -> (Interv (i1, j1))::aux xs ys (* [ ] *) (* [ ] *) | Inf -> (Interv (i1, j1))::aux xs ((Interv (j1+1, j2))::ys) (* [ ] [ same *) (* [ ] *) | Sup -> (Interv (i1, j2))::aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] [ same *) ) | Sup -> aux (y::ys) (x::xs) (* can cos commutative *) ) | _ -> raise (Impossible 8) (* intervise *) ) in (* union_set (tolist xs) (tolist ys) +> fromlist *) List.rev_map exactize (aux (List.rev_map intervise xs) (List.rev_map intervise ys)) (* bug/feature: discovered by vlad rusu, my invariant for intervalle is * not very strong, should return (Interv (1,4)) *) (* let _ = Example (union [Interv (1, 4)] [Interv (1, 3)] = ([Exact 4; Interv (1,3)])) *) let diff xs ys = let rec aux = fun xs ys -> match (xs, ys) with | (vs, []) -> vs | ([],vs) -> [] | (x::xs, y::ys) -> (match (x, y) with | (Interv (i1, j1), Interv (i2, j2)) -> (match i1 <=> i2 with | Equal -> (match j1 <=> j2 with | Equal -> aux xs ys (* [ ] *) (* [ ] *) | Inf -> aux xs ((Interv (j1+1, j2))::ys) (* [ ] *) (* [ ] *) | Sup -> aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] *) ) | Inf -> if j1 < i2 then Interv (i1, j1):: aux xs (y::ys) (* [ ] *) (* [ ] *) else (match j1 <=> j2 with | Equal -> (Interv (i1, i2-1))::aux xs ys (* -1 cos exclude [ *) (* [ ] *) (* [ ] *) | Inf -> (Interv (i1, i2-1))::aux xs ((Interv (j1+1, j2))::ys) (* [ ] *) (* [ ] *) | Sup -> (Interv (i1, i2-1))::aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] *) ) | Sup -> if j2 < i1 then aux (x::xs) ys (* [ ] *) (* [ ] *) else (match j1 <=> j2 with | Equal -> aux xs ys (* [ ] *) (* [ ] *) | Inf -> aux xs ((Interv (j1+1, j2))::ys) (* [ ] *) (* [ ] *) | Sup -> aux ((Interv (j2+1, j1))::xs) ys (* [ ] *) (* [ ] *) ) ) | _ -> raise (Impossible 9) (* intervise *) ) in (* minus_set (tolist xs) (tolist ys) +> fromlist *) List.rev_map exactize (aux (List.rev_map intervise xs) (List.rev_map intervise ys)) (* let _ = Example (diff [Interv (3,7)] [Interv (4,5)] = [Interv (6, 7); Exact 3]) *) (*****************************************************************************) let rec debug = function | [] -> "" | (Exact i)::xs -> (Printf.sprintf "Exact:%d;" i) ^ (debug xs) | (Interv (i,j)::xs) -> (Printf.sprintf "Interv:(%d,%d);" i j) ^ debug xs (*****************************************************************************) (* if operation return wrong result, then may later have to patch them *) let patch1 xs = List.map exactize xs let patch2 xs = xs +> List.map (fun e -> match e with | Interv (i,j) when i > j && i =|= j+1 -> let _ = pr2 (sprintf "i = %d, j = %d" i j) in Exact i | e -> e ) let patch3 xs = let rec aux min xs = xs +> List.fold_left (fun (min,acc) e -> match e with | Exact i -> if i =|= min then (min, acc) else (i, (Exact i)::acc) | Interv (i,j) -> (j, (Interv (i,j)::acc)) ) (min, []) in aux min_int (List.rev xs) +> snd coccinelle-1.0.0-rc19/commons/commons.mllib0000644000175000017500000000050212247437436017534 0ustar eugeneugenDumper ANSITerminal Setb Mapb SetPt Commands Common Common_extra Interfaces Objet Ocollection Seti Oset Oassoc Osequence Ograph Oseti Oseth Osetb Osetpt Oassocb Oassoch Oassoc_buffer Oassoc_cache Oassocid Oarray Ograph2way Ograph_simple Ograph_extended Glimpse Parser_combinators Enum DynArray Suffix_tree Suffix_tree_ext coccinelle-1.0.0-rc19/commons/osequence.ml0000644000175000017500000000037212247437436017366 0ustar eugeneugenopen Oassoc class virtual ['a] osequence = object(o: 'o) (* inherit ['a] ocollection *) inherit [int, 'a] oassoc method virtual nth: int -> 'a method virtual first: 'a method virtual last: 'a (* head tail push pop top cons snoc *) end coccinelle-1.0.0-rc19/commons/interfaces.ml0000644000175000017500000001176712247437436017534 0ustar eugeneugenopen Common.BasicType (*****************************************************************************) (* TypeClass via module signature. *) (*****************************************************************************) (* * Use this not so much for functors, I hate functors, but * more to force me to have consistent naming of stuff. * * It's related to objet.ml in some way, but use a different scheme. * * src: (strongly) inspired by Jane Street core lib, which in turn * may have been strongly inspired by Java Interfaces or Haskell * TypeClass. * * * * Example of use in .mli: * * open Interfaces * include Stringable with type stringable = t * include Comparable with type comparable = t * * Example of use in .ml: * * type xxx * type stringable = xxx * let of_string = bool_of_string * let to_string = string_of_bool * * * No this file is not about (graphical) user interface. See gui.ml for that. * * * todo? but as in type class, or object, can not have default method * with this scheme ? *) (*****************************************************************************) (* Basic *) (*****************************************************************************) (* note: less need for clonable, copyable as in Java. Only needed * when use ref, but refs should be avoided anyway so better not to * encourage it. * * Often found this in haskell: * * data x = ... deriving (Read, Show, Eq, Ord, Enum, Bounded) * * Apparently this is what is considered basic by haskell. *) module type Check_able = sig type checkable val invariant: checkable -> unit (* raise exception *) end (* Normally should not use the '=' of ocaml. cf common.mli on this issue. *) module type Eq_able = sig type eqable val equal : eqable -> eqable -> bool (* Jane Street have far more (complex) stuff for this typeclass *) val (=*=): eqable -> eqable -> bool end (* Same, should not use compare normally, dangerous when evolve code. * Called Ord in haskell. Inherit Eq normally. *) module type Compare_able = sig type compareable val compare: compareable -> compareable -> bool end (* Jane street have also some binable, sexpable *) (* Haskell have lots of related type class after Num such as * Real, Fractional, Integral, RealFrac, Floating, RealFloat *) module type Num_able = sig type numable (* +, -, etc *) end (*****************************************************************************) (* Show/read related *) (*****************************************************************************) (* Called show/read in haskell *) module type String_able = sig type stringable val of_string : string -> stringable val to_string : stringable -> string end module type Debug_able = sig type debugable val debug: debugable -> string end module type XML_able = sig type xmlable val of_xml: string -> xmlable val to_xml: xmlable -> string end (* Jane street have also some BIN_able, and SEXP_able (but no sex_able) *) module type File_able = sig type fileable val load: filename -> fileable val save: fileable -> filename -> unit end (* a.k.a Marshall_able *) module type Serialize_able = sig type serializeable val serialize: serializeable -> string val unserialize: string -> serializeable end module type Open_able = sig type openable val openfile: filename -> openable val close: openable -> unit end (*****************************************************************************) (* Other *) (*****************************************************************************) (* This is related to ocollection.ml in some way, but use a different scheme *) (* Require Constructor class ? So can not do it ? apparently can. Note the * 'b which is not declareted but seems to pose no problem to ocamlc. *) module type Map_able = sig type 'a mapable val map: ('a -> 'b) -> 'a mapable -> 'b mapable end module type Iter_able = sig type 'a iterable val iter: ('a -> unit) -> 'a iterable -> unit end (* testable ? actionable ? *) (* *) (* monad ? functor *) (*****************************************************************************) (* Idea taken from Jane Street Core library, slightly changed. * * It's another way to organize data structures, module instead of objects. * It's also the Java way. * * It makes some code looks a little bit like Haskell* typeclass. * *) (* In Jane Street they put each interface in its own file but then have to * do that: * * module type Stringable = Stringable.S * module type Comparable = Comparable.S * module type Floatable = Floatable.S * module type Hashable = Hashable.S * module type Infix_comparators = Comparable.Infix * module type Monad = Monad.S * module type Robustly_comparable = Robustly_comparable.S * module type Setable = Setable.S * module type Sexpable = Sexpable.S * module type Binable = Binable.S * * And I don't like having too much files, especially as all those xxable * end with able, not start, so don't see them together in the directory. *) coccinelle-1.0.0-rc19/testing.mli0000644000175000017500000000744512247442614015554 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./testing.mli" open Common (*****************************************************************************) (* work with tests/ *) (*****************************************************************************) val testone : string (*prefix*) -> string (*test*) -> bool (*compare_expected*) -> unit val testall : string -> bool -> unit (*****************************************************************************) (* works with tests-big/. The .res, .ok, .spatch_ok, .failed, .var *) (*****************************************************************************) val test_okfailed : filename (*cocci*) -> filename (*c*) list -> unit val test_regression_okfailed : unit -> unit (*****************************************************************************) (* the parameter is the result of Cocci.full_engine *) (*****************************************************************************) val compare_with_expected : (filename * filename option) list -> unit (*****************************************************************************) (* to test/debug the coccinelle subsystems *) (*****************************************************************************) (* pad: * I moved the parsing_c/ subsystem testing in parsing_c/test_parsing_c.ml * as I need it for other projects too. *) val test_parse_cocci : filename -> unit (*****************************************************************************) (* to be called by ocaml toplevel, to test. *) (*****************************************************************************) val sp_of_file : filename (* coccifile *) -> filename option (* isofile *) -> Ast_cocci.metavar list list * Ast_cocci.rule list * Ast_cocci.meta_name list list list * Ast_cocci.meta_name list list list * (Ast_cocci.meta_name list list list (*used after list*) * (*fresh used after list*) Ast_cocci.meta_name list list list * (*fresh used after list seeds*) Ast_cocci.meta_name list list list) * Ast_cocci.meta_name list list list * (string list option * string list option * (Str.regexp * Str.regexp list) option * Get_constants2.combine option) * bool (* format info needed for strings *) (* TODO: Remove val rule_elem_of_string : string -> filename option -> Ast_cocci.rule_elem *) (* val flows_of_ast : Ast_c.program -> Control_flow_c.cflow list val print_flow : Control_flow_c.cflow -> unit val ctls_of_ast : Ast_cocci.rule list -> Ast_cocci.meta_name list list list -> (Lib_engine.ctlcocci * ((Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif) list list)) list list val one_flow : Control_flow_c.cflow list -> Control_flow_c.cflow val one_ctl : Lib_engine.ctlcocci list list -> Lib_engine.ctlcocci *) coccinelle-1.0.0-rc19/readme.txt0000644000175000017500000000672412247437436015377 0ustar eugeneugen Coccinelle Coccinelle allows programmers to easily write some complex style-preserving source-to-source transformations on C source code, like for instance to perform some refactorings. To install Coccinelle from its source, see the instructions in install.txt. Once you have installed coccinelle, there is a script 'spatch' in /usr/bin or /usr/local/bin that invokes the Coccinelle program. If you want to run Coccinelle without installing it, you can run the Coccinelle program directly from the download/build directory. You may then have to setup a few environment variables so that the Coccinelle program knows where to find its configuration files. For bash do: $ source env.sh For tcsh do: $ source env.csh You can test coccinelle with: $ spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c If you haven't installed coccinelle, run then ./spatch or ./spatch.opt If you downloaded the bytecode version of spatch you may first have to install OCaml (which contains the 'ocamlrun' bytecode interpreter, the equivalent of 'java', the Java virtual machine, but for OCaml) and then do: $ ocamlrun spatch -sp_file demos/simple.cocci demos/simple.c -o /tmp/new_simple.c For more information on Coccinelle, type 'make docs' and have a look at the files in the docs/ directory. You may need to install the texlive-fonts-extra packages from your distribution to compile some of the LaTeX documentation files. ** Runtime dependencies under Debian/Ubuntu** - For the OCaml scripting feature in SmPL ocaml-native-compilers or ocaml-nox --------------------------------------------------------------------------- Contributing: Contributions are welcome. Please sign your contributions, according to the following text extracted from Documentation/SubmittingPatches.txt of the Linux kernel: The sign-off is a simple line at the end of the explanation for the patch, which certifies that you wrote it or otherwise have the right to pass it on as an open-source patch. The rules are pretty simple: if you can certify the below: Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. then you just add a line saying Signed-off-by: Random J Developer using your real name (sorry, no pseudonyms or anonymous contributions.) coccinelle-1.0.0-rc19/Makefile.release0000644000175000017500000002645312247437436016461 0ustar eugeneugen ############################################################################## # Release rules to generate website archives ############################################################################## PACKAGE=$(PRJNAME)-$(VERSION) CCPACKAGE=coccicheck-$(CCVERSION) EXCLUDE=$(PACKAGE)/debian .depend DOC=docs/manual/manual.pdf \ docs/manual/options.pdf \ docs/manual/main_grammar.pdf \ docs/html \ docs/man \ docs/spatch.1 \ docs/manual/cocci-python.txt BINSRC=spatch* env.sh env.csh standard.h standard.iso \ *.txt $(DOC) demos/* scripts/spatch* BINSRC-PY=$(BINSRC) $(PYLIB) python/coccilib/ EXCL=$(EXCLUDE:%=--exclude=%) BINSRC2=$(BINSRC:%=$(PACKAGE)/%) BINSRC2-PY=$(BINSRC-PY:%=$(PACKAGE)/%) # TMP should point to a folder that is private to the release # process. In addition, it should not be the direct parent of # the directory in which the release is performed, because it # creates temporary directories that in this case could have # a name clash with the current directory. ifndef TMP TMP=/var/tmp endif # should be defined by Makefile.config ifndef OCAMLVERSION OCAMLVERSION=$(shell ocaml -version |perl -p -e 's/.*version (.*)/$$1/;') endif # can be overriden in the environment ifndef GIT GIT=git endif # the release process rewrites the Makefile.config, so we need # to save important configure flags. remember_ocamlbuild:=$(FEATURE_OCAMLBUILD) ifeq ($(remember_ocamlbuild),yes) extra_configure_flags := --enable-ocamlbuild else extra_configure_flags := endif # Procedure to do first time: # cd ~/release # git clone ... coccinelle # cd coccinelle # # Procedure to do each time: # # 1) make prerelease # WARN: These will clean your local rep. of pending modifications # # UPDATE VERSION number in ./version # and commit it with # # 2) make release # # The project is then automatically licensified. # # 3) make package # # if WEBSITE is set properly, you can also run 'make website' # Check that run an ocaml in /usr/bin # The 'git rebase' is in there just in case you started with # unpushed changes. However, that is probably something you should # not do in the first place. release-help: @echo "To make a release, perform the following steps:" @echo "" @echo "1. Make sure that all changes are committed and pushed." @echo " (making a release will destroy any uncommitted changes)" @echo " Preferably, start from a fresh clone of the coccinelle repo." @echo "2. Run 'make prerelease'. It will generate some files that are not" @echo " in the repository but part of the release tarballs." @echo "3. Edit ./version. It must be a new version." @echo "4. Run 'make release'. It makes changes to the git repository that" @echo " are not idempotent. Running this step again is likely to result" @echo " in some git errors. These are not dramatic and are therefore" @echo " ignored." @echo "5. Run 'make package'. It will build many tarballs." @echo "6. Run 'make website'. Make sure that $(WEBBASE) exists beforehand." @echo " Hint: run step 5 and 6 directly after each other. The tarballs" @echo " are stored temporarily in $(TMP)." @echo "7. Updated some webpages and commit them to svn." prerelease: @echo "pulling changes from the repository" $(GIT) pull --rebase $(MAKE) fix-expected $(MAKE) distclean KEEP_CONFIG=1 @echo "\n\tEdit ./version" @echo "\n\tRun autoreconf" @echo "\tCommit with 'make release'\n" @echo "\t* set the GIT env variable to 'echo' to skip performing any git commands" @echo "\t* changes to files other than ./version will not be committed automatically." fix-expected: @echo "going to generate: tests/SCORE_expected_orig.sexp" $(MAKE) distclean ./configure --enable-release --disable-python $(extra_configure_flags) $(MAKE) opt-only yes | ./spatch.opt -testall --iso-file ./standard.iso --macro-file-builtins ./standard.h cp tests/SCORE_actual.sexp tests/SCORE_expected_orig.sexp @echo "generated: test/SCORE_expected_orig.sexp" release: @echo "Marking version: $(VERSION)" echo -n "$(VERSION)" > ./version $(GIT) add ./version $(GIT) add ./configure $(GIT) add setup/Makefile.in -$(GIT) commit -m "Release $(VERSION)" -$(GIT) tag -a -m "Release $(VERSION)" $(VERSION) $(GIT) push --mirror $(MAKE) licensify @echo "\n\tLicensify has run: do not commit any files from now on!" @echo "\n\tRun 'make package'\n" package: $(MAKE) package-src $(MAKE) package-nopython $(MAKE) package-python @echo "\tPut online with 'make website'" @echo "\tThe coccinelle SVN repository must be in $(WEBBASE)\n" package-src: ./configure --enable-release --disable-python --disable-pcre-syntax $(extra_configure_flags) $(MAKE) srctar $(MAKE) coccicheck # Reconfigures the project without Python support # Note: we disable pcre syntax as well to eliminate the dependency # on those libraries. package-nopython: $(MAKE) distclean ./configure --enable-release --disable-python --disable-pcre-syntax --disable-menhirLib --disable-pycaml $(extra_configure_flags) $(MAKE) bintar $(MAKE) bytecodetar # Reconfigure project with Python support # Note: we disable pcre syntax as well to eliminate the dependency # on those libraries. package-python: $(MAKE) distclean ./configure --enable-release --enable-python --disable-pcre-syntax --disable-menhirLib --disable-pycaml $(extra_configure_flags) $(MAKE) bintar-python $(MAKE) bytecodetar-python # I currently pre-generate the parser so the user does not have to # install menhir on his machine. We could also do a few cleanups. # You may have first to do a 'make licensify'. # # update: make docs generates pdf but also some ugly .log files, so # make clean is there to remove them while not removing the pdf # (only distclean remove the pdfs). srctar: Makefile.config $(MAKE) docs $(MAKE) -C parsing_cocci parser_cocci_menhir.ml $(MAKE) -C parsing_cocci parser_cocci_menhir.mli $(MAKE) distclean KEEP_GENERATED=1 KEEP_CONFIG=1 if test -f "$(TMP)/$(PACKAGE)/"; then rm -f "$(TMP)/$(PACKAGE)/"; fi # remove it if it is a symlink $(MKDIR_P) "$(TMP)/$(PACKAGE)/" cp -rfa ./* "$(TMP)/$(PACKAGE)/" rm -f $(TMP)/$(PACKAGE)/Makefile.config cd $(TMP); tar cvfz $(PACKAGE).tgz --exclude-vcs $(EXCL) $(PACKAGE) rm -rf $(TMP)/$(PACKAGE) bintar: all-dev $(MAKE) docs rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) @if test -n "${PATCHELF}" -a -f spatch; then \ $(PATCHELF) --set-interpreter "/lib/ld-linux.so.2" --set-rpath "" spatch; fi @if test -n "${PATCHELF}" -a -f spatch.opt; then \ $(PATCHELF) --set-interpreter "/lib/ld-linux.so.2" --set-rpath "" spatch.opt; fi cd $(TMP); tar cvfz $(PACKAGE)-bin-x86.tgz --exclude-vcs $(BINSRC2) rm -f $(TMP)/$(PACKAGE) staticbintar: all-release $(MAKE) docs rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) $(MAKE) static cd $(TMP); tar cvfz $(PACKAGE)-bin-x86-static.tgz --exclude-vcs $(BINSRC2) rm -f $(TMP)/$(PACKAGE) bytecodetar: all-dev $(MAKE) docs rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) $(MAKE) purebytecode $(MAKE) copy-stubs @if test -n "${PATCHELF}" -a -f dllpycaml_stubs.so; then \ $(PATCHELF) --set-rpath "" dllpycaml_stubs.so; fi @if test -n "${PATHCELF}" -a -f dllpcre_stubs.so; then \ $(PATCHELF) --set-rpath "" dllpcre_stubs.so; fi cd $(TMP); tar cvfz $(PACKAGE)-bin-bytecode-$(OCAMLVERSION).tgz --exclude-vcs $(BINSRC2) $$(find -L $(PACKAGE) -maxdepth 1 -name 'dll*.so') rm -f $(TMP)/$(PACKAGE) rm -f dllpycaml_stubs.so dllpcre_stubs.so bintar-python: all $(MAKE) docs @if test -n "${PATCHELF}" -a -f spatch; then \ $(PATCHELF) --set-interpreter "/lib/ld-linux.so.2" --set-rpath "" spatch; fi @if test -n "${PATCHELF}" -a -f spatch.opt; then \ $(PATCHELF) --set-interpreter "/lib/ld-linux.so.2" --set-rpath "" spatch.opt; fi rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) cd $(TMP); tar cvfz $(PACKAGE)-bin-x86-python.tgz --exclude-vcs $(BINSRC2-PY) rm -f $(TMP)/$(PACKAGE) bytecodetar-python: all-dev $(MAKE) docs rm -f $(TMP)/$(PACKAGE) ln -s `pwd` $(TMP)/$(PACKAGE) $(MAKE) purebytecode $(MAKE) copy-stubs @if test -n "${PATCHELF}" -a -f dllpycaml_stubs.so; then \ $(PATCHELF) --set-rpath "" dllpycaml_stubs.so; fi @if test -n "${PATHCELF}" -a -f dllpcre_stubs.so; then \ $(PATCHELF) --set-rpath "" dllpcre_stubs.so; fi cd $(TMP); tar cvfz $(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz --exclude-vcs $(BINSRC2-PY) $$(find -L $(PACKAGE) -maxdepth 1 -name 'dll*.so') rm -f $(TMP)/$(PACKAGE) rm -f dllpycaml_stubs.so dllpcre_stubs.so coccicheck: cp -a ./scripts/coccicheck $(TMP)/$(CCPACKAGE) tar cvfz $(TMP)/$(CCPACKAGE).tgz -C $(TMP) --exclude-vcs $(CCPACKAGE) rm -rf $(TMP)/$(CCPACKAGE) clean-packages:: rm -f $(TMP)/$(PACKAGE).tgz rm -f $(TMP)/$(PACKAGE)-bin-x86.tgz rm -f $(TMP)/$(PACKAGE)-bin-bytecode-$(OCAMLVERSION).tgz rm -f $(TMP)/$(PACKAGE)-bin-x86-python.tgz rm -f $(TMP)/$(PACKAGE)-bin-bytecode-$(OCAMLVERSION)-python.tgz rm -f $(TMP)/$(CCPACKAGE).tgz # # No need to licensify 'demos'. Because these are basic building blocks # to use SmPL. # TOLICENSIFY=ctl engine globals parsing_cocci popl popl09 python scripts tools licensify: ocaml str.cma tools/licensify.ml set -e; for i in $(TOLICENSIFY); do cd $$i; ocaml str.cma ../tools/licensify.ml; cd ..; done # When checking out the source from diku sometimes I have some "X in the future" # error messages. fixdates: echo do 'touch **/*.*' ocamlversion: @echo $(OCAMLVERSION) ############################################################################## # Packaging rules -- To build deb packages ############################################################################## # # Run 'make packsrc' to build a Deb source package # # The package is prepared in $(TMP), usually /tmp # Once the package has been build, it is uploaded # to a PPA on launchpad. # # You should have a "coccinelle" project configured # for dput in your ~/.dput.cf file. # # The 'packbin' target is to build a deb package # locally. It is only for testing purpose. # EXCL_SYNC=--exclude ".git" \ --exclude ".gitignore" \ --exclude ".cvsignore" \ --exclude ".svn" \ --exclude "tests" \ --exclude "TODO" \ --cvs-exclude packsrc: prepack $(MAKE) -C $(TMP)/$(PACKAGE)/debian lucid $(MAKE) -C $(TMP)/$(PACKAGE)/debian karmic $(MAKE) -C $(TMP)/$(PACKAGE)/debian maverick $(MAKE) -C $(TMP)/$(PACKAGE)/debian natty $(MAKE) -C $(TMP)/$(PACKAGE)/debian oneiric $(MAKE) push rm -rf $(TMP)/$(PACKAGE)/ packbin: prepack $(MAKE) -C $(TMP)/$(PACKAGE)/debian binary rm -rf $(TMP)/$(PACKAGE)/ rm -rf $(TMP)/$(PACKAGE)_$(VERSION)*_source.build prepack: rsync -a $(EXCL_SYNC) . $(TMP)/$(PACKAGE) $(MAKE) -C $(TMP)/$(PACKAGE) licensify sed -i "s|^OCAMLCFLAGS=.*$$|OCAMLCFLAGS=|" $(TMP)/$(PACKAGE)/Makefile rm -rf $(TMP)/$(PACKAGE)/tools push: cd $(TMP)/ && for p in `ls $(PRJNAME)_$(VERSION)*_source.changes`; do dput $(PRJNAME) $$p ; done rm -rf $(TMP)/$(PRJNAME)_$(VERSION)*_source.changes rm -rf $(TMP)/$(PRJNAME)_$(VERSION)*_source.$(PRJNAME).upload rm -rf $(TMP)/$(PRJNAME)_$(VERSION)*.dsc rm -rf $(TMP)/$(PRJNAME)_$(VERSION)*.tar.gz # Produces a source tarball # Note: start from a fresh working directory # Note: configure first dist: $(MAKE) licensify $(MAKE) docs $(MAKE) -C parsing_cocci parser_cocci_menhir.ml $(MAKE) distclean KEEP_CONFIG=1 KEEP_GENERATED=1 tar cvfz $(PACKAGE).tar.gz --transform="s,^,$(PACKAGE)/,S" --exclude=$(PACKAGE).tar.gz --exclude-backups --exclude-vcs * coccinelle-1.0.0-rc19/popl/0000755000175000017500000000000012247437436014342 5ustar eugeneugencoccinelle-1.0.0-rc19/popl/asttopopl.mli0000644000175000017500000000224612247442616017072 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttopopl.mli" val top : Ast_cocci.top_level -> Ast_popl.sequence coccinelle-1.0.0-rc19/popl/insert_befaft.ml0000644000175000017500000001013512247442616017503 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_befaft.ml" module Past = Ast_popl (* --------------------------------------------------------------------- *) let rec get_before a = function Past.Seq(elem,seq) -> let (elem,ea) = get_before_element a elem in let (seq,sla) = get_before ea seq in (Past.Seq(elem,seq),sla) | Past.Empty -> (Past.Empty,a) | Past.SExists(var,seq) -> failwith "not possible" and get_before_element a = function Past.Term(term) as s -> (s,[s]) | Past.Or(seq1,seq2) -> let (seq1,seq1a) = get_before a seq1 in let (seq2,seq2a) = get_before a seq2 in (Past.Or(seq1,seq2),Common.union_set seq1a seq2a) | Past.DInfo(dots,_,seq_aft) -> let dots = get_before_dots a dots in (Past.DInfo(dots,a,seq_aft),a) | Past.EExists(var,seq) -> failwith "not possible" and get_before_dots a = function Past.Dots -> Past.Dots | Past.Nest(seq) -> let (seq,_) = get_before a seq in Past.Nest(seq) | Past.When(dots,seq) -> let dots = get_before_dots a dots in let (seq,_) = get_before [] seq in Past.When(dots,seq) | Past.DExists(var,dots) -> failwith "not possible" (* --------------------------------------------------------------------- *) let rec get_after a = function Past.Seq(elem,seq) -> let (seq,sla) = get_after a seq in let (elem,ea) = get_after_element sla elem in (Past.Seq(elem,seq),ea) | Past.Empty -> (Past.Empty,a) | Past.SExists(var,seq) -> failwith "not possible" and get_after_element a = function Past.Term(term) as s -> (s,[s]) | Past.Or(seq1,seq2) -> let (seq1,seq1a) = get_after a seq1 in let (seq2,seq2a) = get_after a seq2 in (Past.Or(seq1,seq2),Common.union_set seq1a seq2a) | Past.DInfo(dots,seq_bef,_) -> let dots = get_after_dots a dots in (Past.DInfo(dots,seq_bef,a),a) | Past.EExists(var,seq) -> failwith "not possible" and get_after_dots a = function Past.Dots -> Past.Dots | Past.Nest(seq) -> let (seq,_) = get_after (Common.union_set (get_first [] seq) a) seq in Past.Nest(seq) | Past.When(dots,seq) -> let dots = get_after_dots a dots in let (seq,_) = get_after [] seq in Past.When(dots,seq) | Past.DExists(var,dots) -> failwith "not possible" (* --------------------------------------------------------------------- *) (* like get_after, but just returns the a component; doesn't modify the term *) and get_first a = function Past.Seq(elem,seq) -> let sla = get_first a seq in let ea = get_first_element sla elem in ea | Past.Empty -> a | Past.SExists(var,seq) -> failwith "not possible" and get_first_element a = function Past.Term(term) as s -> [s] | Past.Or(seq1,seq2) -> Common.union_set (get_first a seq1) (get_first a seq2) | Past.DInfo(dots,_,_) -> a | Past.EExists(var,seq) -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Entry point *) let insert_befaft sl = let (sl,_) = get_before [] sl in let (sl,_) = get_after [] sl in sl coccinelle-1.0.0-rc19/popl/insert_quantifiers.ml0000644000175000017500000000736312247442616020617 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_quantifiers.ml" module Ast = Ast_cocci module Past = Ast_popl (* --------------------------------------------------------------------- *) let rec fvs_sequence = function Past.Seq(elem,seq) -> Common.union_set (fvs_element elem) (fvs_sequence seq) | Past.Empty -> [] | Past.SExists(var,seq) -> failwith "not possible" and fvs_element = function Past.Term(term) -> Ast.get_fvs term | Past.Or(seq1,seq2) -> Common.union_set (fvs_sequence seq1) (fvs_sequence seq2) | Past.DInfo(dots,seq_bef,seq_aft) -> List.fold_left (function prev -> function cur -> Common.union_set (fvs_element cur) prev) (fvs_dots dots) seq_bef | Past.EExists(var,seq) -> failwith "not possible" and fvs_dots = function Past.Dots -> [] | Past.Nest(seq) -> fvs_sequence seq | Past.When(dots,seq) -> Common.union_set (fvs_dots dots) (fvs_sequence seq) | Past.DExists(var,dots) -> failwith "not possible" (* --------------------------------------------------------------------- *) let rec quant_sequence bound = function Past.Seq(elem,seq) -> let fe = fvs_element elem in let fs = fvs_sequence seq in let inter = Common.inter_set fe fs in let free = Common.minus_set inter bound in let new_bound = free @ bound in List.fold_right (function cur -> function rest -> Past.SExists(cur,rest)) free (Past.Seq(quant_element new_bound elem, quant_sequence new_bound seq)) | Past.Empty -> Past.Empty | Past.SExists(var,seq) -> failwith "not possible" and quant_element bound = function Past.Term(term) as x -> let free = Common.minus_set (fvs_element x) bound in List.fold_right (function cur -> function rest -> Past.EExists(cur,rest)) free x | Past.Or(seq1,seq2) -> Past.Or(quant_sequence bound seq1,quant_sequence bound seq2) | Past.DInfo(dots,seq_bef,seq_aft) -> Past.DInfo(quant_dots bound dots,seq_bef, List.map (quant_element bound) seq_aft) | Past.EExists(var,seq) -> failwith "not possible" and quant_dots bound = function Past.Dots -> Past.Dots | Past.Nest(seq) -> Past.Nest(quant_sequence bound seq) | Past.When(dots,seq) -> let fd = fvs_dots dots in let fs = fvs_sequence seq in let inter = Common.inter_set fd fs in let free = Common.minus_set inter bound in let new_bound = free @ bound in List.fold_right (function cur -> function rest -> Past.DExists(cur,rest)) free (Past.When(quant_dots new_bound dots, quant_sequence new_bound seq)) | Past.DExists(var,dots) -> failwith "not possible" (* --------------------------------------------------------------------- *) let insert_quantifiers x = quant_sequence [] x coccinelle-1.0.0-rc19/popl/insert_quantifiers.mli0000644000175000017500000000227412247442616020764 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_quantifiers.mli" val insert_quantifiers : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.0-rc19/popl/insert_befaft.mli0000644000175000017500000000226212247442616017656 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_befaft.mli" val insert_befaft : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.0-rc19/popl/popltoctl.ml0000644000175000017500000001604012247442616016711 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popltoctl.ml" module Past = Ast_popl module Ast = Ast_cocci module V = Visitor_ast module CTL = Ast_ctl (* --------------------------------------------------------------------- *) (* result type *) type cocci_predicate = Lib_engine.predicate * Ast.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl (* --------------------------------------------------------------------- *) let contains_modif = let bind x y = x or y in let option_default = false in let mcode r (_,_,kind,_) = match kind with Ast.MINUS(_,_) -> true | Ast.PLUS -> failwith "not possible" | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem let ctl_exists v x keep_wit = CTL.Exists(v,x,keep_wit) let predmaker guard term = let pos = ("","_p") in ctl_exists true pos (if guard && contains_modif term then let v = ("","_v") in ctl_exists true v (CTL.Pred (Lib_engine.Match(term),CTL.Modif v)) else CTL.Pred (Lib_engine.Match(term),CTL.Control)) (* --------------------------------------------------------------------- *) let is_true = function CTL.True -> true | _ -> false let is_false = function CTL.False -> true | _ -> false let ctl_true = CTL.True let ctl_false = CTL.False let ctl_and x y = if is_true x then y else if is_true y then x else CTL.And(CTL.STRICT,x,y) let ctl_or x y = if is_false x then y else if is_false y then x else CTL.Or(x,y) let ctl_seqor x y = CTL.SeqOr(x,y) let ctl_not x = CTL.Not(x) let ctl_ax x = if is_true x then CTL.True else CTL.AX(CTL.FORWARD,CTL.STRICT,x) let after = CTL.Pred(Lib_engine.After, CTL.Control) let exit = CTL.Pred(Lib_engine.Exit, CTL.Control) let truepred = CTL.Pred(Lib_engine.TrueBranch, CTL.Control) let retpred = CTL.Pred(Lib_engine.Return, CTL.Control) let string2var x = ("",x) let labelctr = ref 0 let get_label_ctr _ = let cur = !labelctr in labelctr := cur + 1; string2var (Printf.sprintf "l%d" cur) let ctl_au x seq_after y = let lv = get_label_ctr() in let labelpred = CTL.Pred(Lib_engine.Label lv,CTL.Control) in let preflabelpred = CTL.Pred(Lib_engine.PrefixLabel lv,CTL.Control) in let matchgoto = CTL.Pred(Lib_engine.Goto,CTL.Control) in let matchbreak = predmaker false (Ast.make_term (Ast.Break(Ast.make_mcode "break",Ast.make_mcode ";"))) in let matchcontinue = predmaker false (Ast.make_term (Ast.Continue(Ast.make_mcode "continue",Ast.make_mcode ";"))) in let stop_early = ctl_or after (ctl_and (ctl_and truepred labelpred) (CTL.AU (CTL.FORWARD,CTL.STRICT,preflabelpred, ctl_and preflabelpred (ctl_or retpred (ctl_and (ctl_or (ctl_or matchgoto matchbreak) matchcontinue) (CTL.AG (CTL.FORWARD,CTL.STRICT, ctl_not seq_after))))))) in CTL.AU(CTL.FORWARD,CTL.STRICT,x,ctl_or y stop_early) let ctl_uncheck x = CTL.Uncheck(x) (* --------------------------------------------------------------------- *) let rec ctl_seq keep_wit a = function Past.Seq(elem,seq) -> ctl_element keep_wit (ctl_seq keep_wit a seq) elem | Past.Empty -> a | Past.SExists(var,seq) -> ctl_exists keep_wit var (ctl_seq keep_wit a seq) and ctl_element keep_wit a = function Past.Term(term) -> ctl_and (predmaker keep_wit term) (ctl_ax a) | Past.Or(seq1,seq2) -> ctl_seqor (ctl_seq keep_wit a seq1) (ctl_seq keep_wit a seq2) | Past.DInfo(dots,seq_bef,seq_aft) -> let shortest l = List.fold_left ctl_or ctl_false (List.map (ctl_element false ctl_true) l) in let s = shortest (Common.union_set seq_bef seq_aft) in ctl_au (ctl_and (guard_ctl_dots keep_wit dots) (ctl_not s)) (shortest seq_aft) a | Past.EExists(var,elem) -> ctl_exists keep_wit var (ctl_element keep_wit a elem) (* --------------------------------------------------------------------- *) and guard_ctl_seq keep_wit = function Past.Seq(elem,Past.Empty) -> guard_ctl_element keep_wit elem | Past.Seq(elem,seq) -> ctl_element keep_wit (guard_ctl_seq keep_wit seq) elem | Past.Empty -> ctl_true | Past.SExists(var,seq) -> ctl_exists keep_wit var (guard_ctl_seq keep_wit seq) and guard_ctl_element keep_wit = function Past.Term(term) -> predmaker keep_wit term | Past.Or(seq1,seq2) -> ctl_seqor (guard_ctl_seq keep_wit seq1) (guard_ctl_seq keep_wit seq2) | Past.DInfo(dots,seq_bef,seq_aft) -> let shortest l = List.fold_left ctl_or ctl_false (List.map (ctl_element false ctl_true) l) in let s = shortest (Common.union_set seq_bef seq_aft) in let aft = ctl_or s exit in ctl_au (ctl_and (guard_ctl_dots keep_wit dots) (ctl_not s)) (shortest seq_aft) aft | Past.EExists(var,elem) -> ctl_exists keep_wit var (guard_ctl_element keep_wit elem) and guard_ctl_dots keep_wit = function Past.Dots -> ctl_true | Past.Nest(_) when not keep_wit -> ctl_true | Past.Nest(seq) -> ctl_or (guard_ctl_seq true seq) (ctl_not (guard_ctl_seq false seq)) | Past.When(dots,seq) -> ctl_and (guard_ctl_dots keep_wit dots) (ctl_not (ctl_seq false ctl_true seq)) | Past.DExists(var,dots) -> ctl_exists keep_wit var (guard_ctl_dots keep_wit dots) (* --------------------------------------------------------------------- *) let toctl sl = Asttoctl2.CODE (ctl_seq true ctl_true sl) coccinelle-1.0.0-rc19/popl/asttopopl.ml0000644000175000017500000000564412247442616016726 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttopopl.ml" module Ast = Ast_cocci module Past = Ast_popl (* --------------------------------------------------------------------- *) let rec stm s = match Ast.unwrap s with Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.ExprStatement(_,_) -> Past.Term ast | Ast.Exp(_) -> Past.Term ast | Ast.Decl(_,_,_) -> Past.Term ast | _ -> failwith "complex statements not supported") | Ast.Disj(stm1::stm2::stmts) -> List.fold_left (function prev -> function cur -> Past.Or(Past.Seq(prev,Past.Empty),stm_list cur)) (Past.Or(stm_list stm1,stm_list stm2)) stmts | Ast.Dots(dots,whencodes,_,_) -> (match whencodes with [Ast.WhenNot(a)] -> Past.DInfo(Past.When(Past.Dots,stm_list a),[],[]) | _ -> failwith "only one when != supported") | Ast.Nest(stmt_dots,whencodes,false,_,_) -> let nest = Past.Nest(stm_list stmt_dots) in (match whencodes with [Ast.WhenNot(a)] -> Past.DInfo(Past.When(nest,stm_list a),[],[]) | _ -> failwith "only when != supported") | Ast.While(header,body,(_,_,_,aft)) | Ast.For(header,body,(_,_,_,aft)) -> (* only allowed if only the header is significant *) (match (Ast.unwrap body,aft) with (Ast.Atomic(re),Ast.CONTEXT(_,Ast.NOTHING)) -> (match Ast.unwrap re with Ast.MetaStmt(_,Type_cocci.Unitary,_,false) -> Past.Term header | _ -> failwith "unsupported statement1") | _ -> failwith "unsupported statement2") | _ -> Pretty_print_cocci.statement "" s; failwith "unsupported statement3" and stm_list s = match Ast.unwrap s with Ast.DOTS(d) -> List.fold_right (function cur -> function rest -> Past.Seq(stm cur, rest)) d Past.Empty | _ -> failwith "only DOTS handled" let top s = match Ast.unwrap s with Ast.CODE(stmt_dots) -> stm_list stmt_dots | _ -> failwith "only CODE handled" coccinelle-1.0.0-rc19/popl/pretty_print_popl.mli0000644000175000017500000000232612247442616020641 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_popl.mli" val pretty_print : Ast_popl.sequence -> unit val pretty_print_e : Ast_popl.element -> unit coccinelle-1.0.0-rc19/popl/pretty_print_popl.ml0000644000175000017500000000562212247442616020472 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_popl.ml" open Format module Past = Ast_popl let start_block str = force_newline(); print_string " "; open_box 0 let end_block str = close_box(); force_newline () (* --------------------------------------------------------------------- *) let rec print_sequence = function Past.Seq(e,seq) -> print_element e; force_newline(); print_sequence seq | Past.Empty -> () | Past.SExists((_,v),seq) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_sequence seq and print_element = function Past.Term(term) -> Pretty_print_cocci.rule_elem "" term | Past.Or(seq1,seq2) -> force_newline(); print_string "("; force_newline(); print_sequence seq1; print_string "|"; force_newline(); print_sequence seq2; print_string ")" | Past.DInfo(dots,bef,aft) -> start_block(); List.iter (function b -> print_string ">>>"; print_element b; force_newline()) bef; print_dots dots; List.iter (function b -> force_newline(); print_string "<<<"; print_element b) aft; end_block() | Past.EExists((_,v),elem) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_element elem and print_dots = function Past.Dots -> print_string "..." | Past.Nest(seq)-> print_string "<..."; start_block(); print_sequence seq; end_block(); print_string "...>" | Past.When(dots,seq) -> print_dots dots; print_string " when != "; open_box 0; print_sequence seq; close_box() | Past.DExists((_,v),dots) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_dots dots (* --------------------------------------------------------------------- *) let pretty_print_e e = print_element e; print_newline() let pretty_print sl = print_sequence sl; print_newline() coccinelle-1.0.0-rc19/popl/ast_popl.ml0000644000175000017500000000301212247442616016505 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast_popl.ml" type sequence = Seq of element * sequence | Empty | SExists of Ast_cocci.meta_name * sequence and element = Term of Ast_cocci.rule_elem | Or of sequence * sequence | DInfo of dots * element list (* before *) * element list (* after *) | EExists of Ast_cocci.meta_name * element and dots = Dots | Nest of sequence | When of dots * sequence | DExists of Ast_cocci.meta_name * dots coccinelle-1.0.0-rc19/popl/popl.mli0000644000175000017500000000252612247442616016020 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popl.mli" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl val popl : Ast_cocci.rule -> Asttoctl2.top_formula list coccinelle-1.0.0-rc19/popl/popl.ml0000644000175000017500000000320512247442616015642 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popl.ml" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl let poplz (name,_,ast) = match ast with [ast] -> let ast = Asttopopl.top ast in let ba = Insert_befaft.insert_befaft ast in let qt = Insert_quantifiers.insert_quantifiers ba in [Popltoctl.toctl qt] | _ -> failwith "only one rule allowed" let popl r = match r with Ast_cocci.CocciRule (a,b,c) -> poplz (a,b,c) | _ -> [] coccinelle-1.0.0-rc19/popl/Makefile0000644000175000017500000000543712247442616016007 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #note: if you add a file (a .mli or .ml), dont forget to do a make depend ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET = popl OCAMLCFLAGS ?= -g OPTFLAGS ?= -g SRC = ast_popl.ml asttopopl.ml insert_quantifiers.ml insert_befaft.ml \ pretty_print_popl.ml popltoctl.ml popl.ml flag_popl.ml SYSLIBS=str.cma unix.cma LIBS=../commons/commons.cma ../globals/globals.cma INCLUDE_PATH = -I ../commons -I ../globals \ -I ../ctl -I ../parsing_c -I ../parsing_cocci -I ../engine #The Caml compilers. #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) OCAMLDEP_CMD=$(OCAMLDEP) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) all: $(LIB) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes $(TARGET).top: $(LIB) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) $(LIB): $(OBJS) $(OCAMLC_CMD) -a -o $(LIB) $(OBJS) clean:: rm -f $(LIB) $(TARGET).top $(OPTLIB): $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $(OPTLIB) $(OPTOBJS) # clean rule for LIB.opt clean:: rm -f $(OPTLIB) $(LIB:.cma=.a) .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) $(INCLUDE_PATH) -c $< .mli.cmi: $(OCAMLC_CMD) $(INCLUDE_PATH) -c $< .ml.cmx: $(OCAMLOPT_CMD) $(INCLUDE_PATH) -c $< # clean rule for others files clean:: rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ #*# rm -f .depend distclean: clean .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) $(INCLUDE_PATH) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/popl/popltoctl.mli0000644000175000017500000000253212247442616017063 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popltoctl.mli" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl val toctl : Ast_popl.sequence -> Asttoctl2.top_formula coccinelle-1.0.0-rc19/popl09/0000755000175000017500000000000012247442646014512 5ustar eugeneugencoccinelle-1.0.0-rc19/popl09/asttopopl.mli0000644000175000017500000000224612247442616017243 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttopopl.mli" val top : Ast_cocci.top_level -> Ast_popl.sequence coccinelle-1.0.0-rc19/popl09/insert_quantifiers.ml0000644000175000017500000001055412247442616020764 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_quantifiers.ml" module Ast = Ast_cocci module Past = Ast_popl (* --------------------------------------------------------------------- *) let rec fvs_sequence = function Past.Seq(elem,seq) -> Common.union_set (fvs_element elem) (fvs_sequence seq) | Past.Empty -> [] | Past.SExists(var,seq) -> failwith "not possible" and fvs_term = function Past.Atomic(term) -> Ast.get_fvs term | Past.IfThen(test,thn,(afvs,_,_,_)) -> Common.union_set afvs (Common.union_set (fvs_term test) (fvs_term thn)) | Past.TExists(var,term) -> failwith "not possible" and fvs_element = function Past.Term(term,_) -> fvs_term term | Past.Or(seq1,seq2) -> Common.union_set (fvs_sequence seq1) (fvs_sequence seq2) | Past.DInfo(dots) -> fvs_dots dots | Past.EExists(var,seq) -> failwith "not possible" and fvs_dots = function Past.Dots -> [] | Past.Nest(seq) -> fvs_sequence seq | Past.When(dots,seq) -> Common.union_set (fvs_dots dots) (fvs_sequence seq) (* --------------------------------------------------------------------- *) let inter_set l1 l2 = List.filter (function l1e -> List.mem l1e l2) l1 let minus_set l1 l2 = List.filter (function l1e -> not (List.mem l1e l2)) l1 let rec quant_sequence bound = function Past.Seq(elem,seq) -> let fe = fvs_element elem in let fs = fvs_sequence seq in let inter = inter_set fe fs in let free = minus_set inter bound in let new_bound = free @ bound in List.fold_right (function cur -> function rest -> Past.SExists(cur,rest)) free (Past.Seq(quant_element new_bound elem, quant_sequence new_bound seq)) | Past.Empty -> Past.Empty | Past.SExists(var,seq) -> failwith "not possible" and quant_term bound = function (Past.Atomic(term)) as x -> let free = minus_set (Ast.get_fvs term) bound in List.fold_right (function cur -> function rest -> Past.TExists(cur,rest)) free x | Past.IfThen(test,thn,((afvs,_,_,_) as aft)) -> let fts = fvs_term test in let fth = fvs_term thn in let inter = inter_set fts fth in let free = minus_set inter bound in let new_bound = free @ bound in List.fold_right (function cur -> function rest -> Past.TExists(cur,rest)) free (Past.IfThen(quant_term new_bound test, quant_term new_bound thn, aft)) | Past.TExists(var,term) -> failwith "not possible" and quant_element bound = function Past.Term(term,ba) -> Past.Term(quant_term bound term,dots_bef_aft bound ba) | Past.Or(seq1,seq2) -> Past.Or(quant_sequence bound seq1,quant_sequence bound seq2) | Past.DInfo(dots) -> Past.DInfo(quant_dots bound dots) | Past.EExists(var,seq) -> failwith "not possible" and dots_bef_aft bound = function Past.AddingBetweenDots (brace_term,n) -> Past.AddingBetweenDots (quant_term bound brace_term,n) | Past.DroppingBetweenDots (brace_term,n) -> Past.DroppingBetweenDots (quant_term bound brace_term,n) | Past.NoDots -> Past.NoDots and quant_dots bound = function Past.Dots -> Past.Dots | Past.Nest(seq) -> Past.Nest(quant_sequence bound seq) | Past.When(dots,seq) -> Past.When(quant_dots bound dots, quant_sequence bound seq) (* --------------------------------------------------------------------- *) let insert_quantifiers x = quant_sequence [] x coccinelle-1.0.0-rc19/popl09/insert_quantifiers.mli0000644000175000017500000000227412247442616021135 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_quantifiers.mli" val insert_quantifiers : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.0-rc19/popl09/popl09.mldylib0000644000175000017500000000012112247437436017206 0ustar eugeneugenAst_popl Asttopopl Insert_quantifiers Pretty_print_popl Flag_popl Popltoctl Popl coccinelle-1.0.0-rc19/popl09/popltoctl.ml0000644000175000017500000002016612247442616017066 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popltoctl.ml" module Past = Ast_popl module Ast = Ast_cocci module V = Visitor_ast module CTL = Ast_ctl (* --------------------------------------------------------------------- *) (* result type *) type cocci_predicate = Lib_engine.predicate * Ast.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl (* --------------------------------------------------------------------- *) let contains_modif = let bind x y = x or y in let option_default = false in let mcode r (_,_,kind,_) = match kind with Ast.MINUS(_,_,_,_) -> true | Ast.PLUS _ -> failwith "not possible" | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_rule_elem let ctl_exists keep_wit v x = CTL.Exists(!Flag_popl.keep_all_wits or keep_wit,v,x) let predmaker keep_wit term = if (!Flag_popl.keep_all_wits or keep_wit) && (!Flag_popl.mark_all or contains_modif term) then let v = ("","_v") in ctl_exists true v (CTL.Pred (Lib_engine.Match(term),CTL.Modif v)) else CTL.Pred (Lib_engine.Match(term),CTL.Control) (* --------------------------------------------------------------------- *) let is_true = function CTL.True -> true | _ -> false let is_false = function CTL.False -> true | _ -> false let ctl_true = CTL.True let ctl_false = CTL.False let ctl_and x y = if is_true x then y else if is_true y then x else CTL.And(CTL.STRICT,x,y) let ctl_or x y = if is_false x then y else if is_false y then x else CTL.Or(x,y) let ctl_seqor x y = CTL.SeqOr(x,y) let ctl_not x = CTL.Not(x) let ctl_ax x = if is_true x then CTL.True else CTL.AX(CTL.FORWARD,CTL.STRICT,x) let ctl_ex x = if is_true x then CTL.True else CTL.EX(CTL.FORWARD,x) let ctl_back_ex x = if is_true x then CTL.True else CTL.EX(CTL.BACKWARD,x) let after = CTL.Pred(Lib_engine.After, CTL.Control) let fall = CTL.Pred(Lib_engine.FallThrough, CTL.Control) let exit = CTL.Pred(Lib_engine.Exit, CTL.Control) let truepred = CTL.Pred(Lib_engine.TrueBranch, CTL.Control) let falsepred = CTL.Pred(Lib_engine.FalseBranch, CTL.Control) let retpred = CTL.Pred(Lib_engine.Return, CTL.Control) let string2var x = ("",x) let labelctr = ref 0 let get_label_ctr _ = let cur = !labelctr in labelctr := cur + 1; string2var (Printf.sprintf "l%d" cur) let ctl_au x y = CTL.AU(CTL.FORWARD,CTL.STRICT,x,y) let ctl_uncheck x = CTL.Uncheck(x) let make_meta_rule_elem d = let nm = "_S" in Ast.make_meta_rule_elem nm d ([],[],[]) (* --------------------------------------------------------------------- *) let rec ctl_seq keep_wit a = function Past.Seq(elem,seq) -> ctl_element keep_wit (ctl_seq keep_wit a seq) elem | Past.Empty -> a | Past.SExists(var,seq) -> ctl_exists keep_wit var (ctl_seq keep_wit a seq) and ctl_term keep_wit a = function Past.Atomic(term) -> ctl_and (predmaker keep_wit term) (ctl_ax a) | Past.IfThen(test,thn,(_,_,_,aft)) -> ifthen keep_wit (Some a) test thn aft | Past.TExists(var,term) -> ctl_exists keep_wit var (ctl_term keep_wit a term) and ctl_element keep_wit a = function Past.Term(term,ba) -> do_between_dots keep_wit ba (ctl_term keep_wit a term) a | Past.Or(seq1,seq2) -> ctl_seqor (ctl_seq keep_wit a seq1) (ctl_seq keep_wit a seq2) | Past.DInfo(dots) -> ctl_au (guard_ctl_dots keep_wit a dots) a | Past.EExists(var,elem) -> ctl_exists keep_wit var (ctl_element keep_wit a elem) (* --------------------------------------------------------------------- *) and guard_ctl_seq keep_wit a = function Past.Seq(elem,Past.Empty) -> guard_ctl_element keep_wit a elem | Past.Seq(elem,seq) -> ctl_element keep_wit (guard_ctl_seq keep_wit a seq) elem | Past.Empty -> ctl_true | Past.SExists(var,seq) -> ctl_exists keep_wit var (guard_ctl_seq keep_wit a seq) and guard_ctl_term keep_wit = function Past.Atomic(term) -> predmaker keep_wit term | Past.IfThen(test,thn,(_,_,_,aft)) -> ifthen keep_wit None test thn aft | Past.TExists(var,term) -> ctl_exists keep_wit var (guard_ctl_term keep_wit term) and guard_ctl_element keep_wit a = function Past.Term(term,_) -> guard_ctl_term keep_wit term | Past.Or(seq1,seq2) -> ctl_seqor (guard_ctl_seq keep_wit a seq1) (guard_ctl_seq keep_wit a seq2) | Past.DInfo(dots) -> ctl_au (guard_ctl_dots keep_wit a dots) a | Past.EExists(var,elem) -> ctl_exists keep_wit var (guard_ctl_element keep_wit a elem) and guard_ctl_dots keep_wit a = function Past.Dots -> ctl_true (* | Past.Nest(_) when not keep_wit -> ctl_true a possible optimization, but irrelevant to popl example *) | Past.Nest(seq) -> ctl_or (guard_ctl_seq true a seq) (ctl_not (guard_ctl_seq false a seq)) | Past.When(dots,seq) -> ctl_and (guard_ctl_dots keep_wit a dots) (ctl_not (guard_ctl_seq false a seq)) (* --------------------------------------------------------------------- *) and ifthen keep_wit a test thn aft = (* "if (test) thn; after" becomes: if(test) & AX((TrueBranch & AX thn) v FallThrough v (After & AXAX after)) & EX After (* doesn't work for C code if (x) return 1; else return 2; *) *) let end_code = match (aft,a) with (Ast.CONTEXT(_,Ast.NOTHING),None) -> ctl_true | (Ast.CONTEXT(_,Ast.NOTHING),Some a) -> ctl_ax (ctl_ax a) | (_,None) -> failwith "not possible" | (_,Some a) -> ctl_ax (ctl_and (predmaker keep_wit (make_meta_rule_elem aft)) (ctl_ax a)) in let body = ctl_or (ctl_and truepred (ctl_ax (guard_ctl_term keep_wit thn))) (ctl_or fall (ctl_and after end_code)) in ctl_and (ctl_term keep_wit body test) (match a with Some CTL.True | None -> ctl_true | Some _ -> ctl_ex after) and do_between_dots keep_wit ba term after = match ba with Past.AddingBetweenDots (brace_term,n) | Past.DroppingBetweenDots (brace_term,n) -> (* not sure at all what to do here for after... *) let match_brace = ctl_term keep_wit after brace_term in let v = Printf.sprintf "_r_%d" n in let case1 = ctl_and (CTL.Ref v) match_brace in let case2 = ctl_and (ctl_not (CTL.Ref v)) term in CTL.Let (v,ctl_or (ctl_back_ex truepred) (ctl_back_ex (ctl_back_ex falsepred)), ctl_or case1 case2) | Past.NoDots -> term (* --------------------------------------------------------------------- *) let toctl sl = Asttoctl2.CODE (ctl_seq true ctl_true sl) coccinelle-1.0.0-rc19/popl09/asttopopl.ml0000644000175000017500000000702412247442616017071 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./asttopopl.ml" module Ast = Ast_cocci module Past = Ast_popl (* --------------------------------------------------------------------- *) let term s inif = let fail _ = Pretty_print_cocci.statement "" s; Format.print_newline(); failwith "complex statements not supported" in match Ast.unwrap s with Ast.Atomic(ast) -> (match Ast.unwrap ast with Ast.ExprStatement(_,_) -> Past.Atomic ast | Ast.Exp(_) -> Past.Atomic ast | Ast.Decl(_,_,_) -> Past.Atomic ast | Ast.ReturnExpr(_,_,_) -> Past.Atomic ast | Ast.MetaStmt(_,_,_,_) when inif -> Past.Atomic ast | Ast.DisjRuleElem(_) -> Past.Atomic ast | _ -> fail()) | _ -> fail() let rec stm s = match Ast.unwrap s with Ast.Atomic(ast) -> Past.Term(term s false,dots_bef_aft s false) | Ast.IfThen(header,body,aft) -> Past.Term( Past.IfThen(Past.Atomic header,term body true,aft), dots_bef_aft s true) | Ast.Disj(stm1::stm2::stmts) -> List.fold_left (function prev -> function cur -> Past.Or(Past.Seq(prev,Past.Empty),stm_list cur)) (Past.Or(stm_list stm1,stm_list stm2)) stmts | Ast.Dots(dots,whencodes,_,_) -> Past.DInfo (List.fold_left (function prev -> function Ast.WhenNot(a) -> Past.When(prev,stm_list a) | _ -> failwith "only when != supported") Past.Dots whencodes) | Ast.Nest(starter,stmt_dots,ender,whencodes,false,_,_) -> (match Ast.get_mcodekind starter with Ast.MINUS _ -> failwith "only context nests supported" | _ -> ()); let nest = Past.Nest(stm_list stmt_dots) in Past.DInfo (List.fold_left (function prev -> function Ast.WhenNot(a) -> Past.When(prev,stm_list a) | _ -> failwith "only when != supported") nest whencodes) | _ -> Pretty_print_cocci.statement "" s; failwith "unsupported statement3" and dots_bef_aft s inif = match Ast.get_dots_bef_aft s with Ast.AddingBetweenDots (brace_term,n) -> Past.AddingBetweenDots (term brace_term inif,n) | Ast.DroppingBetweenDots (brace_term,n) -> Past.DroppingBetweenDots (term brace_term inif,n) | Ast.NoDots -> Past.NoDots and stm_list s = match Ast.unwrap s with Ast.DOTS(d) -> List.fold_right (function cur -> function rest -> Past.Seq(stm cur, rest)) d Past.Empty | _ -> failwith "only DOTS handled" let top s = match Ast.unwrap s with Ast.CODE(stmt_dots) -> stm_list stmt_dots | _ -> failwith "only CODE handled" coccinelle-1.0.0-rc19/popl09/pretty_print_popl.mli0000644000175000017500000000232612247442616021012 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_popl.mli" val pretty_print : Ast_popl.sequence -> unit val pretty_print_e : Ast_popl.element -> unit coccinelle-1.0.0-rc19/popl09/popl09.mllib0000644000175000017500000000012112247437436016651 0ustar eugeneugenAst_popl Asttopopl Insert_quantifiers Pretty_print_popl Flag_popl Popltoctl Popl coccinelle-1.0.0-rc19/popl09/pretty_print_popl.ml0000644000175000017500000000742012247442616020641 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_popl.ml" open Format module Past = Ast_popl module Ast = Ast_cocci let start_block str = force_newline(); print_string " "; open_box 0 let end_block str = close_box(); force_newline () (* --------------------------------------------------------------------- *) let print_around printer term = function Ast.NOTHING -> printer term | Ast.BEFORE(bef,_) -> Pretty_print_cocci.print_anything "<<< " bef; printer term | Ast.AFTER(aft,_) -> printer term; Pretty_print_cocci.print_anything ">>> " aft | Ast.BEFOREAFTER(bef,aft,_) -> Pretty_print_cocci.print_anything "<<< " bef; printer term; Pretty_print_cocci.print_anything ">>> " aft let mcode fn = function (x, _, Ast.MINUS(_,_,_,plus_stream), pos) -> print_string "-"; fn x; (match plus_stream with Ast.NOREPLACEMENT -> () | Ast.REPLACEMENT(plus_stream,_) -> Pretty_print_cocci.print_anything ">>> " plus_stream) | (x, _, Ast.CONTEXT(_,plus_streams), pos) -> print_around fn x plus_streams | (x, info, Ast.PLUS _, pos) -> fn x (* --------------------------------------------------------------------- *) let rec print_sequence = function Past.Seq(e,seq) -> print_element e; force_newline(); print_sequence seq | Past.Empty -> () | Past.SExists((_,v),seq) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_sequence seq and print_term = function Past.Atomic(term) -> Pretty_print_cocci.rule_elem "" term | Past.IfThen(test,thn,(_,_,_,aft)) -> print_term test; print_term thn; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Past.TExists((_,v),term) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_term term and print_element = function Past.Term(term,_) -> print_term term | Past.Or(seq1,seq2) -> force_newline(); print_string "("; force_newline(); print_sequence seq1; print_string "|"; force_newline(); print_sequence seq2; print_string ")" | Past.DInfo(dots) -> start_block(); print_dots dots; end_block() | Past.EExists((_,v),elem) -> print_string "exists "; print_string v; print_string " ."; force_newline(); print_element elem and print_dots = function Past.Dots -> print_string "..." | Past.Nest(seq)-> print_string "<..."; start_block(); print_sequence seq; end_block(); print_string "...>" | Past.When(dots,seq) -> print_dots dots; print_string " when != "; open_box 0; print_sequence seq; close_box() (* --------------------------------------------------------------------- *) let pretty_print_e e = print_element e; print_newline() let pretty_print sl = print_sequence sl; print_newline() coccinelle-1.0.0-rc19/popl09/ast_popl.ml0000644000175000017500000000330412247442616016662 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast_popl.ml" type sequence = Seq of element * sequence | Empty | SExists of Ast_cocci.meta_name * sequence and term = Atomic of Ast_cocci.rule_elem | IfThen of term * term * Ast_cocci.end_info | TExists of Ast_cocci.meta_name * term and element = Term of term * dots_bef_aft | Or of sequence * sequence | DInfo of dots | EExists of Ast_cocci.meta_name * element and dots = Dots | Nest of sequence | When of dots * sequence and dots_bef_aft = NoDots | AddingBetweenDots of term * int (*index of let var*) | DroppingBetweenDots of term * int (*index of let var*) coccinelle-1.0.0-rc19/popl09/popl.mli0000644000175000017500000000252612247442616016171 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popl.mli" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl val popl : Ast_cocci.rule -> Asttoctl2.top_formula list coccinelle-1.0.0-rc19/popl09/popl.ml0000644000175000017500000000314612247442616016017 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popl.ml" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl let poplz (name,_,ast) = match ast with [ast] -> let ast = Asttopopl.top ast in let qt = Insert_quantifiers.insert_quantifiers ast in [Popltoctl.toctl qt] | _ -> failwith "only one rule allowed" let popl r = match r with Ast_cocci.CocciRule(a,b,c,_,Ast_cocci.Normal) -> poplz (a,b,c) | _ -> [] coccinelle-1.0.0-rc19/popl09/Makefile0000644000175000017500000000566412247442616016162 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. #note: if you add a file (a .mli or .ml), dont forget to do a make depend ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET = popl OCAMLCFLAGS ?= -g OPTFLAGS ?= -g SRC = ast_popl.ml asttopopl.ml insert_quantifiers.ml \ pretty_print_popl.ml flag_popl.ml popltoctl.ml popl.ml SYSLIBS=str.cma unix.cma LIBS=../commons/commons.cma ../globals/globals.cma INCLUDES = -I ../commons -I ../globals \ -I ../ctl -I ../parsing_cocci -I ../parsing_c -I ../engine #The Caml compilers. #for warning: -w A #for profiling: -p -inline 0 with OCAMLOPT OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(LIB) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes $(TARGET).top: $(LIB) $(OCAMLMKTOP_CMD) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS) $(LIB): $(OBJS) $(OCAMLC_CMD) -a -o $(LIB) $(OBJS) clean:: rm -f $(LIB) $(TARGET).top else all: cd .. && $(OCAMLBUILD) popl09/popl09.cma all.opt: cd .. && $(OCAMLBUILD) popl09/popl09.cmxa clean:: cd .. && $(OCAMLBUILD) -clean endif $(OPTLIB): $(OPTOBJS) $(OCAMLOPT_CMD) -a -o $(OPTLIB) $(OPTOBJS) # clean rule for LIB.opt clean:: rm -f $(OPTLIB) $(LIB:.cma=.a) .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< # clean rule for others files clean:: rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ #*# rm -f .depend distclean: clean .PHONEY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/popl09/flag_popl.ml0000644000175000017500000000225112247442616017004 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_popl.ml" let mark_all = ref false let keep_all_wits = ref false coccinelle-1.0.0-rc19/popl09/popltoctl.mli0000644000175000017500000000253212247442616017234 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./popltoctl.mli" type cocci_predicate = Lib_engine.predicate * Ast_cocci.meta_name Ast_ctl.modif type formula = (cocci_predicate,Ast_cocci.meta_name, Wrapper_ctl.info) Ast_ctl.generic_ctl val toctl : Ast_popl.sequence -> Asttoctl2.top_formula coccinelle-1.0.0-rc19/parsing_cocci/0000755000175000017500000000000012250162456016162 5ustar eugeneugencoccinelle-1.0.0-rc19/parsing_cocci/adjacency.mli0000644000175000017500000000225612247442616020620 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./adjacency.mli" val compute_adjacency : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/insert_plus.ml0000644000175000017500000012122312247442616021071 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_plus.ml" (* The error message "no available token to attach to" often comes in an argument list of unbounded length. In this case, one should move a comma so that there is a comma after the + code. *) (* Start at all of the corresponding BindContext nodes in the minus and plus trees, and traverse their children. We take the same strategy as before: collect the list of minus/context nodes/tokens and the list of plus tokens, and then merge them. *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module CN = Context_neg let empty_isos = ref false let get_option f = function None -> [] | Some x -> f x (* --------------------------------------------------------------------- *) (* Collect root and all context nodes in a tree *) let collect_context e = let bind x y = x @ y in let option_default = [] in let mcode _ = [] in let donothing builder r k e = match Ast0.get_mcodekind e with Ast0.CONTEXT(_) -> (builder e) :: (k e) | _ -> k e in (* special case for everything that contains whencode, so that we skip over it *) let expression r k e = donothing Ast0.expr r k (Ast0.rewrap e (match Ast0.unwrap e with Ast0.NestExpr(starter,exp,ender,whencode,multi) -> Ast0.NestExpr(starter,exp,ender,None,multi) | Ast0.Edots(dots,whencode) -> Ast0.Edots(dots,None) | Ast0.Ecircles(dots,whencode) -> Ast0.Ecircles(dots,None) | Ast0.Estars(dots,whencode) -> Ast0.Estars(dots,None) | e -> e)) in let initialiser r k i = donothing Ast0.ini r k (Ast0.rewrap i (match Ast0.unwrap i with Ast0.Idots(dots,whencode) -> Ast0.Idots(dots,None) | i -> i)) in let statement r k s = donothing Ast0.stmt r k (Ast0.rewrap s (match Ast0.unwrap s with Ast0.Nest(started,stm_dots,ender,whencode,multi) -> Ast0.Nest(started,stm_dots,ender,[],multi) | Ast0.Dots(dots,whencode) -> Ast0.Dots(dots,[]) | Ast0.Circles(dots,whencode) -> Ast0.Circles(dots,[]) | Ast0.Stars(dots,whencode) -> Ast0.Stars(dots,[]) | s -> s)) in let topfn r k e = Ast0.TopTag(e) :: (k e) in let res = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode (donothing Ast0.dotsExpr) (donothing Ast0.dotsInit) (donothing Ast0.dotsParam) (donothing Ast0.dotsStmt) (donothing Ast0.dotsDecl) (donothing Ast0.dotsCase) (donothing Ast0.ident) expression (donothing Ast0.typeC) initialiser (donothing Ast0.param) (donothing Ast0.decl) statement (donothing Ast0.forinfo) (donothing Ast0.case_line) topfn in res.VT0.combiner_rec_top_level e (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* collect the possible join points, in order, among the children of a BindContext. Dots are not allowed. Nests and disjunctions are no problem, because their delimiters take up a line by themselves *) (* An Unfavored token is one that is in a BindContext node; using this causes the node to become Neither, meaning that isomorphisms can't be applied *) (* Toplevel is for the bef token of a function declaration and is for attaching top-level definitions that should come before the complete declaration *) type minus_join_point = Favored | Unfavored | Toplevel | Decl (* Maps the index of a node to the indices of the mcodes it contains *) let root_token_table = (Hashtbl.create(50) : (int, int list) Hashtbl.t) let create_root_token_table minus = Hashtbl.iter (function tokens -> function (node,_) -> let key = match node with Ast0.DotsExprTag(d) -> Ast0.get_index d | Ast0.DotsInitTag(d) -> Ast0.get_index d | Ast0.DotsParamTag(d) -> Ast0.get_index d | Ast0.DotsStmtTag(d) -> Ast0.get_index d | Ast0.DotsDeclTag(d) -> Ast0.get_index d | Ast0.DotsCaseTag(d) -> Ast0.get_index d | Ast0.IdentTag(d) -> Ast0.get_index d | Ast0.ExprTag(d) -> Ast0.get_index d | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> failwith "not possible - iso only" | Ast0.TypeCTag(d) -> Ast0.get_index d | Ast0.ParamTag(d) -> Ast0.get_index d | Ast0.InitTag(d) -> Ast0.get_index d | Ast0.DeclTag(d) -> Ast0.get_index d | Ast0.StmtTag(d) -> Ast0.get_index d | Ast0.ForInfoTag(d) -> Ast0.get_index d | Ast0.CaseLineTag(d) -> Ast0.get_index d | Ast0.TopTag(d) -> Ast0.get_index d | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "not in plus code" | Ast0.HiddenVarTag(p) -> failwith "only within iso phase" in Hashtbl.add root_token_table key tokens) CN.minus_table; List.iter (function r -> let index = Ast0.get_index r in try let _ = Hashtbl.find root_token_table index in () with Not_found -> Hashtbl.add root_token_table index []) minus let collect_minus_join_points root = let root_index = Ast0.get_index root in let unfavored_tokens = Hashtbl.find root_token_table root_index in let bind x y = x @ y in let option_default = [] in let mcode (x,_,info,mcodekind,_,_) = if List.mem (info.Ast0.pos_info.Ast0.offset) unfavored_tokens then [(Unfavored,info,mcodekind)] else [(Favored,info,mcodekind)] in let do_nothing r k e = let info = Ast0.get_info e in let index = Ast0.get_index e in match Ast0.get_mcodekind e with (Ast0.MINUS(_)) as mc -> [(Favored,info,mc)] | (Ast0.CONTEXT(_)) as mc when not(index = root_index) -> (* This was unfavored at one point, but I don't remember why *) [(Favored,info,mc)] | _ -> k e in (* don't want to attach to the outside of DOTS, because metavariables can't bind to that; not good for isomorphisms *) let dots f k d = let multibind l = let rec loop = function [] -> option_default | [x] -> x | x::xs -> bind x (loop xs) in loop l in match Ast0.unwrap d with Ast0.DOTS(l) -> multibind (List.map f l) | Ast0.CIRCLES(l) -> multibind (List.map f l) | Ast0.STARS(l) -> multibind (List.map f l) in let edots r k d = dots r.VT0.combiner_rec_expression k d in let idots r k d = dots r.VT0.combiner_rec_initialiser k d in let pdots r k d = dots r.VT0.combiner_rec_parameter k d in let sdots r k d = dots r.VT0.combiner_rec_statement k d in let ddots r k d = dots r.VT0.combiner_rec_declaration k d in let cdots r k d = dots r.VT0.combiner_rec_case_line k d in (* a case for everything that has a Opt *) let statement r k s = (* let redo_branched res (ifinfo,aftmc) = let redo fv info mc rest = let new_info = {info with Ast0.attachable_end = false} in List.rev ((Favored,ifinfo,aftmc)::(fv,new_info,mc)::rest) in match List.rev res with [(fv,info,mc)] -> (match mc with Ast0.MINUS(_) | Ast0.CONTEXT(_) -> (* even for -, better for isos not to integrate code after an if into the if body. but the problem is that this can extend the region in which a variable is bound, because a variable bound in the aft node would seem to have to be live in the whole if, whereas we might like it to be live in only one branch. ie ideally, if we can keep the minus code in the right order, we would like to drop it as close to the bindings of its free variables. This could be anywhere in the minus code. Perhaps we would like to do this after the application of isomorphisms, though. *) redo fv info mc [] | _ -> res) | (fv,info,mc)::rest -> (match mc with Ast0.CONTEXT(_) -> redo fv info mc rest | _ -> res) | _ -> failwith "unexpected empty code" in *) match Ast0.unwrap s with (* Ast0.IfThen(_,_,_,_,_,aft) | Ast0.IfThenElse(_,_,_,_,_,_,_,aft) | Ast0.While(_,_,_,_,_,aft) | Ast0.For(_,_,_,_,_,_,_,_,aft) | Ast0.Iterator(_,_,_,_,_,aft) -> redo_branched (do_nothing r k s) aft*) | Ast0.FunDecl((info,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (Toplevel,info,bef)::(k s) | Ast0.Decl((info,bef),decl) -> (Decl,info,bef)::(k s) | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> mcode starter @ r.VT0.combiner_rec_statement_dots stmt_dots @ mcode ender | Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode) | Ast0.Stars(d,whencode) -> mcode d (* ignore whencode *) | Ast0.OptStm s | Ast0.UniqueStm s -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_statement s | _ -> do_nothing r k s in let forinfo r k s = match Ast0.unwrap s with Ast0.ForDecl((info,bef),decl) -> (Decl,info,bef)::(k s) | _ -> k s in let expression r k e = match Ast0.unwrap e with Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> mcode starter @ r.VT0.combiner_rec_expression_dots expr_dots @ mcode ender | Ast0.Edots(d,whencode) | Ast0.Ecircles(d,whencode) | Ast0.Estars(d,whencode) -> mcode d (* ignore whencode *) | Ast0.OptExp e | Ast0.UniqueExp e -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_expression e | _ -> do_nothing r k e in let ident r k e = match Ast0.unwrap e with Ast0.OptIdent i | Ast0.UniqueIdent i -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_ident i | _ -> do_nothing r k e in let typeC r k e = match Ast0.unwrap e with Ast0.OptType t | Ast0.UniqueType t -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_typeC t | _ -> do_nothing r k e in let decl r k e = match Ast0.unwrap e with Ast0.OptDecl d | Ast0.UniqueDecl d -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_declaration d | _ -> do_nothing r k e in let initialiser r k e = match Ast0.unwrap e with Ast0.Idots(d,whencode) -> mcode d (* ignore whencode *) | Ast0.OptIni i | Ast0.UniqueIni i -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_initialiser i | _ -> do_nothing r k e in let param r k e = match Ast0.unwrap e with Ast0.OptParam p | Ast0.UniqueParam p -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_parameter p | _ -> do_nothing r k e in let case_line r k e = match Ast0.unwrap e with Ast0.OptCase c -> (* put the + code on the thing, not on the opt *) r.VT0.combiner_rec_case_line c | _ -> do_nothing r k e in let do_top r k (e: Ast0.top_level) = k e in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode edots idots pdots sdots ddots cdots ident expression typeC initialiser param decl statement forinfo case_line do_top let call_collect_minus context_nodes : (int * (minus_join_point * Ast0.info * Ast0.mcodekind) list) list = List.map (function e -> match e with Ast0.DotsExprTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_expression_dots e) | Ast0.DotsInitTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_initialiser_list e) | Ast0.DotsParamTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_parameter_list e) | Ast0.DotsStmtTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_statement_dots e) | Ast0.DotsDeclTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_declaration_dots e) | Ast0.DotsCaseTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_case_line_dots e) | Ast0.IdentTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_ident e) | Ast0.ExprTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_expression e) | Ast0.ArgExprTag(e) | Ast0.TestExprTag(e) -> failwith "not possible - iso only" | Ast0.TypeCTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_typeC e) | Ast0.ParamTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_parameter e) | Ast0.InitTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_initialiser e) | Ast0.DeclTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_declaration e) | Ast0.StmtTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_statement e) | Ast0.ForInfoTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_forinfo e) | Ast0.CaseLineTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_case_line e) | Ast0.TopTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_top_level e) | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "not in plus code" | Ast0.HiddenVarTag(p) -> failwith "only within iso phase") context_nodes (* result of collecting the join points should be sorted in nondecreasing order by line *) let verify l = let get_info = function (Favored,info,_) | (Unfavored,info,_) | (Toplevel,info,_) | (Decl,info,_) -> info in let token_start_line x = (get_info x).Ast0.pos_info.Ast0.logical_start in let token_end_line x = (get_info x).Ast0.pos_info.Ast0.logical_end in let token_real_start_line x = (get_info x).Ast0.pos_info.Ast0.line_start in let token_real_end_line x = (get_info x).Ast0.pos_info.Ast0.line_end in List.iter (function (index,((_::_) as l1)) -> let _ = List.fold_left (function (prev,real_prev) -> function cur -> let ln = token_start_line cur in if ln < prev then failwith (Printf.sprintf "error in collection of - tokens: line %d less than line %d" (token_real_start_line cur) real_prev); (token_end_line cur,token_real_end_line cur)) (token_end_line (List.hd l1), token_real_end_line (List.hd l1)) (List.tl l1) in () | _ -> ()) (* dots, in eg f() has no join points *) l let process_minus minus = Hashtbl.clear root_token_table; create_root_token_table minus; List.concat (List.map (function x -> let res = call_collect_minus (collect_context x) in verify res; res) minus) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* collect the plus tokens *) let mk_structUnion x = Ast.StructUnionTag x let mk_sign x = Ast.SignTag x let mk_ident x = Ast.IdentTag (Ast0toast.ident x) let mk_expression x = Ast.ExpressionTag (Ast0toast.expression x) let mk_constant x = Ast.ConstantTag x let mk_unaryOp x = Ast.UnaryOpTag x let mk_assignOp x = Ast.AssignOpTag x let mk_fixOp x = Ast.FixOpTag x let mk_binaryOp x = Ast.BinaryOpTag x let mk_arithOp x = Ast.ArithOpTag x let mk_logicalOp x = Ast.LogicalOpTag x let mk_declaration x = Ast.DeclarationTag (Ast0toast.declaration x) let mk_topdeclaration x = Ast.DeclarationTag (Ast0toast.declaration x) let mk_storage x = Ast.StorageTag x let mk_inc_file x = Ast.IncFileTag x let mk_statement x = Ast.StatementTag (Ast0toast.statement x) let mk_forinfo x = Ast.ForInfoTag (Ast0toast.forinfo x) let mk_case_line x = Ast.CaseLineTag (Ast0toast.case_line x) let mk_const_vol x = Ast.ConstVolTag x let mk_token x info = Ast.Token (x,Some info) let mk_meta (_,x) info = Ast.Token (x,Some info) let mk_code x = Ast.Code (Ast0toast.top_level x) let mk_exprdots x = Ast.ExprDotsTag (Ast0toast.expression_dots x) let mk_paramdots x = Ast.ParamDotsTag (Ast0toast.parameter_list x) let mk_stmtdots x = Ast.StmtDotsTag (Ast0toast.statement_dots x) let mk_decldots x = Ast.DeclDotsTag (Ast0toast.declaration_dots x) let mk_casedots x = failwith "+ case lines not supported" let mk_typeC x = Ast.FullTypeTag (Ast0toast.typeC false x) let mk_init x = Ast.InitTag (Ast0toast.initialiser x) let mk_param x = Ast.ParamTag (Ast0toast.parameterTypeDef x) let collect_plus_nodes root = let root_index = Ast0.get_index root in let bind x y = x @ y in let option_default = [] in let extract_strings info = let adjust_info = {info with Ast0.strings_before = []; Ast0.strings_after = []} in let extract = function [] -> [] | strings_before -> let (_,first) = List.hd strings_before in let (_,last) = List.hd (List.rev strings_before) in let new_pos_info = {Ast0.line_start = first.Ast0.line_start; Ast0.line_end = last.Ast0.line_start; Ast0.logical_start = first.Ast0.logical_start; Ast0.logical_end = last.Ast0.logical_start; Ast0.column = first.Ast0.column; Ast0.offset = first.Ast0.offset} in let new_info = {adjust_info with Ast0.pos_info = new_pos_info} in let string = List.map (function (s,_) -> s) strings_before in [(new_info,Ast.ONE(*?*),Ast.Directive (string))] in let bef = extract info.Ast0.strings_before in let aft = extract info.Ast0.strings_after in (bef,aft) in let mcode fn (term,_,info,mcodekind,_,_) = match mcodekind with Ast0.PLUS c -> [(info,c,fn term)] | Ast0.CONTEXT _ -> let (bef,aft) = extract_strings info in bef@aft | _ -> [] in let imcode fn (term,_,info,mcodekind,_,_) = match mcodekind with Ast0.PLUS c -> [(info,c,fn term (Ast0toast.convert_info info))] | Ast0.CONTEXT _ -> let (bef,aft) = extract_strings info in bef@aft | _ -> [] in let info (i,_,_) = let (bef,aft) = extract_strings i in bef@aft in let pre_info (i,_) = let (bef,aft) = extract_strings i in bef@aft in let do_nothing fn r k e = match Ast0.get_mcodekind e with (Ast0.CONTEXT(_)) when not(Ast0.get_index e = root_index) -> [] | Ast0.PLUS c -> [(Ast0.get_info e,c,fn e)] | _ -> k e in (* case for everything that is just a wrapper for a simpler thing *) (* case for things with bef aft *) let stmt r k e = match Ast0.unwrap e with Ast0.Exp(exp) -> r.VT0.combiner_rec_expression exp | Ast0.TopExp(exp) -> r.VT0.combiner_rec_expression exp | Ast0.Ty(ty) -> r.VT0.combiner_rec_typeC ty | Ast0.TopInit(init) -> r.VT0.combiner_rec_initialiser init | Ast0.Decl(bef,decl) -> (pre_info bef) @ (do_nothing mk_statement r k e) | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> (pre_info bef) @ (do_nothing mk_statement r k e) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> (do_nothing mk_statement r k e) @ (info aft) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> (do_nothing mk_statement r k e) @ (info aft) | Ast0.While(whl,lp,exp,rp,body,aft) -> (do_nothing mk_statement r k e) @ (info aft) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> (do_nothing mk_statement r k e) @ (info aft) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> (do_nothing mk_statement r k e) @ (info aft) | _ -> do_nothing mk_statement r k e in (* statementTag is preferred, because it indicates that one statement is replaced by one statement, in single_statement *) let stmt_dots r k e = match Ast0.unwrap e with Ast0.DOTS([s]) | Ast0.CIRCLES([s]) | Ast0.STARS([s]) -> r.VT0.combiner_rec_statement s | _ -> do_nothing mk_stmtdots r k e in let toplevel r k e = match Ast0.unwrap e with Ast0.NONDECL(s) -> r.VT0.combiner_rec_statement s | Ast0.CODE(sdots) -> r.VT0.combiner_rec_statement_dots sdots | _ -> do_nothing mk_code r k e in let initdots r k e = k e in V0.flat_combiner bind option_default (imcode mk_meta) (imcode mk_token) (mcode mk_constant) (mcode mk_assignOp) (mcode mk_fixOp) (mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol) (mcode mk_sign) (mcode mk_structUnion) (mcode mk_storage) (mcode mk_inc_file) (do_nothing mk_exprdots) initdots (do_nothing mk_paramdots) stmt_dots (do_nothing mk_decldots) (do_nothing mk_casedots) (do_nothing mk_ident) (do_nothing mk_expression) (do_nothing mk_typeC) (do_nothing mk_init) (do_nothing mk_param) (do_nothing mk_declaration) stmt (do_nothing mk_forinfo) (do_nothing mk_case_line) toplevel let call_collect_plus context_nodes : (int * (Ast0.info * Ast.count * Ast.anything) list) list = List.map (function e -> match e with Ast0.DotsExprTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_expression_dots e) | Ast0.DotsInitTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_initialiser_list e) | Ast0.DotsParamTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_parameter_list e) | Ast0.DotsStmtTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_statement_dots e) | Ast0.DotsDeclTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_declaration_dots e) | Ast0.DotsCaseTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_case_line_dots e) | Ast0.IdentTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_ident e) | Ast0.ExprTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_expression e) | Ast0.ArgExprTag(_) | Ast0.TestExprTag(_) -> failwith "not possible - iso only" | Ast0.TypeCTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_typeC e) | Ast0.InitTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_initialiser e) | Ast0.ParamTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_parameter e) | Ast0.DeclTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_declaration e) | Ast0.StmtTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_statement e) | Ast0.ForInfoTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_forinfo e) | Ast0.CaseLineTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_case_line e) | Ast0.TopTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_top_level e) | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "not visible here" | Ast0.HiddenVarTag(_) -> failwith "only within iso phase") context_nodes (* The plus fragments are converted to a list of lists of lists. Innermost list: Elements have type anything. For any pair of successive elements, n and n+1, the ending line of n is the same as the starting line of n+1. Middle lists: For any pair of successive elements, n and n+1, the ending line of n is one less than the starting line of n+1. Outer list: For any pair of successive elements, n and n+1, the ending line of n is more than one less than the starting line of n+1. *) let logstart info = info.Ast0.pos_info.Ast0.logical_start let logend info = info.Ast0.pos_info.Ast0.logical_end let redo info start finish = let new_pos_info = {info.Ast0.pos_info with Ast0.logical_start = start; Ast0.logical_end = finish} in {info with Ast0.pos_info = new_pos_info} let rec find_neighbors (index,l) : int * (Ast0.info * Ast.count * (Ast.anything list list)) list = let rec loop = function [] -> [] | (i,c,x)::rest -> (match loop rest with ((i1,c1,(x1::rest_inner))::rest_middle)::rest_outer -> let finish1 = logend i in let start2 = logstart i1 in if finish1 = start2 then ((if not (c = c1) then failwith "inconsistent + code"); ((redo i (logstart i) (logend i1),c,(x::x1::rest_inner)) ::rest_middle) ::rest_outer) else if finish1 + 1 = start2 then ((i,c,[x])::(i1,c1,(x1::rest_inner))::rest_middle)::rest_outer else [(i,c,[x])]::((i1,c1,(x1::rest_inner))::rest_middle)::rest_outer | _ -> [[(i,c,[x])]]) (* rest must be [] *) in let res = List.map (function l -> let (start_info,start_count,_) = List.hd l in let (end_info,end_count,_) = List.hd (List.rev l) in (if not (start_count = end_count) then failwith "inconsistent + code"); (redo start_info (logstart start_info) (logend end_info), start_count, List.map (function (_,_,x) -> x) l)) (loop l) in (index,res) let process_plus plus : (int * (Ast0.info * Ast.count * Ast.anything list list) list) list = List.concat (List.map (function x -> List.map find_neighbors (call_collect_plus (collect_context x))) plus) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* merge *) (* let merge_one = function (m1::m2::minus_info,p::plus_info) -> if p < m1, then attach p to the beginning of m1.bef if m1 is Good, fail if it is bad if p > m1 && p < m2, then consider the following possibilities, in order m1 is Good and favored: attach to the beginning of m1.aft m2 is Good and favored: attach to the beginning of m2.bef; drop m1 m1 is Good and unfavored: attach to the beginning of m1.aft m2 is Good and unfavored: attach to the beginning of m2.bef; drop m1 also flip m1.bef if the first where > m1 if we drop m1, then flip m1.aft first if p > m2 m2 is Good and favored: attach to the beginning of m2.aft; drop m1 *) (* end of first argument < start/end of second argument *) let less_than_start info1 info2 = info1.Ast0.pos_info.Ast0.logical_end < info2.Ast0.pos_info.Ast0.logical_start let less_than_end info1 info2 = info1.Ast0.pos_info.Ast0.logical_end < info2.Ast0.pos_info.Ast0.logical_end let greater_than_end info1 info2 = info1.Ast0.pos_info.Ast0.logical_start > info2.Ast0.pos_info.Ast0.logical_end let good_start info = info.Ast0.attachable_start let good_end info = info.Ast0.attachable_end let toplevel = function Toplevel -> true | Favored | Unfavored | Decl -> false let decl = function Decl -> true | Favored | Unfavored | Toplevel -> false let favored = function Favored -> true | Unfavored | Toplevel | Decl -> false let top_code = List.for_all (List.for_all (function Ast.Code _ | Ast.Directive _ -> true | _ -> false)) let storage_code = List.for_all (List.for_all (function Ast.StorageTag _ -> true | _ -> false)) (* The following is probably not correct. The idea is to detect what should be placed completely before the declaration. So type/storage related things do not fall into this category, and complete statements do fall into this category. But perhaps other things should be in this category as well, such as { or ;? *) let predecl_code = let tester = function (* the following should definitely be true *) Ast.DeclarationTag _ | Ast.StatementTag _ | Ast.Rule_elemTag _ | Ast.StmtDotsTag _ | Ast.Code _ | Ast.Directive _ -> true (* the following should definitely be false *) | Ast.FullTypeTag _ | Ast.BaseTypeTag _ | Ast.StructUnionTag _ | Ast.SignTag _ | Ast.StorageTag _ | Ast.ConstVolTag _ | Ast.TypeCTag _ -> false (* not sure about the rest *) | _ -> false in List.for_all (List.for_all tester) let pr = Printf.sprintf let insert thing thinginfo into intoinfo = let get_last l = let l = List.rev l in (List.rev(List.tl l),List.hd l) in let get_first l = (List.hd l,List.tl l) in let thing_start = thinginfo.Ast0.pos_info.Ast0.logical_start in let thing_end = thinginfo.Ast0.pos_info.Ast0.logical_end in let thing_offset = thinginfo.Ast0.pos_info.Ast0.offset in let into_start = intoinfo.Ast0.tline_start in let into_end = intoinfo.Ast0.tline_end in let into_left_offset = intoinfo.Ast0.left_offset in let into_right_offset = intoinfo.Ast0.right_offset in if thing_end < into_start && thing_start < into_start then (thing@into, {{intoinfo with Ast0.tline_start = thing_start} with Ast0.left_offset = thing_offset}) else if thing_end = into_start && thing_offset < into_left_offset then let (prev,last) = get_last thing in let (first,rest) = get_first into in (prev@[last@first]@rest, {{intoinfo with Ast0.tline_start = thing_start} with Ast0.left_offset = thing_offset}) else if thing_start > into_end && thing_end > into_end then (into@thing, {{intoinfo with Ast0.tline_end = thing_end} with Ast0.right_offset = thing_offset}) else if thing_start = into_end && thing_offset > into_right_offset then let (first,rest) = get_first thing in let (prev,last) = get_last into in (prev@[last@first]@rest, {{intoinfo with Ast0.tline_end = thing_end} with Ast0.right_offset = thing_offset}) else begin Printf.printf "thing start %d thing end %d into start %d into end %d\n" thing_start thing_end into_start into_end; Printf.printf "thing offset %d left offset %d right offset %d\n" thing_offset into_left_offset into_right_offset; Pretty_print_cocci.print_anything "" thing; Pretty_print_cocci.print_anything "" into; failwith "can't figure out where to put the + code" end let init thing info = (thing, {Ast0.tline_start = info.Ast0.pos_info.Ast0.logical_start; Ast0.tline_end = info.Ast0.pos_info.Ast0.logical_end; Ast0.left_offset = info.Ast0.pos_info.Ast0.offset; Ast0.right_offset = info.Ast0.pos_info.Ast0.offset}) let it2c = function Ast.ONE -> "one" | Ast.MANY -> "many" let attachbefore (infop,c,p) = function Ast0.MINUS(replacements) -> let (repl,ti) = !replacements in (match repl with Ast.NOREPLACEMENT -> let (bef,ti) = init p infop in replacements := (Ast.REPLACEMENT(bef,c),ti) | Ast.REPLACEMENT(repl,it) -> let it = Ast.lub_count it c in let (bef,ti) = insert p infop repl ti in replacements := (Ast.REPLACEMENT(bef,it),ti)) | Ast0.CONTEXT(neighbors) -> let (repl,ti1,ti2) = !neighbors in (match repl with Ast.BEFORE(bef,it) -> let (bef,ti1) = insert p infop bef ti1 in let it = Ast.lub_count it c in neighbors := (Ast.BEFORE(bef,it),ti1,ti2) | Ast.AFTER(aft,it) -> let (bef,ti1) = init p infop in let it = Ast.lub_count it c in neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2) | Ast.BEFOREAFTER(bef,aft,it) -> let (bef,ti1) = insert p infop bef ti1 in let it = Ast.lub_count it c in neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2) | Ast.NOTHING -> let (bef,ti1) = init p infop in neighbors := (Ast.BEFORE(bef,c),ti1,ti2)) | _ -> failwith "not possible for attachbefore" let attachafter (infop,c,p) = function Ast0.MINUS(replacements) -> let (repl,ti) = !replacements in (match repl with Ast.NOREPLACEMENT -> let (aft,ti) = init p infop in replacements := (Ast.REPLACEMENT(aft,c),ti) | Ast.REPLACEMENT(repl,it) -> let it = Ast.lub_count it c in let (aft,ti) = insert p infop repl ti in replacements := (Ast.REPLACEMENT(aft,it),ti)) | Ast0.CONTEXT(neighbors) -> let (repl,ti1,ti2) = !neighbors in (match repl with Ast.BEFORE(bef,it) -> let (aft,ti2) = init p infop in let it = Ast.lub_count it c in neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2) | Ast.AFTER(aft,it) -> let (aft,ti2) = insert p infop aft ti2 in let it = Ast.lub_count it c in neighbors := (Ast.AFTER(aft,it),ti1,ti2) | Ast.BEFOREAFTER(bef,aft,it) -> let (aft,ti2) = insert p infop aft ti2 in let it = Ast.lub_count it c in neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2) | Ast.NOTHING -> let (aft,ti2) = init p infop in neighbors := (Ast.AFTER(aft,c),ti1,ti2)) | _ -> failwith "not possible for attachbefore" let attach_all_before ps m = List.iter (function x -> attachbefore x m) ps let attach_all_after ps m = List.iter (function x -> attachafter x m) ps let split_at_end info ps = let split_point = info.Ast0.pos_info.Ast0.logical_end in List.partition (function (info,_,_) -> info.Ast0.pos_info.Ast0.logical_end < split_point) ps let allminus = function Ast0.MINUS(_) -> true | _ -> false let rec before_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function [] -> () | (((infop,_,pcode) as p) :: ps) as all -> if less_than_start infop infom1 or (allminus m1 && less_than_end infop infom1) (* account for trees *) then if toplevel f1 then if storage_code pcode then before_m2 x2 rest all (* skip fake token for storage *) else (attachbefore p m1; before_m1 x1 x2 rest ps) else if good_start infom1 then (attachbefore p m1; before_m1 x1 x2 rest ps) else failwith (pr "%d: no available token to attach to" infop.Ast0.pos_info.Ast0.line_start) else after_m1 x1 x2 rest all and after_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function [] -> () | (((infop,count,pcode) as p) :: ps) as all -> (* if the following is false, then some + code is stuck in the middle of some context code (m1). could drop down to the token level. this might require adjustments in ast0toast as well, when + code on expressions is dropped down to + code on expressions. it might also break some invariants on which iso depends, particularly on what it can infer from something being CONTEXT with no top-level modifications. for the moment, we thus give an error, asking the user to rewrite the semantic patch. *) if greater_than_end infop infom1 or is_minus m1 or !empty_isos then if less_than_start infop infom2 then if predecl_code pcode && good_end infom1 && decl f1 then (attachafter p m1; after_m1 x1 x2 rest ps) else if predecl_code pcode && good_start infom2 && decl f2 then before_m2 x2 rest all else if top_code pcode && good_end infom1 && toplevel f1 then (attachafter p m1; after_m1 x1 x2 rest ps) else if top_code pcode && good_start infom2 && toplevel f2 then before_m2 x2 rest all else if good_end infom1 && favored f1 then (attachafter p m1; after_m1 x1 x2 rest ps) else if good_start infom2 && favored f2 then before_m2 x2 rest all else if good_end infom1 then (attachafter p m1; after_m1 x1 x2 rest ps) else if good_start infom2 then before_m2 x2 rest all else failwith (pr "%d: no available token to attach to" infop.Ast0.pos_info.Ast0.line_start) else after_m2 x2 rest all else begin Printf.printf "between: p start %d p end %d m1 start %d m1 end %d m2 start %d m2 end %d\n" infop.Ast0.pos_info.Ast0.line_start infop.Ast0.pos_info.Ast0.line_end infom1.Ast0.pos_info.Ast0.line_start infom1.Ast0.pos_info.Ast0.line_end infom2.Ast0.pos_info.Ast0.line_start infom2.Ast0.pos_info.Ast0.line_end; Pretty_print_cocci.print_anything "" pcode; failwith "The semantic patch is structured in a way that may give bad results with isomorphisms. Please try to rewrite it by moving + code out from -/context terms." end (* not sure this is safe. if have iso problems, consider changing this to always return false *) and is_minus = function Ast0.MINUS _ -> true | _ -> false and before_m2 ((f2,infom2,m2) as x2) rest (p : (Ast0.info * Ast.count * Ast.anything list list) list) = match (rest,p) with (_,[]) -> () | ([],((infop,_,_)::_)) -> let (bef_m2,aft_m2) = split_at_end infom2 p in (* bef_m2 isn't empty *) if good_start infom2 then (attach_all_before bef_m2 m2; after_m2 x2 rest aft_m2) else failwith (pr "%d: no available token to attach to" infop.Ast0.pos_info.Ast0.line_start) | (m::ms,_) -> before_m1 x2 m ms p and after_m2 ((f2,infom2,m2) as x2) rest (p : (Ast0.info * Ast.count * Ast.anything list list) list) = match (rest,p) with (_,[]) -> () | ([],((infop,_,_)::_)) -> if good_end infom2 then attach_all_after p m2 else failwith (pr "%d: no available token to attach to" infop.Ast0.pos_info.Ast0.line_start) | (m::ms,_) -> after_m1 x2 m ms p let merge_one : (minus_join_point * Ast0.info * 'a) list * (Ast0.info * Ast.count * Ast.anything list list) list -> unit = function (m,p) -> (* Printf.printf "minus code\n"; List.iter (function (_,info,_) -> Printf.printf "start %d end %d real_start %d real_end %d attachable start %b attachable end %b\n" info.Ast0.pos_info.Ast0.logical_start info.Ast0.pos_info.Ast0.logical_end info.Ast0.pos_info.Ast0.line_start info.Ast0.pos_info.Ast0.line_end info.Ast0.attachable_start info.Ast0.attachable_end) m; Printf.printf "plus code\n"; List.iter (function (info,_,p) -> Printf.printf "start %d end %d real_start %d real_end %d\n" info.Ast0.pos_info.Ast0.logical_start info.Ast0.pos_info.Ast0.logical_end info.Ast0.pos_info.Ast0.line_end info.Ast0.pos_info.Ast0.line_end; Pretty_print_cocci.print_anything "" p; Format.print_newline()) p; *) match (m,p) with (_,[]) -> () | (m1::m2::restm,p) -> before_m1 m1 m2 restm p | ([m],p) -> before_m2 m [] p | ([],_) -> failwith "minus tree ran out before the plus tree" let merge minus_list plus_list = (* Printf.printf "minus list %s\n" (String.concat " " (List.map (function (x,_) -> string_of_int x) minus_list)); Printf.printf "plus list %s\n" (String.concat " " (List.map (function (x,_) -> string_of_int x) plus_list)); *) List.iter (function (index,minus_info) -> let plus_info = List.assoc index plus_list in merge_one (minus_info,plus_info)) minus_list (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Need to check that CONTEXT nodes have nothing attached to their tokens. If they do, they become MIXED *) let reevaluate_contextness = let bind = (@) in let option_default = [] in let mcode (_,_,_,mc,_,_) = match mc with Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba] | _ -> [] in let pre_info (_,mc) = match mc with Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba] | _ -> [] in let info (_,mc,_) = match mc with Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba] | _ -> [] in let donothing r k e = match Ast0.get_mcodekind e with Ast0.CONTEXT(mc) -> if List.exists (function Ast.NOTHING -> false | _ -> true) (k e) then Ast0.set_mcodekind e (Ast0.MIXED(mc)); [] | _ -> let _ = k e in [] in (* a case for everything with bef or aft *) let stmt r k e = match Ast0.unwrap e with Ast0.Decl(bef,decl) -> (pre_info bef) @ (donothing r k e) | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> (pre_info bef) @ (donothing r k e) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> (donothing r k e) @ (info aft) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> (donothing r k e) @ (info aft) | Ast0.While(whl,lp,exp,rp,body,aft) -> (donothing r k e) @ (info aft) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> (donothing r k e) @ (info aft) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> (donothing r k e) @ (info aft) | _ -> donothing r k e in let res = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing stmt donothing donothing donothing in res.VT0.combiner_rec_top_level (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) let insert_plus minus plus ei = empty_isos := ei; let minus_stream = process_minus minus in let plus_stream = process_plus plus in merge minus_stream plus_stream; List.iter (function x -> let _ = reevaluate_contextness x in ()) minus coccinelle-1.0.0-rc19/parsing_cocci/lexer_cli.mll0000644000175000017500000000353412247442615020647 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lexer_cli.mll" (* Lexer for the command line mode *) { exception Lexical of string let tok = Lexing.lexeme type cli_tok = Id of string | NotEq | EqEq | Other of string | EOF let pretty_print tok = match tok with Id s -> s | NotEq -> "when !=" | EqEq -> "when ==" | Other s -> s | EOF -> "" } let special = ':' let letter = ['A'-'Z' 'a'-'z' '_'] let dec = ['0'-'9'] let alphanum = (letter | dec) let id = letter (alphanum | special)* rule token = parse | "when" [' ' '\t']* "!=" [' ' '\t']* { NotEq } | "when" [' ' '\t']* "==" [' ' '\t']* { EqEq } | [' ' '\t']+ { Other(" ") } | id { Id(tok lexbuf) } | eof { EOF } | _ { Other(tok lexbuf) } coccinelle-1.0.0-rc19/parsing_cocci/arity.ml0000644000175000017500000013506612247442616017664 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./arity.ml" (* Arities matter for the minus slice, but not for the plus slice. *) (* ? only allowed on rule_elems, and on subterms if the context is ? also. *) module Ast0 = Ast0_cocci module Ast = Ast_cocci (* --------------------------------------------------------------------- *) let warning s = Printf.printf "warning: %s\n" s let fail w str = failwith (Printf.sprintf "cocci line %d: %s" ((Ast0.get_info w).Ast0.pos_info.Ast0.line_start) str) let make_opt_unique optfn uniquefn info tgt arity term = let term = Ast0.rewrap info term in if tgt = arity then term else (* tgt must be NONE *) match arity with Ast0.OPT -> Ast0.copywrap info (optfn term) | Ast0.UNIQUE -> Ast0.copywrap info (uniquefn term) | Ast0.NONE -> failwith "tgt must be NONE" let all_same opt_allowed tgt line arities = let tgt = match tgt with Ast0.NONE -> (match List.hd arities with Ast0.OPT when not opt_allowed -> failwith "opt only allowed for the elements of a statement list" | x -> x) | _ -> tgt in if not(List.for_all (function x -> x = tgt) arities) then warning (Printf.sprintf "incompatible arity found on line %d" line); tgt let get_option fn = function None -> None | Some x -> Some (fn x) let anyopt l fn = List.exists (function w -> fn(Ast0.unwrap w)) l let allopt l fn = let rec loop = function [] -> [] | x::xs -> match fn (Ast0.unwrap x) with Some x -> x :: (loop xs) | None -> [] in let res = loop l in if List.length res = List.length l then Some res else None (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Mcode *) let mcode2line (_,_,info,_,_,_) = info.Ast0.pos_info.Ast0.line_start let mcode2arity (_,arity,_,_,_,_) = arity let mcode x = x (* nothing to do ... *) (* --------------------------------------------------------------------- *) (* Dots *) let dots fn d = Ast0.rewrap d (match Ast0.unwrap d with Ast0.DOTS(x) -> Ast0.DOTS(List.map fn x) | Ast0.CIRCLES(x) -> Ast0.CIRCLES(List.map fn x) | Ast0.STARS(x) -> Ast0.STARS(List.map fn x)) let only_dots l = not (List.exists (function x -> match Ast0.unwrap x with Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true | _ -> false) l) let only_circles l = not (List.exists (function x -> match Ast0.unwrap x with Ast0.Dots(_,_) | Ast0.Stars(_,_) -> true | _ -> false) l) let only_stars l = not (List.exists (function x -> match Ast0.unwrap x with Ast0.Dots(_,_) | Ast0.Circles(_,_) -> true | _ -> false) l) let concat_dots fn d = Ast0.rewrap d (match Ast0.unwrap d with Ast0.DOTS(x) -> let l = List.map fn x in if only_dots l then Ast0.DOTS(l) else fail d "inconsistent dots usage" | Ast0.CIRCLES(x) -> let l = List.map fn x in if only_circles l then Ast0.CIRCLES(l) else fail d "inconsistent dots usage" | Ast0.STARS(x) -> let l = List.map fn x in if only_stars l then Ast0.STARS(l) else fail d "inconsistent dots usage") let flat_concat_dots fn d = match Ast0.unwrap d with Ast0.DOTS(x) -> List.map fn x | Ast0.CIRCLES(x) -> List.map fn x | Ast0.STARS(x) -> List.map fn x (* --------------------------------------------------------------------- *) (* Identifier *) let make_id = make_opt_unique (function x -> Ast0.OptIdent x) (function x -> Ast0.UniqueIdent x) let rec ident opt_allowed tgt i = match Ast0.unwrap i with Ast0.Id(name) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_id i tgt arity (Ast0.Id(name)) | Ast0.MetaId(name,constraints,seed,pure) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_id i tgt arity (Ast0.MetaId(name,constraints,seed,pure)) | Ast0.MetaFunc(name,constraints,pure) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_id i tgt arity (Ast0.MetaFunc(name,constraints,pure)) | Ast0.MetaLocalFunc(name,constraints,pure) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_id i tgt arity (Ast0.MetaLocalFunc(name,constraints,pure)) | Ast0.DisjId(starter,id_list,mids,ender) -> let id_list = List.map (ident opt_allowed tgt) id_list in (match List.rev id_list with _::xs -> if anyopt xs (function Ast0.OptIdent(_) -> true | _ -> false) then fail i "opt only allowed in the last disjunct" | _ -> ()); Ast0.rewrap i (Ast0.DisjId(starter,id_list,mids,ender)) | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) | Ast0.AsIdent _ -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Expression *) let make_exp = make_opt_unique (function x -> Ast0.OptExp x) (function x -> Ast0.UniqueExp x) let rec top_expression opt_allowed tgt expr = let exp_same = all_same opt_allowed tgt in match Ast0.unwrap expr with Ast0.Ident(id) -> let new_id = ident opt_allowed tgt id in Ast0.rewrap expr (match Ast0.unwrap new_id with Ast0.OptIdent(id) -> Ast0.OptExp(Ast0.rewrap expr (Ast0.Ident(id))) | Ast0.UniqueIdent(id) -> Ast0.UniqueExp(Ast0.rewrap expr (Ast0.Ident(id))) | _ -> Ast0.Ident(new_id)) | Ast0.Constant(const) -> let arity = exp_same (mcode2line const) [mcode2arity const] in let const = mcode const in make_exp expr tgt arity (Ast0.Constant(const)) | Ast0.StringConstant(lq,str,rq) -> (* all components on the same line, so this is probably pointless... *) let arity = exp_same (mcode2line lq) [mcode2arity lq;mcode2arity rq] in let lq = mcode lq in let str = dots (string_fragment arity) str in let rq = mcode rq in make_exp expr tgt arity (Ast0.StringConstant(lq,str,rq)) | Ast0.FunCall(fn,lp,args,rp) -> let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let fn = expression arity fn in let lp = mcode lp in let args = dots (expression arity) args in let rp = mcode rp in make_exp expr tgt arity (Ast0.FunCall(fn,lp,args,rp)) | Ast0.Assignment(left,op,right,simple) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let left = expression arity left in let op = mcode op in let right = expression arity right in make_exp expr tgt arity (Ast0.Assignment(left,op,right,simple)) | Ast0.Sequence(left,op,right) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let left = expression arity left in let op = mcode op in let right = expression arity right in make_exp expr tgt arity (Ast0.Sequence(left,op,right)) | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let arity = exp_same (mcode2line why) [mcode2arity why; mcode2arity colon] in let exp1 = expression arity exp1 in let why = mcode why in let exp2 = get_option (expression arity) exp2 in let colon = mcode colon in let exp3 = expression arity exp3 in make_exp expr tgt arity (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) | Ast0.Postfix(exp,op) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let exp = expression arity exp in let op = mcode op in make_exp expr tgt arity (Ast0.Postfix(exp,op)) | Ast0.Infix(exp,op) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let exp = expression arity exp in let op = mcode op in make_exp expr tgt arity (Ast0.Infix(exp,op)) | Ast0.Unary(exp,op) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let exp = expression arity exp in let op = mcode op in make_exp expr tgt arity (Ast0.Unary(exp,op)) | Ast0.Binary(left,op,right) -> let arity = exp_same (mcode2line op) [mcode2arity op] in let left = expression arity left in let op = mcode op in let right = expression arity right in make_exp expr tgt arity (Ast0.Binary(left,op,right)) | Ast0.Nested(left,op,right) -> failwith "nested in arity not possible" | Ast0.Paren(lp,exp,rp) -> let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in make_exp expr tgt arity (Ast0.Paren(lp,exp,rp)) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> let arity = exp_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in let exp1 = expression arity exp1 in let lb = mcode lb in let exp2 = expression arity exp2 in let rb = mcode rb in make_exp expr tgt arity (Ast0.ArrayAccess(exp1,lb,exp2,rb)) | Ast0.RecordAccess(exp,pt,field) -> let arity = exp_same (mcode2line pt) [mcode2arity pt] in let exp = expression arity exp in let pt = mcode pt in let field = ident false arity field in make_exp expr tgt arity (Ast0.RecordAccess(exp,pt,field)) | Ast0.RecordPtAccess(exp,ar,field) -> let arity = exp_same (mcode2line ar) [mcode2arity ar] in let exp = expression arity exp in let ar = mcode ar in let field = ident false arity field in make_exp expr tgt arity (Ast0.RecordPtAccess(exp,ar,field)) | Ast0.Cast(lp,ty,rp,exp) -> let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let lp = mcode lp in let ty = typeC arity ty in let rp = mcode rp in let exp = expression arity exp in make_exp expr tgt arity (Ast0.Cast(lp,ty,rp,exp)) | Ast0.SizeOfExpr(szf,exp) -> let arity = exp_same (mcode2line szf) [mcode2arity szf] in let szf = mcode szf in let exp = expression arity exp in make_exp expr tgt arity (Ast0.SizeOfExpr(szf,exp)) | Ast0.SizeOfType(szf,lp,ty,rp) -> let arity = exp_same (mcode2line szf) (List.map mcode2arity [szf;lp;rp]) in let szf = mcode szf in let lp = mcode lp in let ty = typeC arity ty in let rp = mcode rp in make_exp expr tgt arity (Ast0.SizeOfType(szf,lp,ty,rp)) | Ast0.TypeExp(ty) -> Ast0.rewrap expr (Ast0.TypeExp(typeC tgt ty)) | Ast0.MetaErr(name,constraints,pure) -> let arity = exp_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_exp expr tgt arity (Ast0.MetaErr(name,constraints,pure)) | Ast0.MetaExpr(name,constraints,ty,form,pure) -> let arity = exp_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_exp expr tgt arity (Ast0.MetaExpr(name,constraints,ty,form,pure)) | Ast0.MetaExprList(name,lenname,pure) -> let arity = exp_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_exp expr tgt arity (Ast0.MetaExprList(name,lenname,pure)) | Ast0.EComma(cm) -> let arity = exp_same (mcode2line cm) [mcode2arity cm] in let cm = mcode cm in make_exp expr tgt arity (Ast0.EComma(cm)) | Ast0.DisjExpr(starter,exps,mids,ender) -> let exps = List.map (top_expression opt_allowed tgt) exps in (match List.rev exps with _::xs -> if anyopt xs (function Ast0.OptExp(_) -> true | _ -> false) then fail expr "opt only allowed in the last disjunct" | _ -> ()); Ast0.rewrap expr (Ast0.DisjExpr(starter,exps,mids,ender)) | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) -> let res = Ast0.NestExpr(starter, dots (top_expression true Ast0.NONE) exp_dots, ender,whencode,multi) in Ast0.rewrap expr res | Ast0.Edots(dots,whencode) -> let arity = exp_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whencode = get_option (expression Ast0.NONE) whencode in make_exp expr tgt arity (Ast0.Edots(dots,whencode)) | Ast0.Ecircles(dots,whencode) -> let arity = exp_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whencode = get_option (expression Ast0.NONE) whencode in make_exp expr tgt arity (Ast0.Ecircles(dots,whencode)) | Ast0.Estars(dots,whencode) -> let arity = exp_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whencode = get_option (expression Ast0.NONE) whencode in make_exp expr tgt arity (Ast0.Estars(dots,whencode)) | Ast0.Constructor(lp,ty,rp,init) -> let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let lp = mcode lp in let ty = typeC arity ty in let rp = mcode rp in let init = initialiser arity init in make_exp expr tgt arity (Ast0.Constructor(lp,ty,rp,init)) (* why does optexp exist???? *) | Ast0.OptExp(_) | Ast0.UniqueExp(_) | Ast0.AsExpr _ -> failwith "unexpected code" and expression tgt exp = top_expression false tgt exp and make_fragment = make_opt_unique (function x -> failwith "opt not allowed for string fragment") (function x -> failwith "unique not allowed for string fragment") and string_fragment tgt e = match Ast0.unwrap e with Ast0.ConstantFragment(str) -> let arity = all_same false tgt (mcode2line str) [mcode2arity str] in let str = mcode str in make_fragment e tgt arity (Ast0.ConstantFragment(str)) | Ast0.FormatFragment(pct,fmt) -> let arity = all_same false tgt (mcode2line pct) [mcode2arity pct] in let pct = mcode pct in let fmt = string_format arity fmt in make_fragment e tgt arity (Ast0.FormatFragment(pct,fmt)) | Ast0.Strdots(dots) -> let arity = all_same false tgt (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_fragment e tgt arity (Ast0.Strdots(dots)) | Ast0.MetaFormatList(pct,name,lenname) -> let arity = all_same false tgt (mcode2line pct) [mcode2arity pct; mcode2arity name] in let pct = mcode pct in let name = mcode name in make_fragment e tgt arity (Ast0.MetaFormatList(pct,name,lenname)) and make_format = make_opt_unique (function x -> failwith "opt not allowed for string format") (function x -> failwith "unique not allowed for string format") and string_format tgt e = match Ast0.unwrap e with Ast0.ConstantFormat(str) -> let arity = all_same false tgt (mcode2line str) [mcode2arity str] in let str = mcode str in make_format e tgt arity (Ast0.ConstantFormat(str)) | Ast0.MetaFormat(name,constraints) -> let arity = all_same false tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_format e tgt arity (Ast0.MetaFormat(name,constraints)) (* --------------------------------------------------------------------- *) (* Types *) and make_typeC = make_opt_unique (function x -> Ast0.OptType x) (function x -> Ast0.UniqueType x) and top_typeC tgt opt_allowed typ = match Ast0.unwrap typ with Ast0.ConstVol(cv,ty) -> let arity = all_same opt_allowed tgt (mcode2line cv) [mcode2arity cv] in let cv = mcode cv in let ty = typeC arity ty in make_typeC typ tgt arity (Ast0.ConstVol(cv,ty)) | Ast0.BaseType(ty,strings) -> let arity = all_same opt_allowed tgt (mcode2line (List.hd strings)) (List.map mcode2arity strings) in let strings = List.map mcode strings in make_typeC typ tgt arity (Ast0.BaseType(ty,strings)) | Ast0.Signed(sign,ty) -> let arity = all_same opt_allowed tgt (mcode2line sign) [mcode2arity sign] in let sign = mcode sign in let ty = get_option (typeC arity) ty in make_typeC typ tgt arity (Ast0.Signed(sign,ty)) | Ast0.Pointer(ty,star) -> let arity = all_same opt_allowed tgt (mcode2line star) [mcode2arity star] in let ty = typeC arity ty in let star = mcode star in make_typeC typ tgt arity (Ast0.Pointer(ty,star)) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> let arity = all_same opt_allowed tgt (mcode2line lp1) (List.map mcode2arity [lp1;star;rp1;lp2;rp2]) in let ty = typeC arity ty in let params = parameter_list tgt params in make_typeC typ tgt arity (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) | Ast0.FunctionType(ty,lp1,params,rp1) -> let arity = all_same opt_allowed tgt (mcode2line lp1) (List.map mcode2arity [lp1;rp1]) in let ty = get_option (typeC arity) ty in let params = parameter_list tgt params in make_typeC typ tgt arity (Ast0.FunctionType(ty,lp1,params,rp1)) | Ast0.Array(ty,lb,size,rb) -> let arity = all_same opt_allowed tgt (mcode2line lb) [mcode2arity lb;mcode2arity rb] in let ty = typeC arity ty in let lb = mcode lb in let size = get_option (expression arity) size in let rb = mcode rb in make_typeC typ tgt arity (Ast0.Array(ty,lb,size,rb)) | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> let arity = all_same opt_allowed tgt (mcode2line dec) [mcode2arity dec;mcode2arity lp;mcode2arity rp] in let dec = mcode dec in let lp = mcode lp in let length = expression arity length in let comma = get_option mcode comma in let precision_opt = get_option (expression arity) precision_opt in let rp = mcode rp in make_typeC typ tgt arity (Ast0.Decimal(dec,lp,length,comma,precision_opt,rp)) | Ast0.EnumName(kind,name) -> let arity = all_same opt_allowed tgt (mcode2line kind) [mcode2arity kind] in let kind = mcode kind in let name = get_option (ident false arity) name in make_typeC typ tgt arity (Ast0.EnumName(kind,name)) | Ast0.EnumDef(ty,lb,decls,rb) -> let arity = all_same opt_allowed tgt (mcode2line lb) (List.map mcode2arity [lb;rb]) in let ty = typeC arity ty in let lb = mcode lb in let ids = dots (expression tgt) decls in let rb = mcode rb in make_typeC typ tgt arity (Ast0.EnumDef(ty,lb,ids,rb)) | Ast0.StructUnionName(kind,name) -> let arity = all_same opt_allowed tgt (mcode2line kind) [mcode2arity kind] in let kind = mcode kind in let name = get_option (ident false arity) name in make_typeC typ tgt arity (Ast0.StructUnionName(kind,name)) | Ast0.StructUnionDef(ty,lb,decls,rb) -> let arity = all_same opt_allowed tgt (mcode2line lb) (List.map mcode2arity [lb;rb]) in let ty = typeC arity ty in let lb = mcode lb in let decls = dots (declaration tgt) decls in let rb = mcode rb in make_typeC typ tgt arity (Ast0.StructUnionDef(ty,lb,decls,rb)) | Ast0.TypeName(name) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_typeC typ tgt arity (Ast0.TypeName(name)) | Ast0.MetaType(name,pure) -> let arity = all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_typeC typ tgt arity (Ast0.MetaType(name,pure)) | Ast0.DisjType(starter,types,mids,ender) -> let types = List.map (typeC tgt) types in (match List.rev types with _::xs -> if anyopt xs (function Ast0.OptType(_) -> true | _ -> false) then fail typ "opt only allowed in the last disjunct" | _ -> ()); let res = Ast0.DisjType(starter,types,mids,ender) in Ast0.rewrap typ res | Ast0.OptType(_) | Ast0.UniqueType(_) | Ast0.AsType _ -> failwith "unexpected code" and typeC tgt ty = top_typeC tgt false ty (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and make_decl = make_opt_unique (function x -> Ast0.OptDecl x) (function x -> Ast0.UniqueDecl x) and declaration tgt decl = match Ast0.unwrap decl with Ast0.MetaDecl(name,pure) -> let arity = all_same true tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_decl decl tgt arity (Ast0.MetaDecl(name,pure)) | Ast0.MetaField(name,pure) -> let arity = all_same true tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_decl decl tgt arity (Ast0.MetaField(name,pure)) | Ast0.MetaFieldList(name,lenname,pure) -> let arity = all_same true tgt (mcode2line name) [mcode2arity name] in let name = mcode name in make_decl decl tgt arity (Ast0.MetaFieldList(name,lenname,pure)) | Ast0.Init(stg,ty,id,eq,exp,sem) -> let arity = all_same true tgt (mcode2line eq) ((match stg with None -> [] | Some x -> [mcode2arity x]) @ (List.map mcode2arity [eq;sem])) in let stg = get_option mcode stg in let ty = typeC arity ty in let id = ident false arity id in let eq = mcode eq in let exp = initialiser arity exp in let sem = mcode sem in make_decl decl tgt arity (Ast0.Init(stg,ty,id,eq,exp,sem)) | Ast0.UnInit(stg,ty,id,sem) -> let arity = all_same true tgt (mcode2line sem) ((match stg with None -> [] | Some x -> [mcode2arity x]) @ [mcode2arity sem]) in let stg = get_option mcode stg in let ty = typeC arity ty in let id = ident false arity id in let sem = mcode sem in make_decl decl tgt arity (Ast0.UnInit(stg,ty,id,sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let arity = all_same true tgt (mcode2line lp) (List.map mcode2arity [lp;rp;sem]) in let name = ident false arity name in let lp = mcode lp in let args = dots (expression arity) args in let rp = mcode rp in let sem = mcode sem in make_decl decl tgt arity (Ast0.MacroDecl(name,lp,args,rp,sem)) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> let arity = all_same true tgt (mcode2line lp) (List.map mcode2arity [lp;rp;eq;sem]) in let name = ident false arity name in let lp = mcode lp in let args = dots (expression arity) args in let rp = mcode rp in let ini = initialiser arity ini in let sem = mcode sem in make_decl decl tgt arity (Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) | Ast0.TyDecl(ty,sem) -> let arity = all_same true tgt (mcode2line sem) [mcode2arity sem] in let ty = typeC arity ty in let sem = mcode sem in make_decl decl tgt arity (Ast0.TyDecl(ty,sem)) | Ast0.Typedef(stg,ty,id,sem) -> let arity = all_same true tgt (mcode2line sem) [mcode2arity stg;mcode2arity sem] in let stg = mcode stg in let ty = typeC arity ty in let id = typeC arity id in let sem = mcode sem in make_decl decl tgt arity (Ast0.Typedef(stg,ty,id,sem)) | Ast0.DisjDecl(starter,decls,mids,ender) -> let decls = List.map (declaration tgt) decls in (match List.rev decls with _::xs -> if anyopt xs (function Ast0.OptDecl(_) -> true | _ -> false) then fail decl "opt only allowed in the last disjunct" | _ -> ()); let res = Ast0.DisjDecl(starter,decls,mids,ender) in Ast0.rewrap decl res | Ast0.Ddots(dots,whencode) -> let arity = all_same true tgt (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whencode = get_option (declaration Ast0.NONE) whencode in make_decl decl tgt arity (Ast0.Ddots(dots,whencode)) | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) | Ast0.AsDecl _ -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Initializer *) and make_init = make_opt_unique (function x -> Ast0.OptIni x) (function x -> Ast0.UniqueIni x) and initialiser tgt i = let init_same = all_same true tgt in match Ast0.unwrap i with Ast0.MetaInit(name,pure) -> let arity = init_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_init i tgt arity (Ast0.MetaInit(name,pure)) | Ast0.MetaInitList(name,lenname,pure) -> let arity = init_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_init i tgt arity (Ast0.MetaInitList(name,lenname,pure)) | Ast0.InitExpr(exp) -> Ast0.rewrap i (Ast0.InitExpr(expression tgt exp)) | Ast0.InitList(lb,initlist,rb,ordered) -> let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in let lb = mcode lb in let initlist = dots (initialiser arity) initlist in let rb = mcode rb in make_init i tgt arity (Ast0.InitList(lb,initlist,rb,ordered)) | Ast0.InitGccExt(designators,eq,ini) -> let arity = init_same (mcode2line eq) [mcode2arity eq] in let designators = List.map (designator arity) designators in let eq = mcode eq in let ini = initialiser arity ini in make_init i tgt arity (Ast0.InitGccExt(designators,eq,ini)) | Ast0.InitGccName(name,eq,ini) -> let arity = init_same (mcode2line eq) [mcode2arity eq] in let name = ident true arity name in let eq = mcode eq in let ini = initialiser arity ini in make_init i tgt arity (Ast0.InitGccName(name,eq,ini)) | Ast0.IComma(cm) -> let arity = init_same (mcode2line cm) [mcode2arity cm] in let cm = mcode cm in make_init i tgt arity (Ast0.IComma(cm)) | Ast0.Idots(dots,whencode) -> let arity = init_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whencode = get_option (initialiser Ast0.NONE) whencode in make_init i tgt arity (Ast0.Idots(dots,whencode)) | Ast0.OptIni(_) | Ast0.UniqueIni(_) | Ast0.AsInit _ -> failwith "unexpected code" and designator tgt d = let dsame = all_same false tgt in match d with Ast0.DesignatorField(dot,id) -> let arity = dsame (mcode2line dot) [mcode2arity dot] in let dot = mcode dot in let id = ident false arity id in Ast0.DesignatorField(dot,id) | Ast0.DesignatorIndex(lb,exp,rb) -> let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity rb] in let lb = mcode lb in let exp = top_expression false arity exp in let rb = mcode rb in Ast0.DesignatorIndex(lb,exp,rb) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity dots;mcode2arity rb] in let lb = mcode lb in let min = top_expression false arity min in let dots = mcode dots in let max = top_expression false arity max in let rb = mcode rb in Ast0.DesignatorRange(lb,min,dots,max,rb) (* --------------------------------------------------------------------- *) (* Parameter *) and make_param = make_opt_unique (function x -> Ast0.OptParam x) (function x -> Ast0.UniqueParam x) and parameterTypeDef tgt param = let param_same = all_same true tgt in match Ast0.unwrap param with Ast0.VoidParam(ty) -> Ast0.rewrap param (Ast0.VoidParam(typeC tgt ty)) | Ast0.Param(ty,Some id) -> let ty = top_typeC tgt true ty in let id = ident true tgt id in Ast0.rewrap param (match (Ast0.unwrap ty,Ast0.unwrap id) with (Ast0.OptType(ty),Ast0.OptIdent(id)) -> Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,Some id))) | (Ast0.UniqueType(ty),Ast0.UniqueIdent(id)) -> Ast0.UniqueParam(Ast0.rewrap param (Ast0.Param(ty,Some id))) | (Ast0.OptType(ty),_) -> fail param "arity mismatch in param declaration" | (_,Ast0.OptIdent(id)) -> fail param "arity mismatch in param declaration" | _ -> Ast0.Param(ty,Some id)) | Ast0.Param(ty,None) -> let ty = top_typeC tgt true ty in Ast0.rewrap param (match Ast0.unwrap ty with Ast0.OptType(ty) -> Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,None))) | Ast0.UniqueType(ty) -> Ast0.UniqueParam(Ast0.rewrap param (Ast0.Param(ty,None))) | _ -> Ast0.Param(ty,None)) | Ast0.MetaParam(name,pure) -> let arity = param_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_param param tgt arity (Ast0.MetaParam(name,pure)) | Ast0.MetaParamList(name,lenname,pure) -> let arity = param_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_param param tgt arity (Ast0.MetaParamList(name,lenname,pure)) | Ast0.PComma(cm) -> let arity = param_same (mcode2line cm) [mcode2arity cm] in let cm = mcode cm in make_param param tgt arity (Ast0.PComma(cm)) | Ast0.Pdots(dots) -> let arity = param_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_param param tgt arity (Ast0.Pdots(dots)) | Ast0.Pcircles(dots) -> let arity = param_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_param param tgt arity (Ast0.Pcircles(dots)) | Ast0.OptParam(_) | Ast0.UniqueParam(_) | Ast0.AsParam _ -> failwith "unexpected code" and parameter_list tgt = dots (parameterTypeDef tgt) (* --------------------------------------------------------------------- *) (* Top-level code *) and make_rule_elem x = make_opt_unique (function x -> Ast0.OptStm x) (function x -> Ast0.UniqueStm x) x and statement tgt stm = let stm_same = all_same true tgt in match Ast0.unwrap stm with Ast0.Decl(bef,decl) -> let new_decl = declaration tgt decl in Ast0.rewrap stm (match Ast0.unwrap new_decl with Ast0.OptDecl(decl) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.Decl(bef,decl))) | Ast0.UniqueDecl(decl) -> Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Decl(bef,decl))) | _ -> Ast0.Decl(bef,new_decl)) | Ast0.Seq(lbrace,body,rbrace) -> let arity = stm_same (mcode2line lbrace) [mcode2arity lbrace; mcode2arity rbrace] in let lbrace = mcode lbrace in let body = dots (statement arity) body in let rbrace = mcode rbrace in make_rule_elem stm tgt arity (Ast0.Seq(lbrace,body,rbrace)) | Ast0.ExprStatement(exp,sem) -> let arity = stm_same (mcode2line sem) [mcode2arity sem] in let exp = get_option (expression arity) exp in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.ExprStatement(exp,sem)) | Ast0.IfThen(iff,lp,exp,rp,branch,aft) -> let arity = stm_same (mcode2line iff) (List.map mcode2arity [iff;lp;rp]) in let iff = mcode iff in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in let branch = statement arity branch in make_rule_elem stm tgt arity (Ast0.IfThen(iff,lp,exp,rp,branch,aft)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> let arity = stm_same (mcode2line iff) (List.map mcode2arity [iff;lp;rp;els]) in let iff = mcode iff in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in let branch1 = statement arity branch1 in let els = mcode els in let branch2 = statement arity branch2 in make_rule_elem stm tgt arity (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft)) | Ast0.While(wh,lp,exp,rp,body,aft) -> let arity = stm_same (mcode2line wh) (List.map mcode2arity [wh;lp;rp]) in let wh = mcode wh in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in let body = statement arity body in make_rule_elem stm tgt arity (Ast0.While(wh,lp,exp,rp,body,aft)) | Ast0.Do(d,body,wh,lp,exp,rp,sem) -> let arity = stm_same (mcode2line wh) (List.map mcode2arity [d;wh;lp;rp;sem]) in let d = mcode d in let body = statement arity body in let wh = mcode wh in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Do(d,body,wh,lp,exp,rp,sem)) | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,aft) -> let arity = let mcodes = [fr;lp;sem2;rp] in let mcodes = match Ast0.unwrap first with Ast0.ForExp(exp1,sem1) -> sem1::mcodes | Ast0.ForDecl _ -> mcodes in stm_same (mcode2line fr) (List.map mcode2arity mcodes) in let fr = mcode fr in let lp = mcode lp in let first = match Ast0.unwrap first with Ast0.ForExp(exp1,sem1) -> let exp1 = get_option (expression arity) exp1 in let sem1 = mcode sem1 in Ast0.rewrap first (Ast0.ForExp(exp1,sem1)) | Ast0.ForDecl (bef,decl) -> Ast0.rewrap first (Ast0.ForDecl(bef,declaration arity decl)) in let exp2 = get_option (expression arity) exp2 in let sem2 = mcode sem2 in let exp3 = get_option (expression arity) exp3 in let rp = mcode rp in let body = statement arity body in make_rule_elem stm tgt arity (Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,aft)) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> let arity = stm_same (mcode2line lp) (List.map mcode2arity [lp;rp]) in let nm = ident false arity nm in let lp = mcode lp in let args = dots (expression arity) args in let rp = mcode rp in let body = statement arity body in make_rule_elem stm tgt arity (Ast0.Iterator(nm,lp,args,rp,body,aft)) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> let arity = stm_same (mcode2line switch) (List.map mcode2arity [switch;lp;rp;lb;rb]) in let switch = mcode switch in let lp = mcode lp in let exp = expression arity exp in let rp = mcode rp in let lb = mcode lb in let decls = dots (statement arity) decls in let cases = dots (case_line arity) cases in let rb = mcode rb in make_rule_elem stm tgt arity (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) | Ast0.Break(br,sem) -> let arity = stm_same (mcode2line br) (List.map mcode2arity [br;sem]) in let br = mcode br in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Break(br,sem)) | Ast0.Continue(cont,sem) -> let arity = stm_same (mcode2line cont) (List.map mcode2arity [cont;sem]) in let cont = mcode cont in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Continue(cont,sem)) | Ast0.Label(l,dd) -> let arity = mcode2arity dd in let l = ident false tgt l in let dd = mcode dd in make_rule_elem stm tgt arity (Ast0.Label(l,dd)) | Ast0.Goto(goto,l,sem) -> let arity = stm_same (mcode2line goto) (List.map mcode2arity [goto;sem]) in let goto = mcode goto in let l = ident false arity l in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Goto(goto,l,sem)) | Ast0.Return(ret,sem) -> let arity = stm_same (mcode2line ret) (List.map mcode2arity [ret;sem]) in let ret = mcode ret in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Return(ret,sem)) | Ast0.ReturnExpr(ret,exp,sem) -> let arity = stm_same (mcode2line ret) (List.map mcode2arity [ret;sem]) in let ret = mcode ret in let exp = expression arity exp in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.ReturnExpr(ret,exp,sem)) | Ast0.MetaStmt(name,pure) -> let arity = stm_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_rule_elem stm tgt arity (Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,pure) -> let arity = stm_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_rule_elem stm tgt arity (Ast0.MetaStmtList(name,pure)) | Ast0.Exp(exp) -> let new_exp = top_expression true tgt exp in Ast0.rewrap stm (match Ast0.unwrap new_exp with Ast0.OptExp(exp) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.Exp(exp))) | Ast0.UniqueExp(exp) -> Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Exp(exp))) | _ -> Ast0.Exp(new_exp)) | Ast0.TopExp(exp) -> let new_exp = top_expression true tgt exp in Ast0.rewrap stm (match Ast0.unwrap new_exp with Ast0.OptExp(exp) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.TopExp(exp))) | Ast0.UniqueExp(exp) -> Ast0.UniqueStm(Ast0.rewrap stm (Ast0.TopExp(exp))) | _ -> Ast0.TopExp(new_exp)) | Ast0.Ty(ty) -> let new_ty = typeC tgt ty in (* opt makes no sense alone at top level *) Ast0.rewrap stm (match Ast0.unwrap new_ty with Ast0.OptType(ty) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.Ty(ty))) | Ast0.UniqueType(ty) -> Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Ty(ty))) | _ -> Ast0.Ty(new_ty)) | Ast0.TopInit(init) -> let new_init = initialiser tgt init in Ast0.rewrap stm (match Ast0.unwrap new_init with Ast0.OptIni(init) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.TopInit(init))) | Ast0.UniqueIni(init) -> Ast0.UniqueStm(Ast0.rewrap stm (Ast0.TopInit(init))) | _ -> Ast0.TopInit(new_init)) | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) -> let stms = List.map (function x -> concat_dots (statement tgt) x) rule_elem_dots_list in let (found_opt,unopt) = List.fold_left (function (found_opt,lines) -> function x -> let rebuild l = (* previously just checked the last thing in the list, but everything should be optional for the whole thing to be optional *) let is_opt x = match Ast0.unwrap x with Ast0.OptStm(x) -> true | _ -> false in let unopt x = match Ast0.unwrap x with Ast0.OptStm(x) -> x | _ -> x in if List.for_all is_opt l then (true,List.map unopt l) else (false, l) in let (l,k) = match Ast0.unwrap x with Ast0.DOTS(l) -> (l,function l -> Ast0.rewrap x (Ast0.DOTS l)) | Ast0.CIRCLES(l) -> (l,function l -> Ast0.rewrap x (Ast0.CIRCLES l)) | Ast0.STARS(l) -> (l,function l -> Ast0.rewrap x (Ast0.STARS l)) in let (found_opt,l) = rebuild l in (found_opt,(k l)::lines)) (false,[]) stms in let unopt = List.rev unopt in if found_opt then make_rule_elem stm tgt Ast0.OPT (Ast0.Disj(starter,unopt,mids,ender)) else Ast0.rewrap stm (Ast0.Disj(starter,stms,mids,ender)) | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) -> let new_rule_elem_dots = concat_dots (statement Ast0.NONE) rule_elem_dots in let whn = List.map (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE) (expression Ast0.NONE)) whn in Ast0.rewrap stm (Ast0.Nest(starter,new_rule_elem_dots,ender,whn,multi)) | Ast0.Dots(dots,whn) -> let arity = stm_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whn = List.map (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE) (expression Ast0.NONE)) whn in make_rule_elem stm tgt arity (Ast0.Dots(dots,whn)) | Ast0.Circles(dots,whn) -> let arity = stm_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whn = List.map (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE) (expression Ast0.NONE)) whn in make_rule_elem stm tgt arity (Ast0.Circles(dots,whn)) | Ast0.Stars(dots,whn) -> let arity = stm_same (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in let whn = List.map (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE) (expression Ast0.NONE)) whn in make_rule_elem stm tgt arity (Ast0.Stars(dots,whn)) | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> let arity = all_same true tgt (mcode2line lp) ((List.map mcode2arity [lp;rp;lbrace;rbrace]) @ (fninfo2arity fi)) in let fi = List.map (fninfo arity) fi in let name = ident false arity name in let lp = mcode lp in let params = parameter_list arity params in let rp = mcode rp in let lbrace = mcode lbrace in let body = dots (statement arity) body in let rbrace = mcode rbrace in make_rule_elem stm tgt arity (Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace)) | Ast0.Include(inc,s) -> let arity = all_same true tgt (mcode2line inc) [mcode2arity inc; mcode2arity s] in let inc = mcode inc in let s = mcode s in make_rule_elem stm tgt arity (Ast0.Include(inc,s)) | Ast0.Undef(def,id) -> let arity = all_same true tgt (mcode2line def) [mcode2arity def] in let def = mcode def in let id = ident false arity id in make_rule_elem stm tgt arity (Ast0.Undef(def,id)) | Ast0.Define(def,id,params,body) -> let arity = all_same true tgt (mcode2line def) [mcode2arity def] in let def = mcode def in let id = ident false arity id in let params = define_parameters arity params in let body = dots (statement arity) body in make_rule_elem stm tgt arity (Ast0.Define(def,id,params,body)) | Ast0.Pragma(prg,id,body) -> let arity = all_same true tgt (mcode2line prg) [mcode2arity prg] in let prg = mcode prg in let id = ident false arity id in let body = pragmainfo arity body in make_rule_elem stm tgt arity (Ast0.Pragma(prg,id,body)) | Ast0.OptStm(_) | Ast0.UniqueStm(_) | Ast0.AsStmt _ -> failwith "unexpected code" and make_pragma = make_opt_unique (function x -> failwith "opt not allowed for pragma") (function x -> failwith "unique not allowed for pragma") and pragmainfo tgt pi = match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> let arity = all_same false tgt (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let lp = mcode lp in let args = dots (expression arity) args in let rp = mcode rp in make_pragma pi tgt arity (Ast0.PragmaTuple(lp,args,rp)) | Ast0.PragmaIdList(ids) -> let ids = dots (ident false tgt) ids in make_pragma pi tgt tgt (Ast0.PragmaIdList(ids)) | Ast0.PragmaDots (dots) -> let arity = all_same false tgt (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_pragma pi tgt arity (Ast0.PragmaDots (dots)) and define_parameters tgt params = match Ast0.unwrap params with Ast0.NoParams -> params | Ast0.DParams(lp,params,rp) -> let arity = all_same true tgt (mcode2line lp) [mcode2arity lp;mcode2arity rp] in let lp = mcode lp in let params = dots (define_param arity) params in let rp = mcode rp in Ast0.rewrap params (Ast0.DParams(lp,params,rp)) and make_define_param x = make_opt_unique (function x -> Ast0.OptDParam x) (function x -> Ast0.UniqueDParam x) x and define_param tgt param = match Ast0.unwrap param with Ast0.DParam(id) -> let new_id = ident true tgt id in Ast0.rewrap param (match Ast0.unwrap new_id with Ast0.OptIdent(id) -> Ast0.OptDParam(Ast0.rewrap param (Ast0.DParam(id))) | Ast0.UniqueIdent(decl) -> Ast0.UniqueDParam(Ast0.rewrap param (Ast0.DParam(id))) | _ -> Ast0.DParam(new_id)) | Ast0.DPComma(cm) -> let arity = all_same true tgt (mcode2line cm) [mcode2arity cm] in let cm = mcode cm in make_define_param param tgt arity (Ast0.DPComma(cm)) | Ast0.DPdots(dots) -> let arity = all_same true tgt (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_define_param param tgt arity (Ast0.DPdots(dots)) | Ast0.DPcircles(circles) -> let arity = all_same true tgt (mcode2line circles) [mcode2arity circles] in let circles = mcode circles in make_define_param param tgt arity (Ast0.DPcircles(circles)) | Ast0.OptDParam(dp) | Ast0.UniqueDParam(dp) -> failwith "unexpected code" and fninfo arity = function Ast0.FStorage(stg) -> Ast0.FStorage(mcode stg) | Ast0.FType(ty) -> Ast0.FType(typeC arity ty) | Ast0.FInline(inline) -> Ast0.FInline(mcode inline) | Ast0.FAttr(attr) -> Ast0.FAttr(mcode attr) and fninfo2arity fninfo = List.concat (List.map (function Ast0.FStorage(stg) -> [mcode2arity stg] | Ast0.FType(ty) -> [] | Ast0.FInline(inline) -> [mcode2arity inline] | Ast0.FAttr(attr) -> [mcode2arity attr]) fninfo) and whencode notfn alwaysfn expression = function Ast0.WhenNot a -> Ast0.WhenNot (notfn a) | Ast0.WhenAlways a -> Ast0.WhenAlways (alwaysfn a) | Ast0.WhenModifier(x) -> Ast0.WhenModifier(x) | Ast0.WhenNotTrue a -> Ast0.WhenNotTrue (expression a) | Ast0.WhenNotFalse a -> Ast0.WhenNotFalse (expression a) and make_case_line = make_opt_unique (function x -> Ast0.OptCase x) (function x -> failwith "unique not allowed for case_line") and case_line tgt c = match Ast0.unwrap c with Ast0.Default(def,colon,code) -> let arity = all_same true tgt (mcode2line def) [mcode2arity def; mcode2arity colon] in let def = mcode def in let colon = mcode colon in let code = dots (statement arity) code in make_case_line c tgt arity (Ast0.Default(def,colon,code)) | Ast0.Case(case,exp,colon,code) -> let arity = all_same true tgt (mcode2line case) [mcode2arity case; mcode2arity colon] in let case = mcode case in let exp = expression arity exp in let colon = mcode colon in let code = dots (statement arity) code in make_case_line c tgt arity (Ast0.Case(case,exp,colon,code)) | Ast0.DisjCase(starter,case_lines,mids,ender) -> let case_lines = List.map (case_line tgt) case_lines in (match List.rev case_lines with _::xs -> if anyopt xs (function Ast0.OptCase(_) -> true | _ -> false) then fail c "opt only allowed in the last disjunct" | _ -> ()); Ast0.rewrap c (Ast0.DisjCase(starter,case_lines,mids,ender)) | Ast0.OptCase(_) -> failwith "unexpected OptCase" (* --------------------------------------------------------------------- *) (* Function declaration *) (* Haven't thought much about arity here... *) let top_level tgt t = Ast0.rewrap t (match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> if mcode2arity old_file = Ast0.NONE && mcode2arity new_file = Ast0.NONE then Ast0.FILEINFO(mcode old_file,mcode new_file) else fail t "unexpected arity for file info" | Ast0.NONDECL(stmt) -> Ast0.NONDECL(statement tgt stmt) | Ast0.CODE(rule_elem_dots) -> Ast0.CODE(concat_dots (statement tgt) rule_elem_dots) | Ast0.TOPCODE(rule_elem_dots) -> fail t "eliminated by top_level" | Ast0.ERRORWORDS(exps) -> Ast0.ERRORWORDS(List.map (top_expression false Ast0.NONE) exps) | Ast0.OTHER(_) -> fail t "eliminated by top_level") let rule tgt = List.map (top_level tgt) (* --------------------------------------------------------------------- *) (* Entry points *) let minus_arity code = rule Ast0.NONE code coccinelle-1.0.0-rc19/parsing_cocci/comm_assoc.ml0000644000175000017500000000571612247442615020654 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./comm_assoc.ml" (* searches for E op ..., for any commutative and associative binary operator. When this satisfies the isomorphism conditions (ie all minus, or context for the op and ...), then this is converted to Nested(E,op). Nested is not used before this phase. *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let comm_assoc = [Ast.Arith(Ast.Plus);Ast.Arith(Ast.Mul);Ast.Arith(Ast.And);Ast.Arith(Ast.Or); Ast.Logical(Ast.AndLog);Ast.Logical(Ast.OrLog)] let is_minus e = match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false let is_context e = !Flag.sgrep_mode2 or (* everything is context for sgrep *) (match Ast0.get_mcodekind e with Ast0.CONTEXT(cell) -> true | _ -> false) let nopos mc = (Ast0.get_pos mc) = [] let process_binops rule_name = let expr r k e1 = let e = k e1 in match Ast0.unwrap e with Ast0.Binary(left,op,right) when List.mem (Ast0.unwrap_mcode op) comm_assoc -> (match Ast0.unwrap right with Ast0.Edots(d,None) -> if (is_minus e || (is_context e && is_context right)) && nopos op && nopos d (* keep dots to record required modif *) then Ast0.rewrap e (Ast0.Nested(left,op,right)) else (Printf.printf "%s: position variables or mixed modifs interfere with comm_assoc iso" rule_name; Unparse_ast0.expression e1; Format.print_newline(); e) | Ast0.Edots(d,_) -> (Printf.printf "%s: whencode interferes with comm_assoc iso" rule_name; Unparse_ast0.expression e1; Format.print_newline(); e) | _ -> e) | _ -> e in V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_exprfn = expr} let comm_assoc rule rule_name dropped_isos = if List.mem "comm_assoc" dropped_isos then rule else List.map (process_binops rule_name).VT0.rebuilder_rec_top_level rule coccinelle-1.0.0-rc19/parsing_cocci/plus.mli0000644000175000017500000000232112247442616017653 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./plus.mli" val plus : Ast_cocci.rule -> (Ast_cocci.anything * int * int * int * int) list list list coccinelle-1.0.0-rc19/parsing_cocci/visitor_ast0_types.ml0000644000175000017500000002370312247442616022400 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./visitor_ast0_types.ml" module Ast0 = Ast0_cocci module Ast = Ast_cocci type ('a,'n) inout = 'a -> ('n * 'a) type 'n all_functions = {ident : (Ast0.ident,'n) inout; expression : (Ast0.expression,'n) inout; typeC : (Ast0.typeC,'n) inout; declaration : (Ast0.declaration,'n) inout; initialiser : (Ast0.initialiser,'n) inout; initialiser_list : (Ast0.initialiser_list,'n) inout; parameter : (Ast0.parameterTypeDef,'n) inout; parameter_list : (Ast0.parameter_list,'n) inout; statement : (Ast0.statement,'n) inout; forinfo : (Ast0.forinfo,'n) inout; case_line : (Ast0.case_line,'n) inout; top_level : (Ast0.top_level,'n) inout; expression_dots : (Ast0.expression Ast0.dots,'n) inout; statement_dots : (Ast0.statement Ast0.dots,'n) inout; declaration_dots : (Ast0.declaration Ast0.dots,'n) inout; case_line_dots : (Ast0.case_line Ast0.dots,'n) inout; anything : (Ast0.anything,'n) inout} (* ----------------------------------------------------------------------- *) (* combiner *) type ('a,'n) combiner_inout = 'a -> 'n type 'n combiner_rec_functions = {combiner_rec_ident : (Ast0.ident,'n) combiner_inout; combiner_rec_expression : (Ast0.expression,'n) combiner_inout; combiner_rec_typeC : (Ast0.typeC,'n) combiner_inout; combiner_rec_declaration : (Ast0.declaration,'n) combiner_inout; combiner_rec_initialiser : (Ast0.initialiser,'n) combiner_inout; combiner_rec_initialiser_list : (Ast0.initialiser_list,'n) combiner_inout; combiner_rec_parameter : (Ast0.parameterTypeDef,'n) combiner_inout; combiner_rec_parameter_list : (Ast0.parameter_list,'n) combiner_inout; combiner_rec_statement : (Ast0.statement,'n) combiner_inout; combiner_rec_forinfo : (Ast0.forinfo,'n) combiner_inout; combiner_rec_case_line : (Ast0.case_line,'n) combiner_inout; combiner_rec_top_level : (Ast0.top_level,'n) combiner_inout; combiner_rec_expression_dots : (Ast0.expression Ast0.dots,'n) combiner_inout; combiner_rec_statement_dots : (Ast0.statement Ast0.dots,'n) combiner_inout; combiner_rec_declaration_dots : (Ast0.declaration Ast0.dots,'n) combiner_inout; combiner_rec_case_line_dots : (Ast0.case_line Ast0.dots,'n) combiner_inout; combiner_rec_anything : (Ast0.anything,'n) combiner_inout} type ('mc,'n) cmcode = 'n -> 'mc Ast0.mcode -> 'n type ('mc,'n) flat_cmcode = 'mc Ast0.mcode -> 'n type ('cd,'n) ccode = 'n combiner_rec_functions -> ('cd -> 'n) -> 'cd -> 'n type 'n combiner_functions = {combiner_meta_mcode : (Ast.meta_name,'n) cmcode; combiner_string_mcode : (string,'n) cmcode; combiner_const_mcode : (Ast.constant,'n) cmcode; combiner_assign_mcode : (Ast.assignOp,'n) cmcode; combiner_fix_mcode : (Ast.fixOp,'n) cmcode; combiner_unary_mcode : (Ast.unaryOp,'n) cmcode; combiner_binary_mcode : (Ast.binaryOp,'n) cmcode; combiner_cv_mcode : (Ast.const_vol,'n) cmcode; combiner_sign_mcode : (Ast.sign,'n) cmcode; combiner_struct_mcode : (Ast.structUnion,'n) cmcode; combiner_storage_mcode : (Ast.storage,'n) cmcode; combiner_inc_mcode : (Ast.inc_file,'n) cmcode; combiner_dotsexprfn : (Ast0.expression Ast0.dots,'n) ccode; combiner_dotsinitfn : (Ast0.initialiser Ast0.dots,'n) ccode; combiner_dotsparamfn : (Ast0.parameterTypeDef Ast0.dots,'n) ccode; combiner_dotsstmtfn : (Ast0.statement Ast0.dots,'n) ccode; combiner_dotsdeclfn : (Ast0.declaration Ast0.dots,'n) ccode; combiner_dotscasefn : (Ast0.case_line Ast0.dots,'n) ccode; combiner_identfn : (Ast0.ident,'n) ccode; combiner_exprfn : (Ast0.expression,'n) ccode; combiner_tyfn : (Ast0.typeC,'n) ccode; combiner_initfn : (Ast0.initialiser,'n) ccode; combiner_paramfn : (Ast0.parameterTypeDef,'n) ccode; combiner_declfn : (Ast0.declaration,'n) ccode; combiner_stmtfn : (Ast0.statement,'n) ccode; combiner_forinfofn : (Ast0.forinfo,'n) ccode; combiner_casefn : (Ast0.case_line,'n) ccode; combiner_topfn : (Ast0.top_level,'n) ccode} (* ----------------------------------------------------------------------- *) (* rebuilder *) type 'a rebuilder_inout = 'a -> 'a type rebuilder_rec_functions = {rebuilder_rec_ident : Ast0.ident rebuilder_inout; rebuilder_rec_expression : Ast0.expression rebuilder_inout; rebuilder_rec_typeC : Ast0.typeC rebuilder_inout; rebuilder_rec_declaration : Ast0.declaration rebuilder_inout; rebuilder_rec_initialiser : Ast0.initialiser rebuilder_inout; rebuilder_rec_initialiser_list : Ast0.initialiser_list rebuilder_inout; rebuilder_rec_parameter : Ast0.parameterTypeDef rebuilder_inout; rebuilder_rec_parameter_list : Ast0.parameter_list rebuilder_inout; rebuilder_rec_statement : Ast0.statement rebuilder_inout; rebuilder_rec_forinfo : Ast0.forinfo rebuilder_inout; rebuilder_rec_case_line : Ast0.case_line rebuilder_inout; rebuilder_rec_top_level : Ast0.top_level rebuilder_inout; rebuilder_rec_expression_dots : Ast0.expression Ast0.dots rebuilder_inout; rebuilder_rec_statement_dots : Ast0.statement Ast0.dots rebuilder_inout; rebuilder_rec_declaration_dots : Ast0.declaration Ast0.dots rebuilder_inout; rebuilder_rec_case_line_dots : Ast0.case_line Ast0.dots rebuilder_inout; rebuilder_rec_anything : Ast0.anything rebuilder_inout} type 'mc rmcode = 'mc Ast0.mcode rebuilder_inout type 'cd rcode = rebuilder_rec_functions -> ('cd rebuilder_inout) -> 'cd rebuilder_inout type rebuilder_functions = {rebuilder_meta_mcode : Ast_cocci.meta_name rmcode; rebuilder_string_mcode : string rmcode; rebuilder_const_mcode : Ast.constant rmcode; rebuilder_assign_mcode : Ast.assignOp rmcode; rebuilder_fix_mcode : Ast.fixOp rmcode; rebuilder_unary_mcode : Ast.unaryOp rmcode; rebuilder_binary_mcode : Ast.binaryOp rmcode; rebuilder_cv_mcode : Ast.const_vol rmcode; rebuilder_sign_mcode : Ast.sign rmcode; rebuilder_struct_mcode : Ast.structUnion rmcode; rebuilder_storage_mcode : Ast.storage rmcode; rebuilder_inc_mcode : Ast.inc_file rmcode; rebuilder_dotsexprfn : Ast0.expression Ast0.dots rcode; rebuilder_dotsinitfn : Ast0.initialiser Ast0.dots rcode; rebuilder_dotsparamfn : Ast0.parameterTypeDef Ast0.dots rcode; rebuilder_dotsstmtfn : Ast0.statement Ast0.dots rcode; rebuilder_dotsdeclfn : Ast0.declaration Ast0.dots rcode; rebuilder_dotscasefn : Ast0.case_line Ast0.dots rcode; rebuilder_identfn : Ast0.ident rcode; rebuilder_exprfn : Ast0.expression rcode; rebuilder_tyfn : Ast0.typeC rcode; rebuilder_initfn : Ast0.initialiser rcode; rebuilder_paramfn : Ast0.parameterTypeDef rcode; rebuilder_declfn : Ast0.declaration rcode; rebuilder_stmtfn : Ast0.statement rcode; rebuilder_forinfofn : Ast0.forinfo rcode; rebuilder_casefn : Ast0.case_line rcode; rebuilder_topfn : Ast0.top_level rcode} (* ----------------------------------------------------------------------- *) (* combiner_rebuilder *) type ('mc,'a) rcmcode = 'a -> 'mc Ast0.mcode -> ('a * 'mc Ast0.mcode) type ('cd,'a) rccode = 'a all_functions -> ('cd -> ('a * 'cd)) -> 'cd -> ('a * 'cd) type 'n combiner_rebuilder_functions = {combiner_rebuilder_meta_mcode : (Ast_cocci.meta_name,'n) rcmcode; combiner_rebuilder_string_mcode : (string,'n) rcmcode; combiner_rebuilder_const_mcode : (Ast.constant,'n) rcmcode; combiner_rebuilder_assign_mcode : (Ast.assignOp,'n) rcmcode; combiner_rebuilder_fix_mcode : (Ast.fixOp,'n) rcmcode; combiner_rebuilder_unary_mcode : (Ast.unaryOp,'n) rcmcode; combiner_rebuilder_binary_mcode : (Ast.binaryOp,'n) rcmcode; combiner_rebuilder_cv_mcode : (Ast.const_vol,'n) rcmcode; combiner_rebuilder_sign_mcode : (Ast.sign,'n) rcmcode; combiner_rebuilder_struct_mcode : (Ast.structUnion,'n) rcmcode; combiner_rebuilder_storage_mcode : (Ast.storage,'n) rcmcode; combiner_rebuilder_inc_mcode : (Ast.inc_file,'n) rcmcode; combiner_rebuilder_dotsexprfn : (Ast0.expression Ast0.dots,'n) rccode; combiner_rebuilder_dotsinitfn : (Ast0.initialiser Ast0.dots,'n) rccode; combiner_rebuilder_dotsparamfn : (Ast0.parameterTypeDef Ast0.dots,'n) rccode; combiner_rebuilder_dotsstmtfn : (Ast0.statement Ast0.dots,'n) rccode; combiner_rebuilder_dotsdeclfn : (Ast0.declaration Ast0.dots,'n) rccode; combiner_rebuilder_dotscasefn : (Ast0.case_line Ast0.dots,'n) rccode; combiner_rebuilder_identfn : (Ast0.ident,'n) rccode; combiner_rebuilder_exprfn : (Ast0.expression,'n) rccode; combiner_rebuilder_tyfn : (Ast0.typeC,'n) rccode; combiner_rebuilder_initfn : (Ast0.initialiser,'n) rccode; combiner_rebuilder_paramfn : (Ast0.parameterTypeDef,'n) rccode; combiner_rebuilder_declfn : (Ast0.declaration,'n) rccode; combiner_rebuilder_stmtfn : (Ast0.statement,'n) rccode; combiner_rebuilder_forinfofn : (Ast0.forinfo,'n) rccode; combiner_rebuilder_casefn : (Ast0.case_line,'n) rccode; combiner_rebuilder_topfn : (Ast0.top_level,'n) rccode} coccinelle-1.0.0-rc19/parsing_cocci/README0000644000175000017500000000130112247437436017046 0ustar eugeneugenWorkflow: main.ml: an entry point to be used in place of the cocci top level, to check only the parsing of SmPL files. parse_cocci.ml: Initiates the parsing process and subsequent processing phases. There are two entry points: process: called by main, returns metavariables and merged ast code process_for_ctl: called by engine/main, returns no metavariables, but instead ast and ast0 code. ast code is used by ast0toctl for printing and ast0 code is transformed to CTL. arity.ml ast0_cocci.ml ast0toast.ml ast_cocci.ml check_meta.ml data.ml lexer_cocci.ml main.ml merge.ml parse_cocci.ml parser_cocci_menhir.ml parser_cocci.ml plus.ml semantic_cocci.ml top_level.ml unparse_cocci.ml coccinelle-1.0.0-rc19/parsing_cocci/visitor_ast0.ml0000644000175000017500000016323712247442615021162 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./visitor_ast0.ml" (* --------------------------------------------------------------------- *) (* Generic traversal: rebuilder *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module VT0 = Visitor_ast0_types type mode = COMBINER | REBUILDER | BOTH let map_split f l = List.split(List.map f l) let rewrap x (n,e) = (n,Ast0.rewrap x e) let visitor mode bind option_default meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = let multibind l = let rec loop = function [] -> option_default | [x] -> x | x::xs -> bind x (loop xs) in loop l in let map_split_bind f l = let (n,e) = List.split(List.map f l) in (multibind n,e) in let get_option f = function Some x -> let (n,e) = f x in (n,Some e) | None -> (option_default,None) in let do_disj starter lst mids ender processor rebuilder = let (starter_n,starter) = string_mcode starter in let (lst_n,lst) = map_split processor lst in let (mids_n,mids) = map_split string_mcode mids in let (ender_n,ender) = string_mcode ender in (multibind [starter_n;List.hd lst_n; multibind (List.map2 bind mids_n (List.tl lst_n));ender_n], rebuilder starter lst mids ender) in let dotsfn param default all_functions arg = let k d = rewrap d (match Ast0.unwrap d with Ast0.DOTS(l) -> let (n,l) = map_split_bind default l in (n,Ast0.DOTS(l)) | Ast0.CIRCLES(l) -> let (n,l) = map_split_bind default l in (n,Ast0.CIRCLES(l)) | Ast0.STARS(l) -> let (n,l) = map_split_bind default l in (n,Ast0.STARS(l))) in param all_functions k arg in let iddotsfn all_functions k arg = k arg in let strdotsfn all_functions k arg = k arg in let rec expression_dots d = dotsfn dotsexprfn expression all_functions d and identifier_dots d = dotsfn iddotsfn ident all_functions d and initialiser_dots d = dotsfn dotsinitfn initialiser all_functions d and parameter_dots d = dotsfn dotsparamfn parameterTypeDef all_functions d and statement_dots d = dotsfn dotsstmtfn statement all_functions d and declaration_dots d = dotsfn dotsdeclfn declaration all_functions d and case_line_dots d = dotsfn dotscasefn case_line all_functions d and string_fragment_dots d = dotsfn strdotsfn string_fragment all_functions d and ident i = let k i = rewrap i (match Ast0.unwrap i with Ast0.Id(name) -> let (n,name) = string_mcode name in (n,Ast0.Id(name)) | Ast0.MetaId(name,constraints,seed,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaId(name,constraints,seed,pure)) | Ast0.MetaFunc(name,constraints,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaFunc(name,constraints,pure)) | Ast0.MetaLocalFunc(name,constraints,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaLocalFunc(name,constraints,pure)) | Ast0.DisjId(starter,id_list,mids,ender) -> do_disj starter id_list mids ender ident (fun starter id_list mids ender -> Ast0.DisjId(starter,id_list,mids,ender)) | Ast0.OptIdent(id) -> let (n,id) = ident id in (n,Ast0.OptIdent(id)) | Ast0.UniqueIdent(id) -> let (n,id) = ident id in (n,Ast0.UniqueIdent(id)) | Ast0.AsIdent(id,asid) -> let (id_n,id) = ident id in let (asid_n,asid) = ident asid in (bind id_n asid_n, Ast0.AsIdent(id,asid))) in identfn all_functions k i and expression e = let k e = rewrap e (match Ast0.unwrap e with Ast0.Ident(id) -> let (n,id) = ident id in (n,Ast0.Ident(id)) | Ast0.Constant(const) -> let (n,const) = const_mcode const in (n,Ast0.Constant(const)) | Ast0.StringConstant(lq,str,rq) -> let (lq_n,lq) = string_mcode lq in let (str_n,str) = string_fragment_dots str in let (rq_n,rq) = string_mcode rq in (multibind [lq_n;str_n;rq_n],Ast0.StringConstant(lq,str,rq)) | Ast0.FunCall(fn,lp,args,rp) -> let (fn_n,fn) = expression fn in let (lp_n,lp) = string_mcode lp in let (args_n,args) = expression_dots args in let (rp_n,rp) = string_mcode rp in (multibind [fn_n;lp_n;args_n;rp_n], Ast0.FunCall(fn,lp,args,rp)) | Ast0.Assignment(left,op,right,simple) -> let (left_n,left) = expression left in let (op_n,op) = assign_mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Assignment(left,op,right,simple)) | Ast0.Sequence(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = string_mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Sequence(left,op,right)) | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let (exp1_n,exp1) = expression exp1 in let (why_n,why) = string_mcode why in let (exp2_n,exp2) = get_option expression exp2 in let (colon_n,colon) = string_mcode colon in let (exp3_n,exp3) = expression exp3 in (multibind [exp1_n;why_n;exp2_n;colon_n;exp3_n], Ast0.CondExpr(exp1,why,exp2,colon,exp3)) | Ast0.Postfix(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = fix_mcode op in (bind exp_n op_n, Ast0.Postfix(exp,op)) | Ast0.Infix(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = fix_mcode op in (bind op_n exp_n, Ast0.Infix(exp,op)) | Ast0.Unary(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = unary_mcode op in (bind op_n exp_n, Ast0.Unary(exp,op)) | Ast0.Binary(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = binary_mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Binary(left,op,right)) | Ast0.Nested(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = binary_mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Nested(left,op,right)) | Ast0.Paren(lp,exp,rp) -> let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in (multibind [lp_n;exp_n;rp_n], Ast0.Paren(lp,exp,rp)) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> let (exp1_n,exp1) = expression exp1 in let (lb_n,lb) = string_mcode lb in let (exp2_n,exp2) = expression exp2 in let (rb_n,rb) = string_mcode rb in (multibind [exp1_n;lb_n;exp2_n;rb_n], Ast0.ArrayAccess(exp1,lb,exp2,rb)) | Ast0.RecordAccess(exp,pt,field) -> let (exp_n,exp) = expression exp in let (pt_n,pt) = string_mcode pt in let (field_n,field) = ident field in (multibind [exp_n;pt_n;field_n], Ast0.RecordAccess(exp,pt,field)) | Ast0.RecordPtAccess(exp,ar,field) -> let (exp_n,exp) = expression exp in let (ar_n,ar) = string_mcode ar in let (field_n,field) = ident field in (multibind [exp_n;ar_n;field_n], Ast0.RecordPtAccess(exp,ar,field)) | Ast0.Cast(lp,ty,rp,exp) -> let (lp_n,lp) = string_mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = string_mcode rp in let (exp_n,exp) = expression exp in (multibind [lp_n;ty_n;rp_n;exp_n], Ast0.Cast(lp,ty,rp,exp)) | Ast0.SizeOfExpr(szf,exp) -> let (szf_n,szf) = string_mcode szf in let (exp_n,exp) = expression exp in (multibind [szf_n;exp_n],Ast0.SizeOfExpr(szf,exp)) | Ast0.SizeOfType(szf,lp,ty,rp) -> let (szf_n,szf) = string_mcode szf in let (lp_n,lp) = string_mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = string_mcode rp in (multibind [szf_n;lp_n;ty_n;rp_n], Ast0.SizeOfType(szf,lp,ty,rp)) | Ast0.TypeExp(ty) -> let (ty_n,ty) = typeC ty in (ty_n,Ast0.TypeExp(ty)) | Ast0.Constructor(lp,ty,rp,init) -> let (lp_n,lp) = string_mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = string_mcode rp in let (init_n,init) = initialiser init in (multibind [lp_n;ty_n;rp_n;init_n], Ast0.Constructor(lp,ty,rp,init)) | Ast0.MetaErr(name,constraints,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaErr(name,constraints,pure)) | Ast0.MetaExpr(name,constraints,ty,form,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaExpr(name,constraints,ty,form,pure)) | Ast0.MetaExprList(name,lenname,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaExprList(name,lenname,pure)) | Ast0.EComma(cm) -> let (cm_n,cm) = string_mcode cm in (cm_n,Ast0.EComma(cm)) | Ast0.DisjExpr(starter,expr_list,mids,ender) -> do_disj starter expr_list mids ender expression (fun starter expr_list mids ender -> Ast0.DisjExpr(starter,expr_list,mids,ender)) | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> let (starter_n,starter) = string_mcode starter in let (expr_dots_n,expr_dots) = expression_dots expr_dots in let (ender_n,ender) = string_mcode ender in let (whencode_n,whencode) = get_option expression whencode in (multibind [starter_n;expr_dots_n;ender_n;whencode_n], Ast0.NestExpr(starter,expr_dots,ender,whencode,multi)) | Ast0.Edots(dots,whencode) -> let (dots_n,dots) = string_mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Edots(dots,whencode)) | Ast0.Ecircles(dots,whencode) -> let (dots_n,dots) = string_mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Ecircles(dots,whencode)) | Ast0.Estars(dots,whencode) -> let (dots_n,dots) = string_mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Estars(dots,whencode)) | Ast0.OptExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.OptExp(exp)) | Ast0.UniqueExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.UniqueExp(exp)) | Ast0.AsExpr(exp,asexp) -> let (exp_n,exp) = expression exp in let (asexp_n,asexp) = expression asexp in (bind exp_n asexp_n, Ast0.AsExpr(exp,asexp))) in exprfn all_functions k e and string_fragment e = let k e = rewrap e (match Ast0.unwrap e with Ast0.ConstantFragment(str) -> let (str_n,str) = string_mcode str in (str_n,Ast0.ConstantFragment(str)) | Ast0.FormatFragment(pct,fmt) -> let (pct_n,pct) = string_mcode pct in let (fmt_n,fmt) = string_format fmt in (multibind [pct_n;fmt_n], Ast0.FormatFragment(pct,fmt)) | Ast0.Strdots dots -> let (dots_n,dots) = string_mcode dots in (dots_n,Ast0.Strdots dots) | Ast0.MetaFormatList(pct,name,lenname) -> let (pct_n,pct) = string_mcode pct in let (name_n,name) = meta_mcode name in (bind pct_n name_n,Ast0.MetaFormatList(pct,name,lenname))) in k e and string_format e = let k e = rewrap e (match Ast0.unwrap e with Ast0.ConstantFormat(str) -> let (str_n,str) = string_mcode str in (str_n,Ast0.ConstantFormat str) | Ast0.MetaFormat(name,constraints) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaFormat(name,constraints))) in k e and typeC t = let k t = rewrap t (match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> let (cv_n,cv) = cv_mcode cv in let (ty_n,ty) = typeC ty in let front = (* bind in the right order *) match Ast0.unwrap ty with Ast0.Pointer(ty,star) -> bind ty_n cv_n | _ -> bind cv_n ty_n in (front, Ast0.ConstVol(cv,ty)) | Ast0.BaseType(ty,strings) -> let (strings_n,strings) = map_split_bind string_mcode strings in (strings_n, Ast0.BaseType(ty,strings)) | Ast0.Signed(sign,ty) -> let (sign_n,sign) = sign_mcode sign in let (ty_n,ty) = get_option typeC ty in (bind sign_n ty_n, Ast0.Signed(sign,ty)) | Ast0.Pointer(ty,star) -> let (ty_n,ty) = typeC ty in let (star_n,star) = string_mcode star in (bind ty_n star_n, Ast0.Pointer(ty,star)) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [] | Ast0.FunctionType(ty,lp1,params,rp1) -> function_type (ty,lp1,params,rp1) [] | Ast0.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [] | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> let (dec_n,dec) = string_mcode dec in let (lp_n,lp) = string_mcode lp in let (length_n,length) = expression length in let (comma_n,comma) = get_option string_mcode comma in let (precision_n,precision) = get_option expression precision_opt in let (rp_n,rp) = string_mcode rp in (multibind [dec_n; lp_n; length_n; comma_n; precision_n; rp_n], Ast0.Decimal(dec,lp,length,comma,precision_opt,rp)) | Ast0.EnumName(kind,name) -> let (kind_n,kind) = string_mcode kind in let (name_n,name) = get_option ident name in (bind kind_n name_n, Ast0.EnumName(kind,name)) | Ast0.EnumDef(ty,lb,ids,rb) -> let (ty_n,ty) = typeC ty in let (lb_n,lb) = string_mcode lb in let (ids_n,ids) = expression_dots ids in let (rb_n,rb) = string_mcode rb in (multibind [ty_n;lb_n;ids_n;rb_n], Ast0.EnumDef(ty,lb,ids,rb)) | Ast0.StructUnionName(kind,name) -> let (kind_n,kind) = struct_mcode kind in let (name_n,name) = get_option ident name in (bind kind_n name_n, Ast0.StructUnionName(kind,name)) | Ast0.StructUnionDef(ty,lb,decls,rb) -> let (ty_n,ty) = typeC ty in let (lb_n,lb) = string_mcode lb in let (decls_n,decls) = declaration_dots decls in let (rb_n,rb) = string_mcode rb in (multibind [ty_n;lb_n;decls_n;rb_n], Ast0.StructUnionDef(ty,lb,decls,rb)) | Ast0.TypeName(name) -> let (name_n,name) = string_mcode name in (name_n,Ast0.TypeName(name)) | Ast0.MetaType(name,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaType(name,pure)) | Ast0.DisjType(starter,types,mids,ender) -> do_disj starter types mids ender typeC (fun starter types mids ender -> Ast0.DisjType(starter,types,mids,ender)) | Ast0.OptType(ty) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.OptType(ty)) | Ast0.UniqueType(ty) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.UniqueType(ty)) | Ast0.AsType(ty,asty) -> let (ty_n,ty) = typeC ty in let (asty_n,asty) = typeC asty in (bind ty_n asty_n, Ast0.AsType(ty,asty))) in tyfn all_functions k t and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra = let (ty_n,ty) = typeC ty in let (lp1_n,lp1) = string_mcode lp1 in let (star_n,star) = string_mcode star in let (rp1_n,rp1) = string_mcode rp1 in let (lp2_n,lp2) = string_mcode lp2 in let (params_n,params) = parameter_dots params in let (rp2_n,rp2) = string_mcode rp2 in (* have to put the treatment of the identifier into the right position *) (multibind ([ty_n;lp1_n;star_n] @ extra @ [rp1_n;lp2_n;params_n;rp2_n]), Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) and function_type (ty,lp1,params,rp1) extra = let (ty_n,ty) = get_option typeC ty in let (lp1_n,lp1) = string_mcode lp1 in let (params_n,params) = parameter_dots params in let (rp1_n,rp1) = string_mcode rp1 in (* have to put the treatment of the identifier into the right position *) (multibind (ty_n :: extra @ [lp1_n;params_n;rp1_n]), Ast0.FunctionType(ty,lp1,params,rp1)) and array_type (ty,lb,size,rb) extra = let (ty_n,ty) = typeC ty in let (lb_n,lb) = string_mcode lb in let (size_n,size) = get_option expression size in let (rb_n,rb) = string_mcode rb in (multibind (ty_n :: extra @ [lb_n;size_n;rb_n]), Ast0.Array(ty,lb,size,rb)) and named_type ty id = let (id_n,id) = ident id in match Ast0.unwrap ty with Ast0.FunctionPointer(rty,lp1,star,rp1,lp2,params,rp2) -> let tyres = function_pointer (rty,lp1,star,rp1,lp2,params,rp2) [id_n] in (rewrap ty tyres, id) | Ast0.FunctionType(rty,lp1,params,rp1) -> let tyres = function_type (rty,lp1,params,rp1) [id_n] in (rewrap ty tyres, id) | Ast0.Array(rty,lb,size,rb) -> let tyres = array_type (rty,lb,size,rb) [id_n] in (rewrap ty tyres, id) | _ -> let (ty_n,ty) = typeC ty in ((bind ty_n id_n, ty), id) and declaration d = let k d = rewrap d (match Ast0.unwrap d with Ast0.MetaDecl(name,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaDecl(name,pure)) | Ast0.MetaField(name,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaField(name,pure)) | Ast0.MetaFieldList(name,lenname,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaFieldList(name,lenname,pure)) | Ast0.Init(stg,ty,id,eq,ini,sem) -> let (stg_n,stg) = get_option storage_mcode stg in let ((ty_id_n,ty),id) = named_type ty id in let (eq_n,eq) = string_mcode eq in let (ini_n,ini) = initialiser ini in let (sem_n,sem) = string_mcode sem in (multibind [stg_n;ty_id_n;eq_n;ini_n;sem_n], Ast0.Init(stg,ty,id,eq,ini,sem)) | Ast0.UnInit(stg,ty,id,sem) -> let (stg_n,stg) = get_option storage_mcode stg in let ((ty_id_n,ty),id) = named_type ty id in let (sem_n,sem) = string_mcode sem in (multibind [stg_n;ty_id_n;sem_n], Ast0.UnInit(stg,ty,id,sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let (name_n,name) = ident name in let (lp_n,lp) = string_mcode lp in let (args_n,args) = expression_dots args in let (rp_n,rp) = string_mcode rp in let (sem_n,sem) = string_mcode sem in (multibind [name_n;lp_n;args_n;rp_n;sem_n], Ast0.MacroDecl(name,lp,args,rp,sem)) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> let (name_n,name) = ident name in let (lp_n,lp) = string_mcode lp in let (args_n,args) = expression_dots args in let (rp_n,rp) = string_mcode rp in let (eq_n,eq) = string_mcode eq in let (ini_n,ini) = initialiser ini in let (sem_n,sem) = string_mcode sem in (multibind [name_n;lp_n;args_n;rp_n;eq_n;ini_n;sem_n], Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) | Ast0.TyDecl(ty,sem) -> let (ty_n,ty) = typeC ty in let (sem_n,sem) = string_mcode sem in (bind ty_n sem_n, Ast0.TyDecl(ty,sem)) | Ast0.Typedef(stg,ty,id,sem) -> let (stg_n,stg) = string_mcode stg in let (ty_n,ty) = typeC ty in let (id_n,id) = typeC id in let (sem_n,sem) = string_mcode sem in (multibind [stg_n;ty_n;id_n;sem_n], Ast0.Typedef(stg,ty,id,sem)) | Ast0.DisjDecl(starter,decls,mids,ender) -> do_disj starter decls mids ender declaration (fun starter decls mids ender -> Ast0.DisjDecl(starter,decls,mids,ender)) | Ast0.Ddots(dots,whencode) -> let (dots_n,dots) = string_mcode dots in let (whencode_n,whencode) = get_option declaration whencode in (bind dots_n whencode_n, Ast0.Ddots(dots,whencode)) | Ast0.OptDecl(decl) -> let (n,decl) = declaration decl in (n,Ast0.OptDecl(decl)) | Ast0.UniqueDecl(decl) -> let (n,decl) = declaration decl in (n,Ast0.UniqueDecl(decl)) | Ast0.AsDecl(decl,asdecl) -> let (decl_n,decl) = declaration decl in let (asdecl_n,asdecl) = declaration asdecl in (bind decl_n asdecl_n, Ast0.AsDecl(decl,asdecl))) in declfn all_functions k d and initialiser i = let k i = rewrap i (match Ast0.unwrap i with Ast0.MetaInit(name,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaInit(name,pure)) | Ast0.MetaInitList(name,lenname,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaInitList(name,lenname,pure)) | Ast0.InitExpr(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.InitExpr(exp)) | Ast0.InitList(lb,initlist,rb,ordered) -> let (lb_n,lb) = string_mcode lb in let (initlist_n,initlist) = initialiser_dots initlist in let (rb_n,rb) = string_mcode rb in (multibind [lb_n;initlist_n;rb_n], Ast0.InitList(lb,initlist,rb,ordered)) | Ast0.InitGccExt(designators,eq,ini) -> let (dn,designators) = map_split_bind designator designators in let (eq_n,eq) = string_mcode eq in let (ini_n,ini) = initialiser ini in (multibind [dn;eq_n;ini_n], Ast0.InitGccExt(designators,eq,ini)) | Ast0.InitGccName(name,eq,ini) -> let (name_n,name) = ident name in let (eq_n,eq) = string_mcode eq in let (ini_n,ini) = initialiser ini in (multibind [name_n;eq_n;ini_n], Ast0.InitGccName(name,eq,ini)) | Ast0.IComma(cm) -> let (n,cm) = string_mcode cm in (n,Ast0.IComma(cm)) | Ast0.Idots(d,whencode) -> let (d_n,d) = string_mcode d in let (whencode_n,whencode) = get_option initialiser whencode in (bind d_n whencode_n, Ast0.Idots(d,whencode)) | Ast0.OptIni(i) -> let (n,i) = initialiser i in (n,Ast0.OptIni(i)) | Ast0.UniqueIni(i) -> let (n,i) = initialiser i in (n,Ast0.UniqueIni(i)) | Ast0.AsInit(ini,asini) -> let (ini_n,ini) = initialiser ini in let (asini_n,asini) = initialiser asini in (bind ini_n asini_n, Ast0.AsInit(ini,asini))) in initfn all_functions k i and designator = function Ast0.DesignatorField(dot,id) -> let (dot_n,dot) = string_mcode dot in let (id_n,id) = ident id in (bind dot_n id_n, Ast0.DesignatorField(dot,id)) | Ast0.DesignatorIndex(lb,exp,rb) -> let (lb_n,lb) = string_mcode lb in let (exp_n,exp) = expression exp in let (rb_n,rb) = string_mcode rb in (multibind [lb_n;exp_n;rb_n], Ast0.DesignatorIndex(lb,exp,rb)) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> let (lb_n,lb) = string_mcode lb in let (min_n,min) = expression min in let (dots_n,dots) = string_mcode dots in let (max_n,max) = expression max in let (rb_n,rb) = string_mcode rb in (multibind [lb_n;min_n;dots_n;max_n;rb_n], Ast0.DesignatorRange(lb,min,dots,max,rb)) and parameterTypeDef p = let k p = rewrap p (match Ast0.unwrap p with Ast0.VoidParam(ty) -> let (n,ty) = typeC ty in (n,Ast0.VoidParam(ty)) | Ast0.Param(ty,Some id) -> let ((ty_id_n,ty),id) = named_type ty id in (ty_id_n, Ast0.Param(ty,Some id)) | Ast0.Param(ty,None) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.Param(ty,None)) | Ast0.MetaParam(name,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaParam(name,pure)) | Ast0.MetaParamList(name,lenname,pure) -> let (n,name) = meta_mcode name in (n,Ast0.MetaParamList(name,lenname,pure)) | Ast0.AsParam(p,asexp) -> let (p_n,p) = parameterTypeDef p in let (asexp_n,asexp) = expression asexp in (bind p_n asexp_n, Ast0.AsParam(p,asexp)) | Ast0.PComma(cm) -> let (n,cm) = string_mcode cm in (n,Ast0.PComma(cm)) | Ast0.Pdots(dots) -> let (n,dots) = string_mcode dots in (n,Ast0.Pdots(dots)) | Ast0.Pcircles(dots) -> let (n,dots) = string_mcode dots in (n,Ast0.Pcircles(dots)) | Ast0.OptParam(param) -> let (n,param) = parameterTypeDef param in (n,Ast0.OptParam(param)) | Ast0.UniqueParam(param) -> let (n,param) = parameterTypeDef param in (n,Ast0.UniqueParam(param))) in paramfn all_functions k p (* not done for combiner, because the statement is assumed to be already represented elsewhere in the code *) (* NOTE: This is not called for combiner_rebuilder. This is ok for its only current use. *) and process_bef_aft s = Ast0.set_dots_bef_aft s (match Ast0.get_dots_bef_aft s with Ast0.NoDots -> Ast0.NoDots | Ast0.DroppingBetweenDots(stm) -> let (_,stm) = statement stm in Ast0.DroppingBetweenDots(stm) | Ast0.AddingBetweenDots(stm) -> let (_,stm) = statement stm in Ast0.AddingBetweenDots(stm)) and statement s = (if mode = COMBINER then let _ = process_bef_aft s in ()); let k s = rewrap s (match Ast0.unwrap s with Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> let (fi_n,fi) = map_split_bind fninfo fi in let (name_n,name) = ident name in let (lp_n,lp) = string_mcode lp in let (params_n,params) = parameter_dots params in let (rp_n,rp) = string_mcode rp in let (lbrace_n,lbrace) = string_mcode lbrace in let (body_n,body) = statement_dots body in let (rbrace_n,rbrace) = string_mcode rbrace in (multibind [fi_n;name_n;lp_n;params_n;rp_n;lbrace_n;body_n;rbrace_n], Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace)) | Ast0.Decl(bef,decl) -> let (decl_n,decl) = declaration decl in (decl_n,Ast0.Decl(bef,decl)) | Ast0.Seq(lbrace,body,rbrace) -> let (lbrace_n,lbrace) = string_mcode lbrace in let (body_n,body) = statement_dots body in let (rbrace_n,rbrace) = string_mcode rbrace in (multibind [lbrace_n;body_n;rbrace_n], Ast0.Seq(lbrace,body,rbrace)) | Ast0.ExprStatement(exp,sem) -> let (exp_n,exp) = get_option expression exp in let (sem_n,sem) = string_mcode sem in (bind exp_n sem_n, Ast0.ExprStatement(exp,sem)) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> let (iff_n,iff) = string_mcode iff in let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in let (branch1_n,branch1) = statement branch1 in (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n], Ast0.IfThen(iff,lp,exp,rp,branch1,aft)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> let (iff_n,iff) = string_mcode iff in let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in let (branch1_n,branch1) = statement branch1 in let (els_n,els) = string_mcode els in let (branch2_n,branch2) = statement branch2 in (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n;els_n;branch2_n], Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft)) | Ast0.While(whl,lp,exp,rp,body,aft) -> let (whl_n,whl) = string_mcode whl in let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in let (body_n,body) = statement body in (multibind [whl_n;lp_n;exp_n;rp_n;body_n], Ast0.While(whl,lp,exp,rp,body,aft)) | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> let (d_n,d) = string_mcode d in let (body_n,body) = statement body in let (whl_n,whl) = string_mcode whl in let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in let (sem_n,sem) = string_mcode sem in (multibind [d_n;body_n;whl_n;lp_n;exp_n;rp_n;sem_n], Ast0.Do(d,body,whl,lp,exp,rp,sem)) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> let (fr_n,fr) = string_mcode fr in let (lp_n,lp) = string_mcode lp in let (first_n,first) = forinfo first in let (e2_n,e2) = get_option expression e2 in let (sem2_n,sem2) = string_mcode sem2 in let (e3_n,e3) = get_option expression e3 in let (rp_n,rp) = string_mcode rp in let (body_n,body) = statement body in (multibind [fr_n;lp_n;first_n;e2_n;sem2_n;e3_n;rp_n;body_n], Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft)) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> let (nm_n,nm) = ident nm in let (lp_n,lp) = string_mcode lp in let (args_n,args) = expression_dots args in let (rp_n,rp) = string_mcode rp in let (body_n,body) = statement body in (multibind [nm_n;lp_n;args_n;rp_n;body_n], Ast0.Iterator(nm,lp,args,rp,body,aft)) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> let (switch_n,switch) = string_mcode switch in let (lp_n,lp) = string_mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = string_mcode rp in let (lb_n,lb) = string_mcode lb in let (decls_n,decls) = statement_dots decls in let (cases_n,cases) = case_line_dots cases in let (rb_n,rb) = string_mcode rb in (multibind [switch_n;lp_n;exp_n;rp_n;lb_n;decls_n;cases_n;rb_n], Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) | Ast0.Break(br,sem) -> let (br_n,br) = string_mcode br in let (sem_n,sem) = string_mcode sem in (bind br_n sem_n, Ast0.Break(br,sem)) | Ast0.Continue(cont,sem) -> let (cont_n,cont) = string_mcode cont in let (sem_n,sem) = string_mcode sem in (bind cont_n sem_n, Ast0.Continue(cont,sem)) | Ast0.Label(l,dd) -> let (l_n,l) = ident l in let (dd_n,dd) = string_mcode dd in (bind l_n dd_n, Ast0.Label(l,dd)) | Ast0.Goto(goto,l,sem) -> let (goto_n,goto) = string_mcode goto in let (l_n,l) = ident l in let (sem_n,sem) = string_mcode sem in (bind goto_n (bind l_n sem_n), Ast0.Goto(goto,l,sem)) | Ast0.Return(ret,sem) -> let (ret_n,ret) = string_mcode ret in let (sem_n,sem) = string_mcode sem in (bind ret_n sem_n, Ast0.Return(ret,sem)) | Ast0.ReturnExpr(ret,exp,sem) -> let (ret_n,ret) = string_mcode ret in let (exp_n,exp) = expression exp in let (sem_n,sem) = string_mcode sem in (multibind [ret_n;exp_n;sem_n], Ast0.ReturnExpr(ret,exp,sem)) | Ast0.MetaStmt(name,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaStmtList(name,pure)) | Ast0.Disj(starter,statement_dots_list,mids,ender) -> do_disj starter statement_dots_list mids ender statement_dots (fun starter statement_dots_list mids ender -> Ast0.Disj(starter,statement_dots_list,mids,ender)) | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> let (starter_n,starter) = string_mcode starter in let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in let (ender_n,ender) = string_mcode ender in let (whn_n,whn) = map_split_bind (whencode statement_dots statement) whn in (multibind [starter_n;stmt_dots_n;ender_n;whn_n], Ast0.Nest(starter,stmt_dots,ender,whn,multi)) | Ast0.Exp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.Exp(exp)) | Ast0.TopExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.TopExp(exp)) | Ast0.Ty(ty) -> let (ty_n,ty) = typeC ty in (ty_n,Ast0.Ty(ty)) | Ast0.TopInit(init) -> let (init_n,init) = initialiser init in (init_n,Ast0.TopInit(init)) | Ast0.Dots(d,whn) -> let (d_n,d) = string_mcode d in let (whn_n,whn) = map_split_bind (whencode statement_dots statement) whn in (bind d_n whn_n, Ast0.Dots(d,whn)) | Ast0.Circles(d,whn) -> let (d_n,d) = string_mcode d in let (whn_n,whn) = map_split_bind (whencode statement_dots statement) whn in (bind d_n whn_n, Ast0.Circles(d,whn)) | Ast0.Stars(d,whn) -> let (d_n,d) = string_mcode d in let (whn_n,whn) = map_split_bind (whencode statement_dots statement) whn in (bind d_n whn_n, Ast0.Stars(d,whn)) | Ast0.Include(inc,name) -> let (inc_n,inc) = string_mcode inc in let (name_n,name) = inc_mcode name in (bind inc_n name_n, Ast0.Include(inc,name)) | Ast0.Undef(def,id) -> let (def_n,def) = string_mcode def in let (id_n,id) = ident id in (multibind [def_n;id_n],Ast0.Undef(def,id)) | Ast0.Define(def,id,params,body) -> let (def_n,def) = string_mcode def in let (id_n,id) = ident id in let (params_n,params) = define_parameters params in let (body_n,body) = statement_dots body in (multibind [def_n;id_n;params_n;body_n], Ast0.Define(def,id,params,body)) | Ast0.Pragma(prg,id,body) -> let (prg_n,prg) = string_mcode prg in let (id_n,id) = ident id in let (body_n,body) = pragmainfo body in (multibind [prg_n;id_n;body_n],Ast0.Pragma(prg,id,body)) | Ast0.OptStm(re) -> let (re_n,re) = statement re in (re_n,Ast0.OptStm(re)) | Ast0.UniqueStm(re) -> let (re_n,re) = statement re in (re_n,Ast0.UniqueStm(re)) | Ast0.AsStmt(stm,asstm) -> let (stm_n,stm) = statement stm in let (asstm_n,asstm) = statement asstm in (bind stm_n asstm_n, Ast0.AsStmt(stm,asstm))) in let (n,s) = stmtfn all_functions k s in (n,if mode = REBUILDER then process_bef_aft s else s) and forinfo fi = let k fi = rewrap fi (match Ast0.unwrap fi with Ast0.ForExp(e1,sem1) -> let (e1_n,e1) = get_option expression e1 in let (sem1_n,sem1) = string_mcode sem1 in (bind e1_n sem1_n, Ast0.ForExp(e1,sem1)) | Ast0.ForDecl (bef,decl) -> let (decl_n,decl) = declaration decl in (decl_n,Ast0.ForDecl (bef,decl))) in forinfofn all_functions k fi (* not parameterizable for now... *) and pragmainfo pi = let k pi = rewrap pi (match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> let (lp_n,lp) = string_mcode lp in let (args_n,args) = expression_dots args in let (rp_n,rp) = string_mcode rp in (multibind [lp_n;args_n;rp_n], Ast0.PragmaTuple(lp,args,rp)) | Ast0.PragmaIdList(ids) -> let (ids_n,ids) = identifier_dots ids in (ids_n, Ast0.PragmaIdList(ids)) | Ast0.PragmaDots (dots) -> let (dots_n,dots) = string_mcode dots in (dots_n,Ast0.PragmaDots dots)) in k pi (* not parameterizable for now... *) and define_parameters p = let k p = rewrap p (match Ast0.unwrap p with Ast0.NoParams -> (option_default,Ast0.NoParams) | Ast0.DParams(lp,params,rp) -> let (lp_n,lp) = string_mcode lp in let (params_n,params) = define_param_dots params in let (rp_n,rp) = string_mcode rp in (multibind [lp_n;params_n;rp_n], Ast0.DParams(lp,params,rp))) in k p and define_param_dots d = let k d = rewrap d (match Ast0.unwrap d with Ast0.DOTS(l) -> let (n,l) = map_split_bind define_param l in (n,Ast0.DOTS(l)) | Ast0.CIRCLES(l) -> let (n,l) = map_split_bind define_param l in (n,Ast0.CIRCLES(l)) | Ast0.STARS(l) -> let (n,l) = map_split_bind define_param l in (n,Ast0.STARS(l))) in k d and define_param p = let k p = rewrap p (match Ast0.unwrap p with Ast0.DParam(id) -> let (n,id) = ident id in (n,Ast0.DParam(id)) | Ast0.DPComma(comma) -> let (n,comma) = string_mcode comma in (n,Ast0.DPComma(comma)) | Ast0.DPdots(d) -> let (n,d) = string_mcode d in (n,Ast0.DPdots(d)) | Ast0.DPcircles(c) -> let (n,c) = string_mcode c in (n,Ast0.DPcircles(c)) | Ast0.OptDParam(dp) -> let (n,dp) = define_param dp in (n,Ast0.OptDParam(dp)) | Ast0.UniqueDParam(dp) -> let (n,dp) = define_param dp in (n,Ast0.UniqueDParam(dp))) in k p and fninfo = function Ast0.FStorage(stg) -> let (n,stg) = storage_mcode stg in (n,Ast0.FStorage(stg)) | Ast0.FType(ty) -> let (n,ty) = typeC ty in (n,Ast0.FType(ty)) | Ast0.FInline(inline) -> let (n,inline) = string_mcode inline in (n,Ast0.FInline(inline)) | Ast0.FAttr(init) -> let (n,init) = string_mcode init in (n,Ast0.FAttr(init)) and whencode notfn alwaysfn = function Ast0.WhenNot a -> let (n,a) = notfn a in (n,Ast0.WhenNot(a)) | Ast0.WhenAlways a -> let (n,a) = alwaysfn a in (n,Ast0.WhenAlways(a)) | Ast0.WhenModifier(x) -> (option_default,Ast0.WhenModifier(x)) | Ast0.WhenNotTrue(e) -> let (n,e) = expression e in (n,Ast0.WhenNotTrue(e)) | Ast0.WhenNotFalse(e) -> let (n,e) = expression e in (n,Ast0.WhenNotFalse(e)) and case_line c = let k c = rewrap c (match Ast0.unwrap c with Ast0.Default(def,colon,code) -> let (def_n,def) = string_mcode def in let (colon_n,colon) = string_mcode colon in let (code_n,code) = statement_dots code in (multibind [def_n;colon_n;code_n], Ast0.Default(def,colon,code)) | Ast0.Case(case,exp,colon,code) -> let (case_n,case) = string_mcode case in let (exp_n,exp) = expression exp in let (colon_n,colon) = string_mcode colon in let (code_n,code) = statement_dots code in (multibind [case_n;exp_n;colon_n;code_n], Ast0.Case(case,exp,colon,code)) | Ast0.DisjCase(starter,case_lines,mids,ender) -> do_disj starter case_lines mids ender case_line (fun starter case_lines mids ender -> Ast0.DisjCase(starter,case_lines,mids,ender)) | Ast0.OptCase(case) -> let (n,case) = case_line case in (n,Ast0.OptCase(case))) in casefn all_functions k c and top_level t = let k t = rewrap t (match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> let (old_file_n,old_file) = string_mcode old_file in let (new_file_n,new_file) = string_mcode new_file in (bind old_file_n new_file_n,Ast0.FILEINFO(old_file,new_file)) | Ast0.NONDECL(statement_dots) -> let (n,statement_dots) = statement statement_dots in (n,Ast0.NONDECL(statement_dots)) | Ast0.CODE(stmt_dots) -> let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in (stmt_dots_n, Ast0.CODE(stmt_dots)) | Ast0.TOPCODE(stmt_dots) -> let (stmt_dots_n,stmt_dots) = statement_dots stmt_dots in (stmt_dots_n, Ast0.TOPCODE(stmt_dots)) | Ast0.ERRORWORDS(exps) -> let (n,exps) = map_split_bind expression exps in (n, Ast0.ERRORWORDS(exps)) | Ast0.OTHER(_) -> failwith "unexpected code") in topfn all_functions k t and anything a = (* for compile_iso, not parameterisable *) let k = function Ast0.DotsExprTag(exprs) -> let (exprs_n,exprs) = expression_dots exprs in (exprs_n,Ast0.DotsExprTag(exprs)) | Ast0.DotsInitTag(inits) -> let (inits_n,inits) = initialiser_dots inits in (inits_n,Ast0.DotsInitTag(inits)) | Ast0.DotsParamTag(params) -> let (params_n,params) = parameter_dots params in (params_n,Ast0.DotsParamTag(params)) | Ast0.DotsStmtTag(stmts) -> let (stmts_n,stmts) = statement_dots stmts in (stmts_n,Ast0.DotsStmtTag(stmts)) | Ast0.DotsDeclTag(decls) -> let (decls_n,decls) = declaration_dots decls in (decls_n,Ast0.DotsDeclTag(decls)) | Ast0.DotsCaseTag(cases) -> let (cases_n,cases) = case_line_dots cases in (cases_n,Ast0.DotsCaseTag(cases)) | Ast0.IdentTag(id) -> let (id_n,id) = ident id in (id_n,Ast0.IdentTag(id)) | Ast0.ExprTag(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.ExprTag(exp)) | Ast0.ArgExprTag(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.ArgExprTag(exp)) | Ast0.TestExprTag(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.TestExprTag(exp)) | Ast0.TypeCTag(ty) -> let (ty_n,ty) = typeC ty in (ty_n,Ast0.TypeCTag(ty)) | Ast0.ParamTag(param) -> let (param_n,param) = parameterTypeDef param in (param_n,Ast0.ParamTag(param)) | Ast0.InitTag(init) -> let (init_n,init) = initialiser init in (init_n,Ast0.InitTag(init)) | Ast0.DeclTag(decl) -> let (decl_n,decl) = declaration decl in (decl_n,Ast0.DeclTag(decl)) | Ast0.StmtTag(stmt) -> let (stmt_n,stmt) = statement stmt in (stmt_n,Ast0.StmtTag(stmt)) | Ast0.ForInfoTag(fi) -> let (fi_n,fi) = forinfo fi in (fi_n,Ast0.ForInfoTag(fi)) | Ast0.CaseLineTag(c) -> let (c_n,c) = case_line c in (c_n,Ast0.CaseLineTag(c)) | Ast0.TopTag(top) -> let (top_n,top) = top_level top in (top_n,Ast0.TopTag(top)) | Ast0.IsoWhenTag(x) -> (option_default,Ast0.IsoWhenTag(x)) | Ast0.IsoWhenTTag(e) -> let (e_n,e) = expression e in (e_n,Ast0.IsoWhenTTag(e)) | Ast0.IsoWhenFTag(e) -> let (e_n,e) = expression e in (e_n,Ast0.IsoWhenFTag(e)) | Ast0.MetaPosTag(var) -> failwith "not supported" | Ast0.HiddenVarTag(var) -> failwith "not supported" in k a (* not done for combiner, because the statement is assumed to be already represented elsewhere in the code *) and all_functions = {VT0.ident = ident; VT0.expression = expression; VT0.typeC = typeC; VT0.declaration = declaration; VT0.initialiser = initialiser; VT0.initialiser_list = initialiser_dots; VT0.parameter = parameterTypeDef; VT0.parameter_list = parameter_dots; VT0.statement = statement; VT0.forinfo = forinfo; VT0.case_line = case_line; VT0.top_level = top_level; VT0.expression_dots = expression_dots; VT0.statement_dots = statement_dots; VT0.declaration_dots = declaration_dots; VT0.case_line_dots = case_line_dots; VT0.anything = anything} in all_functions let combiner_functions = {VT0.combiner_meta_mcode = (fun opt_default mc -> opt_default); VT0.combiner_string_mcode = (fun opt_default mc -> opt_default); VT0.combiner_const_mcode = (fun opt_default mc -> opt_default); VT0.combiner_assign_mcode = (fun opt_default mc -> opt_default); VT0.combiner_fix_mcode = (fun opt_default mc -> opt_default); VT0.combiner_unary_mcode = (fun opt_default mc -> opt_default); VT0.combiner_binary_mcode = (fun opt_default mc -> opt_default); VT0.combiner_cv_mcode = (fun opt_default mc -> opt_default); VT0.combiner_sign_mcode = (fun opt_default mc -> opt_default); VT0.combiner_struct_mcode = (fun opt_default mc -> opt_default); VT0.combiner_storage_mcode = (fun opt_default mc -> opt_default); VT0.combiner_inc_mcode = (fun opt_default mc -> opt_default); VT0.combiner_dotsexprfn = (fun r k e -> k e); VT0.combiner_dotsinitfn = (fun r k e -> k e); VT0.combiner_dotsparamfn = (fun r k e -> k e); VT0.combiner_dotsstmtfn = (fun r k e -> k e); VT0.combiner_dotsdeclfn = (fun r k e -> k e); VT0.combiner_dotscasefn = (fun r k e -> k e); VT0.combiner_identfn = (fun r k e -> k e); VT0.combiner_exprfn = (fun r k e -> k e); VT0.combiner_tyfn = (fun r k e -> k e); VT0.combiner_initfn = (fun r k e -> k e); VT0.combiner_paramfn = (fun r k e -> k e); VT0.combiner_declfn = (fun r k e -> k e); VT0.combiner_stmtfn = (fun r k e -> k e); VT0.combiner_forinfofn = (fun r k e -> k e); VT0.combiner_casefn = (fun r k e -> k e); VT0.combiner_topfn = (fun r k e -> k e)} let combiner_dz r = {VT0.combiner_rec_ident = (function e -> let (n,_) = r.VT0.ident e in n); VT0.combiner_rec_expression = (function e -> let (n,_) = r.VT0.expression e in n); VT0.combiner_rec_typeC = (function e -> let (n,_) = r.VT0.typeC e in n); VT0.combiner_rec_declaration = (function e -> let (n,_) = r.VT0.declaration e in n); VT0.combiner_rec_initialiser = (function e -> let (n,_) = r.VT0.initialiser e in n); VT0.combiner_rec_initialiser_list = (function e -> let (n,_) = r.VT0.initialiser_list e in n); VT0.combiner_rec_parameter = (function e -> let (n,_) = r.VT0.parameter e in n); VT0.combiner_rec_parameter_list = (function e -> let (n,_) = r.VT0.parameter_list e in n); VT0.combiner_rec_statement = (function e -> let (n,_) = r.VT0.statement e in n); VT0.combiner_rec_forinfo = (function e -> let (n,_) = r.VT0.forinfo e in n); VT0.combiner_rec_case_line = (function e -> let (n,_) = r.VT0.case_line e in n); VT0.combiner_rec_top_level = (function e -> let (n,_) = r.VT0.top_level e in n); VT0.combiner_rec_expression_dots = (function e -> let (n,_) = r.VT0.expression_dots e in n); VT0.combiner_rec_statement_dots = (function e -> let (n,_) = r.VT0.statement_dots e in n); VT0.combiner_rec_declaration_dots = (function e -> let (n,_) = r.VT0.declaration_dots e in n); VT0.combiner_rec_case_line_dots = (function e -> let (n,_) = r.VT0.case_line_dots e in n); VT0.combiner_rec_anything = (function e -> let (n,_) = r.VT0.anything e in n)} let combiner bind option_default functions = let xk k e = let (n,_) = k e in n in let dz = combiner_dz in combiner_dz (visitor COMBINER bind option_default (function mc -> (functions.VT0.combiner_meta_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_string_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_const_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_assign_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_fix_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_unary_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_binary_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_cv_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_sign_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_struct_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_storage_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_inc_mcode option_default mc,mc)) (fun r k e -> (functions.VT0.combiner_dotsexprfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_dotsinitfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_dotsparamfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_dotsstmtfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_dotsdeclfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_dotscasefn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_identfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_exprfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_tyfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_initfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_paramfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_declfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_stmtfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_forinfofn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_casefn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_topfn (dz r) (xk k) e, e))) let flat_combiner bind option_default meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = let dz = combiner_dz in let xk k e = let (n,_) = k e in n in combiner_dz (visitor COMBINER bind option_default (function mc -> (meta_mcode mc,mc)) (function mc -> (string_mcode mc,mc)) (function mc -> (const_mcode mc,mc)) (function mc -> (assign_mcode mc,mc)) (function mc -> (fix_mcode mc,mc)) (function mc -> (unary_mcode mc,mc)) (function mc -> (binary_mcode mc,mc)) (function mc -> (cv_mcode mc,mc)) (function mc -> (sign_mcode mc,mc)) (function mc -> (struct_mcode mc,mc)) (function mc -> (storage_mcode mc,mc)) (function mc -> (inc_mcode mc,mc)) (fun r k e -> (dotsexprfn (dz r) (xk k) e, e)) (fun r k e -> (dotsinitfn (dz r) (xk k) e, e)) (fun r k e -> (dotsparamfn (dz r) (xk k) e, e)) (fun r k e -> (dotsstmtfn (dz r) (xk k) e, e)) (fun r k e -> (dotsdeclfn (dz r) (xk k) e, e)) (fun r k e -> (dotscasefn (dz r) (xk k) e, e)) (fun r k e -> (identfn (dz r) (xk k) e, e)) (fun r k e -> (exprfn (dz r) (xk k) e, e)) (fun r k e -> (tyfn (dz r) (xk k) e, e)) (fun r k e -> (initfn (dz r) (xk k) e, e)) (fun r k e -> (paramfn (dz r) (xk k) e, e)) (fun r k e -> (declfn (dz r) (xk k) e, e)) (fun r k e -> (stmtfn (dz r) (xk k) e, e)) (fun r k e -> (forinfofn (dz r) (xk k) e, e)) (fun r k e -> (casefn (dz r) (xk k) e, e)) (fun r k e -> (topfn (dz r) (xk k) e, e))) let rebuilder_functions = {VT0.rebuilder_meta_mcode = (fun mc -> mc); VT0.rebuilder_string_mcode = (fun mc -> mc); VT0.rebuilder_const_mcode = (fun mc -> mc); VT0.rebuilder_assign_mcode = (fun mc -> mc); VT0.rebuilder_fix_mcode = (fun mc -> mc); VT0.rebuilder_unary_mcode = (fun mc -> mc); VT0.rebuilder_binary_mcode = (fun mc -> mc); VT0.rebuilder_cv_mcode = (fun mc -> mc); VT0.rebuilder_sign_mcode = (fun mc -> mc); VT0.rebuilder_struct_mcode = (fun mc -> mc); VT0.rebuilder_storage_mcode = (fun mc -> mc); VT0.rebuilder_inc_mcode = (fun mc -> mc); VT0.rebuilder_dotsexprfn = (fun r k e -> k e); VT0.rebuilder_dotsinitfn = (fun r k e -> k e); VT0.rebuilder_dotsparamfn = (fun r k e -> k e); VT0.rebuilder_dotsstmtfn = (fun r k e -> k e); VT0.rebuilder_dotsdeclfn = (fun r k e -> k e); VT0.rebuilder_dotscasefn = (fun r k e -> k e); VT0.rebuilder_identfn = (fun r k e -> k e); VT0.rebuilder_exprfn = (fun r k e -> k e); VT0.rebuilder_tyfn = (fun r k e -> k e); VT0.rebuilder_initfn = (fun r k e -> k e); VT0.rebuilder_paramfn = (fun r k e -> k e); VT0.rebuilder_declfn = (fun r k e -> k e); VT0.rebuilder_stmtfn = (fun r k e -> k e); VT0.rebuilder_forinfofn = (fun r k e -> k e); VT0.rebuilder_casefn = (fun r k e -> k e); VT0.rebuilder_topfn = (fun r k e -> k e)} let rebuilder_dz r = {VT0.rebuilder_rec_ident = (function e -> let (_,e) = r.VT0.ident e in e); VT0.rebuilder_rec_expression = (function e -> let (_,e) = r.VT0.expression e in e); VT0.rebuilder_rec_typeC = (function e -> let (_,e) = r.VT0.typeC e in e); VT0.rebuilder_rec_declaration = (function e -> let (_,e) = r.VT0.declaration e in e); VT0.rebuilder_rec_initialiser = (function e -> let (_,e) = r.VT0.initialiser e in e); VT0.rebuilder_rec_initialiser_list = (function e -> let (_,e) = r.VT0.initialiser_list e in e); VT0.rebuilder_rec_parameter = (function e -> let (_,e) = r.VT0.parameter e in e); VT0.rebuilder_rec_parameter_list = (function e -> let (_,e) = r.VT0.parameter_list e in e); VT0.rebuilder_rec_statement = (function e -> let (_,e) = r.VT0.statement e in e); VT0.rebuilder_rec_forinfo = (function e -> let (_,e) = r.VT0.forinfo e in e); VT0.rebuilder_rec_case_line = (function e -> let (_,e) = r.VT0.case_line e in e); VT0.rebuilder_rec_top_level = (function e -> let (_,e) = r.VT0.top_level e in e); VT0.rebuilder_rec_expression_dots = (function e -> let (_,e) = r.VT0.expression_dots e in e); VT0.rebuilder_rec_statement_dots = (function e -> let (_,e) = r.VT0.statement_dots e in e); VT0.rebuilder_rec_declaration_dots = (function e -> let (_,e) = r.VT0.declaration_dots e in e); VT0.rebuilder_rec_case_line_dots = (function e -> let (_,e) = r.VT0.case_line_dots e in e); VT0.rebuilder_rec_anything = (function e -> let (_,e) = r.VT0.anything e in e)} let rebuilder functions = let dz = rebuilder_dz in let xk k e = let (_,e) = k e in e in rebuilder_dz (visitor REBUILDER (fun x y -> x) () (function mc -> ((),functions.VT0.rebuilder_meta_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_string_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_const_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_assign_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_fix_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_unary_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_binary_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_cv_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_sign_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_struct_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_storage_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_inc_mcode mc)) (fun r k e -> ((),functions.VT0.rebuilder_dotsexprfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_dotsinitfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_dotsparamfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_dotsstmtfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_dotsdeclfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_dotscasefn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_identfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_exprfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_tyfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_initfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_paramfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_declfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_stmtfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_forinfofn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_casefn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_topfn (dz r) (xk k) e))) let flat_rebuilder meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = let dz = rebuilder_dz in let xk k e = let (_,e) = k e in e in rebuilder_dz (visitor REBUILDER (fun x y -> x) () (function mc -> ((),meta_mcode mc)) (function mc -> ((),string_mcode mc)) (function mc -> ((),const_mcode mc)) (function mc -> ((),assign_mcode mc)) (function mc -> ((),fix_mcode mc)) (function mc -> ((),unary_mcode mc)) (function mc -> ((),binary_mcode mc)) (function mc -> ((),cv_mcode mc)) (function mc -> ((),sign_mcode mc)) (function mc -> ((),struct_mcode mc)) (function mc -> ((),storage_mcode mc)) (function mc -> ((),inc_mcode mc)) (fun r k e -> ((),dotsexprfn (dz r) (xk k) e)) (fun r k e -> ((),dotsinitfn (dz r) (xk k) e)) (fun r k e -> ((),dotsparamfn (dz r) (xk k) e)) (fun r k e -> ((),dotsstmtfn (dz r) (xk k) e)) (fun r k e -> ((),dotsdeclfn (dz r) (xk k) e)) (fun r k e -> ((),dotscasefn (dz r) (xk k) e)) (fun r k e -> ((),identfn (dz r) (xk k) e)) (fun r k e -> ((),exprfn (dz r) (xk k) e)) (fun r k e -> ((),tyfn (dz r) (xk k) e)) (fun r k e -> ((),initfn (dz r) (xk k) e)) (fun r k e -> ((),paramfn (dz r) (xk k) e)) (fun r k e -> ((),declfn (dz r) (xk k) e)) (fun r k e -> ((),stmtfn (dz r) (xk k) e)) (fun r k e -> ((),forinfofn (dz r) (xk k) e)) (fun r k e -> ((),casefn (dz r) (xk k) e)) (fun r k e -> ((),topfn (dz r) (xk k) e))) let combiner_rebuilder_functions = {VT0.combiner_rebuilder_meta_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_string_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_const_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_assign_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_fix_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_unary_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_binary_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_cv_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_sign_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_struct_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_storage_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_inc_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_dotsexprfn = (fun r k e -> k e); VT0.combiner_rebuilder_dotsinitfn = (fun r k e -> k e); VT0.combiner_rebuilder_dotsparamfn = (fun r k e -> k e); VT0.combiner_rebuilder_dotsstmtfn = (fun r k e -> k e); VT0.combiner_rebuilder_dotsdeclfn = (fun r k e -> k e); VT0.combiner_rebuilder_dotscasefn = (fun r k e -> k e); VT0.combiner_rebuilder_identfn = (fun r k e -> k e); VT0.combiner_rebuilder_exprfn = (fun r k e -> k e); VT0.combiner_rebuilder_tyfn = (fun r k e -> k e); VT0.combiner_rebuilder_initfn = (fun r k e -> k e); VT0.combiner_rebuilder_paramfn = (fun r k e -> k e); VT0.combiner_rebuilder_declfn = (fun r k e -> k e); VT0.combiner_rebuilder_stmtfn = (fun r k e -> k e); VT0.combiner_rebuilder_forinfofn = (fun r k e -> k e); VT0.combiner_rebuilder_casefn = (fun r k e -> k e); VT0.combiner_rebuilder_topfn = (fun r k e -> k e)} let combiner_rebuilder bind option_default functions = visitor BOTH bind option_default (functions.VT0.combiner_rebuilder_meta_mcode option_default) (functions.VT0.combiner_rebuilder_string_mcode option_default) (functions.VT0.combiner_rebuilder_const_mcode option_default) (functions.VT0.combiner_rebuilder_assign_mcode option_default) (functions.VT0.combiner_rebuilder_fix_mcode option_default) (functions.VT0.combiner_rebuilder_unary_mcode option_default) (functions.VT0.combiner_rebuilder_binary_mcode option_default) (functions.VT0.combiner_rebuilder_cv_mcode option_default) (functions.VT0.combiner_rebuilder_sign_mcode option_default) (functions.VT0.combiner_rebuilder_struct_mcode option_default) (functions.VT0.combiner_rebuilder_storage_mcode option_default) (functions.VT0.combiner_rebuilder_inc_mcode option_default) functions.VT0.combiner_rebuilder_dotsexprfn functions.VT0.combiner_rebuilder_dotsinitfn functions.VT0.combiner_rebuilder_dotsparamfn functions.VT0.combiner_rebuilder_dotsstmtfn functions.VT0.combiner_rebuilder_dotsdeclfn functions.VT0.combiner_rebuilder_dotscasefn functions.VT0.combiner_rebuilder_identfn functions.VT0.combiner_rebuilder_exprfn functions.VT0.combiner_rebuilder_tyfn functions.VT0.combiner_rebuilder_initfn functions.VT0.combiner_rebuilder_paramfn functions.VT0.combiner_rebuilder_declfn functions.VT0.combiner_rebuilder_stmtfn functions.VT0.combiner_rebuilder_forinfofn functions.VT0.combiner_rebuilder_casefn functions.VT0.combiner_rebuilder_topfn coccinelle-1.0.0-rc19/parsing_cocci/test.cocci0000644000175000017500000000357512247442615020161 0ustar eugeneugen// Copyright 2012, INRIA // Julia Lawall, Gilles Muller // Copyright 2010-2011, INRIA, University of Copenhagen // Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix // Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen // Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix // This file is part of Coccinelle. // // Coccinelle is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, according to version 2 of the License. // // Coccinelle is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Coccinelle. If not, see . // // The authors reserve the right to distribute this or future versions of // Coccinelle under other licenses. @@ struct SHT sht; local function proc_info_func; @@ sht.proc_info = proc_info_func; @@ identifier buffer, start, offset, length, inout, hostptr, hostno; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... } ... ?- scsi_host_put(hostptr); ... } @@ expression E; @@ proc_info_func(...) { <... ( \+- E->host_no == hostno + E == shpnt | - hostno + shpnt->host_no ) ...> } @@ struct foo E; @@ proc_info_func(...) { <... ( \+- E->host_no == hostno + E == shpnt | - hostno + shpnt->host_no ) ...> } coccinelle-1.0.0-rc19/parsing_cocci/data.mli0000644000175000017500000001326612247442615017612 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./data.mli" (* types that clutter the .mly file *) (* for iso metavariables, true if they can only match nonmodified, unitary metavariables *) type fresh = bool type incl_iso = Include of string | Iso of (string,string) Common.either | Virt of string list (* virtual rules *) type clt = line_type * int * int * int * int (* starting spaces *) * (Ast_cocci.added_string * Ast0_cocci.position_info) list (*code before*) * (Ast_cocci.added_string * Ast0_cocci.position_info) list (*code after *) * Ast0_cocci.anything list (* position variable, minus only *) (* ---------------------------------------------------------------------- *) and line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | PLUSPLUS | CONTEXT | UNIQUE | OPT type iconstraints = Ast_cocci.idconstraint type econstraints = Ast0_cocci.constraints type pconstraints = Ast_cocci.meta_name list val in_rule_name : bool ref (* true if parsing the rule name *) val in_meta : bool ref (* true if parsing the metavariable decls *) val in_iso : bool ref (* true if parsing the isomorphisms *) val in_generating : bool ref(* true if generating a rule *) val ignore_patch_or_match : bool ref (* skip rules not satisfying virt *) val in_prolog : bool ref (* true if parsing the beginning of an SP *) val saw_struct : bool ref (* true if saw struct/union *) val inheritable_positions : string list ref val call_in_meta : (unit -> 'a) -> 'a val all_metadecls : (string, Ast_cocci.metavar list) Hashtbl.t val clear_meta: (unit -> unit) ref val add_meta_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_id_meta: (Ast_cocci.meta_name -> iconstraints -> Ast0_cocci.pure -> unit) ref val add_virt_id_meta_found: (string -> string -> unit) ref val add_virt_id_meta_not_found: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_fresh_id_meta: (Ast_cocci.meta_name -> Ast_cocci.seed -> unit) ref val add_type_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_init_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_initlist_meta: (Ast_cocci.meta_name -> Ast_cocci.list_len -> Ast0_cocci.pure -> unit) ref val add_param_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_paramlist_meta: (Ast_cocci.meta_name -> Ast_cocci.list_len -> Ast0_cocci.pure -> unit) ref val add_const_meta: (Type_cocci.typeC list option -> Ast_cocci.meta_name -> econstraints -> Ast0_cocci.pure -> unit) ref val add_err_meta: (Ast_cocci.meta_name -> econstraints -> Ast0_cocci.pure -> unit) ref val add_exp_meta: (Type_cocci.typeC list option -> Ast_cocci.meta_name -> econstraints -> Ast0_cocci.pure -> unit) ref val add_idexp_meta: (Type_cocci.typeC list option -> Ast_cocci.meta_name -> econstraints -> Ast0_cocci.pure -> unit) ref val add_local_idexp_meta: (Type_cocci.typeC list option -> Ast_cocci.meta_name -> econstraints -> Ast0_cocci.pure -> unit) ref val add_explist_meta: (Ast_cocci.meta_name -> Ast_cocci.list_len -> Ast0_cocci.pure -> unit) ref val add_decl_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_field_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_symbol_meta: (string -> unit) ref val add_field_list_meta: (Ast_cocci.meta_name -> Ast_cocci.list_len -> Ast0_cocci.pure -> unit) ref val add_stm_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_stmlist_meta: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref val add_func_meta: (Ast_cocci.meta_name -> iconstraints -> Ast0_cocci.pure -> unit) ref val add_local_func_meta: (Ast_cocci.meta_name -> iconstraints -> Ast0_cocci.pure -> unit) ref val add_declarer_meta: (Ast_cocci.meta_name -> iconstraints -> Ast0_cocci.pure -> unit) ref val add_iterator_meta: (Ast_cocci.meta_name -> iconstraints -> Ast0_cocci.pure -> unit) ref val add_pos_meta: (Ast_cocci.meta_name -> pconstraints -> Ast_cocci.meta_collect -> unit) ref val add_fmt_meta: (Ast_cocci.meta_name -> iconstraints -> unit) ref val add_fmtlist_meta: (Ast_cocci.meta_name -> Ast_cocci.list_len -> unit) ref val add_type_name: (string -> unit) ref val add_declarer_name: (string -> unit) ref val add_iterator_name: (string -> unit) ref val init_rule: (unit -> unit) ref val install_bindings: (string -> unit) ref (* ---------------------------------------------------------------------- *) (* String format things *) val format_metavariables : (string * (Ast_cocci.meta_name * iconstraints)) list ref val format_list_metavariables : (string * (Ast_cocci.meta_name * Ast_cocci.list_len)) list ref coccinelle-1.0.0-rc19/parsing_cocci/type_cocci.ml0000644000175000017500000001154412247442616020647 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./type_cocci.ml" (* for metavariables in general, but here because needed for metatypes *) type inherited = bool (* true if inherited *) type keep_binding = Unitary (* need no info *) | Nonunitary (* need an env entry *) | Saved (* need a witness *) type meta_name = string * string (*Ast_cocci.meta_name*) type typeC = ConstVol of const_vol * typeC | BaseType of baseType | SignedT of sign * typeC option | Pointer of typeC | FunctionPointer of typeC (* only return type *) | Array of typeC (* drop size info *) | Decimal of name * name | EnumName of name | StructUnionName of structUnion * name | TypeName of string | MetaType of meta_name * keep_binding * inherited | Unknown (* for metavariables of type expression *^* *) and name = NoName | Name of string | Num of string | MV of meta_name * keep_binding * inherited and tagged_string = string and baseType = VoidType | CharType | ShortType | ShortIntType | IntType | DoubleType | LongDoubleType | FloatType | LongType | LongIntType | LongLongType | LongLongIntType | SizeType | SSizeType | PtrDiffType | BoolType and structUnion = Struct | Union and sign = Signed | Unsigned and const_vol = Const | Volatile (* --------------------------------------------------------------------- *) (* Printer *) open Format let rec type2c = function ConstVol(cv,ty) -> (const_vol cv) ^ (type2c ty) | BaseType(ty) -> baseType ty | SignedT(sgn,None) -> sign sgn | SignedT(sgn,Some ty) -> (sign sgn) ^ (type2c ty) | Pointer(ty) -> (type2c ty) ^ "*" | FunctionPointer(ty) -> (type2c ty) ^ "(*)(...)" | Array(ty) -> (type2c ty) ^ "[] " | Decimal(e1,e2) -> Printf.sprintf "decimal(%s,%s) " (print_name e1) (print_name e2) | EnumName(name) -> "enum " ^ (print_name name) | StructUnionName(kind,name) -> (structUnion kind) ^ (print_name name) | TypeName(name) -> name ^ " " | MetaType((rule,name),keep,inherited) -> name ^ " " (* let print_unitary = function Unitary -> print_string "unitary" | Nonunitary -> print_string "nonunitary" | Saved -> print_string "saved" in print_string "/* "; print_string "keep:"; print_unitary keep; print_string " inherited:"; print_bool inherited; print_string " */" *) | Unknown -> "unknown " and print_name = function NoName -> "" | MV ((_,name),_,_) -> name ^ " " | Name name -> name ^ " " | Num n -> n ^ " " and baseType = function VoidType -> "void " | CharType -> "char " | ShortType -> "short " | ShortIntType -> "short int " | IntType -> "int " | DoubleType -> "double " | LongDoubleType -> "long double " | FloatType -> "float " | LongType -> "long " | LongIntType -> "long int " | LongLongType -> "long long " | LongLongIntType -> "long long int " | BoolType -> "bool " | SizeType -> "size_t " | SSizeType -> "ssize_t " | PtrDiffType -> "ptrdiff_t " and structUnion = function Struct -> "struct " | Union -> "union " and sign = function Signed -> "signed " | Unsigned -> "unsigned " and const_vol = function Const -> "const " | Volatile -> "volatile " let typeC t = print_string (type2c t) (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 = Pointer(int) *) (* only used in iso *) (* needs to do something for MetaType *) let compatible t1 = function None -> t1 = Unknown | Some t2 -> let rec loop = function (Unknown,_) -> true | (ConstVol(cv1,ty1),ConstVol(cv2,ty2)) when cv1 = cv2 -> loop(ty1,ty2) | (Pointer(ty1),Pointer(ty2)) -> loop(ty1,ty2) | (FunctionPointer(ty1),_) -> false (* not enough info *) | (_,FunctionPointer(ty2)) -> false (* not enough info *) | (Array(ty1),Array(ty2)) -> loop(ty1,ty2) | (_,_) -> t1=t2 in loop (t1,t2) coccinelle-1.0.0-rc19/parsing_cocci/top_level.ml0000644000175000017500000000777712247442616020534 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./top_level.ml" (* Reorganize the top level of a rule to be a list of either top-level declarations or code dots. A function declaration is always considered top level. A statement is always considered code dots. A variable declaration is ambiguous. We use the heuristic that if there are code dots somewhere else, then the variable declaration is at top level, otherwise it applies both at top level and to all code. *) (* This is assumed to be done before compute_lines, and thus the info on a complex term is assumed to be Ast0.default_info *) module Ast0 = Ast0_cocci let top_dots l = let circle x = match Ast0.unwrap x with Ast0.Circles(_) -> true | _ -> false in let star x = match Ast0.unwrap x with Ast0.Stars(_) -> true | _ -> false in if List.exists circle l then Ast0.wrap (Ast0.CIRCLES(l)) else if List.exists star l then Ast0.wrap (Ast0.STARS(l)) else Ast0.wrap (Ast0.DOTS(l)) let rec is_decl s = match Ast0.unwrap s with Ast0.Decl(_,e) -> true | _ -> false let isonly f l = match Ast0.undots l with [s] -> f s | _ -> false let isall f l = List.for_all (isonly f) l let rec is_toplevel s = match Ast0.unwrap s with Ast0.Decl(_,e) -> true | Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_toplevel stmts | Ast0.ExprStatement(Some fc,_) -> false | Ast0.Include(_,_) -> true | Ast0.Undef(_,_) -> true | Ast0.Define(_,_,_,_) -> true | Ast0.Pragma(_,_,_) -> true | _ -> false let scan_code must_be_code l = let rec loop = function [] -> ([],[]) | (x::xs) as all -> (match Ast0.unwrap x with (Ast0.OTHER(code)) -> let (front,rest) = loop xs in (code::front,rest) | _ -> ([],all)) in match loop l with ([],_) as res -> res | (code,rest) -> (match code with | [x] when is_decl x && must_be_code -> ([Ast0.wrap(Ast0.NONDECL x)],rest) | _ when List.for_all is_toplevel code -> ([Ast0.wrap(Ast0.TOPCODE(top_dots code))],rest) | _ -> ([Ast0.wrap(Ast0.CODE(top_dots code))],rest)) let rec scan_top_decl = function [] -> ([],[]) | ((topdecl::rest) as all) -> (match Ast0.unwrap topdecl with Ast0.OTHER(_) -> ([],all) | _ -> let (front,rest) = scan_top_decl rest in (topdecl::front,rest)) (* for debugging *) let l2c l = match Ast0.unwrap l with Ast0.NONDECL(_) -> "decl" | Ast0.CODE(_) -> "code" | Ast0.TOPCODE(_) -> "code" | Ast0.FILEINFO(_,_) -> "fileinfo" | Ast0.ERRORWORDS(_) -> "errorwords" | Ast0.OTHER(_) -> "other" let rec top_level must_be_code l = match scan_code must_be_code l with (code,[]) -> code | (code,rest) -> (match scan_top_decl rest with (top_decls,[]) -> code@top_decls | (top_decls,rest) -> code @ top_decls @ (top_level must_be_code rest)) let clean l = List.map (function tl -> match Ast0.unwrap tl with Ast0.TOPCODE x -> Ast0.rewrap tl (Ast0.CODE x) | _ -> tl) l coccinelle-1.0.0-rc19/parsing_cocci/visitor_ast0.mli0000644000175000017500000001240512247442615021321 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./visitor_ast0.mli" val combiner_functions : 'a Visitor_ast0_types.combiner_functions val combiner : ('a -> 'a -> 'a) -> 'a -> 'a Visitor_ast0_types.combiner_functions -> 'a Visitor_ast0_types.combiner_rec_functions val flat_combiner : ('a -> 'a -> 'a) -> 'a -> ((Ast_cocci.meta_name,'a) Visitor_ast0_types.flat_cmcode) -> ((string,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.constant,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.assignOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.fixOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.unaryOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.binaryOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.const_vol,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.sign,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.structUnion,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.storage,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.inc_file,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast0_cocci.expression Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.initialiser Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.parameterTypeDef Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.statement Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.declaration Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.case_line Ast0_cocci.dots,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.ident,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.expression,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.typeC,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.initialiser,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.parameterTypeDef,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.declaration,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.statement,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.forinfo,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.case_line,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.top_level,'a) Visitor_ast0_types.ccode) -> 'a Visitor_ast0_types.combiner_rec_functions val rebuilder_functions : Visitor_ast0_types.rebuilder_functions val rebuilder : Visitor_ast0_types.rebuilder_functions -> Visitor_ast0_types.rebuilder_rec_functions val flat_rebuilder : (Ast_cocci.meta_name Visitor_ast0_types.rmcode) -> (string Visitor_ast0_types.rmcode) -> (Ast_cocci.constant Visitor_ast0_types.rmcode) -> (Ast_cocci.assignOp Visitor_ast0_types.rmcode) -> (Ast_cocci.fixOp Visitor_ast0_types.rmcode) -> (Ast_cocci.unaryOp Visitor_ast0_types.rmcode) -> (Ast_cocci.binaryOp Visitor_ast0_types.rmcode) -> (Ast_cocci.const_vol Visitor_ast0_types.rmcode) -> (Ast_cocci.sign Visitor_ast0_types.rmcode) -> (Ast_cocci.structUnion Visitor_ast0_types.rmcode) -> (Ast_cocci.storage Visitor_ast0_types.rmcode) -> (Ast_cocci.inc_file Visitor_ast0_types.rmcode) -> (Ast0_cocci.expression Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.initialiser Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.parameterTypeDef Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.statement Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.declaration Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.case_line Ast0_cocci.dots Visitor_ast0_types.rcode) -> (Ast0_cocci.ident Visitor_ast0_types.rcode) -> (Ast0_cocci.expression Visitor_ast0_types.rcode) -> (Ast0_cocci.typeC Visitor_ast0_types.rcode) -> (Ast0_cocci.initialiser Visitor_ast0_types.rcode) -> (Ast0_cocci.parameterTypeDef Visitor_ast0_types.rcode) -> (Ast0_cocci.declaration Visitor_ast0_types.rcode) -> (Ast0_cocci.statement Visitor_ast0_types.rcode) -> (Ast0_cocci.forinfo Visitor_ast0_types.rcode) -> (Ast0_cocci.case_line Visitor_ast0_types.rcode) -> (Ast0_cocci.top_level Visitor_ast0_types.rcode) -> Visitor_ast0_types.rebuilder_rec_functions val combiner_rebuilder_functions : 'a Visitor_ast0_types.combiner_rebuilder_functions val combiner_rebuilder : ('a -> 'a -> 'a) -> 'a -> 'a Visitor_ast0_types.combiner_rebuilder_functions -> 'a Visitor_ast0_types.all_functions coccinelle-1.0.0-rc19/parsing_cocci/get_constants2.mli0000644000175000017500000000305512247442615021631 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_constants2.mli" type combine = And of combine list | Or of combine list | Elem of string | False | True val get_constants : Ast_cocci.rule list -> (((Ast_cocci.meta_name list) list) list) (*negated pos vars*) -> (string list option (* grep result *) * string list option (* non-grep result, if any *) * (Str.regexp * Str.regexp list) option (* cocci-grep result *) * combine option (* raw non-grep result, if any *)) coccinelle-1.0.0-rc19/parsing_cocci/ast_cocci.ml0000644000175000017500000010245312247442615020454 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast_cocci.ml" (* --------------------------------------------------------------------- *) (* Modified code *) type added_string = Noindent of string | Indent of string | Space of string type info = { line : int; column : int; strbef : (added_string * int (* line *) * int (* col *)) list; straft : (added_string * int (* line *) * int (* col *)) list } type line = int type meta_name = string * string (* need to be careful about rewrapping, to avoid duplicating pos info currently, the pos info is always None until asttoctl2. *) type 'a wrap = {node : 'a; node_line : line; free_vars : meta_name list; (*free vars*) minus_free_vars : meta_name list; (*minus free vars*) fresh_vars : (meta_name * seed) list; (*fresh vars*) inherited : meta_name list; (*inherited vars*) saved_witness : meta_name list; (*witness vars*) bef_aft : dots_bef_aft; (* the following is for or expressions *) pos_info : meta_name mcode option; (* pos info, try not to duplicate *) true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *) (* the following is only for declarations *) safe_for_multi_decls : bool; (* isos relevant to the term; ultimately only used for rule_elems *) iso_info : (string*anything) list } and 'a befaft = BEFORE of 'a list list * count | AFTER of 'a list list * count | BEFOREAFTER of 'a list list * 'a list list * count | NOTHING and 'a replacement = REPLACEMENT of 'a list list * count | NOREPLACEMENT and 'a mcode = 'a * info * mcodekind * meta_pos list (* pos variables *) (* pos is an offset indicating where in the C code the mcodekind has an effect *) (* int list is the match instances, which are only meaningful in annotated C code *) (* adjacency is the adjacency index, which is incremented on context dots *) (* iteration is only allowed on context code, the intuition vaguely being that there is no way to replace something more than once. Actually, allowing iterated additions on minus code would cause problems with some heuristics for adding braces, because one couldn't identify simple replacements with certainty. Anyway, iteration doesn't seem to be needed on - code for the moment. Although it may be confusing that there can be iterated addition of code before context code where the context code is immediately followed by removed code. *) and adjacency = ALLMINUS | ADJ of int and mcodekind = MINUS of pos * int list * adjacency * anything replacement | CONTEXT of pos * anything befaft | PLUS of count and count = ONE (* + *) | MANY (* ++ *) and fixpos = Real of int (* charpos *) | Virt of int * int (* charpos + offset *) and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos) and dots_bef_aft = NoDots | AddingBetweenDots of statement * int (*index of let var*) | DroppingBetweenDots of statement * int (*index of let var*) and inherited = Type_cocci.inherited and keep_binding = Type_cocci.keep_binding and multi = bool (*true if a nest is one or more, false if it is zero or more*) and end_info = meta_name list (*free vars*) * (meta_name * seed) list (*fresh*) * meta_name list (*inherited vars*) * mcodekind (* --------------------------------------------------------------------- *) (* Metavariables *) and arity = UNIQUE | OPT | MULTI | NONE and metavar = MetaMetaDecl of arity * meta_name (* name *) | MetaIdDecl of arity * meta_name (* name *) | MetaFreshIdDecl of meta_name (* name *) * seed (* seed *) | MetaTypeDecl of arity * meta_name (* name *) | MetaInitDecl of arity * meta_name (* name *) | MetaInitListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaListlenDecl of meta_name (* name *) | MetaParamDecl of arity * meta_name (* name *) | MetaParamListDecl of arity * meta_name (*name*) * list_len (*len*) | MetaConstDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaErrDecl of arity * meta_name (* name *) | MetaExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaIdExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaLocalIdExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaExpListDecl of arity * meta_name (*name*) * list_len (*len*) | MetaDeclDecl of arity * meta_name (* name *) | MetaFieldDecl of arity * meta_name (* name *) | MetaFieldListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaStmDecl of arity * meta_name (* name *) | MetaStmListDecl of arity * meta_name (* name *) | MetaFuncDecl of arity * meta_name (* name *) | MetaLocalFuncDecl of arity * meta_name (* name *) | MetaPosDecl of arity * meta_name (* name *) | MetaFmtDecl of arity * meta_name (* name *) | MetaFragListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaAnalysisDecl of string * meta_name (* name *) | MetaDeclarerDecl of arity * meta_name (* name *) | MetaIteratorDecl of arity * meta_name (* name *) and list_len = AnyLen | MetaLen of meta_name | CstLen of int and seed = NoVal | StringSeed of string | ListSeed of seed_elem list and seed_elem = SeedString of string | SeedId of meta_name (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) and 'a base_dots = DOTS of 'a list | CIRCLES of 'a list | STARS of 'a list and 'a dots = 'a base_dots wrap (* --------------------------------------------------------------------- *) (* Identifier *) and base_ident = Id of string mcode | MetaId of meta_name mcode * idconstraint * keep_binding * inherited | MetaFunc of meta_name mcode * idconstraint * keep_binding * inherited | MetaLocalFunc of meta_name mcode * idconstraint * keep_binding * inherited | AsIdent of ident * ident (* as ident, always metavar *) | DisjId of ident list | OptIdent of ident | UniqueIdent of ident and ident = base_ident wrap (* --------------------------------------------------------------------- *) (* Expression *) and base_expression = Ident of ident | Constant of constant mcode | StringConstant of string mcode (* quote *) * string_fragment dots * string mcode (* quote *) | FunCall of expression * string mcode (* ( *) * expression dots * string mcode (* ) *) | Assignment of expression * assignOp mcode * expression * bool (* true if it can match an initialization *) | Sequence of expression * string mcode (* , *) * expression | CondExpr of expression * string mcode (* ? *) * expression option * string mcode (* : *) * expression | Postfix of expression * fixOp mcode | Infix of expression * fixOp mcode | Unary of expression * unaryOp mcode | Binary of expression * binaryOp mcode * expression | Nested of expression * binaryOp mcode * expression | ArrayAccess of expression * string mcode (* [ *) * expression * string mcode (* ] *) | RecordAccess of expression * string mcode (* . *) * ident | RecordPtAccess of expression * string mcode (* -> *) * ident | Cast of string mcode (* ( *) * fullType * string mcode (* ) *) * expression | SizeOfExpr of string mcode (* sizeof *) * expression | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) * fullType * string mcode (* ) *) | TypeExp of fullType (*type name used as an expression, only in arg or #define*) | Paren of string mcode (* ( *) * expression * string mcode (* ) *) | Constructor of string mcode (* ( *) * fullType * string mcode (* ) *) * initialiser | MetaErr of meta_name mcode * constraints * keep_binding * inherited | MetaExpr of meta_name mcode * constraints * keep_binding * Type_cocci.typeC list option * form * inherited | MetaExprList of meta_name mcode * listlen * keep_binding * inherited (* only in arg lists *) | AsExpr of expression * expression (* as expr, always metavar *) | EComma of string mcode (* only in arg lists *) | DisjExpr of expression list | NestExpr of string mcode (* <.../<+... *) * expression dots * string mcode (* ...>/...+> *) * expression option * multi (* can appear in arg lists, and also inside Nest, as in: if(< ... X ... Y ...>) In the following, the expression option is the WHEN *) | Edots of string mcode (* ... *) * expression option | Ecircles of string mcode (* ooo *) * expression option | Estars of string mcode (* *** *) * expression option | OptExp of expression | UniqueExp of expression and constraints = NoConstraint | NotIdCstrt of reconstraint | NotExpCstrt of expression list | SubExpCstrt of meta_name list (* Constraints on Meta-* Identifiers, Functions *) and idconstraint = IdNoConstraint | IdNegIdSet of string list * meta_name list | IdRegExpConstraint of reconstraint and reconstraint = | IdRegExp of string * Regexp.regexp | IdNotRegExp of string * Regexp.regexp (* ANY = int E; ID = idexpression int X; CONST = constant int X; *) and form = ANY | ID | LocalID | CONST (* form for MetaExp *) and expression = base_expression wrap and listlen = MetaListLen of meta_name mcode * keep_binding * inherited | CstListLen of int | AnyListLen and base_string_fragment = ConstantFragment of string mcode | FormatFragment of string mcode (*%*) * string_format (* format *) | Strdots of string mcode | MetaFormatList of string mcode (*%*) * meta_name mcode * listlen * keep_binding * inherited and string_fragment = base_string_fragment wrap and base_string_format = ConstantFormat of string mcode | MetaFormat of meta_name mcode * idconstraint * keep_binding * inherited and string_format = base_string_format wrap and unaryOp = GetRef | GetRefLabel | DeRef | UnPlus | UnMinus | Tilde | Not and assignOp = SimpleAssign | OpAssign of arithOp and fixOp = Dec | Inc and binaryOp = Arith of arithOp | Logical of logicalOp and arithOp = Plus | Minus | Mul | Div | Mod | DecLeft | DecRight | And | Or | Xor | Min | Max and logicalOp = Inf | Sup | InfEq | SupEq | Eq | NotEq | AndLog | OrLog and constant = String of string | Char of string | Int of string | Float of string | DecimalConst of (string * string * string) (* --------------------------------------------------------------------- *) (* Types *) and base_fullType = Type of bool (* true if all minus *) * const_vol mcode option * typeC | AsType of fullType * fullType (* as type, always metavar *) | DisjType of fullType list (* only after iso *) | OptType of fullType | UniqueType of fullType and base_typeC = BaseType of baseType * string mcode list (* Yoann style *) | SignedT of sign mcode * typeC option | Pointer of fullType * string mcode (* * *) | FunctionPointer of fullType * string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* string mcode (* ( *)*parameter_list*string mcode(* ) *) (* used for the automatic managment of prototypes *) | FunctionType of bool (* true if all minus for dropping return type *) * fullType option * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Array of fullType * string mcode (* [ *) * expression option * string mcode (* ] *) | Decimal of string mcode (* decimal *) * string mcode (* ( *) * expression * string mcode option (* , *) * expression option * string mcode (* ) *) (* IBM C only *) | EnumName of string mcode (*enum*) * ident option (* name *) | EnumDef of fullType (* either EnumName or metavar *) * string mcode (* { *) * expression dots * string mcode (* } *) | StructUnionName of structUnion mcode * ident option (* name *) | StructUnionDef of fullType (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) | TypeName of string mcode (* pad: should be 'of ident' ? *) | MetaType of meta_name mcode * keep_binding * inherited and fullType = base_fullType wrap and typeC = base_typeC wrap and baseType = VoidType | CharType | ShortType | ShortIntType | IntType | DoubleType | LongDoubleType | FloatType | LongType | LongIntType | LongLongType | LongLongIntType | SizeType | SSizeType | PtrDiffType and structUnion = Struct | Union and sign = Signed | Unsigned and const_vol = Const | Volatile (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and base_declaration = Init of storage mcode option * fullType * ident * string mcode (*=*) * initialiser * string mcode (*;*) | UnInit of storage mcode option * fullType * ident * string mcode (* ; *) | TyDecl of fullType * string mcode (* ; *) | MacroDecl of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (*=*) * initialiser * string mcode (* ; *) | Typedef of string mcode (*typedef*) * fullType * typeC (* either TypeName or metavar *) * string mcode (*;*) | DisjDecl of declaration list (* Ddots is for a structure declaration *) | Ddots of string mcode (* ... *) * declaration option (* whencode *) | MetaDecl of meta_name mcode * keep_binding * inherited | MetaField of meta_name mcode * keep_binding * inherited | MetaFieldList of meta_name mcode * listlen * keep_binding * inherited | AsDecl of declaration * declaration | OptDecl of declaration | UniqueDecl of declaration and declaration = base_declaration wrap (* --------------------------------------------------------------------- *) (* Initializers *) and base_initialiser = MetaInit of meta_name mcode * keep_binding * inherited | MetaInitList of meta_name mcode * listlen * keep_binding * inherited | AsInit of initialiser * initialiser (* as init, always metavar *) | InitExpr of expression | ArInitList of string mcode (*{*) * initialiser dots * string mcode (*}*) | StrInitList of bool (* true if all are - *) * string mcode (*{*) * initialiser list * string mcode (*}*) * initialiser list (* whencode: elements that shouldn't appear in init *) | InitGccExt of designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) | InitGccName of ident (* name *) * string mcode (*:*) * initialiser | IComma of string mcode (* , *) | Idots of string mcode (* ... *) * initialiser option (* whencode *) | OptIni of initialiser | UniqueIni of initialiser and designator = DesignatorField of string mcode (* . *) * ident | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *) | DesignatorRange of string mcode (* [ *) * expression * string mcode (* ... *) * expression * string mcode (* ] *) and initialiser = base_initialiser wrap (* --------------------------------------------------------------------- *) (* Parameter *) and base_parameterTypeDef = VoidParam of fullType | Param of fullType * ident option | MetaParam of meta_name mcode * keep_binding * inherited | MetaParamList of meta_name mcode * listlen * keep_binding * inherited | AsParam of parameterTypeDef * expression (* expr, always metavar *) | PComma of string mcode | Pdots of string mcode (* ... *) | Pcircles of string mcode (* ooo *) | OptParam of parameterTypeDef | UniqueParam of parameterTypeDef and parameterTypeDef = base_parameterTypeDef wrap and parameter_list = parameterTypeDef dots (* --------------------------------------------------------------------- *) (* #define Parameters *) and base_define_param = DParam of ident | DPComma of string mcode | DPdots of string mcode (* ... *) | DPcircles of string mcode (* ooo *) | OptDParam of define_param | UniqueDParam of define_param and define_param = base_define_param wrap and base_define_parameters = NoParams (* not parameter list, not an empty one *) | DParams of string mcode(*( *) * define_param dots * string mcode(* )*) and define_parameters = base_define_parameters wrap (* --------------------------------------------------------------------- *) (* positions *) (* PER = keep bindings separate, ALL = collect them *) and meta_collect = PER | ALL and meta_pos = MetaPos of meta_name mcode * meta_name list * meta_collect * keep_binding * inherited (* --------------------------------------------------------------------- *) (* Function declaration *) and storage = Static | Auto | Register | Extern (* --------------------------------------------------------------------- *) (* Top-level code *) and base_rule_elem = FunHeader of mcodekind (* before the function header *) * bool (* true if all minus, for dropping static, etc *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Decl of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration | SeqStart of string mcode (* { *) | SeqEnd of string mcode (* } *) | ExprStatement of expression option * string mcode (*;*) | IfHeader of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) | Else of string mcode (* else *) | WhileHeader of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) | DoHeader of string mcode (* do *) | WhileTail of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* ; *) | ForHeader of string mcode (* for *) * string mcode (* ( *) * forinfo * expression option * string mcode (*;*) * expression option * string mcode (* ) *) | IteratorHeader of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) | SwitchHeader of string mcode (* switch *) * string mcode (* ( *) * expression * string mcode (* ) *) | Break of string mcode (* break *) * string mcode (* ; *) | Continue of string mcode (* continue *) * string mcode (* ; *) | Label of ident * string mcode (* : *) | Goto of string mcode (* goto *) * ident * string mcode (* ; *) | Return of string mcode (* return *) * string mcode (* ; *) | ReturnExpr of string mcode (* return *) * expression * string mcode (* ; *) | MetaRuleElem of meta_name mcode * keep_binding * inherited | MetaStmt of meta_name mcode * keep_binding * metaStmtInfo * inherited | MetaStmtList of meta_name mcode * keep_binding * inherited | Exp of expression (* matches a subterm *) | TopExp of expression (* for macros body, exp at top level, not subexp *) | Ty of fullType (* only at SP top level, matches a subterm *) | TopInit of initialiser (* only at top level *) | Include of string mcode (*#include*) * inc_file mcode (*file *) | Undef of string mcode (* #define *) * ident (* name *) | DefineHeader of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) | Pragma of string mcode (* #pragma *) * ident * pragmainfo | Case of string mcode (* case *) * expression * string mcode (*:*) | Default of string mcode (* default *) * string mcode (*:*) | DisjRuleElem of rule_elem list and base_pragmainfo = PragmaTuple of string mcode(* ( *) * expression dots * string mcode(* ) *) | PragmaIdList of ident dots | PragmaDots of string mcode and pragmainfo = base_pragmainfo wrap and forinfo = ForExp of expression option * string mcode (*;*) | ForDecl of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration and fninfo = FStorage of storage mcode | FType of fullType | FInline of string mcode | FAttr of string mcode and metaStmtInfo = NotSequencible | SequencibleAfterDots of dots_whencode list | Sequencible and rule_elem = base_rule_elem wrap and base_statement = Seq of rule_elem (* { *) * statement dots * rule_elem (* } *) | IfThen of rule_elem (* header *) * statement * end_info (* endif *) | IfThenElse of rule_elem (* header *) * statement * rule_elem (* else *) * statement * end_info (* endif *) | While of rule_elem (* header *) * statement * end_info(*endwhile*) | Do of rule_elem (* do *) * statement * rule_elem (* tail *) | For of rule_elem (* header *) * statement * end_info (*endfor*) | Iterator of rule_elem (* header *) * statement * end_info (*enditer*) | Switch of rule_elem (* header *) * rule_elem (* { *) * statement (*decl*) dots * case_line list * rule_elem(*}*) | Atomic of rule_elem | Disj of statement dots list | Nest of string mcode (* <.../<+... *) * statement dots * string mcode (* ...>/...+> *) * (statement dots,statement) whencode list * multi * dots_whencode list * dots_whencode list | FunDecl of rule_elem (* header *) * rule_elem (* { *) * statement dots * rule_elem (* } *) | Define of rule_elem (* header *) * statement dots | AsStmt of statement * statement (* as statement, always metavar *) | Dots of string mcode (* ... *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | Circles of string mcode (* ooo *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | Stars of string mcode (* *** *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | OptStm of statement | UniqueStm of statement and ('a,'b) whencode = WhenNot of 'a | WhenAlways of 'b | WhenModifier of when_modifier | WhenNotTrue of rule_elem (* useful for fvs *) | WhenNotFalse of rule_elem and when_modifier = (* The following removes the shortest path constraint. It can be used with other when modifiers *) WhenAny (* The following removes the special consideration of error paths. It can be used with other when modifiers *) | WhenStrict | WhenForall | WhenExists (* only used with asttoctl *) and dots_whencode = WParen of rule_elem * meta_name (*pren_var*) | Other of statement | Other_dots of statement dots and statement = base_statement wrap and base_case_line = CaseLine of rule_elem (* case/default header *) * statement dots | OptCase of case_line and case_line = base_case_line wrap and inc_file = Local of inc_elem list | NonLocal of inc_elem list and inc_elem = IncPath of string | IncDots and base_top_level = NONDECL of statement | CODE of statement dots | FILEINFO of string mcode (* old file *) * string mcode (* new file *) | ERRORWORDS of expression list and top_level = base_top_level wrap and parser_kind = ExpP | TyP | AnyP and rulename = CocciRulename of string option * dependency * string list * string list * exists * parser_kind | GeneratedRulename of string option * dependency * string list * string list * exists * parser_kind | ScriptRulename of string option (* name *) * string (* language *) * dependency | InitialScriptRulename of string option (* name *) * string (* language *) * dependency | FinalScriptRulename of string option (* name *) * string (* language *) * dependency and ruletype = Normal | Generated and rule = CocciRule of string (* name *) * (dependency * string list (* dropped isos *) * exists) * top_level list * bool list * ruletype | ScriptRule of string (* name *) * (* metaname for python (untyped), metavar for ocaml (typed) *) string * dependency * (script_meta_name * meta_name * metavar) list (*inherited vars*) * meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string (*language*) * dependency * string (*code*) | FinalScriptRule of string (* name *) * string (*language*) * dependency * string (*code*) and script_meta_name = string option (*string*) * string option (*ast*) and dependency = Dep of string (* rule applies for the current binding *) | AntiDep of string (* rule doesn't apply for the current binding *) | EverDep of string (* rule applies for some binding *) | NeverDep of string (* rule never applies for any binding *) | AndDep of dependency * dependency | OrDep of dependency * dependency | NoDep | FailDep and rule_with_metavars = metavar list * rule and anything = FullTypeTag of fullType | BaseTypeTag of baseType | StructUnionTag of structUnion | SignTag of sign | IdentTag of ident | ExpressionTag of expression | ConstantTag of constant | UnaryOpTag of unaryOp | AssignOpTag of assignOp | FixOpTag of fixOp | BinaryOpTag of binaryOp | ArithOpTag of arithOp | LogicalOpTag of logicalOp | DeclarationTag of declaration | InitTag of initialiser | StorageTag of storage | IncFileTag of inc_file | Rule_elemTag of rule_elem | StatementTag of statement | ForInfoTag of forinfo | CaseLineTag of case_line | ConstVolTag of const_vol | Token of string * info option | Directive of added_string list | Code of top_level | ExprDotsTag of expression dots | ParamDotsTag of parameterTypeDef dots | StmtDotsTag of statement dots | DeclDotsTag of declaration dots | TypeCTag of typeC | ParamTag of parameterTypeDef | SgrepStartTag of string | SgrepEndTag of string (* --------------------------------------------------------------------- *) and exists = Exists | Forall | Undetermined (* | ReverseForall - idea: look back on all flow paths; not implemented *) (* --------------------------------------------------------------------- *) let mkToken x = Token (x,None) (* --------------------------------------------------------------------- *) let lub_count i1 i2 = match (i1,i2) with (MANY,MANY) -> MANY | _ -> ONE (* --------------------------------------------------------------------- *) let rewrap model x = {model with node = x} let rewrap_mcode (_,a,b,c) x = (x,a,b,c) let unwrap x = x.node let unwrap_mcode (x,_,_,_) = x let get_mcodekind (_,_,x,_) = x let get_line x = x.node_line let get_mcode_line (_,l,_,_) = l.line let get_mcode_col (_,l,_,_) = l.column let get_fvs x = x.free_vars let set_fvs fvs x = {x with free_vars = fvs} let get_mfvs x = x.minus_free_vars let set_mfvs mfvs x = {x with minus_free_vars = mfvs} let get_fresh x = x.fresh_vars let get_inherited x = x.inherited let get_saved x = x.saved_witness let get_dots_bef_aft x = x.bef_aft let set_dots_bef_aft d x = {x with bef_aft = d} let get_pos x = x.pos_info let set_pos x pos = {x with pos_info = pos} let get_test_exp x = x.true_if_test_exp let set_test_exp x = {x with true_if_test_exp = true} let get_safe_decl x = x.safe_for_multi_decls let get_isos x = x.iso_info let set_isos x isos = {x with iso_info = isos} let get_pos_var (_,_,_,p) = p let set_pos_var vr (a,b,c,_) = (a,b,c,vr) let drop_pos (a,b,c,_) = (a,b,c,[]) let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) = Common.union_all (List.map (function WhenNot(a) -> get_fvs a | WhenAlways(a) -> get_fvs a | WhenModifier(_) -> [] | WhenNotTrue(e) -> get_fvs e | WhenNotFalse(e) -> get_fvs e) whencode) (* --------------------------------------------------------------------- *) let get_meta_name = function MetaMetaDecl(ar,nm) -> nm | MetaIdDecl(ar,nm) -> nm | MetaFreshIdDecl(nm,seed) -> nm | MetaTypeDecl(ar,nm) -> nm | MetaInitDecl(ar,nm) -> nm | MetaInitListDecl(ar,nm,nm1) -> nm | MetaListlenDecl(nm) -> nm | MetaParamDecl(ar,nm) -> nm | MetaParamListDecl(ar,nm,nm1) -> nm | MetaConstDecl(ar,nm,ty) -> nm | MetaErrDecl(ar,nm) -> nm | MetaExpDecl(ar,nm,ty) -> nm | MetaIdExpDecl(ar,nm,ty) -> nm | MetaLocalIdExpDecl(ar,nm,ty) -> nm | MetaExpListDecl(ar,nm,nm1) -> nm | MetaDeclDecl(ar,nm) -> nm | MetaFieldDecl(ar,nm) -> nm | MetaFieldListDecl(ar,nm,nm1) -> nm | MetaStmDecl(ar,nm) -> nm | MetaStmListDecl(ar,nm) -> nm | MetaFuncDecl(ar,nm) -> nm | MetaLocalFuncDecl(ar,nm) -> nm | MetaPosDecl(ar,nm) -> nm | MetaFmtDecl(ar,nm) -> nm | MetaFragListDecl(ar,nm,nm1) -> nm | MetaAnalysisDecl(code,nm) -> nm | MetaDeclarerDecl(ar,nm) -> nm | MetaIteratorDecl(ar,nm) -> nm (* --------------------------------------------------------------------- *) and tag2c = function FullTypeTag _ -> "FullTypeTag" | BaseTypeTag _ -> "BaseTypeTag" | StructUnionTag _ -> "StructUnionTag" | SignTag _ -> "SignTag" | IdentTag _ -> "IdentTag" | ExpressionTag _ -> "ExpressionTag" | ConstantTag _ -> "ConstantTag" | UnaryOpTag _ -> "UnaryOpTag" | AssignOpTag _ -> "AssignOpTag" | FixOpTag _ -> "FixOpTag" | BinaryOpTag _ -> "BinaryOpTag" | ArithOpTag _ -> "ArithOpTag" | LogicalOpTag _ -> "LogicalOpTag" | DeclarationTag _ -> "DeclarationTag" | InitTag _ -> "InitTag" | StorageTag _ -> "StorageTag" | IncFileTag _ -> "IncFileTag" | Rule_elemTag _ -> "Rule_elemTag" | StatementTag _ -> "StatementTag" | ForInfoTag _ -> "ForInfoTag" | CaseLineTag _ -> "CaseLineTag" | ConstVolTag _ -> "ConstVolTag" | Token _ -> "Token" | Directive _ -> "Directive" | Code _ -> "Code" | ExprDotsTag _ -> "ExprDotsTag" | ParamDotsTag _ -> "ParamDotsTag" | StmtDotsTag _ -> "StmtDotsTag" | DeclDotsTag _ -> "DeclDotsTag" | TypeCTag _ -> "TypeCTag" | ParamTag _ -> "ParamTag" | SgrepStartTag _ -> "SgrepStartTag" | SgrepEndTag _ -> "SgrepEndTag" (* --------------------------------------------------------------------- *) let no_info = { line = 0; column = -1; strbef = []; straft = [] } let make_term x = {node = x; node_line = 0; free_vars = []; minus_free_vars = []; fresh_vars = []; inherited = []; saved_witness = []; bef_aft = NoDots; pos_info = None; true_if_test_exp = false; safe_for_multi_decls = false; iso_info = [] } let make_inherited_term x inherited = {node = x; node_line = 0; free_vars = []; minus_free_vars = []; fresh_vars = []; inherited = inherited; saved_witness = []; bef_aft = NoDots; pos_info = None; true_if_test_exp = false; safe_for_multi_decls = false; iso_info = [] } let make_meta_rule_elem s d (fvs,fresh,inh) = let rule = "" in {(make_term (MetaRuleElem(((rule,s),no_info,d,[]),Type_cocci.Unitary,false))) with free_vars = fvs; fresh_vars = fresh; inherited = inh} let make_meta_decl s d (fvs,fresh,inh) = let rule = "" in {(make_term (MetaDecl(((rule,s),no_info,d,[]),Type_cocci.Unitary,false))) with free_vars = fvs; fresh_vars = fresh; inherited = inh} let make_mcode x = (x,no_info,CONTEXT(NoPos,NOTHING),[]) (* --------------------------------------------------------------------- *) let equal_pos x y = x = y (* --------------------------------------------------------------------- *) let undots x = match unwrap x with DOTS e -> e | CIRCLES e -> e | STARS e -> e coccinelle-1.0.0-rc19/parsing_cocci/iso_compile.ml0000644000175000017500000001056612247442615021032 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iso_compile.ml" module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module Ast0 = Ast0_cocci module Ast = Ast_cocci (* Detects where position variables can be present in the match of an isomorphism. This is allowed if all elements of an isomorphism have only one token or if we can somehow match up equal tokens of all of the isomorphic variants. *) let sequence_tokens = let mcode x = (* sort of unpleasant to convert the token representation to a string but we can't make a list of mcodes otherwise because the types are all different *) [(Dumper.dump (Ast0.unwrap_mcode x),Ast0.get_pos_ref x)] in let donothing r k e = k e in let bind x y = x @ y in let option_default = [] in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* In general, we will get a list of lists: [[tokens1;tokens2;tokens3];[tokens4;tokens5;tokens6];[tokens7;tokens8]] If all of the lists of tokens contain only one element, we are done. Otherwise, we focus on tokens1. For each of its elements, if they are present in all of the others, then a position is assigned, and if not then a position is not. The order of the elements in the other lists is irrelevant; we just take the first unannotated element that matches. Once we are done with the elements of tokens1, we skip to tokens 4 and repeat, including considering the one-element special case. *) let pctr = ref 0 let get_p _ = let c = !pctr in pctr := c + 1; let name = ("",Printf.sprintf "p%d" c) in (* pos var just gives a name we can look up, used for historical reasons *) Ast0.HiddenVarTag ([Ast0.MetaPosTag(Ast0.MetaPos(Ast0.make_mcode name,[],Ast.PER))]) let process_info l = let rec loop previously_used = function [] -> () | ((f::r)::xs) as a -> let safe_add p pos = (* don't add pos var where a pos var is already present *) if Common.inter_set previously_used pos = [] then p::pos else pos in let p = if List.for_all (List.for_all (function e -> List.length e = 1)) a then let p = get_p() in List.iter (List.iter (List.iter (function (_,pos) -> pos := safe_add p !pos))) a; [p] else let all = r @ List.concat xs in let rec find_first_available a = function [] -> raise Not_found | (str,pos)::xs -> if str = a && Common.inter_set previously_used !pos = [] then pos else find_first_available a xs in List.fold_left (function prev -> function (str,pos) -> if Common.inter_set previously_used !pos = [] then try let entries = List.map (find_first_available str) all in let p = get_p() in pos := p::!pos; List.iter (function pos -> pos := p :: !pos) entries; p::prev with Not_found -> prev (* otherwise already annotated *) else prev) [] f in loop (p@previously_used) xs | _ -> failwith "bad iso" in loop l (* Entry point *) let process (metavars,alts,name) = let toks = List.map (List.map sequence_tokens.VT0.combiner_rec_anything) alts in process_info [] toks coccinelle-1.0.0-rc19/parsing_cocci/parsing_cocci.mldylib0000644000175000017500000000105012247437436022350 0ustar eugeneugenFlag_parsing_cocci Type_cocci Ast_cocci Ast0_cocci Pretty_print_cocci Unparse_ast0 Visitor_ast0_types Visitor_ast Visitor_ast0 Compute_lines Comm_assoc Iso_pattern Iso_compile Single_statement Simple_assignments Get_metas Ast0toast Check_meta Top_level Type_infer Test_exps Unitary_ast0 Arity Index Context_neg Adjust_pragmas Insert_plus Function_prototypes Unify_ast Semantic_cocci Data Free_vars Safe_for_multi_decls Parse_aux Disjdistr Lexer_cocci Parser_cocci_menhir Lexer_cli Lexer_script Get_constants2 Id_utils Adjacency Parse_cocci Command_linecoccinelle-1.0.0-rc19/parsing_cocci/test_exps.mli0000644000175000017500000000234712247442615020715 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./test_exps.mli" val process : Ast0_cocci.rule -> Ast0_cocci.rule val process_anything : Ast0_cocci.anything -> Ast0_cocci.anything coccinelle-1.0.0-rc19/parsing_cocci/type_cocci.mli0000644000175000017500000000460012247442615021012 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./type_cocci.mli" type inherited = bool (* true if inherited *) type keep_binding = Unitary (* need no info *) | Nonunitary (* need an env entry *) | Saved (* need a witness *) type meta_name = string * string (*Ast_cocci.meta_name*) type typeC = ConstVol of const_vol * typeC | BaseType of baseType | SignedT of sign * typeC option | Pointer of typeC | FunctionPointer of typeC (* only return type *) | Array of typeC (* drop size info *) | Decimal of name * name | EnumName of name | StructUnionName of structUnion * name | TypeName of string | MetaType of meta_name * keep_binding * inherited | Unknown (* for metavariables of type expression *^* *) and name = NoName | Name of string | Num of string | MV of meta_name * keep_binding * inherited and tagged_string = string and baseType = VoidType | CharType | ShortType | ShortIntType | IntType | DoubleType | LongDoubleType | FloatType | LongType | LongIntType | LongLongType | LongLongIntType | SizeType | SSizeType | PtrDiffType | BoolType and structUnion = Struct | Union and sign = Signed | Unsigned and const_vol = Const | Volatile val type2c : typeC -> string val typeC : typeC -> unit val compatible : typeC -> typeC option -> bool coccinelle-1.0.0-rc19/parsing_cocci/single_statement.mli0000644000175000017500000000226412247442615022242 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./single_statement.mli" val single_statement : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/iso_compile.mli0000644000175000017500000000224412247442615021175 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iso_compile.mli" val process : Iso_pattern.isomorphism -> unit coccinelle-1.0.0-rc19/parsing_cocci/command_line.ml0000644000175000017500000001244412247442615021152 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./command_line.ml" (* ---------------------------------------------------------------------- *) (* useful functions *) let starts_with c s = if String.length s > 0 && String.get s 0 = c then Some (String.sub s 1 ((String.length s) - 1)) else None let ends_with c s = if String.length s > 0 && String.get s ((String.length s) - 1) = c then Some (String.sub s 0 ((String.length s) - 1)) else None let split_when fn l = let rec loop acc = function | [] -> raise Not_found | x::xs -> (match fn x with Some x -> List.rev acc, x, xs | None -> loop (x :: acc) xs) in loop [] l (* ---------------------------------------------------------------------- *) (* make a semantic patch from a string *) let find_metavariables tokens = let rec loop env = function [] -> (env,[]) | x :: xs -> (* single upper case letter is a metavariable *) let (x,xs,env) = (* Testing for uppercase and length is not enough as "+" is a single character identical in upper/lower case. *) (* The ":" delimiter could not be used two times 1) Str.split 2) split_when (ends_with ...) Otherwise split_when will raise a Not_found exception. *) match Str.bounded_split (Str.regexp ":") x 2 with [before;after] -> let (ty,endty,afterty) = split_when (ends_with ':') (after::xs) in let decl = Printf.sprintf "%s %s;\n" (String.concat "" (ty@[endty])) before in (try if decl = List.assoc before env then (before,afterty,env) else failwith (before^" already declared with another type") with Not_found -> let env = (before, decl) :: env in (before,afterty,env)) | _ -> if Str.string_match (Str.regexp "[A-Z]") x 0 then begin try let _ = Some(List.assoc x env) in (x,xs,env) with Not_found -> let env = (x,(Printf.sprintf "metavariable %s;\n" x)) :: env in (x,xs,env) end else (x,xs,env) in let (env,sp) = loop env xs in (env,x::sp) in loop [] tokens let find_when_dots tokens = let rec loop = function [] -> [] | "when !=" :: e :: rest -> "when != " :: e :: "\n" :: (loop rest) | "when ==" :: e :: rest -> "when == " :: e :: "\n" :: (loop rest) | "when" :: " " :: e :: rest -> "when" :: " " :: e :: "\n" :: (loop rest) | "..." :: "when" :: rest -> "\n" :: "..." :: (loop ("when" :: rest)) | "..." :: rest -> "\n" :: "..." :: "\n" :: (loop rest) | x::xs -> x::(loop xs) in loop tokens let add_stars tokens = let rec loop = function [] -> [] | "." :: "." :: "." :: rest -> "..." :: skip rest | "<" :: "." :: "." :: "." :: rest -> "<..." :: skip rest | "<" :: "+" :: "." :: "." :: "." :: rest -> "<+..." :: skip rest | "\n" :: rest -> "\n" :: loop rest | x :: xs -> ("* " ^ x) :: (skip xs) and skip = function [] -> [] | "\n" :: rest -> "\n" :: loop rest | x :: xs -> x :: skip xs in loop tokens let rec add_spaces = function [] -> [] | x :: "\n" :: rest -> x :: "\n" :: (add_spaces rest) | "\n" :: rest -> "\n" :: (add_spaces rest) | x :: rest -> x :: " " :: (add_spaces rest) let reparse tokens = let (env,code) = find_metavariables tokens in let env = String.concat "" (List.map snd env) in let code = find_when_dots code in let code = add_stars code in let code = String.concat "" code in let res = "@@\n"^env^"@@\n"^code in Printf.printf "%s\n\n" res; let out = Common.new_temp_file "sp" ".cocci" in let o = open_out out in Printf.fprintf o "%s\n" res; close_out o; out let tokenize first = let lexbuf = Lexing.from_string first in let rec loop b = let tok = Lexer_cli.token b in if not (tok = Lexer_cli.EOF) then let s = Lexer_cli.pretty_print tok in s :: loop b else [] in loop lexbuf (* ---------------------------------------------------------------------- *) (* entry point *) let command_line args = let info = try Some (Common.split_when (function x -> List.mem x ["-sp";"--sp"]) args) with Not_found -> None in match info with None -> args | Some(pre_args,sp,post_args) -> (match post_args with first::post_args -> pre_args @ "--sp-file" :: (reparse (tokenize first)) :: post_args | [] -> failwith "--sp needs an argument") coccinelle-1.0.0-rc19/parsing_cocci/unparse_ast0.mli0000644000175000017500000000335012247442615021276 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unparse_ast0.mli" val expression_dots : Ast0_cocci.expression Ast0_cocci.dots -> unit val parameter_list : Ast0_cocci.parameterTypeDef Ast0_cocci.dots -> unit val statement_dots : Ast0_cocci.statement Ast0_cocci.dots -> unit val ident : Ast0_cocci.ident -> unit val expression : Ast0_cocci.expression -> unit val typeC : Ast0_cocci.typeC -> unit val parameterTypeDef : Ast0_cocci.parameterTypeDef -> unit val declaration : Ast0_cocci.declaration -> unit val statement : string -> Ast0_cocci.statement -> unit val top_level : Ast0_cocci.top_level -> unit val unparse : Ast0_cocci.rule -> unit val unparse_anything : Ast0_cocci.anything -> unit coccinelle-1.0.0-rc19/parsing_cocci/id_utils.ml0000644000175000017500000000460412247442615020340 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./id_utils.ml" (* evaluation of nested and and or using id-utils *) module GC = Get_constants2 let evaluated = Hashtbl.create(100) exception Out let memoize exp vl = Hashtbl.add evaluated exp vl; vl let rec interpret dir exp = let res = try Some (Hashtbl.find evaluated exp) with Not_found -> None in match res with Some x -> x | None -> memoize exp (match exp with GC.Elem oo -> let cmd = Printf.sprintf "lid -f %s/%s -l %s -S newline" dir !Flag_parsing_cocci.id_utils_index oo in (* lid puts the matched word at the beginning of the first line of the output... *) (match Common.cmd_to_list cmd with [] -> [] | x::xs -> (match Str.split (Str.regexp "[ \t]+") x with [oop;file] when oo = oop -> file :: xs | _ -> failwith (Printf.sprintf "unexpected output of %s" cmd))) | GC.And l -> let rec loop = function [] -> failwith "bad and" | [x] -> interpret dir x | x :: xs -> (match interpret dir x with [] -> raise Out | resx -> let resxs = loop xs in Common.inter_set resx resxs) in (try loop l with Out -> []) | GC.Or l -> List.fold_left (function prev -> function cur -> Common.union_set (interpret dir cur) prev) [] l | _ -> failwith "not possible") coccinelle-1.0.0-rc19/parsing_cocci/unparse_ast0.ml0000644000175000017500000007204312247442615021132 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unparse_ast0.ml" open Format module Ast = Ast_cocci module Ast0 = Ast0_cocci module U = Pretty_print_cocci let quiet = ref true (* true = no decoration on - context, etc *) let full_ids = ref false (* true = print rule name as well *) let start_block str = force_newline(); print_string " "; open_box 0 let end_block str = close_box(); force_newline () let print_option = Common.do_option let print_between = Common.print_between (* --------------------------------------------------------------------- *) (* Positions *) let rec meta_pos l = List.iter (function var -> let current_name = Ast0.meta_pos_name var in let (_,name) = Ast0.unwrap_mcode current_name in print_string "@"; print_string name; meta_pos (Ast0.get_pos current_name)) l (* --------------------------------------------------------------------- *) (* Modified code *) let mcodekind brackets fn x info mc = let print = function Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in List.iter (function (s,_) -> print s) info.Ast0.strings_before; (match mc with Ast0.MINUS(plus_stream) -> let (lb,rb) = if !quiet then ("","") else match brackets with Some x -> ("[","]^"^(string_of_int x)) | None -> ("","") in let (plus_stream,_) = !plus_stream in if !quiet then fn x else (print_string "-"; print_string lb; fn x; print_string rb); (match plus_stream with Ast.NOREPLACEMENT -> () | Ast.REPLACEMENT(plus_stream,_) -> U.print_anything ">>> " plus_stream) | Ast0.CONTEXT(plus_streams) -> let (lb,rb) = if !quiet then ("","") else match brackets with Some x -> ("[",("]^"^(string_of_int x))) | None -> ("","") in let (plus_streams,t1,t2) = !plus_streams in U.print_around (function x -> print_string lb; fn x; print_string rb) x plus_streams | Ast0.PLUS _ -> print_int (info.Ast0.pos_info.Ast0.column); fn x | Ast0.MIXED(plus_streams) -> let (lb,rb) = if !quiet then ("","") else let n = match brackets with Some x -> "^"^(string_of_int x) | None -> "" in ("§","½"^n) in let (plus_streams,_,_) = !plus_streams in U.print_around (function x -> print_string lb; fn x; print_string rb) x plus_streams); List.iter (function (s,_) -> print s) info.Ast0.strings_after let mcode fn (x,_,info,mc,pos,adj) = let fn x = fn x; meta_pos !pos in mcodekind (Some info.Ast0.pos_info.Ast0.line_start)(*None*) fn x info mc let print_context x fn = mcodekind (Some (Ast0.get_line x)) fn () (Ast0.get_info x) (Ast0.get_mcodekind x) let print_meta (ctx,name) = (if !full_ids then (print_string ctx; print_string ":")); print_string name (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) let dots between fn d = print_context d (function _ -> match Ast0.unwrap d with Ast0.DOTS(l) -> print_between between fn l | Ast0.CIRCLES(l) -> print_between between fn l | Ast0.STARS(l) -> print_between between fn l) (* --------------------------------------------------------------------- *) (* Disjunctions *) let do_disj lst processor = print_string "\n("; force_newline(); print_between (function _ -> print_string "\n|"; force_newline()) processor lst; print_string "\n)" (* --------------------------------------------------------------------- *) let print_types = function None -> () | Some ty -> print_string "/* "; Format.print_flush(); print_between (function _ -> print_string ", ") Type_cocci.typeC ty; Format.print_flush(); print_string " */" (* --------------------------------------------------------------------- *) (* Identifier *) let rec ident i = print_context i (function _ -> match Ast0.unwrap i with Ast0.Id(name) -> mcode print_string name | Ast0.MetaId(name,_,_,_) -> mcode print_meta name | Ast0.MetaFunc(name,_,_) -> mcode print_meta name | Ast0.MetaLocalFunc(name,_,_) -> mcode print_meta name | Ast0.DisjId(_,id_list,_,_) -> do_disj id_list ident | Ast0.OptIdent(id) -> print_string "?"; ident id | Ast0.UniqueIdent(id) -> print_string "!"; ident id | Ast0.AsIdent(id,asid) -> ident id; print_string "@"; ident asid) (* --------------------------------------------------------------------- *) (* Expression *) let print_string_box s = print_string s; open_box 0 let rec expression e = print_option Type_cocci.typeC (Ast0.get_type e); print_context e (function _ -> match Ast0.unwrap e with Ast0.Ident(id) -> ident id | Ast0.Constant(const) -> mcode U.constant const | Ast0.StringConstant(lq,str,rq) -> mcode print_string lq; let _ = dots (function _ -> ()) string_fragment str in mcode print_string rq | Ast0.FunCall(fn,lp,args,rp) -> expression fn; mcode print_string_box lp; let _ = dots (function _ -> ()) expression args in close_box(); mcode print_string rp | Ast0.Assignment(left,op,right,_) -> expression left; print_string " "; mcode U.assignOp op; print_string " "; expression right | Ast0.Sequence(left,op,right) -> expression left; mcode print_string op; print_string " "; expression right | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> expression exp1; print_string " "; mcode print_string why; print_option (function e -> print_string " "; expression e) exp2; print_string " "; mcode print_string colon; expression exp3 | Ast0.Postfix(exp,op) -> expression exp; mcode U.fixOp op | Ast0.Infix(exp,op) -> mcode U.fixOp op; expression exp | Ast0.Unary(exp,op) -> mcode U.unaryOp op; expression exp | Ast0.Binary(left,op,right) -> print_string "("; expression left; print_string " "; mcode U.binaryOp op; print_string " "; expression right; print_string ")" | Ast0.Nested(left,op,right) -> print_string "("; expression left; print_string " "; mcode U.binaryOp op; print_string " "; expression right; print_string ")" | Ast0.Paren(lp,exp,rp) -> mcode print_string_box lp; expression exp; close_box(); mcode print_string rp | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> expression exp1; mcode print_string_box lb; expression exp2; close_box(); mcode print_string rb | Ast0.RecordAccess(exp,pt,field) -> expression exp; mcode print_string pt; ident field | Ast0.RecordPtAccess(exp,ar,field) -> expression exp; mcode print_string ar; ident field | Ast0.Cast(lp,ty,rp,exp) -> mcode print_string_box lp; typeC ty; close_box(); mcode print_string rp; expression exp | Ast0.SizeOfExpr(szf,exp) -> mcode print_string szf; expression exp | Ast0.SizeOfType(szf,lp,ty,rp) -> mcode print_string szf; mcode print_string_box lp; typeC ty; close_box(); mcode print_string rp | Ast0.TypeExp(ty) -> typeC ty | Ast0.Constructor(lp,ty,rp,init) -> mcode print_string_box lp; typeC ty; close_box(); mcode print_string rp; initialiser init | Ast0.MetaErr(name,_,_) -> mcode print_meta name | Ast0.MetaExpr(name,_,ty,_,pure) -> mcode print_meta name; print_types ty(*; print_string "^"; (match pure with Ast0.Pure -> print_string "pure" | Ast0.Impure -> print_string "impure" | Ast0.Context -> print_string "context" | Ast0.PureContext -> print_string "pure_context")*) | Ast0.MetaExprList(name,_,_) -> mcode print_meta name | Ast0.EComma(cm) -> mcode print_string cm; print_space() | Ast0.DisjExpr(_,exp_list,_,_) -> do_disj exp_list expression | Ast0.NestExpr(starter,expr_dots,ender,None,multi) -> mcode print_string starter; start_block(); dots force_newline expression expr_dots; end_block(); mcode print_string ender | Ast0.NestExpr(starter,expr_dots,ender,Some whencode,multi) -> mcode print_string starter; print_string " WHEN != "; expression whencode; start_block(); dots force_newline expression expr_dots; end_block(); mcode print_string ender | Ast0.Edots(dots,Some whencode) | Ast0.Ecircles(dots,Some whencode) | Ast0.Estars(dots,Some whencode) -> mcode print_string dots; print_string " WHEN != "; expression whencode | Ast0.Edots(dots,None) | Ast0.Ecircles(dots,None) | Ast0.Estars(dots,None) -> mcode print_string dots | Ast0.OptExp(exp) -> print_string "?"; expression exp | Ast0.UniqueExp(exp) -> print_string "!"; expression exp | Ast0.AsExpr(exp,asexp) -> expression exp; print_string "@"; expression asexp) and expression_dots x = dots (function _ -> ()) expression x and string_fragment e = match Ast0.unwrap e with Ast0.ConstantFragment(str) -> mcode print_string str | Ast0.FormatFragment(pct,fmt) -> mcode print_string pct; string_format fmt | Ast0.Strdots dots -> mcode print_string dots | Ast0.MetaFormatList(pct,name,lenname) -> mcode print_string pct; mcode print_meta name and string_format e = match Ast0.unwrap e with Ast0.ConstantFormat(str) -> mcode print_string str | Ast0.MetaFormat(name,_) -> mcode print_meta name (* --------------------------------------------------------------------- *) (* Types *) and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn = typeC ty; mcode print_string lp1; mcode print_string star; fn(); mcode print_string rp1; mcode print_string lp2; parameter_list params; mcode print_string rp2 and print_function_type (ty,lp1,params,rp1) fn = print_option typeC ty; fn(); mcode print_string lp1; parameter_list params; mcode print_string rp1 and typeC t = print_context t (function _ -> match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> mcode U.const_vol cv; print_string " "; typeC ty | Ast0.BaseType(ty,strings) -> List.iter (function s -> mcode print_string s; print_string " ") strings | Ast0.Signed(sgn,ty) -> mcode U.sign sgn; print_option typeC ty | Ast0.Pointer(ty,star) -> typeC ty; mcode print_string star | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> ()) | Ast0.FunctionType(ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> ()) | Ast0.Array(ty,lb,size,rb) -> typeC ty; mcode print_string lb; print_option expression size; mcode print_string rb | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> mcode print_string dec; mcode print_string lp; expression length; print_option (mcode print_string) comma; print_option expression precision_opt; mcode print_string rp | Ast0.EnumName(kind,name) -> mcode print_string kind; print_option (function x -> ident x; print_string " ") name | Ast0.EnumDef(ty,lb,ids,rb) -> typeC ty; mcode print_string lb; dots force_newline expression ids; mcode print_string rb | Ast0.StructUnionName(kind,name) -> mcode U.structUnion kind; print_option (function x -> ident x; print_string " ") name | Ast0.StructUnionDef(ty,lb,decls,rb) -> typeC ty; mcode print_string lb; dots force_newline declaration decls; mcode print_string rb | Ast0.TypeName(name)-> mcode print_string name; print_string " " | Ast0.MetaType(name,_)-> mcode print_meta name; print_string " " | Ast0.DisjType(_,types,_,_) -> do_disj types typeC | Ast0.OptType(ty) -> print_string "?"; typeC ty | Ast0.UniqueType(ty) -> print_string "!"; typeC ty | Ast0.AsType(ty,asty) -> typeC ty; print_string "@"; typeC asty) (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and print_named_type ty id = match Ast0.unwrap ty with Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> print_string " "; ident id) | Ast0.FunctionType(ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> print_string " "; ident id) | Ast0.Array(ty,lb,size,rb) -> let rec loop ty k = match Ast0.unwrap ty with Ast0.Array(ty,lb,size,rb) -> loop ty (function _ -> k (); mcode print_string lb; print_option expression size; mcode print_string rb) | _ -> typeC ty; ident id; k () in loop ty (function _ -> ()) | _ -> typeC ty; ident id and declaration d = print_context d (function _ -> match Ast0.unwrap d with Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) | Ast0.MetaFieldList(name,_,_) -> mcode print_meta name | Ast0.Init(stg,ty,id,eq,ini,sem) -> print_option (mcode U.storage) stg; print_named_type ty id; print_string " "; mcode print_string eq; print_string " "; initialiser ini; mcode print_string sem | Ast0.UnInit(stg,ty,id,sem) -> print_option (mcode U.storage) stg; print_named_type ty id; mcode print_string sem | Ast0.MacroDecl(name,lp,args,rp,sem) -> ident name; mcode print_string_box lp; let _ = dots (function _ -> ()) expression args in close_box(); mcode print_string rp; mcode print_string sem | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> ident name; mcode print_string_box lp; let _ = dots (function _ -> ()) expression args in close_box(); mcode print_string rp; print_string " "; mcode print_string eq; print_string " "; initialiser ini; mcode print_string sem | Ast0.TyDecl(ty,sem) -> typeC ty; mcode print_string sem | Ast0.Typedef(stg,ty,id,sem) -> mcode print_string stg; typeC ty; typeC id; mcode print_string sem | Ast0.DisjDecl(_,decls,_,_) -> print_string "\n("; force_newline(); print_between (function _ -> print_string "\n|"; force_newline()) declaration decls; print_string "\n)" | Ast0.Ddots(dots,Some whencode) -> mcode print_string dots; print_string " when != "; declaration whencode | Ast0.Ddots(dots,None) -> mcode print_string dots | Ast0.OptDecl(decl) -> print_string "?"; declaration decl | Ast0.UniqueDecl(decl) -> print_string "!"; declaration decl | Ast0.AsDecl(decl,asdecl) -> declaration decl; print_string "@"; declaration asdecl) and declaration_dots l = dots (function _ -> ()) declaration l (* --------------------------------------------------------------------- *) (* Initialiser *) and initialiser i = print_context i (function _ -> match Ast0.unwrap i with Ast0.MetaInit(name,_)-> mcode print_meta name; print_string " " | Ast0.MetaInitList(name,_,_)-> mcode print_meta name; print_string " " | Ast0.InitExpr(exp) -> expression exp | Ast0.InitList(lb,initlist,rb,ordered) -> (*doesn't show commas dropped in unordered case*) mcode print_string lb; open_box 0; let _ = dots (function _ -> ()) initialiser initlist in close_box(); mcode print_string rb | Ast0.InitGccExt(designators,eq,ini) -> List.iter designator designators; print_string " "; mcode print_string eq; print_string " "; initialiser ini | Ast0.InitGccName(name,eq,ini) -> ident name; mcode print_string eq; initialiser ini | Ast0.IComma(cm) -> mcode print_string cm; force_newline() | Ast0.Idots(d,Some whencode) -> mcode print_string d; print_string " WHEN != "; initialiser whencode | Ast0.Idots(d,None) -> mcode print_string d | Ast0.OptIni(ini) -> print_string "?"; initialiser ini | Ast0.UniqueIni(ini) -> print_string "!"; initialiser ini | Ast0.AsInit(ini,asini) -> initialiser ini; print_string "@"; initialiser asini) and designator = function Ast0.DesignatorField(dot,id) -> mcode print_string dot; ident id | Ast0.DesignatorIndex(lb,exp,rb) -> mcode print_string lb; expression exp; mcode print_string rb | Ast0.DesignatorRange(lb,min,dots,max,rb) -> mcode print_string lb; expression min; mcode print_string dots; expression max; mcode print_string rb and initialiser_list l = dots (function _ -> ()) initialiser l (* --------------------------------------------------------------------- *) (* Parameter *) and parameterTypeDef p = print_context p (function _ -> match Ast0.unwrap p with Ast0.VoidParam(ty) -> typeC ty | Ast0.Param(ty,Some id) -> print_named_type ty id | Ast0.Param(ty,None) -> typeC ty | Ast0.MetaParam(name,_) -> mcode print_meta name | Ast0.MetaParamList(name,_,_) -> mcode print_meta name | Ast0.PComma(cm) -> mcode print_string cm; print_space() | Ast0.Pdots(dots) -> mcode print_string dots | Ast0.Pcircles(dots) -> mcode print_string dots | Ast0.OptParam(param) -> print_string "?"; parameterTypeDef param | Ast0.UniqueParam(param) -> print_string "!"; parameterTypeDef param | Ast0.AsParam(p,asexp) -> parameterTypeDef p; print_string "@"; expression asexp) and parameter_list l = dots (function _ -> ()) parameterTypeDef l (* --------------------------------------------------------------------- *) (* Top-level code *) and statement arity s = print_context s (function _ -> match Ast0.unwrap s with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> print_string arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; close_box(); mcode print_string rp; print_string " "; print_string arity; mcode print_string lbrace; start_block(); dots force_newline (statement arity) body; end_block(); print_string arity; mcode print_string rbrace | Ast0.Decl(_,decl) -> print_string arity; declaration decl | Ast0.Seq(lbrace,body,rbrace) -> print_string arity; mcode print_string lbrace; start_block(); dots force_newline (statement arity) body; end_block(); print_string arity; mcode print_string rbrace | Ast0.ExprStatement(exp,sem) -> print_string arity; print_option expression exp; mcode print_string sem | Ast0.IfThen(iff,lp,exp,rp,branch1,(info,aft,adj)) -> print_string arity; mcode print_string iff; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " "; statement arity branch1; mcode (function _ -> ()) ((),(),info,aft,ref [],adj) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,aft,adj)) -> print_string arity; mcode print_string iff; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " "; statement arity branch1; print_string arity; mcode print_string els; print_string " "; statement arity branch2; mcode (function _ -> ()) ((),(),info,aft,ref [],adj) | Ast0.While(whl,lp,exp,rp,body,(info,aft,adj)) -> print_string arity; mcode print_string whl; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " "; statement arity body; mcode (function _ -> ()) ((),(),info,aft,ref [],adj) | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> print_string arity; mcode print_string d; print_string " "; statement arity body; print_string arity; mcode print_string whl; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; mcode print_string sem | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,(info,aft,adj)) -> print_string arity; mcode print_string fr; mcode print_string_box lp; (match Ast0.unwrap first with Ast0.ForExp(e1,sem1) -> print_option expression e1; mcode print_string sem1 | Ast0.ForDecl (_,decl) -> declaration decl); print_option expression e2; mcode print_string sem2; print_option expression e3; close_box(); mcode print_string rp; print_string " "; statement arity body; mcode (function _ -> ()) ((),(),info,aft,ref [],adj) | Ast0.Iterator(nm,lp,args,rp,body,(info,aft,adj)) -> print_string arity; ident nm; print_string " "; mcode print_string_box lp; let _ = dots (function _ -> ()) expression args in close_box(); mcode print_string rp; print_string " "; statement arity body; mcode (function _ -> ()) ((),(),info,aft,ref [],adj) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> print_string arity; mcode print_string switch; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " "; mcode print_string lb; dots force_newline (statement arity) decls; dots force_newline (case_line arity) cases; mcode print_string rb | Ast0.Break(br,sem) -> print_string arity; mcode print_string br; mcode print_string sem | Ast0.Continue(cont,sem) -> print_string arity; mcode print_string cont; mcode print_string sem | Ast0.Label(l,dd) -> ident l; print_string ":" | Ast0.Goto(goto,l,sem) -> mcode print_string goto; ident l; mcode print_string sem | Ast0.Return(ret,sem) -> print_string arity; mcode print_string ret; mcode print_string sem | Ast0.ReturnExpr(ret,exp,sem) -> print_string arity; mcode print_string ret; print_string " "; expression exp; mcode print_string sem | Ast0.MetaStmt(name,pure) -> print_string arity; mcode print_meta name;(* print_string "^"; (match pure with Ast0.Pure -> print_string "pure" | Ast0.Impure -> print_string "impure" | Ast0.Context -> print_string "context" | Ast0.PureContext -> print_string "pure_context")*) | Ast0.MetaStmtList(name,_) -> print_string arity; mcode print_meta name | Ast0.Disj(starter,statement_dots_list,_,ender) -> print_string arity; print_string "\n"; mcode print_string starter; force_newline(); print_between (function _ -> print_string "\n|"; force_newline()) (dots force_newline (statement arity)) statement_dots_list; print_string "\n"; mcode print_string ender | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> print_string arity; mcode print_string starter; open_box 0; List.iter (whencode (dots force_newline (statement "")) (statement "")) whn; close_box(); start_block(); dots force_newline (statement arity) stmt_dots; end_block(); mcode print_string ender | Ast0.Exp(exp) -> print_string arity; expression exp | Ast0.TopExp(exp) -> print_string arity; expression exp | Ast0.Ty(ty) -> print_string arity; typeC ty | Ast0.TopInit(init) -> initialiser init | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> print_string arity; mcode print_string d; List.iter (whencode (dots force_newline (statement "")) (statement "")) whn | Ast0.Include(inc,s) -> mcode print_string inc; print_string " "; mcode U.inc_file s | Ast0.Undef(def,id) -> mcode print_string def; print_string " "; ident id | Ast0.Define(def,id,params,body) -> mcode print_string def; print_string " "; ident id; print_define_parameters params; print_string " "; dots force_newline (statement arity) body | Ast0.Pragma(prg,id,body) -> mcode print_string prg; print_string " "; ident id; print_string " "; pragmainfo body | Ast0.OptStm(re) -> statement "?" re | Ast0.UniqueStm(re) -> statement "!" re | Ast0.AsStmt(stm,asstm) -> statement arity stm; print_string "@"; statement arity asstm) and pragmainfo pi = match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp | Ast0.PragmaIdList(ids) -> dots (function _ -> ()) ident ids | Ast0.PragmaDots(dots) -> mcode print_string dots and print_define_parameters params = match Ast0.unwrap params with Ast0.NoParams -> () | Ast0.DParams(lp,params,rp) -> mcode print_string lp; dots (function _ -> ()) print_define_param params; mcode print_string rp and print_define_param param = match Ast0.unwrap param with Ast0.DParam(id) -> ident id | Ast0.DPComma(comma) -> mcode print_string comma | Ast0.DPdots(dots) -> mcode print_string dots | Ast0.DPcircles(circles) -> mcode print_string circles | Ast0.OptDParam(dp) -> print_string "?"; print_define_param dp | Ast0.UniqueDParam(dp) -> print_string "!"; print_define_param dp and print_fninfo = function Ast0.FStorage(stg) -> mcode U.storage stg | Ast0.FType(ty) -> typeC ty | Ast0.FInline(inline) -> mcode print_string inline | Ast0.FAttr(attr) -> mcode print_string attr and whencode notfn alwaysfn = function Ast0.WhenNot a -> print_string " WHEN != "; open_box 0; notfn a; close_box() | Ast0.WhenAlways a -> print_string " WHEN = "; open_box 0; alwaysfn a; close_box() | Ast0.WhenModifier x -> print_string " WHEN "; U.print_when_modif x | Ast0.WhenNotTrue a -> print_string " WHEN != TRUE "; open_box 0; expression a; close_box() | Ast0.WhenNotFalse a -> print_string " WHEN != FALSE "; open_box 0; expression a; close_box() and case_line arity c = print_context c (function _ -> match Ast0.unwrap c with Ast0.Default(def,colon,code) -> print_string arity; mcode print_string def; mcode print_string colon; print_string " "; dots force_newline (statement arity) code | Ast0.Case(case,exp,colon,code) -> print_string arity; mcode print_string case; print_string " "; expression exp; mcode print_string colon; print_string " "; dots force_newline (statement arity) code | Ast0.DisjCase(starter,case_lines,mids,ender) -> print_string "\n("; force_newline(); print_between (function _ -> print_string "\n|"; force_newline()) (case_line arity) case_lines; print_string "\n)" | Ast0.OptCase(case) -> case_line "?" case) and statement_dots l = dots (function _ -> ()) (statement "") l and case_dots l = dots (function _ -> ()) (case_line "") l (* --------------------------------------------------------------------- *) (* Top level code *) let top_level t = print_context t (function _ -> match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> print_string "--- "; mcode print_string old_file; force_newline(); print_string "+++ "; mcode print_string new_file | Ast0.NONDECL(stmt) -> statement "" stmt | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) -> dots force_newline (statement "") stmt_dots | Ast0.ERRORWORDS(exps) -> print_string "error words = ["; print_between (function _ -> print_string ", ") expression exps; print_string "]" | Ast0.OTHER(s) -> print_string "OTHER("; statement "" s; print_string ")") let rule = print_between (function _ -> force_newline(); force_newline()) top_level let unparse_anything x = let q = !quiet in quiet := true; (match x with Ast0.DotsExprTag(d) -> print_string "ExpDots:"; force_newline(); expression_dots d | Ast0.DotsParamTag(d) -> parameter_list d | Ast0.DotsInitTag(d) -> initialiser_list d | Ast0.DotsStmtTag(d) -> print_string "StmDots:"; force_newline(); statement_dots d | Ast0.DotsDeclTag(d) -> declaration_dots d | Ast0.DotsCaseTag(d) -> case_dots d | Ast0.IdentTag(d) -> ident d | Ast0.ExprTag(d) | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> print_string "Exp:"; force_newline(); expression d | Ast0.TypeCTag(d) -> typeC d | Ast0.ParamTag(d) -> parameterTypeDef d | Ast0.InitTag(d) -> initialiser d | Ast0.DeclTag(d) -> declaration d | Ast0.StmtTag(d) -> print_string "Stm:"; force_newline(); statement "" d | Ast0.ForInfoTag(fi) -> print_string "ForInfo:"; force_newline(); (match Ast0.unwrap fi with Ast0.ForExp(e1,sem1) -> print_option expression e1; mcode print_string sem1 | Ast0.ForDecl (_,decl) -> declaration decl) | Ast0.CaseLineTag(d) -> case_line "" d | Ast0.TopTag(d) -> top_level d | Ast0.IsoWhenTag(x) -> U.print_when_modif x | Ast0.IsoWhenTTag(e) -> expression e | Ast0.IsoWhenFTag(e) -> expression e | Ast0.MetaPosTag(var) -> meta_pos [x] | Ast0.HiddenVarTag(var) -> failwith "should not need to be printed"); quiet := q; print_newline() let unparse x = print_string "\n@@\n@@"; force_newline(); force_newline(); rule x; print_newline() let unparse_to_string x = Common.format_to_string (function _ -> unparse x) coccinelle-1.0.0-rc19/parsing_cocci/insert_plus.mli0000644000175000017500000000233012247442615021236 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./insert_plus.mli" val insert_plus : Ast0_cocci.rule -> Ast0_cocci.rule -> bool -> unit (* bool is true if no isos *) coccinelle-1.0.0-rc19/parsing_cocci/data.ml0000644000175000017500000001631012247442615017432 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./data.ml" module Ast0 = Ast0_cocci module Ast = Ast_cocci (* types that clutter the .mly file *) (* for iso metavariables, true if they can only match nonmodified, unitary metavariables *) type fresh = bool type incl_iso = Include of string | Iso of (string,string) Common.either | Virt of string list (* virtual rules *) type clt = line_type * int * int * int * int (* starting spaces *) * (Ast_cocci.added_string * Ast0.position_info) list (* code before *) * (Ast_cocci.added_string * Ast0.position_info) list (* code after *) * Ast0.anything list (* position variable, minus only *) (* ---------------------------------------------------------------------- *) (* Things that need to be seen by the lexer and parser. *) and line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | PLUSPLUS | CONTEXT | UNIQUE | OPT type iconstraints = Ast.idconstraint type econstraints = Ast0.constraints type pconstraints = Ast.meta_name list let in_rule_name = ref false let in_meta = ref false let in_iso = ref false let in_generating = ref false let ignore_patch_or_match = ref false let in_prolog = ref false (* state machine for lexer..., allows smpl keywords as type names *) let saw_struct = ref false let inheritable_positions = ref ([] : string list) (* rules from which posns can be inherited *) let call_in_meta f = in_meta := true; saw_struct := false; let res = f() in in_meta := false; res let all_metadecls = (Hashtbl.create(100) : (string, Ast.metavar list) Hashtbl.t) let clear_meta: (unit -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_meta_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_id_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_virt_id_meta_found: (string -> string -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_virt_id_meta_not_found: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_fresh_id_meta: (Ast.meta_name -> Ast.seed -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_type_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_init_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_initlist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_param_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_paramlist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_const_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_err_meta: (Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_exp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_idexp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_local_idexp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_explist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_decl_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_field_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_field_list_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_symbol_meta: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_stm_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_stmlist_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_func_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_local_func_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_declarer_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_decl") let add_iterator_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref (fun _ -> failwith "uninitialized add_iter") let add_pos_meta: (Ast.meta_name -> pconstraints -> Ast.meta_collect -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_fmt_meta: (Ast.meta_name -> iconstraints -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_fmtlist_meta: (Ast.meta_name -> Ast.list_len -> unit) ref = ref (fun _ -> failwith "uninitialized add_meta") let add_type_name: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_type") let add_declarer_name: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_decl") let add_iterator_name: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_iter") let init_rule: (unit -> unit) ref = ref (fun _ -> failwith "uninitialized install_bindings") let install_bindings: (string -> unit) ref = ref (fun _ -> failwith "uninitialized install_bindings") (* ---------------------------------------------------------------------- *) (* String format things *) let format_metavariables = ref ([] : (string * (Ast.meta_name * iconstraints)) list) let format_list_metavariables = ref ([] : (string * (Ast.meta_name * Ast.list_len)) list) coccinelle-1.0.0-rc19/parsing_cocci/test2.cocci0000644000175000017500000000333512247442615020235 0ustar eugeneugen// Copyright 2012, INRIA // Julia Lawall, Gilles Muller // Copyright 2010-2011, INRIA, University of Copenhagen // Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix // Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen // Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix // This file is part of Coccinelle. // // Coccinelle is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, according to version 2 of the License. // // Coccinelle is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Coccinelle. If not, see . // // The authors reserve the right to distribute this or future versions of // Coccinelle under other licenses. @@ struct SHT sht; local function proc_info_func; @@ sht.proc_info = proc_info_func; @@ identifier buffer, start, offset, length, inout, hostptr, hostno; @@ proc_info_func ( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (!hostptr) { ... } ... ?- scsi_host_put(hostptr); ... } @@ expression E; @@ proc_info_func(...) { <... ( \+- E->host_no == hostno + E == shpnt | - hostno + shpnt->host_no ) ...> } coccinelle-1.0.0-rc19/parsing_cocci/ast0toast.mli0000644000175000017500000000474212247442615020622 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast0toast.mli" val ast0toast : string -> Ast_cocci.dependency -> string list (* dropped isos *) -> Ast_cocci.exists -> Ast0_cocci.rule -> bool list -> Ast_cocci.ruletype -> Ast_cocci.rule val ast0toast_toplevel : Ast0_cocci.top_level -> Ast_cocci.top_level val ident : Ast0_cocci.ident -> Ast_cocci.ident val expression : Ast0_cocci.expression -> Ast_cocci.expression val expression_dots : Ast0_cocci.expression Ast0_cocci.dots -> Ast_cocci.expression Ast_cocci.dots val initialiser : Ast0_cocci.initialiser -> Ast_cocci.initialiser val statement : Ast0_cocci.statement -> Ast_cocci.statement val forinfo : Ast0_cocci.forinfo -> Ast_cocci.forinfo val statement_dots : Ast0_cocci.statement Ast0_cocci.dots -> Ast_cocci.statement Ast_cocci.dots val declaration_dots : Ast0_cocci.declaration Ast0_cocci.dots -> Ast_cocci.declaration Ast_cocci.dots val case_line : Ast0_cocci.case_line -> Ast_cocci.case_line val typeC : bool (*allminus*) -> Ast0_cocci.typeC -> Ast_cocci.fullType val declaration : Ast0_cocci.declaration -> Ast_cocci.declaration val parameterTypeDef : Ast0_cocci.parameterTypeDef -> Ast_cocci.parameterTypeDef val parameter_list : Ast0_cocci.parameter_list -> Ast_cocci.parameter_list val top_level : Ast0_cocci.top_level -> Ast_cocci.top_level val mcode : 'a Ast0_cocci.mcode -> 'a Ast_cocci.mcode val convert_info : Ast0_cocci.info -> Ast_cocci.info coccinelle-1.0.0-rc19/parsing_cocci/visitor_ast.mli0000644000175000017500000001472212247442616021246 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./visitor_ast.mli" type 'a combiner = {combiner_ident : Ast_cocci.ident -> 'a; combiner_expression : Ast_cocci.expression -> 'a; combiner_fragment : Ast_cocci.string_fragment -> 'a; combiner_format : Ast_cocci.string_format -> 'a; combiner_fullType : Ast_cocci.fullType -> 'a; combiner_typeC : Ast_cocci.typeC -> 'a; combiner_declaration : Ast_cocci.declaration -> 'a; combiner_initialiser : Ast_cocci.initialiser -> 'a; combiner_parameter : Ast_cocci.parameterTypeDef -> 'a; combiner_parameter_list : Ast_cocci.parameter_list -> 'a; combiner_rule_elem : Ast_cocci.rule_elem -> 'a; combiner_statement : Ast_cocci.statement -> 'a; combiner_case_line : Ast_cocci.case_line -> 'a; combiner_top_level : Ast_cocci.top_level -> 'a; combiner_anything : Ast_cocci.anything -> 'a; combiner_expression_dots : Ast_cocci.expression Ast_cocci.dots -> 'a; combiner_statement_dots : Ast_cocci.statement Ast_cocci.dots -> 'a; combiner_declaration_dots : Ast_cocci.declaration Ast_cocci.dots -> 'a; combiner_initialiser_dots : Ast_cocci.initialiser Ast_cocci.dots -> 'a} type ('mc,'a) cmcode = 'a combiner -> 'mc Ast_cocci.mcode -> 'a type ('cd,'a) ccode = 'a combiner -> ('cd -> 'a) -> 'cd -> 'a val combiner : ('a -> 'a -> 'a) -> 'a -> ((Ast_cocci.meta_name,'a) cmcode) -> ((string,'a) cmcode) -> ((Ast_cocci.constant,'a) cmcode) -> ((Ast_cocci.assignOp,'a) cmcode) -> ((Ast_cocci.fixOp,'a) cmcode) -> ((Ast_cocci.unaryOp,'a) cmcode) -> ((Ast_cocci.binaryOp,'a) cmcode) -> ((Ast_cocci.const_vol,'a) cmcode) -> ((Ast_cocci.sign,'a) cmcode) -> ((Ast_cocci.structUnion,'a) cmcode) -> ((Ast_cocci.storage,'a) cmcode) -> ((Ast_cocci.inc_file,'a) cmcode) -> ((Ast_cocci.expression Ast_cocci.dots,'a) ccode) -> ((Ast_cocci.parameterTypeDef Ast_cocci.dots,'a) ccode) -> ((Ast_cocci.statement Ast_cocci.dots,'a) ccode) -> ((Ast_cocci.declaration Ast_cocci.dots,'a) ccode) -> ((Ast_cocci.initialiser Ast_cocci.dots,'a) ccode) -> ((Ast_cocci.ident,'a) ccode) -> ((Ast_cocci.expression,'a) ccode) -> ((Ast_cocci.string_fragment,'a) ccode) -> ((Ast_cocci.string_format,'a) ccode) -> ((Ast_cocci.fullType,'a) ccode) -> ((Ast_cocci.typeC,'a) ccode) -> ((Ast_cocci.initialiser,'a) ccode) -> ((Ast_cocci.parameterTypeDef,'a) ccode) -> ((Ast_cocci.declaration,'a) ccode) -> ((Ast_cocci.rule_elem,'a) ccode) -> ((Ast_cocci.statement,'a) ccode) -> ((Ast_cocci.case_line,'a) ccode) -> ((Ast_cocci.top_level,'a) ccode) -> ((Ast_cocci.anything,'a) ccode) -> 'a combiner type 'a inout = 'a -> 'a (* for specifying the type of rebuilder *) type rebuilder = {rebuilder_ident : Ast_cocci.ident inout; rebuilder_expression : Ast_cocci.expression inout; rebuilder_fragment : Ast_cocci.string_fragment inout; rebuilder_format : Ast_cocci.string_format inout; rebuilder_fullType : Ast_cocci.fullType inout; rebuilder_typeC : Ast_cocci.typeC inout; rebuilder_declaration : Ast_cocci.declaration inout; rebuilder_initialiser : Ast_cocci.initialiser inout; rebuilder_parameter : Ast_cocci.parameterTypeDef inout; rebuilder_parameter_list : Ast_cocci.parameter_list inout; rebuilder_statement : Ast_cocci.statement inout; rebuilder_case_line : Ast_cocci.case_line inout; rebuilder_rule_elem : Ast_cocci.rule_elem inout; rebuilder_top_level : Ast_cocci.top_level inout; rebuilder_expression_dots : Ast_cocci.expression Ast_cocci.dots inout; rebuilder_statement_dots : Ast_cocci.statement Ast_cocci.dots inout; rebuilder_declaration_dots : Ast_cocci.declaration Ast_cocci.dots inout; rebuilder_initialiser_dots : Ast_cocci.initialiser Ast_cocci.dots inout; rebuilder_define_param_dots: Ast_cocci.define_param Ast_cocci.dots inout; rebuilder_define_param : Ast_cocci.define_param inout; rebuilder_define_parameters : Ast_cocci.define_parameters inout; rebuilder_anything : Ast_cocci.anything inout} type 'mc rmcode = 'mc Ast_cocci.mcode inout type 'cd rcode = rebuilder -> ('cd inout) -> 'cd inout val rebuilder : (Ast_cocci.meta_name rmcode) -> (string rmcode) -> (Ast_cocci.constant rmcode) -> (Ast_cocci.assignOp rmcode) -> (Ast_cocci.fixOp rmcode) -> (Ast_cocci.unaryOp rmcode) -> (Ast_cocci.binaryOp rmcode) -> (Ast_cocci.const_vol rmcode) -> (Ast_cocci.sign rmcode) -> (Ast_cocci.structUnion rmcode) -> (Ast_cocci.storage rmcode) -> (Ast_cocci.inc_file rmcode) -> (Ast_cocci.expression Ast_cocci.dots rcode) -> (Ast_cocci.parameterTypeDef Ast_cocci.dots rcode) -> (Ast_cocci.statement Ast_cocci.dots rcode) -> (Ast_cocci.declaration Ast_cocci.dots rcode) -> (Ast_cocci.initialiser Ast_cocci.dots rcode) -> (Ast_cocci.ident rcode) -> (Ast_cocci.expression rcode) -> (Ast_cocci.string_fragment rcode) -> (Ast_cocci.string_format rcode) -> (Ast_cocci.fullType rcode) -> (Ast_cocci.typeC rcode) -> (Ast_cocci.initialiser rcode) -> (Ast_cocci.parameterTypeDef rcode) -> (Ast_cocci.declaration rcode) -> (Ast_cocci.rule_elem rcode) -> (Ast_cocci.statement rcode) -> (Ast_cocci.case_line rcode) -> (Ast_cocci.top_level rcode) -> (Ast_cocci.anything rcode) -> rebuilder coccinelle-1.0.0-rc19/parsing_cocci/ast0_cocci.mli0000644000175000017500000005704412247442615020712 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast0_cocci.mli" (* --------------------------------------------------------------------- *) (* Modified code *) type arity = OPT | UNIQUE | NONE type token_info = { tline_start : int; tline_end : int; left_offset : int; right_offset : int } val default_token_info : token_info type mcodekind = MINUS of (Ast_cocci.anything Ast_cocci.replacement * token_info) ref | PLUS of Ast_cocci.count | CONTEXT of (Ast_cocci.anything Ast_cocci.befaft * token_info * token_info) ref | MIXED of (Ast_cocci.anything Ast_cocci.befaft * token_info * token_info) ref type position_info = { line_start : int; line_end : int; logical_start : int; logical_end : int; column : int; offset : int; } type info = { pos_info : position_info; attachable_start : bool; attachable_end : bool; mcode_start : mcodekind list; mcode_end : mcodekind list; (* the following are only for + code *) strings_before : (Ast_cocci.added_string * position_info) list; strings_after : (Ast_cocci.added_string * position_info) list; isSymbolIdent : bool; (* is the token a symbol identifier or not *) } type adjacency = int type fake_mcode = info * mcodekind * adjacency type 'a mcode = 'a * arity * info * mcodekind * anything list ref (* pos, - only *) * adjacency (* adjacency_index *) and 'a wrap = { node : 'a; info : info; index : int ref; mcodekind : mcodekind ref; exp_ty : Type_cocci.typeC option ref; (* only for expressions *) bef_aft : dots_bef_aft; (* only for statements *) true_if_arg : bool; (* true if "arg_exp", only for exprs *) true_if_test : bool; (* true if "test position", only for exprs *) true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *) (*nonempty if this represents the use of an iso*) iso_info : (string*anything) list } and dots_bef_aft = NoDots | AddingBetweenDots of statement | DroppingBetweenDots of statement (* for iso metavariables, true if they can only match nonmodified, unitary metavariables for SP metavariables, true if the metavariable is unitary (valid up to isomorphism phase only) *) and pure = Impure | Pure | Context | PureContext (* pure and only context *) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) and 'a base_dots = DOTS of 'a list | CIRCLES of 'a list | STARS of 'a list and 'a dots = 'a base_dots wrap (* --------------------------------------------------------------------- *) (* Identifier *) and base_ident = Id of string mcode | MetaId of Ast_cocci.meta_name mcode * Ast_cocci.idconstraint * Ast_cocci.seed * pure | MetaFunc of Ast_cocci.meta_name mcode * Ast_cocci.idconstraint * pure | MetaLocalFunc of Ast_cocci.meta_name mcode * Ast_cocci.idconstraint * pure | AsIdent of ident * ident (* as ident, always metavar *) | DisjId of string mcode * ident list * string mcode list (* the |s *) * string mcode | OptIdent of ident | UniqueIdent of ident and ident = base_ident wrap (* --------------------------------------------------------------------- *) (* Expression *) and base_expression = Ident of ident | Constant of Ast_cocci.constant mcode | StringConstant of string mcode (* quote *) * string_fragment dots * string mcode (* quote *) | FunCall of expression * string mcode (* ( *) * expression dots * string mcode (* ) *) | Assignment of expression * Ast_cocci.assignOp mcode * expression * bool (* true if it can match an initialization *) | Sequence of expression * string mcode (* , *) * expression | CondExpr of expression * string mcode (* ? *) * expression option * string mcode (* : *) * expression | Postfix of expression * Ast_cocci.fixOp mcode | Infix of expression * Ast_cocci.fixOp mcode | Unary of expression * Ast_cocci.unaryOp mcode | Binary of expression * Ast_cocci.binaryOp mcode * expression | Nested of expression * Ast_cocci.binaryOp mcode * expression | Paren of string mcode (* ( *) * expression * string mcode (* ) *) | ArrayAccess of expression * string mcode (* [ *) * expression * string mcode (* ] *) | RecordAccess of expression * string mcode (* . *) * ident | RecordPtAccess of expression * string mcode (* -> *) * ident | Cast of string mcode (* ( *) * typeC * string mcode (* ) *) * expression | SizeOfExpr of string mcode (* sizeof *) * expression | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) * typeC * string mcode (* ) *) | TypeExp of typeC | Constructor of string mcode (* ( *) * typeC * string mcode (* ) *) * initialiser | MetaErr of Ast_cocci.meta_name mcode * constraints * pure | MetaExpr of Ast_cocci.meta_name mcode * constraints * Type_cocci.typeC list option * Ast_cocci.form * pure | MetaExprList of Ast_cocci.meta_name mcode (* only in arglists *) * listlen * pure | AsExpr of expression * expression (* as expr, always metavar *) | EComma of string mcode (* only in arglists *) | DisjExpr of string mcode * expression list * string mcode list * string mcode | NestExpr of string mcode * expression dots * string mcode * expression option * Ast_cocci.multi | Edots of string mcode (* ... *) * expression option | Ecircles of string mcode (* ooo *) * expression option | Estars of string mcode (* *** *) * expression option | OptExp of expression | UniqueExp of expression and expression = base_expression wrap and constraints = NoConstraint | NotIdCstrt of Ast_cocci.reconstraint | NotExpCstrt of expression list | SubExpCstrt of Ast_cocci.meta_name list and listlen = MetaListLen of Ast_cocci.meta_name mcode | CstListLen of int | AnyListLen and base_string_fragment = ConstantFragment of string mcode | FormatFragment of string mcode (*%*) * string_format (* format *) | Strdots of string mcode | MetaFormatList of string mcode (*%*) * Ast_cocci.meta_name mcode * listlen and string_fragment = base_string_fragment wrap and base_string_format = ConstantFormat of string mcode | MetaFormat of Ast_cocci.meta_name mcode * Ast_cocci.idconstraint and string_format = base_string_format wrap (* --------------------------------------------------------------------- *) (* Types *) and base_typeC = ConstVol of Ast_cocci.const_vol mcode * typeC | BaseType of Ast_cocci.baseType * string mcode list | Signed of Ast_cocci.sign mcode * typeC option | Pointer of typeC * string mcode (* * *) | FunctionPointer of typeC * string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* string mcode (* ( *)*parameter_list*string mcode(* ) *) | FunctionType of typeC option * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Array of typeC * string mcode (* [ *) * expression option * string mcode (* ] *) | Decimal of string mcode (* decimal *) * string mcode (* ( *) * expression * string mcode option (* , *) * expression option * string mcode (* ) *) (* IBM C only *) | EnumName of string mcode (*enum*) * ident option (* name *) | EnumDef of typeC (* either StructUnionName or metavar *) * string mcode (* { *) * expression dots * string mcode (* } *) | StructUnionName of Ast_cocci.structUnion mcode * ident option (* name *) | StructUnionDef of typeC (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) | TypeName of string mcode | MetaType of Ast_cocci.meta_name mcode * pure | AsType of typeC * typeC (* as type, always metavar *) | DisjType of string mcode * typeC list * (* only after iso *) string mcode list (* the |s *) * string mcode | OptType of typeC | UniqueType of typeC and typeC = base_typeC wrap (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and base_declaration = MetaDecl of Ast_cocci.meta_name mcode * pure (* variables *) | MetaField of Ast_cocci.meta_name mcode * pure (* structure fields *) | MetaFieldList of Ast_cocci.meta_name mcode * listlen * pure | AsDecl of declaration * declaration | Init of Ast_cocci.storage mcode option * typeC * ident * string mcode (*=*) * initialiser * string mcode (*;*) | UnInit of Ast_cocci.storage mcode option * typeC * ident * string mcode (* ; *) | TyDecl of typeC * string mcode (* ; *) | MacroDecl of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (*=*) * initialiser * string mcode (* ; *) | Typedef of string mcode (* typedef *) * typeC * typeC * string mcode (*;*) | DisjDecl of string mcode * declaration list * string mcode list * string mcode | Ddots of string mcode (* ... *) * declaration option (* whencode *) | OptDecl of declaration | UniqueDecl of declaration and declaration = base_declaration wrap (* --------------------------------------------------------------------- *) (* Initializers *) and base_initialiser = MetaInit of Ast_cocci.meta_name mcode * pure | MetaInitList of Ast_cocci.meta_name mcode * listlen * pure | AsInit of initialiser * initialiser (* as init, always metavar *) | InitExpr of expression | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) * bool (* true if ordered, false if unordered *) | InitGccExt of designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) | InitGccName of ident (* name *) * string mcode (*:*) * initialiser | IComma of string mcode | Idots of string mcode (* ... *) * initialiser option (* whencode *) | OptIni of initialiser | UniqueIni of initialiser and designator = DesignatorField of string mcode (* . *) * ident | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *) | DesignatorRange of string mcode (* [ *) * expression * string mcode (* ... *) * expression * string mcode (* ] *) and initialiser = base_initialiser wrap and initialiser_list = initialiser dots (* --------------------------------------------------------------------- *) (* Parameter *) and base_parameterTypeDef = VoidParam of typeC | Param of typeC * ident option | MetaParam of Ast_cocci.meta_name mcode * pure | MetaParamList of Ast_cocci.meta_name mcode * listlen * pure | AsParam of parameterTypeDef * expression (* expr, always metavar *) | PComma of string mcode | Pdots of string mcode (* ... *) | Pcircles of string mcode (* ooo *) | OptParam of parameterTypeDef | UniqueParam of parameterTypeDef and parameterTypeDef = base_parameterTypeDef wrap and parameter_list = parameterTypeDef dots (* --------------------------------------------------------------------- *) (* #define Parameters *) and base_define_param = DParam of ident | DPComma of string mcode | DPdots of string mcode (* ... *) | DPcircles of string mcode (* ooo *) | OptDParam of define_param | UniqueDParam of define_param and define_param = base_define_param wrap and base_define_parameters = NoParams | DParams of string mcode(*( *) * define_param dots * string mcode(* )*) and define_parameters = base_define_parameters wrap (* --------------------------------------------------------------------- *) (* Statement*) and base_statement = Decl of (info * mcodekind) (* before the decl *) * declaration | Seq of string mcode (* { *) * statement dots * string mcode (* } *) | ExprStatement of expression option * string mcode (*;*) | IfThen of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * fake_mcode (* after info *) | IfThenElse of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * string mcode (* else *) * statement * fake_mcode (* after info *) | While of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * fake_mcode (* after info *) | Do of string mcode (* do *) * statement * string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* ; *) | For of string mcode (* for *) * string mcode (* ( *) * forinfo * expression option * string mcode (*;*) * expression option * string mcode (* ) *) * statement * fake_mcode (* after info *) | Iterator of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * statement * fake_mcode (* after info *) | Switch of string mcode (* switch *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* { *) * statement (*decl*) dots * case_line dots * string mcode (* } *) | Break of string mcode (* break *) * string mcode (* ; *) | Continue of string mcode (* continue *) * string mcode (* ; *) | Label of ident * string mcode (* : *) | Goto of string mcode (* goto *) * ident * string mcode (* ; *) | Return of string mcode (* return *) * string mcode (* ; *) | ReturnExpr of string mcode (* return *) * expression * string mcode (* ; *) | MetaStmt of Ast_cocci.meta_name mcode * pure | MetaStmtList of Ast_cocci.meta_name mcode (*only in statement lists*) * pure | AsStmt of statement * statement (* as statement, always metavar *) | Exp of expression (* only in dotted statement lists *) | TopExp of expression (* for macros body *) | Ty of typeC (* only at top level *) | TopInit of initialiser (* only at top level *) | Disj of string mcode * statement dots list * string mcode list * string mcode | Nest of string mcode * statement dots * string mcode * (statement dots,statement) whencode list * Ast_cocci.multi | Dots of string mcode (* ... *) * (statement dots,statement) whencode list | Circles of string mcode (* ooo *) * (statement dots,statement) whencode list | Stars of string mcode (* *** *) * (statement dots,statement) whencode list | FunDecl of (info * mcodekind) (* before the function decl *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * string mcode (* ) *) * string mcode (* { *) * statement dots * string mcode (* } *) | Include of string mcode (* #include *) * Ast_cocci.inc_file mcode(* file *) | Undef of string mcode (* #define *) * ident (* name *) | Define of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) * statement dots | Pragma of string mcode (* #pragma *) * ident * pragmainfo | OptStm of statement | UniqueStm of statement and base_pragmainfo = PragmaTuple of string mcode(* ( *) * expression dots * string mcode(* ) *) | PragmaIdList of ident dots | PragmaDots of string mcode and pragmainfo = base_pragmainfo wrap and base_forinfo = ForExp of expression option * string mcode (*;*) | ForDecl of (info * mcodekind) (* before the decl *) * declaration and forinfo = base_forinfo wrap and fninfo = FStorage of Ast_cocci.storage mcode | FType of typeC | FInline of string mcode | FAttr of string mcode and ('a,'b) whencode = WhenNot of 'a | WhenAlways of 'b | WhenModifier of Ast_cocci.when_modifier | WhenNotTrue of expression | WhenNotFalse of expression and statement = base_statement wrap and base_case_line = Default of string mcode (* default *) * string mcode (*:*) * statement dots | Case of string mcode (* case *) * expression * string mcode (*:*) * statement dots | DisjCase of string mcode * case_line list * string mcode list (* the |s *) * string mcode | OptCase of case_line and case_line = base_case_line wrap (* --------------------------------------------------------------------- *) (* Positions *) and meta_pos = MetaPos of Ast_cocci.meta_name mcode * Ast_cocci.meta_name list * Ast_cocci.meta_collect (* --------------------------------------------------------------------- *) (* Top-level code *) and base_top_level = NONDECL of statement (* cannot match all of a top-level declaration *) | TOPCODE of statement dots | CODE of statement dots | FILEINFO of string mcode (* old file *) * string mcode (* new file *) | ERRORWORDS of expression list | OTHER of statement (* temporary, disappears after top_level.ml *) and top_level = base_top_level wrap and rule = top_level list and parsed_rule = CocciRule of (rule * Ast_cocci.metavar list * (string list * string list * Ast_cocci.dependency * string * Ast_cocci.exists)) * (rule * Ast_cocci.metavar list) * Ast_cocci.ruletype | ScriptRule of string (* name *) * string * Ast_cocci.dependency * (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar) list (*inherited vars*) * Ast_cocci.meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string (*language*) * Ast_cocci.dependency * string (*code*) | FinalScriptRule of string (* name *) * string (*language*) * Ast_cocci.dependency * string (*code*) (* --------------------------------------------------------------------- *) and dependency = Dep of string (* rule applies for the current binding *) | AntiDep of dependency (* rule doesn't apply for the current binding *) | EverDep of string (* rule applies for some binding *) | NeverDep of string (* rule never applies for any binding *) | AndDep of dependency * dependency | OrDep of dependency * dependency | NoDep | FailDep (* --------------------------------------------------------------------- *) and anything = DotsExprTag of expression dots | DotsInitTag of initialiser dots | DotsParamTag of parameterTypeDef dots | DotsStmtTag of statement dots | DotsDeclTag of declaration dots | DotsCaseTag of case_line dots | IdentTag of ident | ExprTag of expression | ArgExprTag of expression (* for isos *) | TestExprTag of expression (* for isos *) | TypeCTag of typeC | ParamTag of parameterTypeDef | InitTag of initialiser | DeclTag of declaration | StmtTag of statement | ForInfoTag of forinfo | CaseLineTag of case_line | TopTag of top_level | IsoWhenTag of Ast_cocci.when_modifier (*only for when code, in iso phase*) | IsoWhenTTag of expression(*only for when code, in iso phase*) | IsoWhenFTag of expression(*only for when code, in iso phase*) | MetaPosTag of meta_pos | HiddenVarTag of anything list (* in iso_compile/pattern only *) val dotsExpr : expression dots -> anything val dotsInit : initialiser dots -> anything val dotsParam : parameterTypeDef dots -> anything val dotsStmt : statement dots -> anything val dotsDecl : declaration dots -> anything val dotsCase : case_line dots -> anything val ident : ident -> anything val expr : expression -> anything val typeC : typeC -> anything val param : parameterTypeDef -> anything val ini : initialiser -> anything val decl : declaration -> anything val stmt : statement -> anything val forinfo : forinfo -> anything val case_line : case_line -> anything val top : top_level -> anything (* --------------------------------------------------------------------- *) val undots : 'a dots -> 'a list (* --------------------------------------------------------------------- *) (* Avoid cluttering the parser. Calculated in compute_lines.ml. *) val default_info : unit -> info val default_befaft : unit -> mcodekind val context_befaft : unit -> mcodekind val wrap : 'a -> 'a wrap val context_wrap : 'a -> 'a wrap val unwrap : 'a wrap -> 'a val unwrap_mcode : 'a mcode -> 'a val rewrap : 'a wrap -> 'b -> 'b wrap val rewrap_mcode : 'a mcode -> 'b -> 'b mcode val copywrap : 'a wrap -> 'b -> 'b wrap val get_pos : 'a mcode -> anything list val get_pos_ref : 'a mcode -> anything list ref val set_pos : anything list -> 'a mcode -> 'a mcode val get_info : 'a wrap -> info val set_info : 'a wrap -> info -> 'a wrap val get_index : 'a wrap -> int val set_index : 'a wrap -> int -> unit val get_line : 'a wrap -> int val get_line_end : 'a wrap -> int val get_mcodekind : 'a wrap -> mcodekind val get_mcode_mcodekind : 'a mcode -> mcodekind val get_mcodekind_ref : 'a wrap -> mcodekind ref val set_mcodekind : 'a wrap -> mcodekind -> unit val set_type : 'a wrap -> Type_cocci.typeC option -> unit val get_type : 'a wrap -> Type_cocci.typeC option val set_dots_bef_aft : statement -> dots_bef_aft -> statement val get_dots_bef_aft : 'a wrap -> dots_bef_aft val set_arg_exp : expression -> expression val get_arg_exp : expression -> bool val set_test_pos : expression -> expression val get_test_pos : 'a wrap -> bool val set_test_exp : expression -> expression val clear_test_exp : expression -> expression val get_test_exp : 'a wrap -> bool val set_iso : 'a wrap -> (string*anything) list -> 'a wrap val get_iso : 'a wrap -> (string*anything) list val fresh_index : unit -> int val set_mcode_data : 'a -> 'a mcode -> 'a mcode val make_mcode : 'a -> 'a mcode val make_mcode_info : 'a -> info -> 'a mcode val make_minus_mcode : 'a -> 'a mcode val meta_pos_name : anything -> Ast_cocci.meta_name mcode val ast0_type_to_type : typeC -> Type_cocci.typeC val reverse_type : Type_cocci.typeC -> base_typeC exception TyConv val lub_pure : pure -> pure -> pure (* --------------------------------------------------------------------- *) val rule_name : string ref (* for the convenience of the parser *) coccinelle-1.0.0-rc19/parsing_cocci/disjdistr.ml0000644000175000017500000004525612247442615020533 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./disjdistr.ml" module Ast = Ast_cocci module V = Visitor_ast let disjmult2 e1 e2 k = List.concat (List.map (function e1 -> List.map (function e2 -> k e1 e2) e2) e1) let disjmult3 e1 e2 e3 k = List.concat (List.map (function e1 -> List.concat (List.map (function e2 -> List.map (function e3 -> k e1 e2 e3) e3) e2)) e1) let rec disjmult f = function [] -> [[]] | x::xs -> let cur = f x in let rest = disjmult f xs in disjmult2 cur rest (function cur -> function rest -> cur :: rest) let rec disjmult_two fstart frest (start,rest) = let cur = fstart start in let rest = disjmult frest rest in disjmult2 cur rest (function cur -> function rest -> (cur,rest)) let disjoption f = function None -> [None] | Some x -> List.map (function x -> Some x) (f x) let disjdots f d = match Ast.unwrap d with Ast.DOTS(l) -> List.map (function l -> Ast.rewrap d (Ast.DOTS(l))) (disjmult f l) | Ast.CIRCLES(l) -> List.map (function l -> Ast.rewrap d (Ast.CIRCLES(l))) (disjmult f l) | Ast.STARS(l) -> List.map (function l -> Ast.rewrap d (Ast.STARS(l))) (disjmult f l) let rec disjty ft = match Ast.unwrap ft with Ast.Type(allminus,cv,ty) -> let ty = disjtypeC ty in List.map (function ty -> Ast.rewrap ft (Ast.Type(allminus,cv,ty))) ty | Ast.AsType(ty,asty) -> (* as ty doesn't contain disj *) let ty = disjty ty in List.map (function ty -> Ast.rewrap ft (Ast.AsType(ty,asty))) ty | Ast.DisjType(types) -> List.concat (List.map disjty types) | Ast.OptType(ty) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap ft (Ast.OptType(ty))) ty | Ast.UniqueType(ty) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap ft (Ast.UniqueType(ty))) ty and disjtypeC bty = match Ast.unwrap bty with Ast.BaseType(_) | Ast.SignedT(_,_) -> [bty] | Ast.Pointer(ty,star) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap bty (Ast.Pointer(ty,star))) ty | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap bty (Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))) ty | Ast.FunctionType (s,ty,lp1,params,rp1) -> let ty = disjoption disjty ty in List.map (function ty -> Ast.rewrap bty (Ast.FunctionType (s,ty,lp1,params,rp1))) ty | Ast.Array(ty,lb,size,rb) -> disjmult2 (disjty ty) (disjoption disjexp size) (function ty -> function size -> Ast.rewrap bty (Ast.Array(ty,lb,size,rb))) | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> disjmult2 (disjexp length) (disjoption disjexp precision_opt) (function length -> function precision_opt -> Ast.rewrap bty (Ast.Decimal(dec,lp,length,comma,precision_opt,rp))) | Ast.EnumName(_,_) | Ast.StructUnionName(_,_) -> [bty] | Ast.EnumDef(ty,lb,ids,rb) -> disjmult2 (disjty ty) (disjdots disjexp ids) (function ty -> function ids -> Ast.rewrap bty (Ast.EnumDef(ty,lb,ids,rb))) | Ast.StructUnionDef(ty,lb,decls,rb) -> disjmult2 (disjty ty) (disjdots disjdecl decls) (function ty -> function decls -> Ast.rewrap bty (Ast.StructUnionDef(ty,lb,decls,rb))) | Ast.TypeName(_) | Ast.MetaType(_,_,_) -> [bty] and disjident e = match Ast.unwrap e with Ast.DisjId(id_list) -> List.concat (List.map disjident id_list) | Ast.OptIdent(id) -> let id = disjident id in List.map (function id -> Ast.rewrap e (Ast.OptIdent(id))) id | Ast.UniqueIdent(id) -> let id = disjident id in List.map (function id -> Ast.rewrap e (Ast.UniqueIdent(id))) id | _ -> [e] and disjexp e = match Ast.unwrap e with Ast.Ident(_) | Ast.Constant(_) | Ast.StringConstant(_) -> [e] (* even Ident can't contain disj, nor StringConstant *) | Ast.FunCall(fn,lp,args,rp) -> disjmult2 (disjexp fn) (disjdots disjexp args) (function fn -> function args -> Ast.rewrap e (Ast.FunCall(fn,lp,args,rp))) | Ast.Assignment(left,op,right,simple) -> disjmult2 (disjexp left) (disjexp right) (function left -> function right -> Ast.rewrap e (Ast.Assignment(left,op,right,simple))) | Ast.Sequence(left,op,right) -> disjmult2 (disjexp left) (disjexp right) (function left -> function right -> Ast.rewrap e (Ast.Sequence(left,op,right))) | Ast.CondExpr(exp1,why,Some exp2,colon,exp3) -> let res = disjmult disjexp [exp1;exp2;exp3] in List.map (function [exp1;exp2;exp3] -> Ast.rewrap e (Ast.CondExpr(exp1,why,Some exp2,colon,exp3)) | _ -> failwith "not possible") res | Ast.CondExpr(exp1,why,None,colon,exp3) -> disjmult2 (disjexp exp1) (disjexp exp3) (function exp1 -> function exp3 -> Ast.rewrap e (Ast.CondExpr(exp1,why,None,colon,exp3))) | Ast.Postfix(exp,op) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.Postfix(exp,op))) exp | Ast.Infix(exp,op) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.Infix(exp,op))) exp | Ast.Unary(exp,op) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.Unary(exp,op))) exp | Ast.Binary(left,op,right) -> disjmult2 (disjexp left) (disjexp right) (function left -> function right -> Ast.rewrap e (Ast.Binary(left,op,right))) | Ast.Nested(exp,op,right) -> (* disj not possible in right *) let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.Nested(exp,op,right))) exp | Ast.Paren(lp,exp,rp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.Paren(lp,exp,rp))) exp | Ast.ArrayAccess(exp1,lb,exp2,rb) -> disjmult2 (disjexp exp1) (disjexp exp2) (function exp1 -> function exp2 -> Ast.rewrap e (Ast.ArrayAccess(exp1,lb,exp2,rb))) | Ast.RecordAccess(exp,pt,field) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) exp | Ast.RecordPtAccess(exp,ar,field) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) exp | Ast.Cast(lp,ty,rp,exp) -> disjmult2 (disjty ty) (disjexp exp) (function ty -> function exp -> Ast.rewrap e (Ast.Cast(lp,ty,rp,exp))) | Ast.SizeOfExpr(szf,exp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.SizeOfExpr(szf,exp))) exp | Ast.SizeOfType(szf,lp,ty,rp) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap e (Ast.SizeOfType(szf,lp,ty,rp))) ty | Ast.TypeExp(ty) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap e (Ast.TypeExp(ty))) ty | Ast.Constructor(lp,ty,rp,init) -> disjmult2 (disjty ty) (disjini init) (function ty -> function exp -> Ast.rewrap e (Ast.Constructor(lp,ty,rp,init))) | Ast.MetaErr(_,_,_,_) | Ast.MetaExpr(_,_,_,_,_,_) | Ast.MetaExprList(_,_,_,_) | Ast.EComma(_) -> [e] | Ast.AsExpr(exp,asexp) -> (* as exp doesn't contain disj *) let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.AsExpr(exp,asexp))) exp | Ast.DisjExpr(exp_list) -> List.concat (List.map disjexp exp_list) | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) -> (* not sure what to do here, so ambiguities still possible *) [e] | Ast.Edots(dots,_) | Ast.Ecircles(dots,_) | Ast.Estars(dots,_) -> [e] | Ast.OptExp(exp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp | Ast.UniqueExp(exp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.UniqueExp(exp))) exp and disjparam p = match Ast.unwrap p with Ast.VoidParam(ty) -> [p] (* void is the only possible value *) | Ast.Param(ty,id) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap p (Ast.Param(ty,id))) ty | Ast.AsParam(pm,asexp) -> (* as exp doesn't contain disj *) let pm = disjparam pm in List.map (function pm -> Ast.rewrap p (Ast.AsParam(pm,asexp))) pm | Ast.MetaParam(_,_,_) | Ast.MetaParamList(_,_,_,_) | Ast.PComma(_) -> [p] | Ast.Pdots(dots) | Ast.Pcircles(dots) -> [p] | Ast.OptParam(param) -> let param = disjparam param in List.map (function param -> Ast.rewrap p (Ast.OptParam(param))) param | Ast.UniqueParam(param) -> let param = disjparam param in List.map (function param -> Ast.rewrap p (Ast.UniqueParam(param))) param and disjini i = match Ast.unwrap i with Ast.MetaInit(_,_,_) | Ast.MetaInitList(_,_,_,_) -> [i] | Ast.AsInit(ini,asini) -> let ini = disjini ini in List.map (function ini -> Ast.rewrap i (Ast.AsInit(ini,asini))) ini | Ast.InitExpr(exp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap i (Ast.InitExpr(exp))) exp | Ast.ArInitList(lb,initlist,rb) -> List.map (function initlist -> Ast.rewrap i (Ast.ArInitList(lb,initlist,rb))) (disjdots disjini initlist) | Ast.StrInitList(allminus,lb,initlist,rb,whencode) -> List.map (function initlist -> Ast.rewrap i (Ast.StrInitList(allminus,lb,initlist,rb,whencode))) (disjmult disjini initlist) | Ast.InitGccExt(designators,eq,ini) -> let designators = disjmult designator designators in let ini = disjini ini in disjmult2 designators ini (function designators -> function ini -> Ast.rewrap i (Ast.InitGccExt(designators,eq,ini))) | Ast.InitGccName(name,eq,ini) -> let ini = disjini ini in List.map (function ini -> Ast.rewrap i (Ast.InitGccName(name,eq,ini))) ini | Ast.IComma(comma) -> [i] | Ast.Idots(dots,_) -> [i] | Ast.OptIni(ini) -> let ini = disjini ini in List.map (function ini -> Ast.rewrap i (Ast.OptIni(ini))) ini | Ast.UniqueIni(ini) -> let ini = disjini ini in List.map (function ini -> Ast.rewrap i (Ast.UniqueIni(ini))) ini and designator = function Ast.DesignatorField(dot,id) -> [Ast.DesignatorField(dot,id)] | Ast.DesignatorIndex(lb,exp,rb) -> let exp = disjexp exp in List.map (function exp -> Ast.DesignatorIndex(lb,exp,rb)) exp | Ast.DesignatorRange(lb,min,dots,max,rb) -> disjmult2 (disjexp min) (disjexp max) (function min -> function max -> Ast.DesignatorRange(lb,min,dots,max,rb)) and disjdecl d = match Ast.unwrap d with Ast.MetaDecl(_,_,_) | Ast.MetaField(_,_,_) | Ast.MetaFieldList(_,_,_,_) -> [d] | Ast.AsDecl(decl,asdecl) -> let decl = disjdecl decl in List.map (function decl -> Ast.rewrap d (Ast.AsDecl(decl,asdecl))) decl | Ast.Init(stg,ty,id,eq,ini,sem) -> disjmult2 (disjty ty) (disjini ini) (function ty -> function ini -> Ast.rewrap d (Ast.Init(stg,ty,id,eq,ini,sem))) | Ast.UnInit(stg,ty,id,sem) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap d (Ast.UnInit(stg,ty,id,sem))) ty | Ast.MacroDecl(name,lp,args,rp,sem) -> List.map (function args -> Ast.rewrap d (Ast.MacroDecl(name,lp,args,rp,sem))) (disjdots disjexp args) | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> disjmult2 (disjdots disjexp args) (disjini ini) (function args -> function ini -> Ast.rewrap d (Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem))) | Ast.TyDecl(ty,sem) -> let ty = disjty ty in List.map (function ty -> Ast.rewrap d (Ast.TyDecl(ty,sem))) ty | Ast.Typedef(stg,ty,id,sem) -> let ty = disjty ty in (* disj not allowed in id *) List.map (function ty -> Ast.rewrap d (Ast.Typedef(stg,ty,id,sem))) ty | Ast.DisjDecl(decls) -> List.concat (List.map disjdecl decls) | Ast.Ddots(_,_) -> [d] | Ast.OptDecl(decl) -> let decl = disjdecl decl in List.map (function decl -> Ast.rewrap d (Ast.OptDecl(decl))) decl | Ast.UniqueDecl(decl) -> let decl = disjdecl decl in List.map (function decl -> Ast.rewrap d (Ast.UniqueDecl(decl))) decl let generic_orify_rule_elem f re exp rebuild = match f exp with [exp] -> re | orexps -> Ast.rewrap re (Ast.DisjRuleElem (List.map rebuild orexps)) let orify_rule_elem re exp rebuild = generic_orify_rule_elem disjexp re exp rebuild let orify_rule_elem_ty = generic_orify_rule_elem disjty let orify_rule_elem_param = generic_orify_rule_elem disjparam let orify_rule_elem_decl = generic_orify_rule_elem disjdecl let orify_rule_elem_ini = generic_orify_rule_elem disjini let rec disj_rule_elem r k re = match Ast.unwrap re with Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) -> generic_orify_rule_elem (disjdots disjparam) re params (function params -> Ast.rewrap re (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp))) | Ast.Decl(bef,allminus,decl) -> orify_rule_elem_decl re decl (function decl -> Ast.rewrap re (Ast.Decl(bef,allminus,decl))) | Ast.SeqStart(brace) -> re | Ast.SeqEnd(brace) -> re | Ast.ExprStatement(Some exp,sem) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.ExprStatement(Some exp,sem))) | Ast.ExprStatement(None,sem) -> re | Ast.IfHeader(iff,lp,exp,rp) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.IfHeader(iff,lp,exp,rp))) | Ast.Else(els) -> re | Ast.WhileHeader(whl,lp,exp,rp) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.WhileHeader(whl,lp,exp,rp))) | Ast.DoHeader(d) -> re | Ast.WhileTail(whl,lp,exp,rp,sem) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.WhileTail(whl,lp,exp,rp,sem))) | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> let disjfirst = function Ast.ForExp(e1,sem1) -> List.map (function e1 -> Ast.ForExp(e1,sem1)) (disjoption disjexp e1) | Ast.ForDecl (bef,allminus,decl) -> List.map (function decl -> Ast.ForDecl (bef,allminus,decl)) (disjdecl decl) in generic_orify_rule_elem (disjmult_two disjfirst (disjoption disjexp)) re (first,[e2;e3]) (function (first,[exp2;exp3]) -> Ast.rewrap re (Ast.ForHeader(fr,lp,first,exp2,sem2,exp3,rp)) | _ -> failwith "not possible") | Ast.IteratorHeader(whl,lp,args,rp) -> generic_orify_rule_elem (disjdots disjexp) re args (function args -> Ast.rewrap re (Ast.IteratorHeader(whl,lp,args,rp))) | Ast.SwitchHeader(switch,lp,exp,rp) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.SwitchHeader(switch,lp,exp,rp))) | Ast.Break(_,_) | Ast.Continue(_,_) | Ast.Label(_,_) | Ast.Goto(_,_,_) | Ast.Return(_,_) -> re | Ast.ReturnExpr(ret,exp,sem) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.ReturnExpr(ret,exp,sem))) | Ast.MetaRuleElem(_,_,_) | Ast.MetaStmt(_,_,_,_) | Ast.MetaStmtList(_,_,_) -> re | Ast.Exp(exp) -> orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.Exp(exp))) | Ast.TopExp(exp) -> orify_rule_elem re exp (function exp -> Ast.rewrap exp (Ast.TopExp(exp))) | Ast.Ty(ty) -> orify_rule_elem_ty re ty (function ty -> Ast.rewrap ty (Ast.Ty(ty))) | Ast.TopInit(init) -> orify_rule_elem_ini re init (function init -> Ast.rewrap init (Ast.TopInit(init))) | Ast.Include(inc,s) -> re | Ast.Undef(def,id) -> re | Ast.DefineHeader(def,id,params) -> re | Ast.Pragma(prg,id,body) -> let pragmabody body = match Ast.unwrap body with Ast.PragmaTuple(lp,args,rp) -> let args = disjdots disjexp args in List.map (function args -> Ast.rewrap body (Ast.PragmaTuple(lp,args,rp))) args | Ast.PragmaIdList(ids) -> [body] | Ast.PragmaDots(dots) -> [body] in generic_orify_rule_elem pragmabody re body (function body -> Ast.rewrap re (Ast.Pragma(prg,id,body))) | Ast.Default(def,colon) -> re | Ast.Case(case,exp,colon) -> orify_rule_elem re exp (function exp -> Ast.rewrap re (Ast.Case(case,exp,colon))) | Ast.DisjRuleElem(l) -> (* only case lines *) Ast.rewrap re(Ast.DisjRuleElem(List.map (disj_rule_elem r k) l)) let disj_all = let mcode x = x in let donothing r k e = k e in V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing disj_rule_elem donothing donothing donothing donothing (* ----------------------------------------------------------------------- *) (* collect iso information at the rule_elem level *) let collect_all_isos = let bind = (@) in let option_default = [] in let mcode r x = [] in let donothing r k e = Common.union_set (Ast.get_isos e) (k e) in let doanything r k e = k e in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing doanything let collect_iso_info = let mcode x = x in let donothing r k e = k e in let rule_elem r k e = match Ast.unwrap e with Ast.DisjRuleElem(l) -> k e | _ -> let isos = collect_all_isos.V.combiner_rule_elem e in Ast.set_isos e isos in V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing rule_elem donothing donothing donothing donothing (* ----------------------------------------------------------------------- *) let disj rules = List.map (function (mv,r) -> match r with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> (mv, r) | Ast.CocciRule (nm, rule_info, r, isexp, ruletype) -> let res = List.map (function x -> let res = disj_all.V.rebuilder_top_level x in if !Flag.track_iso_usage then collect_iso_info.V.rebuilder_top_level res else res) r in (mv, Ast.CocciRule (nm,rule_info,res,isexp,ruletype))) rules coccinelle-1.0.0-rc19/parsing_cocci/commas_on_lists.ml0000644000175000017500000000676612247442616021731 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./commas_on_lists.ml" module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* Add commas in init lists or exp lists, if needed. This must be done before the adjacency calculation so that the commas get the right adjacency numbers. This is needed for correct formatting in unparse_c.ml *) (* commas in dotted lists, here due to polymorphism restrictions *) let add_comma is_comma is_dots make_comma itemlist = match Ast0.unwrap itemlist with Ast0.DOTS(x) -> (match List.rev x with [] -> itemlist (* Not sure if comma is needed if the list is just ...; leave it there for now. See list_matcher in cocci_vs_c.ml in first try_matches case. *) (* | [e] when is_dots e -> itemlist*) | e::es -> if is_comma e then itemlist else let comma = match Ast0.get_mcodekind e with Ast0.MINUS(_) -> (Ast0.make_minus_mcode ",") | _ -> (Ast0.make_mcode ",") in Ast0.rewrap itemlist (Ast0.DOTS (List.rev (Ast0.rewrap e (make_comma comma) :: (e::es))))) | _ -> failwith "not possible" let add_exp_comma = add_comma (function x -> match Ast0.unwrap x with Ast0.EComma _ -> true | _ -> false) (function x -> match Ast0.unwrap x with Ast0.Edots _ -> true | _ -> false) (function x -> Ast0.EComma x) and add_init_comma = add_comma (function x -> match Ast0.unwrap x with Ast0.IComma _ -> true | _ -> false) (function x -> match Ast0.unwrap x with Ast0.Idots _ -> true | _ -> false) (function x -> Ast0.IComma x) (* --------------------------------------------------------------------- *) (* special cases for terms that contain comma-separated lists where the trailing comma is allowed but not required *) let base_typeC r k t = let t = k t in match Ast0.unwrap t with Ast0.EnumDef(ty,lb,ids,rb) -> let ids = add_exp_comma ids in Ast0.rewrap t (Ast0.EnumDef(ty,lb,ids,rb)) | _ -> t let initialiser r k i = let i = k i in match Ast0.unwrap i with Ast0.InitList(lb,initlist,rb,ordered) -> let initlist = add_init_comma initlist in Ast0.rewrap i (Ast0.InitList(lb,initlist,rb,ordered)) | _ -> i let process p = let fn = V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_tyfn = base_typeC; VT0.rebuilder_initfn = initialiser} in List.map fn.VT0.rebuilder_rec_top_level p coccinelle-1.0.0-rc19/parsing_cocci/check_meta.ml0000644000175000017500000006250112247442615020607 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./check_meta.ml" (* For minus fragment, checks that all of the identifier metavariables that are used are not declared as fresh, and check that all declared variables are used. For plus fragment, just check that the variables declared as fresh are used. What is the issue about error variables? (don't remember) *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* all fresh identifiers *) let fresh_table = (Hashtbl.create(50) : (Ast.meta_name, unit) Hashtbl.t) let warning s = Printf.fprintf stderr "warning: %s\n" s let promote name = (name,(),Ast0.default_info(),(),None,-1) (* --------------------------------------------------------------------- *) let find_loop table name = let rec loop = function [] -> raise Not_found | x::xs -> (try Hashtbl.find x name with Not_found -> loop xs) in loop table let check_table table minus (name,_,info,_,_,_) = let rl = info.Ast0.pos_info.Ast0.line_start in if minus then (try (find_loop table name) := true with Not_found -> (try Hashtbl.find fresh_table name; let (_,name) = name in failwith (Printf.sprintf "%d: unexpected use of a fresh identifier %s" rl name) with Not_found -> ())) else (try (find_loop table name) := true with Not_found -> ()) let get_opt fn = Common.do_option fn (* --------------------------------------------------------------------- *) (* Dots *) let dots fn d = match Ast0.unwrap d with Ast0.DOTS(x) -> List.iter fn x | Ast0.CIRCLES(x) -> List.iter fn x | Ast0.STARS(x) -> List.iter fn x (* --------------------------------------------------------------------- *) (* Identifier *) type context = ID | FIELD | FN | GLOBAL (* heuristic for distinguishing ifdef variables from undeclared metavariables*) let is_ifdef name = String.length name > 2 && String.uppercase name = name let rec ident context old_metas table minus i = match Ast0.unwrap i with Ast0.Id((name,_,info,_,_,_) : string Ast0.mcode) -> let rl = info.Ast0.pos_info.Ast0.line_start in let is_plus i = match Ast0.get_mcodekind i with Ast0.PLUS _ -> true | _ -> false in let err = if List.exists (function x -> x = name) old_metas && (minus || is_plus i) then begin warning (Printf.sprintf "line %d: %s, previously declared as a metavariable, is used as an identifier" rl name); true end else false in (match context with ID -> if not (is_ifdef name) && minus && not err(* warn only once per id *) && not info.Ast0.isSymbolIdent then warning (Printf.sprintf "line %d: should %s be a metavariable?" rl name) | _ -> ()) | Ast0.MetaId(name,_,seedval,_) -> check_table table minus name; seed table minus seedval | Ast0.MetaFunc(name,_,_) -> check_table table minus name | Ast0.MetaLocalFunc(name,_,_) -> check_table table minus name | Ast0.AsIdent(id,asid) -> failwith "not generated yet" | Ast0.DisjId(_,id_list,_,_) -> List.iter (ident context old_metas table minus) id_list | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) -> failwith "unexpected code" and seed table minus = function Ast.NoVal -> () | Ast.StringSeed _ -> () | Ast.ListSeed elems -> List.iter (function Ast.SeedString _ -> () | Ast.SeedId name -> check_table table minus (promote name)) elems (* --------------------------------------------------------------------- *) (* Expression *) let rec expression context old_metas table minus e = match Ast0.unwrap e with Ast0.Ident(id) -> ident context old_metas table minus id | Ast0.StringConstant(lq,str,rq) -> dots (string_fragment old_metas table minus) str | Ast0.FunCall(fn,lp,args,rp) -> expression FN old_metas table minus fn; dots (expression ID old_metas table minus) args | Ast0.Assignment(left,op,right,_) -> expression context old_metas table minus left; expression ID old_metas table minus right | Ast0.Sequence(left,op,right) -> expression context old_metas table minus left; expression ID old_metas table minus right | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> expression ID old_metas table minus exp1; get_opt (expression ID old_metas table minus) exp2; expression ID old_metas table minus exp3 | Ast0.Postfix(exp,op) -> expression ID old_metas table minus exp | Ast0.Infix(exp,op) -> expression ID old_metas table minus exp | Ast0.Unary(exp,op) -> expression ID old_metas table minus exp | Ast0.Binary(left,op,right) -> expression ID old_metas table minus left; expression ID old_metas table minus right | Ast0.Nested(left,op,right) -> expression ID old_metas table minus left; expression ID old_metas table minus right | Ast0.Paren(lp,exp,rp) -> expression ID old_metas table minus exp | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> expression ID old_metas table minus exp1; expression ID old_metas table minus exp2 | Ast0.RecordAccess(exp,pt,field) -> expression ID old_metas table minus exp; ident FIELD old_metas table minus field | Ast0.RecordPtAccess(exp,ar,field) -> expression ID old_metas table minus exp; ident FIELD old_metas table minus field | Ast0.Cast(lp,ty,rp,exp) -> typeC old_metas table minus ty; expression ID old_metas table minus exp | Ast0.SizeOfExpr(szf,exp) -> expression ID old_metas table minus exp | Ast0.SizeOfType(szf,lp,ty,rp) -> typeC old_metas table minus ty | Ast0.TypeExp(ty) -> typeC old_metas table minus ty | Ast0.Constructor(lp,ty,rp,init) -> typeC old_metas table minus ty; initialiser old_metas table minus init | Ast0.MetaExpr(name,_,Some tys,_,_) -> List.iter (function x -> List.iter (function ty -> check_table table minus (promote ty)) (get_type_name x)) tys; check_table table minus name | Ast0.MetaExpr(name,_,_,_,_) | Ast0.MetaErr(name,_,_) -> check_table table minus name | Ast0.MetaExprList(name,Ast0.MetaListLen lenname,_) -> check_table table minus name; check_table table minus lenname | Ast0.MetaExprList(name,_,_) -> check_table table minus name | Ast0.AsExpr(exp,asexp) -> failwith "not generated yet" | Ast0.DisjExpr(_,exps,_,_) -> List.iter (expression context old_metas table minus) exps | Ast0.NestExpr(_,exp_dots,_,w,_) -> dots (expression ID old_metas table minus) exp_dots; get_opt (expression ID old_metas table minus) w | Ast0.Edots(_,Some x) | Ast0.Ecircles(_,Some x) | Ast0.Estars(_,Some x) -> expression ID old_metas table minus x | Ast0.OptExp(x) | Ast0.UniqueExp(x) -> expression ID old_metas table minus x | _ -> () (* no metavariable subterms *) and get_type_name = function Type_cocci.ConstVol(_,ty) | Type_cocci.SignedT(_,Some ty) | Type_cocci.Pointer(ty) | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty | Type_cocci.EnumName(Type_cocci.MV(nm,_,_)) -> [nm] | Type_cocci.StructUnionName(_,Type_cocci.MV(nm,_,_)) -> [nm] | Type_cocci.MetaType(nm,_,_) -> [nm] | Type_cocci.Decimal(nm1,nm2) -> let get_name = function Type_cocci.MV(nm,_,_) -> [nm] | _ -> [] in (get_name nm1) @ (get_name nm2) | _ -> [] (* --------------------------------------------------------------------- *) (* Types *) and typeC old_metas table minus t = match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty | Ast0.Signed(sgn,ty) -> get_opt (typeC old_metas table minus) ty | Ast0.Pointer(ty,star) -> typeC old_metas table minus ty | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> typeC old_metas table minus ty; parameter_list old_metas table minus params | Ast0.FunctionType(ty,lp1,params,rp1) -> get_opt (typeC old_metas table minus) ty; parameter_list old_metas table minus params | Ast0.Array(ty,lb,size,rb) -> typeC old_metas table minus ty; get_opt (expression ID old_metas table minus) size | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> expression ID old_metas table minus length; get_opt (expression ID old_metas table minus) precision_opt | Ast0.MetaType(name,_) -> check_table table minus name | Ast0.AsType(ty,asty) -> failwith "not generated yet" | Ast0.DisjType(_,types,_,_) -> List.iter (typeC old_metas table minus) types | Ast0.EnumName(en,Some id) -> ident GLOBAL old_metas table minus id | Ast0.EnumDef(ty,lb,ids,rb) -> typeC old_metas table minus ty; dots (expression GLOBAL old_metas table minus) ids | Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id | Ast0.StructUnionDef(ty,lb,decls,rb) -> typeC old_metas table minus ty; dots (declaration GLOBAL old_metas table minus) decls | Ast0.OptType(ty) | Ast0.UniqueType(ty) -> failwith "unexpected code" | _ -> () (* no metavariable subterms *) (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and declaration context old_metas table minus d = match Ast0.unwrap d with Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) -> check_table table minus name | Ast0.MetaFieldList(name,Ast0.MetaListLen lenname,_) -> check_table table minus name; check_table table minus lenname | Ast0.MetaFieldList(name,_,_) -> check_table table minus name | Ast0.AsDecl(decl,asdecl) -> failwith "not generated yet" | Ast0.Init(stg,ty,id,eq,ini,sem) -> typeC old_metas table minus ty; ident context old_metas table minus id; (match Ast0.unwrap ini with Ast0.InitExpr exp -> expression ID old_metas table minus exp | _ -> (* if minus then failwith "complex initializer specification not allowed in - code" else*) initialiser old_metas table minus ini) | Ast0.UnInit(stg,ty,id,sem) -> typeC old_metas table minus ty; ident context old_metas table minus id | Ast0.MacroDecl(name,lp,args,rp,sem) -> ident GLOBAL old_metas table minus name; dots (expression ID old_metas table minus) args | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> ident GLOBAL old_metas table minus name; dots (expression ID old_metas table minus) args; (match Ast0.unwrap ini with Ast0.InitExpr exp -> expression ID old_metas table minus exp | _ -> initialiser old_metas table minus ini) | Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty | Ast0.Typedef(stg,ty,id,sem) -> typeC old_metas table minus ty; typeC old_metas table minus id | Ast0.DisjDecl(_,decls,_,_) -> List.iter (declaration ID old_metas table minus) decls | Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x | Ast0.Ddots(_,None) -> () | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Initialiser *) and initialiser old_metas table minus ini = match Ast0.unwrap ini with Ast0.MetaInit(name,_) -> check_table table minus name | Ast0.MetaInitList(name,Ast0.MetaListLen lenname,_) -> check_table table minus name; check_table table minus lenname | Ast0.MetaInitList(name,_,_) -> check_table table minus name | Ast0.AsInit(ini,asini) -> failwith "not generated yet" | Ast0.InitExpr(exp) -> expression ID old_metas table minus exp | Ast0.InitList(lb,initlist,rb,ordered) -> dots (initialiser old_metas table minus) initlist | Ast0.InitGccExt(designators,eq,ini) -> List.iter (designator old_metas table minus) designators; initialiser old_metas table minus ini | Ast0.InitGccName(name,eq,ini) -> ident FIELD old_metas table minus name; initialiser old_metas table minus ini | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x | Ast0.OptIni(_) | Ast0.UniqueIni(_) -> failwith "unexpected code" | _ -> () (* no metavariable subterms *) and designator old_metas table minus = function Ast0.DesignatorField(dot,id) -> ident FIELD old_metas table minus id | Ast0.DesignatorIndex(lb,exp,rb) -> expression ID old_metas table minus exp | Ast0.DesignatorRange(lb,min,dots,max,rb) -> expression ID old_metas table minus min; expression ID old_metas table minus max and initialiser_list old_metas table minus = dots (initialiser old_metas table minus) (* --------------------------------------------------------------------- *) (* Parameter *) and parameterTypeDef old_metas table minus param = match Ast0.unwrap param with Ast0.Param(ty,id) -> get_opt (ident ID old_metas table minus) id; typeC old_metas table minus ty | Ast0.MetaParam(name,_) -> check_table table minus name | Ast0.MetaParamList(name,Ast0.MetaListLen lenname,_) -> check_table table minus name; check_table table minus lenname | Ast0.MetaParamList(name,_,_) -> check_table table minus name | _ -> () (* no metavariable subterms *) and parameter_list old_metas table minus = dots (parameterTypeDef old_metas table minus) (* --------------------------------------------------------------------- *) (* String fragment *) and string_fragment old_metas table minus e = match Ast0.unwrap e with Ast0.ConstantFragment(str) -> () | Ast0.FormatFragment(pct,fmt) -> string_format old_metas table minus fmt | Ast0.Strdots dots -> () | Ast0.MetaFormatList(pct,name,Ast0.MetaListLen lenname) -> check_table table minus name; check_table table minus lenname | Ast0.MetaFormatList(pct,name,lenname) -> check_table table minus name and string_format old_metas table minus e = match Ast0.unwrap e with Ast0.ConstantFormat(str) -> () | Ast0.MetaFormat(name,_) -> check_table table minus name (* --------------------------------------------------------------------- *) (* Top-level code *) and statement old_metas table minus s = match Ast0.unwrap s with Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl | Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body | Ast0.ExprStatement(exp,sem) -> get_opt (expression ID old_metas table minus) exp | Ast0.IfThen(iff,lp,exp,rp,branch,_) -> expression ID old_metas table minus exp; statement old_metas table minus branch | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) -> expression ID old_metas table minus exp; statement old_metas table minus branch1; statement old_metas table minus branch2 | Ast0.While(wh,lp,exp,rp,body,_) -> expression ID old_metas table minus exp; statement old_metas table minus body | Ast0.Do(d,body,wh,lp,exp,rp,sem) -> statement old_metas table minus body; expression ID old_metas table minus exp | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,_) -> (match Ast0.unwrap first with Ast0.ForExp(exp1,sem1) -> get_opt (expression ID old_metas table minus) exp1 | Ast0.ForDecl (_,decl) -> declaration ID old_metas table minus decl); get_opt (expression ID old_metas table minus) exp2; get_opt (expression ID old_metas table minus) exp3; statement old_metas table minus body | Ast0.Iterator(nm,lp,args,rp,body,_) -> ident GLOBAL old_metas table minus nm; dots (expression ID old_metas table minus) args; statement old_metas table minus body | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> expression ID old_metas table minus exp; dots (statement old_metas table minus) decls; dots (case_line old_metas table minus) cases | Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp | Ast0.MetaStmt(name,_) -> check_table table minus name | Ast0.MetaStmtList(name,_) -> check_table table minus name | Ast0.AsStmt(stm,asstm) -> failwith "not generated yet" | Ast0.Exp(exp) -> expression ID old_metas table minus exp | Ast0.TopExp(exp) -> expression ID old_metas table minus exp | Ast0.Ty(ty) -> typeC old_metas table minus ty | Ast0.TopInit(init) -> initialiser old_metas table minus init | Ast0.Disj(_,rule_elem_dots_list,_,_) -> List.iter (dots (statement old_metas table minus)) rule_elem_dots_list | Ast0.Nest(_,rule_elem_dots,_,w,_) -> dots (statement old_metas table minus) rule_elem_dots; List.iter (whencode (dots (statement old_metas table minus)) (statement old_metas table minus) (expression ID old_metas table minus)) w | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) -> List.iter (whencode (dots (statement old_metas table minus)) (statement old_metas table minus) (expression ID old_metas table minus)) x | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) -> ident FN old_metas table minus name; List.iter (fninfo old_metas table minus) fi; parameter_list old_metas table minus params; dots (statement old_metas table minus) body | Ast0.Include(inc,s) -> () (* no metavariables possible *) | Ast0.Undef(def,id) -> ident GLOBAL old_metas table minus id | Ast0.Define(def,id,params,body) -> ident GLOBAL old_metas table minus id; define_parameters old_metas table minus params; dots (statement old_metas table minus) body | Ast0.Pragma(prg,id,body) -> ident GLOBAL old_metas table minus id; pragmainfo old_metas table minus body | Ast0.Label(i,_) -> ident ID old_metas table minus i | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i | _ -> () (* no metavariable subterms *) and pragmainfo old_metas table minus pi = match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> dots (expression ID old_metas table minus) args | Ast0.PragmaIdList(ids) -> dots (ident GLOBAL old_metas table minus) ids | Ast0.PragmaDots (dots) -> () and define_param old_metas table minus p = match Ast0.unwrap p with Ast0.DParam(id) -> ident GLOBAL old_metas table minus id | Ast0.DPComma(_) | Ast0.DPdots(_) | Ast0.DPcircles(_) -> () (* no metavariable subterms *) | Ast0.OptDParam(dp) -> define_param old_metas table minus dp | Ast0.UniqueDParam(dp) -> define_param old_metas table minus dp and define_parameters old_metas table minus x = match Ast0.unwrap x with Ast0.NoParams -> () | Ast0.DParams(lp,dp,rp) -> dots (define_param old_metas table minus) dp and fninfo old_metas table minus = function Ast0.FStorage(stg) -> () | Ast0.FType(ty) -> typeC old_metas table minus ty | Ast0.FInline(inline) -> () | Ast0.FAttr(attr) -> () and whencode notfn alwaysfn expression = function Ast0.WhenNot a -> notfn a | Ast0.WhenAlways a -> alwaysfn a | Ast0.WhenModifier(_) -> () | Ast0.WhenNotTrue a -> expression a | Ast0.WhenNotFalse a -> expression a and case_line old_metas table minus c = match Ast0.unwrap c with Ast0.Default(def,colon,code) -> dots (statement old_metas table minus) code | Ast0.Case(case,exp,colon,code) -> expression GLOBAL old_metas table minus exp; dots (statement old_metas table minus) code | Ast0.DisjCase(_,case_lines,_,_) -> List.iter (case_line old_metas table minus) case_lines | Ast0.OptCase(case) -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Rules *) let top_level old_metas table minus t = match Ast0.unwrap t with Ast0.NONDECL(stmt) -> statement old_metas table minus stmt | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots | Ast0.ERRORWORDS(exps) -> List.iter (expression FN old_metas table minus) exps | _ -> () (* no metavariables possible *) let rule old_metas table minus rules = List.iter (top_level old_metas table minus) rules (* --------------------------------------------------------------------- *) let positions table rules = let rec rmcode x = (* needed for type inference, nonpolymorphic *) List.iter (function var -> let name = Ast0.meta_pos_name var in (find_loop table (Ast0.unwrap_mcode name)) := true; rmcode name) (Ast0.get_pos x) in let rec mcode x = List.iter (function var -> let name = Ast0.meta_pos_name var in (find_loop table (Ast0.unwrap_mcode name)) := true; rmcode name) (Ast0.get_pos x) in let option_default = () in let bind x y = () in let donothing r k e = k e in let fn = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in List.iter fn.VT0.combiner_rec_top_level rules let dup_positions rules = let mcode x = List.concat (List.map (function Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,_)) -> [Ast0.unwrap_mcode name] | _ -> []) (Ast0.get_pos x)) in let option_default = [] in let bind x y = x@y in (* Case for everything that has a disj. Note, no positions on ( | ) of a disjunction, so no need to recurse on these. *) let expression r k e = match Ast0.unwrap e with Ast0.DisjExpr(_,explist,_,_) -> List.fold_left Common.union_set option_default (List.map r.VT0.combiner_rec_expression explist) | _ -> k e in let typeC r k e = (* not sure relevant because "only after iso" *) match Ast0.unwrap e with Ast0.DisjType(_,types,_,_) -> List.fold_left Common.union_set option_default (List.map r.VT0.combiner_rec_typeC types) | _ -> k e in let declaration r k e = match Ast0.unwrap e with Ast0.DisjDecl(_,decls,_,_) -> List.fold_left Common.union_set option_default (List.map r.VT0.combiner_rec_declaration decls) | _ -> k e in let statement r k e = match Ast0.unwrap e with Ast0.Disj(_,stmts,_,_) -> List.fold_left Common.union_set option_default (List.map r.VT0.combiner_rec_statement_dots stmts) | _ -> k e in let donothing r k e = k e in let fn = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing expression typeC donothing donothing declaration statement donothing donothing donothing in let res = List.sort compare (List.fold_left Common.union_set option_default (List.map fn.VT0.combiner_rec_top_level rules)) in let rec loop = function [] | [_] -> () | ((rule,name) as x)::y::_ when x = y -> failwith (Printf.sprintf "duplicate use of %s.%s" rule name) | _::xs -> loop xs in loop res (* --------------------------------------------------------------------- *) let make_table l = let table = (Hashtbl.create(List.length l) : (Ast.meta_name, bool ref) Hashtbl.t) in List.iter (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l; table let add_to_fresh_table l = List.iter (function x -> let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ()) l let check_all_marked rname err table after_err = Hashtbl.iter (function name -> function (cell) -> if not (!cell) then let (_,name) = name in warning (Printf.sprintf "%s: %s %s not used %s" rname err name after_err)) table let check_meta rname old_metas inherited_metavars metavars minus plus = let old_metas = List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in let (fresh,other) = List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false) metavars in let (err,other) = List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false) other in let (ierr,iother) = List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false) inherited_metavars in let fresh_table = make_table fresh in let err_table = make_table (err@ierr) in let other_table = make_table other in let iother_table = make_table iother in add_to_fresh_table fresh; rule old_metas [iother_table;other_table;err_table] true minus; positions [iother_table;other_table] minus; dup_positions minus; check_all_marked rname "metavariable" other_table "in the - or context code"; rule old_metas [iother_table;fresh_table;err_table] false plus; check_all_marked rname "inherited metavariable" iother_table "in the -, +, or context code"; check_all_marked rname "metavariable" fresh_table "in the + code"; check_all_marked rname "error metavariable" err_table "" coccinelle-1.0.0-rc19/parsing_cocci/get_constants.mli0000644000175000017500000000226312247442616021550 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_constants.mli" val get_constants : Ast_cocci.rule list -> string list list coccinelle-1.0.0-rc19/parsing_cocci/semantic_cocci.ml0000644000175000017500000000222412247442615021463 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./semantic_cocci.ml" exception Semantic of string coccinelle-1.0.0-rc19/parsing_cocci/merge.mli0000644000175000017500000000241412247442615017771 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./merge.mli" val do_merge : Ast0_cocci.rule -> (Ast_cocci.anything * int * int * int * int) list list list -> unit (* updates Ast0_cocci.rule argument *) coccinelle-1.0.0-rc19/parsing_cocci/compute_lines.mli0000644000175000017500000000262112247442616021541 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./compute_lines.mli" val compute_lines : bool -> Ast0_cocci.rule -> Ast0_cocci.rule val compute_statement_dots_lines : bool -> Ast0_cocci.statement Ast0_cocci.dots -> Ast0_cocci.statement Ast0_cocci.dots val compute_statement_lines : bool -> Ast0_cocci.statement -> Ast0_cocci.statement coccinelle-1.0.0-rc19/parsing_cocci/type_infer.ml0000644000175000017500000004061612247442615020673 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./type_infer.ml" module T = Type_cocci module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* Type inference: Just propagates information based on declarations. Could try to infer more precise information about expression metavariables, but not sure it is worth it. The most obvious goal is to distinguish between test expressions that have pointer, integer, and boolean type when matching isomorphisms, but perhaps other needs will become apparent. *) (* "functions" that return a boolean value *) let bool_functions = ["likely";"unlikely"] let err wrapped ty s = T.typeC ty; Format.print_newline(); failwith (Printf.sprintf "line %d: %s" (Ast0.get_line wrapped) s) type id = Id of string | Meta of Ast.meta_name let int_type = T.BaseType(T.IntType) let void_type = T.BaseType(T.VoidType) let bool_type = T.BaseType(T.BoolType) let char_type = T.BaseType(T.CharType) let float_type = T.BaseType(T.FloatType) let size_type = T.BaseType(T.SizeType) let ssize_type = T.BaseType(T.SSizeType) let ptrdiff_type = T.BaseType(T.PtrDiffType) let rec lub_type t1 t2 = match (t1,t2) with (None,None) -> None | (None,Some t) -> t2 | (Some t,None) -> t1 | (Some t1,Some t2) -> let rec loop = function (T.Unknown,t2) -> t2 | (t1,T.Unknown) -> t1 | (T.ConstVol(cv1,ty1),T.ConstVol(cv2,ty2)) when cv1 = cv2 -> T.ConstVol(cv1,loop(ty1,ty2)) (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *) | (T.Pointer(ty1),T.Pointer(ty2)) -> T.Pointer(loop(ty1,ty2)) | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2) | (T.Pointer(ty1),ty2) -> T.Pointer(ty1) | (T.Array(ty1),T.Array(ty2)) -> T.Array(loop(ty1,ty2)) | (T.TypeName(s1),t2) -> t2 | (t1,T.TypeName(s1)) -> t1 | (t1,_) -> t1 in (* arbitrarily pick the first, assume type correct *) Some (loop (t1,t2)) let lub_envs envs = List.fold_left (function acc -> function env -> List.fold_left (function acc -> function (var,ty) -> let (relevant,irrelevant) = List.partition (function (x,_) -> x = var) acc in match relevant with [] -> (var,ty)::acc | [(x,ty1)] -> (match lub_type (Some ty) (Some ty1) with Some new_ty -> (var,new_ty)::irrelevant | None -> irrelevant) | _ -> failwith "bad type environment") acc env) [] envs let rec propagate_types env = let option_default = None in let bind x y = option_default in (* no generic way of combining types *) let ident r k i = match Ast0.unwrap i with Ast0.Id((s, _, _, _, _, _) as id) -> (try Some(List.assoc (Id(Ast0.unwrap_mcode id)) env) with Not_found -> None) | Ast0.MetaId(id,_,_,_) -> (try Some(List.assoc (Meta(Ast0.unwrap_mcode id)) env) with Not_found -> None) | Ast0.DisjId(_,id_list,_,_) -> let types = List.map Ast0.get_type id_list in let combined = List.fold_left lub_type None types in (match combined with None -> None | Some t -> List.iter (function i -> Ast0.set_type i (Some t)) id_list; Some t) | Ast0.AsIdent _ -> failwith "not possible" | _ -> k i in let strip_cv = function Some (T.ConstVol(_,t)) -> Some t | t -> t in (* types that might be integer types. should char be allowed? *) let rec is_int_type = function T.BaseType(T.IntType) | T.BaseType(T.LongType) | T.BaseType(T.ShortType) | T.BaseType(T.SizeType) | T.MetaType(_,_,_) | T.TypeName _ | T.EnumName _ | T.SignedT(_,None) -> true | T.SignedT(_,Some ty) -> is_int_type ty | _ -> false in let expression r k e = let res = k e in let ty = match Ast0.unwrap e with (* pad: the type of id is set in the ident visitor *) Ast0.Ident(id) -> Ast0.set_type e res; res | Ast0.Constant(const) -> (match Ast0.unwrap_mcode const with Ast.String(_) -> Some (T.Pointer(char_type)) | Ast.Char(_) -> Some (char_type) | Ast.Int(_) -> Some (int_type) | Ast.Float(_) -> Some (float_type) | Ast.DecimalConst(_,l,p) -> Some (T.Decimal(T.Num l, T.Num p))) (* pad: note that in C can do either ptr(...) or ( *ptr)(...) * so I am not sure this code is enough. *) | Ast0.StringConstant _ -> Some (T.Array(char_type)) | Ast0.FunCall(fn,lp,args,rp) -> (match Ast0.get_type fn with Some (T.FunctionPointer(ty)) -> Some ty | _ -> (match Ast0.unwrap fn with Ast0.Ident(id) -> (match Ast0.unwrap id with Ast0.Id(id) -> if List.mem (Ast0.unwrap_mcode id) bool_functions then Some(bool_type) else None | _ -> None) | _ -> None)) | Ast0.Assignment(exp1,op,exp2,_) -> let ty = lub_type (Ast0.get_type exp1) (Ast0.get_type exp2) in Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty | Ast0.Sequence(exp1,op,exp2) -> Ast0.get_type exp2 | Ast0.CondExpr(exp1,why,Some exp2,colon,exp3) -> let ty = lub_type (Ast0.get_type exp2) (Ast0.get_type exp3) in Ast0.set_type exp2 ty; Ast0.set_type exp3 ty; ty | Ast0.CondExpr(exp1,why,None,colon,exp3) -> Ast0.get_type exp3 | Ast0.Postfix(exp,op) | Ast0.Infix(exp,op) -> (* op is dec or inc *) Ast0.get_type exp | Ast0.Unary(exp,op) -> (match Ast0.unwrap_mcode op with Ast.GetRef -> (match Ast0.get_type exp with None -> Some (T.Pointer(T.Unknown)) | Some t -> Some (T.Pointer(t))) | Ast.GetRefLabel -> Some (T.Pointer(void_type)) | Ast.DeRef -> (match Ast0.get_type exp with Some (T.Pointer(t)) -> Some t | _ -> None) | Ast.UnPlus -> Ast0.get_type exp | Ast.UnMinus -> Ast0.get_type exp | Ast.Tilde -> Ast0.get_type exp | Ast.Not -> Some(bool_type)) | Ast0.Nested(exp1,op,exp2) -> failwith "nested in type inf not possible" | Ast0.Binary(exp1,op,exp2) -> let ty1 = Ast0.get_type exp1 in let ty2 = Ast0.get_type exp2 in let same_type = function (None,None) -> Some (int_type) (* pad: pointer arithmetic handling as in ptr+1 *) | (Some (T.Pointer ty1),Some ty2) when is_int_type ty2 -> Some (T.Pointer ty1) | (Some ty1,Some (T.Pointer ty2)) when is_int_type ty1 -> Some (T.Pointer ty2) | (t1,t2) -> let ty = lub_type t1 t2 in Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty in (match Ast0.unwrap_mcode op with Ast.Arith(op) -> same_type (ty1, ty2) | Ast.Logical(Ast.AndLog) | Ast.Logical(Ast.OrLog) -> Some(bool_type) | Ast.Logical(op) -> let ty = lub_type ty1 ty2 in Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; Some(bool_type)) | Ast0.Paren(lp,exp,rp) -> Ast0.get_type exp | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> (match strip_cv (Ast0.get_type exp2) with None -> Ast0.set_type exp2 (Some(int_type)) | Some(ty) when is_int_type ty -> () | Some(Type_cocci.Unknown) -> (* unknown comes from param types, not sure why this is not just None... *) Ast0.set_type exp2 (Some(int_type)) | Some ty -> err exp2 ty "bad type for an array index"); (match strip_cv (Ast0.get_type exp1) with None -> None | Some (T.Array(ty)) -> Some ty | Some (T.Pointer(ty)) -> Some ty | Some (T.MetaType(_,_,_)) -> None | Some x -> err exp1 x "ill-typed array reference") (* pad: should handle structure one day and look 'field' in environment *) | Ast0.RecordAccess(exp,pt,field) -> (match strip_cv (Ast0.get_type exp) with None -> None | Some (T.StructUnionName(_,_)) -> None | Some (T.TypeName(s)) -> None | Some (T.MetaType(_,_,_)) -> None | Some x -> err exp x "non-structure type in field ref") | Ast0.RecordPtAccess(exp,ar,field) -> (match strip_cv (Ast0.get_type exp) with None -> None | Some (T.Pointer(t)) -> (match strip_cv (Some t) with | Some (T.Unknown) -> None | Some (T.MetaType(_,_,_)) -> None | Some (T.TypeName(s)) -> None | Some (T.StructUnionName(s,t)) -> None | Some x -> err exp (T.Pointer(t)) "non-structure pointer type in field ref" | _ -> failwith "not possible") | Some (T.MetaType(_,_,_)) -> None | Some (T.TypeName(s)) -> None | Some x -> err exp x "non-structure pointer type in field ref") | Ast0.Cast(lp,ty,rp,exp) -> Some(Ast0.ast0_type_to_type ty) | Ast0.SizeOfExpr(szf,exp) -> Some(int_type) | Ast0.SizeOfType(szf,lp,ty,rp) -> Some(int_type) | Ast0.TypeExp(ty) -> None | Ast0.Constructor(lp,ty,rp,init) -> Some(Ast0.ast0_type_to_type ty) | Ast0.MetaErr(name,_,_) -> None | Ast0.MetaExpr(name,_,Some [ty],_,_) -> Some ty | Ast0.MetaExpr(name,_,ty,_,_) -> None | Ast0.MetaExprList(name,_,_) -> None | Ast0.EComma(cm) -> None | Ast0.DisjExpr(_,exp_list,_,_) -> let types = List.map Ast0.get_type exp_list in let combined = List.fold_left lub_type None types in (match combined with None -> None | Some t -> List.iter (function e -> Ast0.set_type e (Some t)) exp_list; Some t) | Ast0.NestExpr(starter,expr_dots,ender,None,multi) -> let _ = r.VT0.combiner_rec_expression_dots expr_dots in None | Ast0.NestExpr(starter,expr_dots,ender,Some e,multi) -> let _ = r.VT0.combiner_rec_expression_dots expr_dots in let _ = r.VT0.combiner_rec_expression e in None | Ast0.Edots(_,None) | Ast0.Ecircles(_,None) | Ast0.Estars(_,None) -> None | Ast0.Edots(_,Some e) | Ast0.Ecircles(_,Some e) | Ast0.Estars(_,Some e) -> let _ = r.VT0.combiner_rec_expression e in None | Ast0.OptExp(exp) -> Ast0.get_type exp | Ast0.UniqueExp(exp) -> Ast0.get_type exp | Ast0.AsExpr _ -> failwith "not possible" in Ast0.set_type e ty; ty in let rec strip id = match Ast0.unwrap id with Ast0.Id(name) -> [Id(Ast0.unwrap_mcode name)] | Ast0.MetaId(name,_,_,_) -> [Meta(Ast0.unwrap_mcode name)] | Ast0.MetaFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)] | Ast0.MetaLocalFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)] | Ast0.DisjId(_,id_list,_,_) -> List.concat (List.map strip id_list) | Ast0.OptIdent(id) -> strip id | Ast0.UniqueIdent(id) -> strip id | Ast0.AsIdent _ -> failwith "not possible" in let process_whencode notfn allfn exp = function Ast0.WhenNot(x) -> let _ = notfn x in () | Ast0.WhenAlways(x) -> let _ = allfn x in () | Ast0.WhenModifier(_) -> () | Ast0.WhenNotTrue(x) -> let _ = exp x in () | Ast0.WhenNotFalse(x) -> let _ = exp x in () in (* assume that all of the declarations are at the beginning of a statement list, which is required by C, but not actually required by the cocci parser *) let rec process_statement_list r acc = function [] -> acc | (s::ss) -> (match Ast0.unwrap s with Ast0.Decl(_,decl) -> let new_acc = (process_decl acc decl)@acc in process_statement_list r new_acc ss | Ast0.Dots(_,wc) -> (* why is this case here? why is there none for nests? *) List.iter (process_whencode r.VT0.combiner_rec_statement_dots r.VT0.combiner_rec_statement r.VT0.combiner_rec_expression) wc; process_statement_list r acc ss | Ast0.Disj(_,statement_dots_list,_,_) -> let new_acc = lub_envs (List.map (function x -> process_statement_list r acc (Ast0.undots x)) statement_dots_list) in process_statement_list r new_acc ss | _ -> let _ = (propagate_types acc).VT0.combiner_rec_statement s in process_statement_list r acc ss) and process_decl env decl = match Ast0.unwrap decl with Ast0.MetaDecl(_,_) | Ast0.MetaField(_,_) | Ast0.MetaFieldList(_,_,_) -> [] | Ast0.Init(_,ty,id,_,exp,_) -> let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in let ty = Ast0.ast0_type_to_type ty in List.map (function i -> (i,ty)) (strip id) | Ast0.UnInit(_,ty,id,_) -> let ty = Ast0.ast0_type_to_type ty in List.map (function i -> (i,ty)) (strip id) | Ast0.MacroDecl(_,_,_,_,_) -> [] | Ast0.MacroDeclInit(_,_,_,_,_,exp,_) -> let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in [] | Ast0.TyDecl(ty,_) -> [] (* pad: should handle typedef one day and add a binding *) | Ast0.Typedef((a,_,_,_,_,_),b,c,(d,_,_,_,_,_)) -> [] | Ast0.DisjDecl(_,disjs,_,_) -> List.concat(List.map (process_decl env) disjs) | Ast0.Ddots(_,_) -> [] (* not in a statement list anyway *) | Ast0.OptDecl(decl) -> process_decl env decl | Ast0.UniqueDecl(decl) -> process_decl env decl | Ast0.AsDecl _ -> failwith "not possible" in let statement_dots r k d = match Ast0.unwrap d with Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> let _ = process_statement_list r env l in option_default in let post_bool exp = let rec process_test exp = match (Ast0.unwrap exp,Ast0.get_type exp) with (Ast0.Edots(_,_),_) -> None | (Ast0.NestExpr(_,_,_,_,_),_) -> None | (Ast0.MetaExpr(_,_,_,_,_),_) -> (* if a type is known, it is specified in the decl *) None | (Ast0.Paren(lp,exp,rp),None) -> process_test exp (* the following doesn't seem like a good idea - triggers int isos on all test expressions *) (*| (_,None) -> Some (int_type) *) | _ -> None in let new_expty = process_test exp in (match new_expty with None -> () (* leave things as they are *) | Some ty -> Ast0.set_type exp new_expty) in let statement r k s = match Ast0.unwrap s with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> let rec get_binding p = match Ast0.unwrap p with Ast0.Param(ty,Some id) -> let ty = Ast0.ast0_type_to_type ty in List.map (function i -> (i,ty)) (strip id) | Ast0.OptParam(param) -> get_binding param | Ast0.AsParam(param,e) -> get_binding param | _ -> [] in let fenv = List.concat (List.map get_binding (Ast0.undots params)) in (propagate_types (fenv@env)).VT0.combiner_rec_statement_dots body | Ast0.IfThen(_,_,exp,_,_,_) | Ast0.IfThenElse(_,_,exp,_,_,_,_,_) | Ast0.While(_,_,exp,_,_,_) | Ast0.Do(_,_,_,_,exp,_,_) -> let _ = k s in post_bool exp; None | Ast0.For(a,b,first,exp,c,d,e,f,g) -> (match Ast0.unwrap first with Ast0.ForExp _ -> (match exp with Some exp -> let _ = k s in post_bool exp; None | None -> k s) | Ast0.ForDecl (_,decl) -> (* not super elegant..., reuses a ; (d) *) let newenv = (process_decl env decl)@env in let dummy = Ast0.rewrap first (Ast0.ForExp (None,c)) in (propagate_types newenv).VT0.combiner_rec_statement (Ast0.rewrap s (Ast0.For(a,b,dummy,exp,c,d,e,f,g)))) | Ast0.Switch(_,_,exp,_,_,decls,cases,_) -> let senv = process_statement_list r env (Ast0.undots decls) in let res = (propagate_types (senv@env)).VT0.combiner_rec_case_line_dots cases in post_bool exp; res | _ -> k s and case_line r k c = match Ast0.unwrap c with Ast0.Case(case,exp,colon,code) -> let _ = k c in (match Ast0.get_type exp with None -> Ast0.set_type exp (Some (int_type)) | _ -> ()); None | _ -> k c in V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_dotsstmtfn = statement_dots; VT0.combiner_identfn = ident; VT0.combiner_exprfn = expression; VT0.combiner_stmtfn = statement; VT0.combiner_casefn = case_line} let type_infer code = let prop = propagate_types [(Id("NULL"),T.Pointer(T.Unknown))] in let fn = prop.VT0.combiner_rec_top_level in let _ = List.map fn code in () coccinelle-1.0.0-rc19/parsing_cocci/unitary_ast0.mli0000644000175000017500000000301112247442615021306 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unitary_ast0.mli" (* 'iso is the return type of parse_iso, which currently is (Ast_cocci.metavar list * Ast0_cocci.anything list list) list *) (* val do_unitary : (Ast0_cocci.rule * Ast_cocci.metavar list * 'iso) list -> (Ast0_cocci.rule * Ast_cocci.metavar list) list -> (Ast0_cocci.rule * Ast_cocci.metavar list * 'iso) list *) val do_unitary : Ast0_cocci.parsed_rule list -> Ast0_cocci.parsed_rule list coccinelle-1.0.0-rc19/parsing_cocci/arity.mli0000644000175000017500000000224412247442616020024 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./arity.mli" val minus_arity : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/adjacency.ml0000644000175000017500000000562312247442615020447 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./adjacency.ml" module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let compute_adjacency p = let counter = ref 0 in let mcode (a,b,c,d,e,_) = (a,b,c,d,e,!counter) in let string_mcode ((str,_,info,mc,_,_) as x) = match str with "..." | "<..." | "...>" | "<+..." | "...+>" -> (match mc with Ast0.MINUS _ -> mcode x | Ast0.CONTEXT _ -> counter := !counter + 1; x | _ -> failwith "unexpected mcode for ...") | _ -> mcode x in let statement r k s = let s = k s in (* a case for each kind of term that has a fake node *) Ast0.rewrap s (match Ast0.unwrap s with Ast0.IfThen(iff,lp,exp,rp,branch,(info,mc,_)) -> Ast0.IfThen(iff,lp,exp,rp,branch,(info,mc,!counter)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,mc,_)) -> Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,mc,!counter)) | Ast0.While(wh,lp,exp,rp,body,(info,mc,_)) -> Ast0.While(wh,lp,exp,rp,body,(info,mc,!counter)) | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(info,mc,_)) -> Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(info,mc,!counter)) | Ast0.Iterator(nm,lp,args,rp,body,(info,mc,_)) -> Ast0.Iterator(nm,lp,args,rp,body,(info,mc,!counter)) | s -> s) in let fn = V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_meta_mcode = mcode; VT0.rebuilder_string_mcode = string_mcode; VT0.rebuilder_const_mcode = mcode; VT0.rebuilder_assign_mcode = mcode; VT0.rebuilder_fix_mcode = mcode; VT0.rebuilder_unary_mcode = mcode; VT0.rebuilder_binary_mcode = mcode; VT0.rebuilder_cv_mcode = mcode; VT0.rebuilder_sign_mcode = mcode; VT0.rebuilder_struct_mcode = mcode; VT0.rebuilder_storage_mcode = mcode; VT0.rebuilder_inc_mcode = mcode; VT0.rebuilder_stmtfn = statement;} in List.map fn.VT0.rebuilder_rec_top_level p coccinelle-1.0.0-rc19/parsing_cocci/safe_for_multi_decls.ml0000644000175000017500000000715112247442615022674 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./safe_for_multi_decls.ml" (* This phase sets the safe_for_multi_decls field, which is normally false, to true for transformations on declarations where the only change is on the declared variable. This is the only kind of change on such a declaration that can safely be done without splitting the declaration. *) module Ast = Ast_cocci module V = Visitor_ast let mcode _ (_,_,kind,_) = match kind with Ast.MINUS(_,_,_,_) -> true | Ast.PLUS _ -> failwith "not possible" | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING) let contains_modif = let bind x y = x or y in let option_default = false in let do_nothing r k e = k e in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl(bef,_,decl) -> bind (mcode r ((),(),bef,[])) res | _ -> res in let init r k i = let res = k i in match Ast.unwrap i with Ast.StrInitList(allminus,_,_,_,_) -> allminus or res | _ -> res in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing init do_nothing do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_fullType let decl r k e = let e = k e in match Ast.unwrap e with Ast.Init(stg,ty,_,_,_,sem) | Ast.UnInit(stg,ty,_,sem) -> let stg_modif = match stg with Some stg -> mcode () stg | None -> false in let ft_modif = contains_modif ty in let sem_modif = mcode () sem in if not(stg_modif or ft_modif or sem_modif) then {e with Ast.safe_for_multi_decls = true} else e | _ -> e let mcode e = e let donothing r k e = k e let process = let fn = V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing decl donothing donothing donothing donothing donothing in List.map fn.V.rebuilder_top_level let safe_for_multi_decls rules = List.map (function (mv,r) -> (mv, match r with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> r | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) -> Ast.CocciRule(nm, rule_info,process r,is_exp,ruletype))) rules coccinelle-1.0.0-rc19/parsing_cocci/iso_pattern.mli0000644000175000017500000000265412247442615021227 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iso_pattern.mli" type isomorphism = Ast_cocci.metavar list * Ast0_cocci.anything list list * string(*iso name*) val apply_isos : isomorphism list -> Ast0_cocci.rule -> string (* rule name *) -> Ast_cocci.metavar list * Ast0_cocci.rule val rebuild_mcode : int option -> Visitor_ast0_types.rebuilder_rec_functions coccinelle-1.0.0-rc19/parsing_cocci/top_level.mli0000644000175000017500000000237512247442616020672 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./top_level.mli" val top_level : bool (* true if must be code *) -> Ast0_cocci.rule -> Ast0_cocci.rule val clean : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/type_infer.mli0000644000175000017500000000223512247442615021037 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./type_infer.mli" val type_infer : Ast0_cocci.rule -> unit coccinelle-1.0.0-rc19/parsing_cocci/parse_printf.ml0000644000175000017500000000732412247442615021222 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./parse_printf.ml" (* %[parameter][flags][width][.precision][length]type *) exception Not_format_string let suffix s n = String.sub s n (String.length s - n) let string_of_char c = Printf.sprintf "%c" c let safe_get s n = try String.get s n with _ -> raise Not_format_string let check_parameter s = match Str.split (Str.regexp_string "$") s with a::rest -> (try let _ = int_of_string a in (Some a, String.concat "$" rest) with Failure "int_of_string" -> (None, s)) | _ -> (None, s) let check_flags s = let c1 = safe_get s 0 in match c1 with '+' | ' ' | '-' | '#' | '0' -> (Some (string_of_char c1), suffix s 1) | _ -> (None, s) let check_width s = if safe_get s 0 = '*' then (Some "*", suffix s 1) else let re = Str.regexp "[0-9]+" in if Str.string_match re s 0 then let front = Str.matched_string s in let front_len = String.length front in (Some front, suffix s front_len) else (None, s) let check_precision s = match safe_get s 0 with '.' -> let s1 = suffix s 1 in (match check_width s1 with (Some n, s) -> (Some ("."^n), s) | (None, s) -> raise Not_format_string) | _ -> (None, s) (* PRI macros not supported *) let check_length s = let c1 = safe_get s 0 in match c1 with 'h' -> let s1 = suffix s 1 in let c2 = safe_get s1 0 in (match c2 with 'h' -> (Some "hh", suffix s1 1) | _ -> (Some "h", s1)) | 'l' -> let s1 = suffix s 1 in let c2 = safe_get s1 0 in (match c2 with 'l' -> (Some "ll", suffix s1 1) | _ -> (Some "l", s1)) | 'L' | 'z' | 'j' | 't' -> (Some (string_of_char c1), suffix s 1) | 'I' -> let s1 = suffix s 1 in if Str.string_match (Str.regexp "32") s1 0 or Str.string_match (Str.regexp "64") s1 0 then (Some ("I"^Str.matched_string s1), suffix s1 2) else (Some "I", suffix s 1) | 'q' (* BSD *) -> (Some "q", suffix s 1) | _ -> (None, s) let check_type s = let c1 = safe_get s 0 in match c1 with 'd' | 'i' | 'u' | 'f' | 'F' | 'e' | 'E' | 'g' | 'G' | 'x' | 'X' | 'o' | 's' | 'c' | 'p' | 'a' | 'A' | 'n' -> (string_of_char c1, suffix s 1) | _ -> raise Not_format_string (* perhaps useful for ocaml scripts *) let get_all_pieces s = let (p,s) = check_parameter s in let (f,s) = check_flags s in let (w,s) = check_width s in let (pr,s) = check_precision s in let (l,s) = check_length s in let (t,s) = check_type s in (p,f,w,pr,l,t,s) let unsome = function Some s -> s | None -> "" let get_format_string s = let (p,f,w,pr,l,t,s) = get_all_pieces s in (((unsome p) ^ (unsome f) ^ (unsome w) ^ (unsome pr) ^ (unsome l) ^ t), s) coccinelle-1.0.0-rc19/parsing_cocci/compute_lines.ml0000644000175000017500000013513712247442615021400 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./compute_lines.ml" (* Computes starting and ending logical lines for statements and expressions. every node gets an index as well. *) module Ast0 = Ast0_cocci module Ast = Ast_cocci (* --------------------------------------------------------------------- *) (* Result *) (* This is a horrible hack. We need to have a special treatment for the code inside a nest, and this is to avoid threading that information around everywhere *) let in_nest_count = ref 0 let check_attachable v = if !in_nest_count > 0 then false else v let mkres x e left right = let lstart = Ast0.get_info left in let lend = Ast0.get_info right in let pos_info = { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start; Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end; Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start; Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end; Ast0.column = lstart.Ast0.pos_info.Ast0.column; Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in let info = { Ast0.pos_info = pos_info; (* not clear that the next two lines serve any purpose *) Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start; Ast0.attachable_end = check_attachable lend.Ast0.attachable_end; Ast0.mcode_start = lstart.Ast0.mcode_start; Ast0.mcode_end = lend.Ast0.mcode_end; (* only for tokens, not inherited upwards *) Ast0.strings_before = []; Ast0.strings_after = []; Ast0.isSymbolIdent = false; } in {x with Ast0.node = e; Ast0.info = info} (* This looks like it is there to allow distribution of plus code over disjunctions. But this doesn't work with single_statement, as the plus code has not been distributed to the place that it expects. So the only reasonably easy solution seems to be to disallow distribution. *) (* inherit attachable is because single_statement doesn't work well when + code is attached outside an or, but this has to be allowed after isomorphisms have been introduced. So only set it to true then, or when we know that the code involved cannot contain a statement, ie it is a declaration. *) let inherit_attachable = ref false let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) = let lstart = Ast0.get_info left in let lend = Ast0.get_info right in let pos_info = { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start; Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end; Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start; Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end; Ast0.column = lstart.Ast0.pos_info.Ast0.column; Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in let info = { Ast0.pos_info = pos_info; Ast0.attachable_start = check_attachable (if !inherit_attachable then astart else false); Ast0.attachable_end = check_attachable (if !inherit_attachable then aend else false); Ast0.mcode_start = start_mcodes; Ast0.mcode_end = end_mcodes; (* only for tokens, not inherited upwards *) Ast0.strings_before = []; Ast0.strings_after = []; Ast0.isSymbolIdent = false; } in {x with Ast0.node = e; Ast0.info = info} (* --------------------------------------------------------------------- *) let get_option fn = function None -> None | Some x -> Some (fn x) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Mcode *) let promote_mcode (_,_,info,mcodekind,_,_) = let new_info = {info with Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} let promote_mcode_plus_one (_,_,info,mcodekind,_,_) = let new_pos_info = {info.Ast0.pos_info with Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1; Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1; Ast0.line_end = info.Ast0.pos_info.Ast0.line_end + 1; Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_end + 1; } in let new_info = {info with Ast0.pos_info = new_pos_info; Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} let promote_to_statement stm mcodekind = let info = Ast0.get_info stm in let new_pos_info = {info.Ast0.pos_info with Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_end; Ast0.line_start = info.Ast0.pos_info.Ast0.line_end; } in let new_info = {info with Ast0.pos_info = new_pos_info; Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]; Ast0.attachable_start = check_attachable true; Ast0.attachable_end = check_attachable true} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} let promote_to_statement_start stm mcodekind = let info = Ast0.get_info stm in let new_pos_info = {info.Ast0.pos_info with Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_start; Ast0.line_end = info.Ast0.pos_info.Ast0.line_start; } in let new_info = {info with Ast0.pos_info = new_pos_info; Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]; Ast0.attachable_start = check_attachable true; Ast0.attachable_end = check_attachable true} in {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind} (* mcode is good by default *) let bad_mcode (t,a,info,mcodekind,pos,adj) = let new_info = {info with Ast0.attachable_start = check_attachable false; Ast0.attachable_end = check_attachable false} in (t,a,new_info,mcodekind,pos,adj) let normal_mcode (t,a,info,mcodekind,pos,adj) = let new_info = if !in_nest_count > 0 then {info with Ast0.attachable_start = check_attachable false; Ast0.attachable_end = check_attachable false} else info in (t,a,new_info,mcodekind,pos,adj) let get_all_start_info l = (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l, List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l)) let get_all_end_info l = (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l, List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l)) (* --------------------------------------------------------------------- *) (* Dots *) (* for the logline classification and the mcode field, on both sides, skip over initial minus dots, as they don't contribute anything *) let dot_list is_dots fn = function [] -> failwith "dots should not be empty" | l -> let get_node l fn = let first = List.hd l in let chosen = match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in (* get the logline decorator and the mcodekind of the chosen node *) fn (Ast0.get_info chosen) in let forward = List.map fn l in let backward = List.rev forward in let (first_attachable,first_mcode) = get_node forward (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in let (last_attachable,last_mcode) = get_node backward (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in let first = List.hd forward in let last = List.hd backward in let first_info = { (Ast0.get_info first) with Ast0.attachable_start = check_attachable first_attachable; Ast0.mcode_start = first_mcode } in let last_info = { (Ast0.get_info last) with Ast0.attachable_end = check_attachable last_attachable; Ast0.mcode_end = last_mcode } in let first = Ast0.set_info first first_info in let last = Ast0.set_info last last_info in (forward,first,last) let dots is_dots prev fn d = match (prev,Ast0.unwrap d) with (Some prev,Ast0.DOTS([])) -> mkres d (Ast0.DOTS []) prev prev | (None,Ast0.DOTS([])) -> Ast0.set_info d {(Ast0.get_info d) with Ast0.attachable_start = check_attachable false; Ast0.attachable_end = check_attachable false} | (_,Ast0.DOTS(x)) -> let (l,lstart,lend) = dot_list is_dots fn x in mkres d (Ast0.DOTS l) lstart lend | (_,Ast0.CIRCLES(x)) -> let (l,lstart,lend) = dot_list is_dots fn x in mkres d (Ast0.CIRCLES l) lstart lend | (_,Ast0.STARS(x)) -> let (l,lstart,lend) = dot_list is_dots fn x in mkres d (Ast0.STARS l) lstart lend (* --------------------------------------------------------------------- *) (* Disjunctions *) let do_disj e starter xs mids ender processor rebuilder = let starter = bad_mcode starter in let xs = List.map processor xs in let mids = List.map bad_mcode mids in let ender = bad_mcode ender in mkmultires e (rebuilder starter xs mids ender) (promote_mcode starter) (promote_mcode ender) (get_all_start_info xs) (get_all_end_info xs) (* --------------------------------------------------------------------- *) (* Identifier *) (* for #define name, with no value, to compute right side *) let mkidres a b c d r = (mkres a b c d,r) let rec full_ident i = match Ast0.unwrap i with Ast0.Id(nm) -> let nm = normal_mcode nm in let name = promote_mcode nm in mkidres i (Ast0.Id(nm)) name name (Some name) | Ast0.MetaId(nm,a,b,c) -> let nm = normal_mcode nm in let name = promote_mcode nm in mkidres i (Ast0.MetaId(nm,a,b,c)) name name (Some name) | Ast0.MetaFunc(nm,a,b) -> let nm = normal_mcode nm in let name = promote_mcode nm in mkidres i (Ast0.MetaFunc(nm,a,b)) name name (Some name) | Ast0.MetaLocalFunc(nm,a,b) -> let nm = normal_mcode nm in let name = promote_mcode nm in mkidres i (Ast0.MetaLocalFunc(nm,a,b)) name name (Some name) | Ast0.DisjId(starter,ids,mids,ender) -> let res = do_disj i starter ids mids ender ident (fun starter ids mids ender -> Ast0.DisjId(starter,ids,mids,ender)) in (res,None) | Ast0.OptIdent(id) -> let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r | Ast0.UniqueIdent(id) -> let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r | Ast0.AsIdent _ -> failwith "not possible" and ident i = let (id,_) = full_ident i in id (* --------------------------------------------------------------------- *) (* Expression *) let is_exp_dots e = match Ast0.unwrap e with Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true | _ -> false let is_str_dots e = match Ast0.unwrap e with Ast0.Strdots(_) -> true | _ -> false let rec expression e = match Ast0.unwrap e with Ast0.Ident(id) -> let id = ident id in mkres e (Ast0.Ident(id)) id id | Ast0.Constant(const) -> let const = normal_mcode const in let ln = promote_mcode const in mkres e (Ast0.Constant(const)) ln ln | Ast0.StringConstant(lq,str,rq) -> let lq = normal_mcode lq in let str = dots is_str_dots (Some(promote_mcode lq)) string_fragment str in let rq = normal_mcode rq in mkres e (Ast0.StringConstant(lq,str,rq)) (promote_mcode lq) (promote_mcode rq) | Ast0.FunCall(fn,lp,args,rp) -> let fn = expression fn in let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in let rp = normal_mcode rp in mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp) | Ast0.Assignment(left,op,right,simple) -> let left = expression left in let op = normal_mcode op in let right = expression right in mkres e (Ast0.Assignment(left,op,right,simple)) left right | Ast0.Sequence(left,op,right) -> let left = expression left in let op = normal_mcode op in let right = expression right in mkres e (Ast0.Sequence(left,op,right)) left right | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let exp1 = expression exp1 in let why = normal_mcode why in let exp2 = get_option expression exp2 in let colon = normal_mcode colon in let exp3 = expression exp3 in mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3 | Ast0.Postfix(exp,op) -> let exp = expression exp in let op = normal_mcode op in mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op) | Ast0.Infix(exp,op) -> let exp = expression exp in let op = normal_mcode op in mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp | Ast0.Unary(exp,op) -> let exp = expression exp in let op = normal_mcode op in mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp | Ast0.Binary(left,op,right) -> let left = expression left in let op = normal_mcode op in let right = expression right in mkres e (Ast0.Binary(left,op,right)) left right | Ast0.Nested(left,op,right) -> let left = expression left in let op = normal_mcode op in let right = expression right in mkres e (Ast0.Nested(left,op,right)) left right | Ast0.Paren(lp,exp,rp) -> let lp = normal_mcode lp in let rp = normal_mcode rp in mkres e (Ast0.Paren(lp,expression exp,rp)) (promote_mcode lp) (promote_mcode rp) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> let exp1 = expression exp1 in let lb = normal_mcode lb in let exp2 = expression exp2 in let rb = normal_mcode rb in mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb) | Ast0.RecordAccess(exp,pt,field) -> let exp = expression exp in let pt = normal_mcode pt in let field = ident field in mkres e (Ast0.RecordAccess(exp,pt,field)) exp field | Ast0.RecordPtAccess(exp,ar,field) -> let exp = expression exp in let ar = normal_mcode ar in let field = ident field in mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field | Ast0.Cast(lp,ty,rp,exp) -> let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp | Ast0.SizeOfExpr(szf,exp) -> let szf = normal_mcode szf in let exp = expression exp in mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp | Ast0.SizeOfType(szf,lp,ty,rp) -> let szf = normal_mcode szf in let lp = normal_mcode lp in let rp = normal_mcode rp in mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp)) (promote_mcode szf) (promote_mcode rp) | Ast0.TypeExp(ty) -> let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty | Ast0.Constructor(lp,ty,rp,init) -> let lp = normal_mcode lp in let init = initialiser init in let rp = normal_mcode rp in mkres e (Ast0.Constructor(lp,typeC ty,rp,init)) (promote_mcode lp) init | Ast0.MetaErr(name,a,b) -> let name = normal_mcode name in let ln = promote_mcode name in mkres e (Ast0.MetaErr(name,a,b)) ln ln | Ast0.MetaExpr(name,a,b,c,d) -> let name = normal_mcode name in let ln = promote_mcode name in mkres e (Ast0.MetaExpr(name,a,b,c,d)) ln ln | Ast0.MetaExprList(name,a,b) -> let name = normal_mcode name in let ln = promote_mcode name in mkres e (Ast0.MetaExprList(name,a,b)) ln ln | Ast0.EComma(cm) -> (*let cm = bad_mcode cm in*) (* why was this bad??? *) let cm = normal_mcode cm in let ln = promote_mcode cm in mkres e (Ast0.EComma(cm)) ln ln | Ast0.DisjExpr(starter,exps,mids,ender) -> do_disj e starter exps mids ender expression (fun starter exps mids ender -> Ast0.DisjExpr(starter,exps,mids,ender)) | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) -> (* See explanation on Nest *) let wrapper f = match Ast0.get_mcode_mcodekind starter with Ast0.MINUS _ -> in_nest_count := !in_nest_count + 1; let res = f() in in_nest_count := !in_nest_count - 1; res | _ -> f() in let exp_dots = wrapper (function _ -> dots is_exp_dots None expression exp_dots) in let starter = bad_mcode starter in let ender = bad_mcode ender in mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi)) (promote_mcode starter) (promote_mcode ender) | Ast0.Edots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.Edots(dots,whencode)) ln ln | Ast0.Ecircles(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.Ecircles(dots,whencode)) ln ln | Ast0.Estars(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.Estars(dots,whencode)) ln ln | Ast0.OptExp(exp) -> let exp = expression exp in mkres e (Ast0.OptExp(exp)) exp exp | Ast0.UniqueExp(exp) -> let exp = expression exp in mkres e (Ast0.UniqueExp(exp)) exp exp | Ast0.AsExpr _ -> failwith "not possible" and expression_dots x = dots is_exp_dots None expression x (* all are bad mcode because can't have modifications inside a string *) and string_fragment e = match Ast0.unwrap e with Ast0.ConstantFragment(str) -> let str = bad_mcode str in let ln = promote_mcode str in mkres e (Ast0.ConstantFragment(str)) ln ln | Ast0.FormatFragment(pct,fmt) -> let pct = bad_mcode pct in let ln = promote_mcode pct in let fmt = string_format fmt in mkres e (Ast0.FormatFragment(pct,fmt)) ln fmt | Ast0.Strdots dots -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.Strdots dots) ln ln | Ast0.MetaFormatList(pct,name,lenname) -> (* pct is particularly bad in this case, because it is ignored in the matching process. The metavariable matches the complete format specification, including the % *) let pct = bad_mcode pct in let ln1 = promote_mcode pct in let name = bad_mcode name in let ln2 = promote_mcode name in mkres e (Ast0.MetaFormatList(pct,name,lenname)) ln1 ln2 and string_format e = match Ast0.unwrap e with Ast0.ConstantFormat(str) -> let str = bad_mcode str in let ln = promote_mcode str in mkres e (Ast0.ConstantFormat str) ln ln | Ast0.MetaFormat(name,constraints) -> let name = bad_mcode name in let ln = promote_mcode name in mkres e (Ast0.MetaFormat(name,constraints)) ln ln (* --------------------------------------------------------------------- *) (* Types *) and typeC t = match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> let cv = normal_mcode cv in let ty = typeC ty in mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty | Ast0.BaseType(ty,strings) -> let strings = List.map normal_mcode strings in let first = List.hd strings in let last = List.hd (List.rev strings) in mkres t (Ast0.BaseType(ty,strings)) (promote_mcode first) (promote_mcode last) | Ast0.Signed(sgn,None) -> let sgn = normal_mcode sgn in mkres t (Ast0.Signed(sgn,None)) (promote_mcode sgn) (promote_mcode sgn) | Ast0.Signed(sgn,Some ty) -> let sgn = normal_mcode sgn in let ty = typeC ty in mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty | Ast0.Pointer(ty,star) -> let ty = typeC ty in let star = normal_mcode star in mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> let ty = typeC ty in let lp1 = normal_mcode lp1 in let star = normal_mcode star in let rp1 = normal_mcode rp1 in let lp2 = normal_mcode lp2 in let params = parameter_list (Some(promote_mcode lp2)) params in let rp2 = normal_mcode rp2 in mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) ty (promote_mcode rp2) | Ast0.FunctionType(Some ty,lp1,params,rp1) -> let ty = typeC ty in let lp1 = normal_mcode lp1 in let params = parameter_list (Some(promote_mcode lp1)) params in let rp1 = normal_mcode rp1 in let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in mkres t res ty (promote_mcode rp1) | Ast0.FunctionType(None,lp1,params,rp1) -> let lp1 = normal_mcode lp1 in let params = parameter_list (Some(promote_mcode lp1)) params in let rp1 = normal_mcode rp1 in let res = Ast0.FunctionType(None,lp1,params,rp1) in mkres t res (promote_mcode lp1) (promote_mcode rp1) | Ast0.Array(ty,lb,size,rb) -> let ty = typeC ty in let lb = normal_mcode lb in let rb = normal_mcode rb in mkres t (Ast0.Array(ty,lb,get_option expression size,rb)) ty (promote_mcode rb) | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> let dec = normal_mcode dec in let lp = normal_mcode lp in let length = expression length in let comma = get_option normal_mcode comma in let precision_opt = get_option expression precision_opt in let rp = normal_mcode rp in mkres t (Ast0.Decimal(dec,lp,length,comma,precision_opt,rp)) (promote_mcode dec) (promote_mcode rp) | Ast0.EnumName(kind,Some name) -> let kind = normal_mcode kind in let name = ident name in mkres t (Ast0.EnumName(kind,Some name)) (promote_mcode kind) name | Ast0.EnumName(kind,None) -> let kind = normal_mcode kind in let mc = promote_mcode kind in mkres t (Ast0.EnumName(kind,None)) mc mc | Ast0.EnumDef(ty,lb,ids,rb) -> let ty = typeC ty in let lb = normal_mcode lb in let ids = dots is_exp_dots (Some(promote_mcode lb)) expression ids in let rb = normal_mcode rb in mkres t (Ast0.EnumDef(ty,lb,ids,rb)) ty (promote_mcode rb) | Ast0.StructUnionName(kind,Some name) -> let kind = normal_mcode kind in let name = ident name in mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name | Ast0.StructUnionName(kind,None) -> let kind = normal_mcode kind in let mc = promote_mcode kind in mkres t (Ast0.StructUnionName(kind,None)) mc mc | Ast0.StructUnionDef(ty,lb,decls,rb) -> let ty = typeC ty in let lb = normal_mcode lb in let decls = dots is_decl_dots (Some(promote_mcode lb)) declaration decls in let rb = normal_mcode rb in mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb) | Ast0.TypeName(name) -> let name = normal_mcode name in let ln = promote_mcode name in mkres t (Ast0.TypeName(name)) ln ln | Ast0.MetaType(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres t (Ast0.MetaType(name,a)) ln ln | Ast0.DisjType(starter,types,mids,ender) -> do_disj t starter types mids ender typeC (fun starter types mids ender -> Ast0.DisjType(starter,types,mids,ender)) | Ast0.OptType(ty) -> let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty | Ast0.UniqueType(ty) -> let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty | Ast0.AsType _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and is_decl_dots s = match Ast0.unwrap s with Ast0.Ddots(_,_) -> true | _ -> false and declaration d = match Ast0.unwrap d with Ast0.MetaDecl(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres d (Ast0.MetaDecl(name,a)) ln ln | Ast0.MetaField(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres d (Ast0.MetaField(name,a)) ln ln | Ast0.MetaFieldList(name,a,b) -> let name = normal_mcode name in let ln = promote_mcode name in mkres d (Ast0.MetaFieldList(name,a,b)) ln ln | Ast0.Init(stg,ty,id,eq,exp,sem) -> let ty = typeC ty in let id = ident id in let eq = normal_mcode eq in let exp = initialiser exp in let sem = normal_mcode sem in (match stg with None -> mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem) | Some x -> let stg = Some (normal_mcode x) in mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) (promote_mcode x) (promote_mcode sem)) | Ast0.UnInit(stg,ty,id,sem) -> let ty = typeC ty in let id = ident id in let sem = normal_mcode sem in (match stg with None -> mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem) | Some x -> let stg = Some (normal_mcode x) in mkres d (Ast0.UnInit(stg,ty,id,sem)) (promote_mcode x) (promote_mcode sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let name = ident name in let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in let rp = normal_mcode rp in let sem = normal_mcode sem in mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> let name = ident name in let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in let rp = normal_mcode rp in let eq = normal_mcode eq in let ini = initialiser ini in let sem = normal_mcode sem in mkres d (Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) name (promote_mcode sem) | Ast0.TyDecl(ty,sem) -> let ty = typeC ty in let sem = normal_mcode sem in mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem) | Ast0.Typedef(stg,ty,id,sem) -> let stg = normal_mcode stg in let ty = typeC ty in let id = typeC id in let sem = normal_mcode sem in mkres d (Ast0.Typedef(stg,ty,id,sem)) (promote_mcode stg) (promote_mcode sem) | Ast0.DisjDecl(starter,decls,mids,ender) -> do_disj d starter decls mids ender declaration (fun starter decls mids ender -> Ast0.DisjDecl(starter,decls,mids,ender)) | Ast0.Ddots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres d (Ast0.Ddots(dots,whencode)) ln ln | Ast0.OptDecl(decl) -> let decl = declaration decl in mkres d (Ast0.OptDecl(declaration decl)) decl decl | Ast0.UniqueDecl(decl) -> let decl = declaration decl in mkres d (Ast0.UniqueDecl(declaration decl)) decl decl | Ast0.AsDecl _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Initializer *) and is_init_dots i = match Ast0.unwrap i with Ast0.Idots(_,_) -> true | _ -> false and initialiser i = match Ast0.unwrap i with Ast0.MetaInit(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres i (Ast0.MetaInit(name,a)) ln ln | Ast0.MetaInitList(name,a,b) -> let name = normal_mcode name in let ln = promote_mcode name in mkres i (Ast0.MetaInitList(name,a,b)) ln ln | Ast0.InitExpr(exp) -> let exp = expression exp in mkres i (Ast0.InitExpr(exp)) exp exp | Ast0.InitList(lb,initlist,rb,ordered) -> let lb = normal_mcode lb in let initlist = dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in let rb = normal_mcode rb in mkres i (Ast0.InitList(lb,initlist,rb,ordered)) (promote_mcode lb) (promote_mcode rb) | Ast0.InitGccExt(designators,eq,ini) -> let (delims,designators) = (* non empty due to parsing *) List.split (List.map designator designators) in let eq = normal_mcode eq in let ini = initialiser ini in mkres i (Ast0.InitGccExt(designators,eq,ini)) (promote_mcode (List.hd delims)) ini | Ast0.InitGccName(name,eq,ini) -> let name = ident name in let eq = normal_mcode eq in let ini = initialiser ini in mkres i (Ast0.InitGccName(name,eq,ini)) name ini | Ast0.IComma(cm) -> let cm = normal_mcode cm in let ln = promote_mcode cm in mkres i (Ast0.IComma(cm)) ln ln | Ast0.Idots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres i (Ast0.Idots(dots,whencode)) ln ln | Ast0.OptIni(ini) -> let ini = initialiser ini in mkres i (Ast0.OptIni(ini)) ini ini | Ast0.UniqueIni(ini) -> let ini = initialiser ini in mkres i (Ast0.UniqueIni(ini)) ini ini | Ast0.AsInit _ -> failwith "not possible" and designator = function Ast0.DesignatorField(dot,id) -> let dot = normal_mcode dot in (dot,Ast0.DesignatorField(dot,ident id)) | Ast0.DesignatorIndex(lb,exp,rb) -> let lb = normal_mcode lb in let rb = normal_mcode rb in (lb,Ast0.DesignatorIndex(lb,expression exp,rb)) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> let lb = normal_mcode lb in let dots = normal_mcode dots in let rb = normal_mcode rb in (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb)) and initialiser_list prev = dots is_init_dots prev initialiser (* for export *) and initialiser_dots x = dots is_init_dots None initialiser x (* --------------------------------------------------------------------- *) (* Parameter *) and is_param_dots p = match Ast0.unwrap p with Ast0.Pdots(_) | Ast0.Pcircles(_) -> true | _ -> false and parameterTypeDef p = match Ast0.unwrap p with Ast0.VoidParam(ty) -> let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty | Ast0.Param(ty,Some id) -> let id = ident id in let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id | Ast0.Param(ty,None) -> let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty | Ast0.MetaParam(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres p (Ast0.MetaParam(name,a)) ln ln | Ast0.MetaParamList(name,a,b) -> let name = normal_mcode name in let ln = promote_mcode name in mkres p (Ast0.MetaParamList(name,a,b)) ln ln | Ast0.PComma(cm) -> (*let cm = bad_mcode cm in*) (* why was this bad??? *) let cm = normal_mcode cm in let ln = promote_mcode cm in mkres p (Ast0.PComma(cm)) ln ln | Ast0.Pdots(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres p (Ast0.Pdots(dots)) ln ln | Ast0.Pcircles(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres p (Ast0.Pcircles(dots)) ln ln | Ast0.OptParam(param) -> let res = parameterTypeDef param in mkres p (Ast0.OptParam(res)) res res | Ast0.UniqueParam(param) -> let res = parameterTypeDef param in mkres p (Ast0.UniqueParam(res)) res res | Ast0.AsParam _ -> failwith "not possible" and parameter_list prev = dots is_param_dots prev parameterTypeDef (* for export *) let parameter_dots x = dots is_param_dots None parameterTypeDef x (* --------------------------------------------------------------------- *) let is_define_param_dots s = match Ast0.unwrap s with Ast0.DPdots(_) | Ast0.DPcircles(_) -> true | _ -> false let rec define_param p = match Ast0.unwrap p with Ast0.DParam(id) -> let id = ident id in mkres p (Ast0.DParam(id)) id id | Ast0.DPComma(cm) -> (*let cm = bad_mcode cm in*) (* why was this bad??? *) let cm = normal_mcode cm in let ln = promote_mcode cm in mkres p (Ast0.DPComma(cm)) ln ln | Ast0.DPdots(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres p (Ast0.DPdots(dots)) ln ln | Ast0.DPcircles(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres p (Ast0.DPcircles(dots)) ln ln | Ast0.OptDParam(dp) -> let res = define_param dp in mkres p (Ast0.OptDParam(res)) res res | Ast0.UniqueDParam(dp) -> let res = define_param dp in mkres p (Ast0.UniqueDParam(res)) res res let define_parameters x id = match Ast0.unwrap x with Ast0.NoParams -> (x,id) (* no info, should be ignored *) | Ast0.DParams(lp,dp,rp) -> let lp = normal_mcode lp in let dp = dots is_define_param_dots None define_param dp in let rp = normal_mcode rp in let l = promote_mcode lp in let r = promote_mcode rp in (mkres x (Ast0.DParams(lp,dp,rp)) l r, r) (* --------------------------------------------------------------------- *) (* Top-level code *) let is_stm_dots s = match Ast0.unwrap s with Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true | _ -> false let rec statement s = let res = match Ast0.unwrap s with Ast0.Decl((_,bef),decl) -> let decl = declaration decl in let left = promote_to_statement_start decl bef in mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl | Ast0.Seq(lbrace,body,rbrace) -> let lbrace = normal_mcode lbrace in let body = dots is_stm_dots (Some(promote_mcode lbrace)) statement body in let rbrace = normal_mcode rbrace in mkres s (Ast0.Seq(lbrace,body,rbrace)) (promote_mcode lbrace) (promote_mcode rbrace) | Ast0.ExprStatement(Some exp,sem) -> let exp = expression exp in let sem = normal_mcode sem in mkres s (Ast0.ExprStatement(Some exp,sem)) exp (promote_mcode sem) | Ast0.ExprStatement(None,sem) -> let sem = normal_mcode sem in let promoted_sem = promote_mcode sem in mkres s (Ast0.ExprStatement(None,sem)) promoted_sem promoted_sem | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft,adj)) -> let iff = normal_mcode iff in let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in let branch = statement branch in let right = promote_to_statement branch aft in mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft,adj))) (promote_mcode iff) right | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft,adj)) -> let iff = normal_mcode iff in let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in let branch1 = statement branch1 in let els = normal_mcode els in let branch2 = statement branch2 in let right = promote_to_statement branch2 aft in mkres s (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2, (Ast0.get_info right,aft,adj))) (promote_mcode iff) right | Ast0.While(wh,lp,exp,rp,body,(_,aft,adj)) -> let wh = normal_mcode wh in let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft,adj))) (promote_mcode wh) right | Ast0.Do(d,body,wh,lp,exp,rp,sem) -> let d = normal_mcode d in let body = statement body in let wh = normal_mcode wh in let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem)) (promote_mcode d) (promote_mcode sem) | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(_,aft,adj)) -> let fr = normal_mcode fr in let lp = normal_mcode lp in let first = match Ast0.unwrap first with Ast0.ForExp(None,sem1) -> let sem1 = normal_mcode sem1 in mkres first (Ast0.ForExp(None,sem1)) (promote_mcode sem1) (promote_mcode sem1) | Ast0.ForExp(Some exp1,sem1) -> let exp1 = expression exp1 in let sem1 = normal_mcode sem1 in mkres first (Ast0.ForExp(Some exp1,sem1)) exp1 (promote_mcode sem1) | Ast0.ForDecl((_,bef),decl) -> let decl = declaration decl in let left = promote_to_statement_start decl bef in mkres first (Ast0.ForDecl ((Ast0.get_info left,bef),decl)) decl decl in let exp2 = get_option expression exp2 in let sem2 = normal_mcode sem2 in let exp3 = get_option expression exp3 in let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body, (Ast0.get_info right,aft,adj))) (promote_mcode fr) right | Ast0.Iterator(nm,lp,args,rp,body,(_,aft,adj)) -> let nm = ident nm in let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in let rp = normal_mcode rp in let body = statement body in let right = promote_to_statement body aft in mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft,adj))) nm right | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> let switch = normal_mcode switch in let lp = normal_mcode lp in let exp = expression exp in let rp = normal_mcode rp in let lb = normal_mcode lb in let decls = dots is_stm_dots (Some(promote_mcode lb)) statement decls in let cases = dots (function _ -> false) (if Ast0.undots decls = [] then (Some(promote_mcode lb)) else None (* not sure this is right, but not sure the case can arise either *)) case_line cases in let rb = normal_mcode rb in mkres s (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) (promote_mcode switch) (promote_mcode rb) | Ast0.Break(br,sem) -> let br = normal_mcode br in let sem = normal_mcode sem in mkres s (Ast0.Break(br,sem)) (promote_mcode br) (promote_mcode sem) | Ast0.Continue(cont,sem) -> let cont = normal_mcode cont in let sem = normal_mcode sem in mkres s (Ast0.Continue(cont,sem)) (promote_mcode cont) (promote_mcode sem) | Ast0.Label(l,dd) -> let l = ident l in let dd = normal_mcode dd in mkres s (Ast0.Label(l,dd)) l (promote_mcode dd) | Ast0.Goto(goto,id,sem) -> let goto = normal_mcode goto in let id = ident id in let sem = normal_mcode sem in mkres s (Ast0.Goto(goto,id,sem)) (promote_mcode goto) (promote_mcode sem) | Ast0.Return(ret,sem) -> let ret = normal_mcode ret in let sem = normal_mcode sem in mkres s (Ast0.Return(ret,sem)) (promote_mcode ret) (promote_mcode sem) | Ast0.ReturnExpr(ret,exp,sem) -> let ret = normal_mcode ret in let exp = expression exp in let sem = normal_mcode sem in mkres s (Ast0.ReturnExpr(ret,exp,sem)) (promote_mcode ret) (promote_mcode sem) | Ast0.MetaStmt(name,a) -> let ln = promote_mcode name in mkres s (Ast0.MetaStmt(name,a)) ln ln | Ast0.MetaStmtList(name,a) -> let ln = promote_mcode name in mkres s (Ast0.MetaStmtList(name,a)) ln ln | Ast0.Exp(exp) -> let exp = expression exp in mkres s (Ast0.Exp(exp)) exp exp | Ast0.TopExp(exp) -> let exp = expression exp in mkres s (Ast0.TopExp(exp)) exp exp | Ast0.Ty(ty) -> let ty = typeC ty in mkres s (Ast0.Ty(ty)) ty ty | Ast0.TopInit(init) -> let init = initialiser init in mkres s (Ast0.TopInit(init)) init init | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) -> let starter = bad_mcode starter in let mids = List.map bad_mcode mids in let ender = bad_mcode ender in let rec loop prevs = function [] -> [] | stm::stms -> (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs))) statement stm):: (loop (List.tl prevs) stms) in let elems = loop (starter::mids) rule_elem_dots_list in mkmultires s (Ast0.Disj(starter,elems,mids,ender)) (promote_mcode starter) (promote_mcode ender) (get_all_start_info elems) (get_all_end_info elems) | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) -> let starter = bad_mcode starter in let ender = bad_mcode ender in let wrapper f = match Ast0.get_mcode_mcodekind starter with Ast0.MINUS _ -> (* if minus, then all nest code has to be minus. This is checked at the token level, in parse_cocci.ml. All nest code is also unattachable. We strip the minus annotations from the nest code because in the CTL another metavariable will take care of removing all the code matched by the nest. Without stripping the minus annotations, we would get a double transformation. Perhaps there is a more elegant way to do this in the CTL, but it is not easy, because of the interaction with the whencode and the implementation of plus *) in_nest_count := !in_nest_count + 1; let res = f() in in_nest_count := !in_nest_count - 1; res | _ -> f() in let rule_elem_dots = wrapper (function _ -> dots is_stm_dots None statement rule_elem_dots) in mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi)) (promote_mcode starter) (promote_mcode ender) | Ast0.Dots(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres s (Ast0.Dots(dots,whencode)) ln ln | Ast0.Circles(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres s (Ast0.Circles(dots,whencode)) ln ln | Ast0.Stars(dots,whencode) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres s (Ast0.Stars(dots,whencode)) ln ln | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) -> let fninfo = List.map (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x) fninfo in let name = ident name in let lp = normal_mcode lp in let params = parameter_list (Some(promote_mcode lp)) params in let rp = normal_mcode rp in let lbrace = normal_mcode lbrace in let body = dots is_stm_dots (Some(promote_mcode lbrace)) statement body in let rbrace = normal_mcode rbrace in let left = (* cases on what is leftmost *) match fninfo with [] -> promote_to_statement_start name bef | Ast0.FStorage(stg)::_ -> promote_to_statement_start (promote_mcode stg) bef | Ast0.FType(ty)::_ -> promote_to_statement_start ty bef | Ast0.FInline(inline)::_ -> promote_to_statement_start (promote_mcode inline) bef | Ast0.FAttr(attr)::_ -> promote_to_statement_start (promote_mcode attr) bef in (* pretend it is one line before the start of the function, so that it will catch things defined at top level. We assume that these will not be defined on the same line as the function. This is a HACK. A better approach would be to attach top_level things to this node, and other things to the node after, but that would complicate insert_plus, which doesn't distinguish between different mcodekinds *) let res = Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace, body,rbrace) in (* have to do this test again, because of typing problems - can't save the result, only use it *) (match fninfo with [] -> mkres s res name (promote_mcode rbrace) | Ast0.FStorage(stg)::_ -> mkres s res (promote_mcode stg) (promote_mcode rbrace) | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace) | Ast0.FInline(inline)::_ -> mkres s res (promote_mcode inline) (promote_mcode rbrace) | Ast0.FAttr(attr)::_ -> mkres s res (promote_mcode attr) (promote_mcode rbrace)) | Ast0.Include(inc,stm) -> let inc = normal_mcode inc in let stm = normal_mcode stm in mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm) | Ast0.Undef(def,id) -> let def = normal_mcode def in let id = ident id in mkres s (Ast0.Undef(def,id)) (promote_mcode def) id | Ast0.Define(def,id,params,body) -> let def = normal_mcode def in let (id,right) = full_ident id in (match right with None -> failwith "no disj id for #define" | Some right -> let (params,prev) = define_parameters params right in let body = dots is_stm_dots (Some prev) statement body in mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body) | Ast0.Pragma(prg,id,body) -> let prg = normal_mcode prg in let id = ident id in let body = pragmainfo body in mkres s (Ast0.Pragma(prg,id,body)) (promote_mcode prg) body | Ast0.OptStm(stm) -> let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm | Ast0.UniqueStm(stm) -> let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm | Ast0.AsStmt _ -> failwith "not possible" in Ast0.set_dots_bef_aft res (match Ast0.get_dots_bef_aft res with Ast0.NoDots -> Ast0.NoDots | Ast0.AddingBetweenDots s -> Ast0.AddingBetweenDots(statement s) | Ast0.DroppingBetweenDots s -> Ast0.DroppingBetweenDots(statement s)) and pragmainfo pi = match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> let lp = normal_mcode lp in let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in let rp = normal_mcode rp in mkres pi (Ast0.PragmaTuple(lp,args,rp)) (promote_mcode lp) (promote_mcode rp) | Ast0.PragmaIdList(ids) -> (* ids can't be empty, so None is ok *) let ids = dots (function _ -> false) None ident ids in mkres pi (Ast0.PragmaIdList(ids)) ids ids | Ast0.PragmaDots(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres pi (Ast0.PragmaDots(dots)) ln ln and case_line c = match Ast0.unwrap c with Ast0.Default(def,colon,code) -> let def = normal_mcode def in let colon = normal_mcode colon in let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code | Ast0.Case(case,exp,colon,code) -> let case = normal_mcode case in let exp = expression exp in let colon = normal_mcode colon in let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code | Ast0.DisjCase(starter,case_lines,mids,ender) -> do_disj c starter case_lines mids ender case_line (fun starter case_lines mids ender -> Ast0.DisjCase(starter,case_lines,mids,ender)) | Ast0.OptCase(case) -> let case = case_line case in mkres c (Ast0.OptCase(case)) case case and statement_dots x = dots is_stm_dots None statement x (* --------------------------------------------------------------------- *) (* Function declaration *) let top_level t = match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> t | Ast0.NONDECL(stmt) -> let stmt = statement stmt in mkres t (Ast0.NONDECL(stmt)) stmt stmt | Ast0.CODE(rule_elem_dots) -> let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots | Ast0.ERRORWORDS(exps) -> t | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level" (* --------------------------------------------------------------------- *) (* Entry points *) let compute_lines attachable_or x = in_nest_count := 0; inherit_attachable := attachable_or; List.map top_level x let compute_statement_lines attachable_or x = in_nest_count := 0; inherit_attachable := attachable_or; statement x let compute_statement_dots_lines attachable_or x = in_nest_count := 0; inherit_attachable := attachable_or; statement_dots x coccinelle-1.0.0-rc19/parsing_cocci/pretty_print_cocci.ml0000644000175000017500000011264412247442615022433 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_cocci.ml" open Format module Ast = Ast_cocci let print_plus_flag = ref true let print_minus_flag = ref true let print_newlines_disj = ref true let start_block str = force_newline(); print_string " "; open_box 0 let end_block str = close_box(); force_newline () let print_string_box s = print_string s; open_box 0 let print_option = Common.do_option let print_between = Common.print_between (* --------------------------------------------------------------------- *) (* Modified code *) (* avoid polyvariance problems *) let anything : (Ast.anything -> unit) ref = ref (function _ -> ()) let rec print_anything str = function [] -> () | stream -> start_block(); print_between force_newline (function x -> print_string str; open_box 0; print_anything_list x; close_box()) stream; end_block() and print_anything_list = function [] -> () | [x] -> !anything x | bef::((aft::_) as rest) -> !anything bef; let space = (match bef with Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_) | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or (match aft with Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_) | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true | _ -> false) in if space then print_string " "; print_anything_list rest let print_around printer term = function Ast.NOTHING -> printer term | Ast.BEFORE(bef,_) -> print_anything "<<< " bef; printer term | Ast.AFTER(aft,_) -> printer term; print_anything ">>> " aft | Ast.BEFOREAFTER(bef,aft,_) -> print_anything "<<< " bef; printer term; print_anything ">>> " aft let print_string_befaft fn x info = let print = function Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in List.iter (function (s,_,_) -> print s; force_newline()) info.Ast.strbef; fn x; List.iter (function (s,_,_) -> force_newline(); print s) info.Ast.straft let print_meta (r,x) = print_string r; print_string ":"; print_string x let print_pos l = List.iter (function Ast.MetaPos(name,_,_,_,_) -> let name = Ast.unwrap_mcode name in print_string "@"; print_meta name) l let mcode fn = function (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) -> if !print_minus_flag then print_string (if !Flag.sgrep_mode2 then "*" else "-"); fn x; print_pos pos; if !print_plus_flag then (match plus_stream with Ast.NOREPLACEMENT -> () | Ast.REPLACEMENT(plus_stream,_) -> print_anything ">>> " plus_stream) | (x, _, Ast.CONTEXT(_,plus_streams), pos) -> if !print_plus_flag then let fn x = fn x; print_pos pos in print_around fn x plus_streams else (fn x; print_pos pos) | (x, info, Ast.PLUS _, pos) -> let fn x = fn x; print_pos pos in print_string_befaft fn x info let print_mcodekind = function Ast.MINUS(_,_,_,plus_stream) -> print_string "MINUS"; (match plus_stream with Ast.NOREPLACEMENT -> () | Ast.REPLACEMENT(plus_stream,_) -> print_anything ">>> " plus_stream) | Ast.CONTEXT(_,plus_streams) -> print_around (function _ -> print_string "CONTEXT") () plus_streams | Ast.PLUS _ -> print_string "PLUS" (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) let dots between fn d = match Ast.unwrap d with Ast.DOTS(l) -> print_between between fn l | Ast.CIRCLES(l) -> print_between between fn l | Ast.STARS(l) -> print_between between fn l let nest_dots starter ender fn f d = mcode print_string starter; f(); start_block(); (match Ast.unwrap d with Ast.DOTS(l) -> print_between force_newline fn l | Ast.CIRCLES(l) -> print_between force_newline fn l | Ast.STARS(l) -> print_between force_newline fn l); end_block(); mcode print_string ender (* --------------------------------------------------------------------- *) (* Disjunctions *) let print_disj_list fn l = if !print_newlines_disj then (force_newline(); print_string "("; force_newline()) else print_string "("; print_between (function _ -> if !print_newlines_disj then (force_newline(); print_string "|"; force_newline()) else print_string " | ") fn l; if !print_newlines_disj then (force_newline(); print_string ")"; force_newline()) else print_string ")" (* --------------------------------------------------------------------- *) let print_type keep info = function None -> () (* print_string "/* "; print_string "keep:"; print_unitary keep; print_string " inherited:"; print_bool inherited; print_string " */"*) | Some ty -> () (*; print_string "/* "; print_between (function _ -> print_string ", ") Type_cocci.typeC ty;(* print_string "keep:"; print_unitary keep; print_string " inherited:"; print_bool inherited;*) print_string " */"*) (* --------------------------------------------------------------------- *) (* Constraint on Identifier and Function *) (* FIXME: Not called at the moment *) let rec idconstraint = function Ast.IdNoConstraint -> print_string "/* No constraint */" | Ast.IdNegIdSet (str,meta) -> List.iter (function s -> print_string (" "^s)) str; List.iter (function (r,n) -> print_string " "; print_meta(r,n)) meta | Ast.IdRegExpConstraint re -> regconstraint re and regconstraint = function Ast.IdRegExp (re,_) -> print_string "~= \""; print_string re; print_string "\"" | Ast.IdNotRegExp (re,_) -> print_string "~!= \""; print_string re; print_string "\"" (* --------------------------------------------------------------------- *) (* Identifier *) let rec ident i = match Ast.unwrap i with Ast.Id(name) -> mcode print_string name | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name | Ast.AsIdent(id,asid) -> ident id; print_string "@"; ident asid | Ast.DisjId(id_list) -> print_disj_list ident id_list | Ast.OptIdent(id) -> print_string "?"; ident id | Ast.UniqueIdent(id) -> print_string "!"; ident id and print_unitary = function Type_cocci.Unitary -> print_string "unitary" | Type_cocci.Nonunitary -> print_string "nonunitary" | Type_cocci.Saved -> print_string "saved" (* --------------------------------------------------------------------- *) (* Expression *) let rec expression e = match Ast.unwrap e with Ast.Ident(id) -> ident id | Ast.Constant(const) -> mcode constant const | Ast.StringConstant(lq,str,rq) -> mcode print_string lq; dots (function _ -> ()) string_fragment str; mcode print_string rq | Ast.FunCall(fn,lp,args,rp) -> expression fn; mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp | Ast.Assignment(left,op,right,simple) -> expression left; print_string " "; mcode assignOp op; print_string " "; expression right | Ast.Sequence(left,op,right) -> expression left; mcode print_string op; print_string " "; expression right | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> expression exp1; print_string " "; mcode print_string why; print_option (function e -> print_string " "; expression e) exp2; print_string " "; mcode print_string colon; expression exp3 | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op | Ast.Infix(exp,op) -> mcode fixOp op; expression exp | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp | Ast.Binary(left,op,right) -> expression left; print_string " "; mcode binaryOp op; print_string " "; expression right | Ast.Nested(left,op,right) -> expression left; print_string " "; mcode binaryOp op; print_string " "; expression right | Ast.Paren(lp,exp,rp) -> mcode print_string_box lp; expression exp; close_box(); mcode print_string rp | Ast.ArrayAccess(exp1,lb,exp2,rb) -> expression exp1; mcode print_string_box lb; expression exp2; close_box(); mcode print_string rb | Ast.RecordAccess(exp,pt,field) -> expression exp; mcode print_string pt; ident field | Ast.RecordPtAccess(exp,ar,field) -> expression exp; mcode print_string ar; ident field | Ast.Cast(lp,ty,rp,exp) -> mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp; expression exp | Ast.SizeOfExpr(sizeof,exp) -> mcode print_string sizeof; expression exp | Ast.SizeOfType(sizeof,lp,ty,rp) -> mcode print_string sizeof; mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp | Ast.TypeExp(ty) -> fullType ty | Ast.Constructor(lp,ty,rp,init) -> mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp; initialiser init | Ast.MetaErr(name,_,_,_) -> mcode print_meta name | Ast.MetaExpr(name,_,keep,ty,form,inherited) -> mcode print_meta name; print_type keep inherited ty | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name | Ast.AsExpr(exp,asexp) -> expression exp; print_string "@"; expression asexp | Ast.EComma(cm) -> mcode print_string cm; print_space() | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi) -> nest_dots starter ender expression (function _ -> print_string " when != "; expression whencode) expr_dots | Ast.NestExpr(starter,expr_dots,ender,None,multi) -> nest_dots starter ender expression (function _ -> ()) expr_dots | Ast.Edots(dots,Some whencode) | Ast.Ecircles(dots,Some whencode) | Ast.Estars(dots,Some whencode) -> mcode print_string dots; print_string " when != "; expression whencode | Ast.Edots(dots,None) | Ast.Ecircles(dots,None) | Ast.Estars(dots,None) -> mcode print_string dots | Ast.OptExp(exp) -> print_string "?"; expression exp | Ast.UniqueExp(exp) -> print_string "!"; expression exp and string_fragment e = match Ast.unwrap e with Ast.ConstantFragment(str) -> mcode print_string str | Ast.FormatFragment(pct,fmt) -> mcode print_string pct; string_format fmt | Ast.Strdots dots -> mcode print_string dots | Ast.MetaFormatList(pct,name,lenname,_,_) -> mcode print_string pct; mcode print_meta name and string_format e = match Ast.unwrap e with Ast.ConstantFormat(str) -> mcode print_string str | Ast.MetaFormat(name,_,_,_) -> mcode print_meta name and unaryOp = function Ast.GetRef -> print_string "&" | Ast.GetRefLabel -> print_string "&&" | Ast.DeRef -> print_string "*" | Ast.UnPlus -> print_string "+" | Ast.UnMinus -> print_string "-" | Ast.Tilde -> print_string "~" | Ast.Not -> print_string "!" and assignOp = function Ast.SimpleAssign -> print_string "=" | Ast.OpAssign(aop) -> arithOp aop; print_string "=" and fixOp = function Ast.Dec -> print_string "--" | Ast.Inc -> print_string "++" and binaryOp = function Ast.Arith(aop) -> arithOp aop | Ast.Logical(lop) -> logicalOp lop and arithOp = function Ast.Plus -> print_string "+" | Ast.Minus -> print_string "-" | Ast.Mul -> print_string "*" | Ast.Div -> print_string "/" | Ast.Min -> print_string " print_string ">?" | Ast.Mod -> print_string "%" | Ast.DecLeft -> print_string "<<" | Ast.DecRight -> print_string ">>" | Ast.And -> print_string "&" | Ast.Or -> print_string "|" | Ast.Xor -> print_string "^" and logicalOp = function Ast.Inf -> print_string "<" | Ast.Sup -> print_string ">" | Ast.InfEq -> print_string "<=" | Ast.SupEq -> print_string ">=" | Ast.Eq -> print_string "==" | Ast.NotEq -> print_string "!=" | Ast.AndLog -> print_string "&&" | Ast.OrLog -> print_string "||" and constant = function Ast.String(s) -> print_string "\""; print_string s; print_string "\"" | Ast.Char(s) -> print_string "'"; print_string s; print_string "'" | Ast.Int(s) -> print_string s | Ast.Float(s) -> print_string s | Ast.DecimalConst(s,_,_) -> print_string s (* --------------------------------------------------------------------- *) (* Declarations *) and storage = function Ast.Static -> print_string "static " | Ast.Auto -> print_string "auto " | Ast.Register -> print_string "register " | Ast.Extern -> print_string "extern " (* --------------------------------------------------------------------- *) (* Types *) and fullType ft = match Ast.unwrap ft with Ast.Type(_,cv,ty) -> (match Ast.unwrap ty with Ast.Pointer(_,_) -> typeC ty; print_option (function x -> print_string " "; mcode const_vol x) cv | _ -> print_option (function x -> mcode const_vol x; print_string " ") cv; typeC ty) | Ast.AsType(ty,asty) -> fullType ty; print_string "@"; fullType asty | Ast.DisjType(decls) -> print_disj_list fullType decls | Ast.OptType(ty) -> print_string "?"; fullType ty | Ast.UniqueType(ty) -> print_string "!"; fullType ty and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn = fullType ty; mcode print_string lp1; mcode print_string star; fn(); mcode print_string rp1; mcode print_string lp1; parameter_list params; mcode print_string rp2 and print_function_type (ty,lp1,params,rp1) fn = print_option fullType ty; fn(); mcode print_string lp1; parameter_list params; mcode print_string rp1 and print_fninfo = function Ast.FStorage(stg) -> mcode storage stg | Ast.FType(ty) -> fullType ty | Ast.FInline(inline) -> mcode print_string inline; print_string " " | Ast.FAttr(attr) -> mcode print_string attr; print_string " " and typeC ty = match Ast.unwrap ty with Ast.BaseType(ty,strings) -> List.iter (function s -> mcode print_string s; print_string " ") strings | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option typeC ty | Ast.Pointer(ty,star) -> fullType ty; mcode print_string star | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> ()) | Ast.FunctionType (_,ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> ()) | Ast.Array(ty,lb,size,rb) -> fullType ty; mcode print_string lb; print_option expression size; mcode print_string rb | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> mcode print_string dec; mcode print_string lp; expression length; print_option (mcode print_string) comma; print_option expression precision_opt; mcode print_string rp | Ast.EnumName(kind,name) -> mcode print_string kind; print_option (function x -> ident x; print_string " ") name | Ast.EnumDef(ty,lb,ids,rb) -> fullType ty; mcode print_string lb; dots force_newline expression ids; mcode print_string rb | Ast.StructUnionName(kind,name) -> mcode structUnion kind; print_option (function x -> ident x; print_string " ") name | Ast.StructUnionDef(ty,lb,decls,rb) -> fullType ty; mcode print_string lb; dots force_newline declaration decls; mcode print_string rb | Ast.TypeName(name) -> mcode print_string name; print_string " " | Ast.MetaType(name,_,_) -> mcode print_meta name; print_string " " and baseType = function Ast.VoidType -> print_string "void " | Ast.CharType -> print_string "char " | Ast.ShortType -> print_string "short " | Ast.ShortIntType -> print_string "short int " | Ast.IntType -> print_string "int " | Ast.DoubleType -> print_string "double " | Ast.LongDoubleType -> print_string "long double " | Ast.FloatType -> print_string "float " | Ast.LongType -> print_string "long " | Ast.LongIntType -> print_string "long int " | Ast.LongLongType -> print_string "long long " | Ast.LongLongIntType -> print_string "long long int " | Ast.SizeType -> print_string "size_t " | Ast.SSizeType -> print_string "ssize_t " | Ast.PtrDiffType -> print_string "ptrdiff_t " and structUnion = function Ast.Struct -> print_string "struct " | Ast.Union -> print_string "union " and sign = function Ast.Signed -> print_string "signed " | Ast.Unsigned -> print_string "unsigned " and const_vol = function Ast.Const -> print_string "const" | Ast.Volatile -> print_string "volatile" (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and print_named_type ty id = match Ast.unwrap ty with Ast.Type(_,None,ty1) -> (match Ast.unwrap ty1 with Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> print_string " "; ident id) | Ast.FunctionType(_,ty,lp1,params,rp1) -> print_function_type (ty,lp1,params,rp1) (function _ -> print_string " "; ident id) | Ast.Array(ty,lb,size,rb) -> let rec loop ty k = match Ast.unwrap ty with Ast.Array(ty,lb,size,rb) -> (match Ast.unwrap ty with Ast.Type(_,cv,ty) -> print_option (function x -> mcode const_vol x; print_string " ") cv; loop ty (function _ -> k (); mcode print_string lb; print_option expression size; mcode print_string rb) | _ -> failwith "complex array types not supported") | _ -> typeC ty; ident id; k () in loop ty1 (function _ -> ()) | _ -> fullType ty; ident id) | _ -> fullType ty; ident id and declaration d = match Ast.unwrap d with Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) | Ast.MetaFieldList(name,_,_,_) -> mcode print_meta name | Ast.AsDecl(decl,asdecl) -> declaration decl; print_string "@"; declaration asdecl | Ast.Init(stg,ty,id,eq,ini,sem) -> print_option (mcode storage) stg; print_named_type ty id; print_string " "; mcode print_string eq; print_string " "; initialiser ini; mcode print_string sem | Ast.UnInit(stg,ty,id,sem) -> print_option (mcode storage) stg; print_named_type ty id; mcode print_string sem | Ast.MacroDecl(name,lp,args,rp,sem) -> ident name; mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp; mcode print_string sem | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> ident name; mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp; print_string " "; mcode print_string eq; print_string " "; initialiser ini; mcode print_string sem | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem | Ast.Typedef(stg,ty,id,sem) -> mcode print_string stg; print_string " "; fullType ty; typeC id; mcode print_string sem | Ast.DisjDecl(decls) -> print_disj_list declaration decls | Ast.Ddots(dots,Some whencode) -> mcode print_string dots; print_string " when != "; declaration whencode | Ast.Ddots(dots,None) -> mcode print_string dots | Ast.OptDecl(decl) -> print_string "?"; declaration decl | Ast.UniqueDecl(decl) -> print_string "!"; declaration decl (* --------------------------------------------------------------------- *) (* Initialiser *) and initialiser i = match Ast.unwrap i with Ast.MetaInit(name,_,_) -> mcode print_meta name; print_string " " | Ast.MetaInitList(name,_,_,_) -> mcode print_meta name; print_string " " | Ast.AsInit(ini,asini) -> initialiser ini; print_string "@"; initialiser asini | Ast.InitExpr(exp) -> expression exp | Ast.ArInitList(lb,initlist,rb) -> mcode print_string lb; open_box 0; dots force_newline initialiser initlist; close_box(); mcode print_string rb | Ast.StrInitList(allminus,lb,initlist,rb,whencode) -> mcode print_string lb; open_box 0; if not (whencode = []) then (print_string " WHEN != "; print_between (function _ -> print_string " v ") initialiser whencode; force_newline()); List.iter initialiser initlist; close_box(); mcode print_string rb | Ast.InitGccExt(designators,eq,ini) -> List.iter designator designators; print_string " "; mcode print_string eq; print_string " "; initialiser ini | Ast.InitGccName(name,eq,ini) -> ident name; mcode print_string eq; initialiser ini | Ast.IComma(comma) -> mcode print_string comma; force_newline() | Ast.Idots(dots,Some whencode) -> mcode print_string dots; print_string " when != "; initialiser whencode | Ast.Idots(dots,None) -> mcode print_string dots | Ast.OptIni(ini) -> print_string "?"; initialiser ini | Ast.UniqueIni(ini) -> print_string "!"; initialiser ini and designator = function Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id | Ast.DesignatorIndex(lb,exp,rb) -> mcode print_string lb; expression exp; mcode print_string rb | Ast.DesignatorRange(lb,min,dots,max,rb) -> mcode print_string lb; expression min; mcode print_string dots; expression max; mcode print_string rb (* --------------------------------------------------------------------- *) (* Parameter *) and parameterTypeDef p = match Ast.unwrap p with Ast.VoidParam(ty) -> fullType ty | Ast.Param(ty,Some id) -> print_named_type ty id | Ast.Param(ty,None) -> fullType ty | Ast.MetaParam(name,_,_) -> mcode print_meta name | Ast.MetaParamList(name,_,_,_) -> mcode print_meta name | Ast.PComma(cm) -> mcode print_string cm; print_space() | Ast.Pdots(dots) -> mcode print_string dots | Ast.Pcircles(dots) -> mcode print_string dots | Ast.OptParam(param) -> print_string "?"; parameterTypeDef param | Ast.UniqueParam(param) -> print_string "!"; parameterTypeDef param | Ast.AsParam(p,asexp) -> parameterTypeDef p; print_string "@"; expression asexp and parameter_list l = dots (function _ -> ()) parameterTypeDef l (* --------------------------------------------------------------------- *) (* Top-level code *) let rec rule_elem arity re = match Ast.unwrap re with Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) -> mcode (function _ -> ()) ((),Ast.no_info,bef,[]); print_string arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; close_box(); mcode print_string rp; print_string " " | Ast.Decl(bef,allminus,decl) -> mcode (function _ -> ()) ((),Ast.no_info,bef,[]); print_string arity; declaration decl | Ast.SeqStart(brace) -> print_string arity; mcode print_string brace; if !print_newlines_disj then start_block() | Ast.SeqEnd(brace) -> if !print_newlines_disj then end_block(); print_string arity; mcode print_string brace | Ast.ExprStatement(exp,sem) -> print_string arity; print_option expression exp; mcode print_string sem | Ast.IfHeader(iff,lp,exp,rp) -> print_string arity; mcode print_string iff; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " " | Ast.Else(els) -> print_string arity; mcode print_string els; print_string " " | Ast.WhileHeader(whl,lp,exp,rp) -> print_string arity; mcode print_string whl; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " " | Ast.DoHeader(d) -> print_string arity; mcode print_string d; print_string " " | Ast.WhileTail(whl,lp,exp,rp,sem) -> print_string arity; mcode print_string whl; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; mcode print_string sem | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> print_string arity; mcode print_string fr; mcode print_string_box lp; forinfo first; print_option expression e2; mcode print_string sem2; print_option expression e3; close_box(); mcode print_string rp; print_string " " | Ast.IteratorHeader(nm,lp,args,rp) -> print_string arity; ident nm; print_string " "; mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp; print_string " " | Ast.SwitchHeader(switch,lp,exp,rp) -> print_string arity; mcode print_string switch; print_string " "; mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; print_string " " | Ast.Break(br,sem) -> print_string arity; mcode print_string br; mcode print_string sem | Ast.Continue(cont,sem) -> print_string arity; mcode print_string cont; mcode print_string sem | Ast.Label(l,dd) -> ident l; mcode print_string dd | Ast.Goto(goto,l,sem) -> mcode print_string goto; ident l; mcode print_string sem | Ast.Return(ret,sem) -> print_string arity; mcode print_string ret; mcode print_string sem | Ast.ReturnExpr(ret,exp,sem) -> print_string arity; mcode print_string ret; print_string " "; expression exp; mcode print_string sem | Ast.MetaRuleElem(name,_,_) -> print_string arity; mcode print_meta name | Ast.MetaStmt(name,_,_,_) -> print_string arity; mcode print_meta name | Ast.MetaStmtList(name,_,_) -> print_string arity; mcode print_meta name | Ast.Exp(exp) -> print_string arity; expression exp | Ast.TopExp(exp) -> print_string arity; expression exp | Ast.Ty(ty) -> print_string arity; fullType ty | Ast.TopInit(init) -> initialiser init | Ast.Include(inc,s) -> mcode print_string inc; print_string " "; mcode inc_file s | Ast.Undef(def,id) -> mcode print_string def; print_string " "; ident id | Ast.DefineHeader(def,id,params) -> mcode print_string def; print_string " "; ident id; print_define_parameters params | Ast.Pragma(prg,id,body) -> mcode print_string prg; print_string " "; ident id; print_string " "; pragmainfo body | Ast.Default(def,colon) -> mcode print_string def; mcode print_string colon; print_string " " | Ast.Case(case,exp,colon) -> mcode print_string case; print_string " "; expression exp; mcode print_string colon; print_string " " | Ast.DisjRuleElem(res) -> print_string arity; force_newline(); print_string "("; force_newline(); print_between (function _ -> force_newline();print_string "|"; force_newline()) (rule_elem arity) res; force_newline(); print_string ")" and forinfo = function Ast.ForExp(e1,sem1) -> print_option expression e1; mcode print_string sem1 | Ast.ForDecl (bef,allminus,decl) -> mcode (function _ -> ()) ((),Ast.no_info,bef,[]); declaration decl and pragmainfo pi = match Ast.unwrap pi with Ast.PragmaTuple(lp,args,rp) -> mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp | Ast.PragmaIdList(ids) -> dots (function _ -> ()) ident ids | Ast.PragmaDots (dots) -> mcode print_string dots and print_define_parameters params = match Ast.unwrap params with Ast.NoParams -> () | Ast.DParams(lp,params,rp) -> mcode print_string lp; dots (function _ -> ()) print_define_param params; mcode print_string rp and print_define_param param = match Ast.unwrap param with Ast.DParam(id) -> ident id | Ast.DPComma(comma) -> mcode print_string comma | Ast.DPdots(dots) -> mcode print_string dots | Ast.DPcircles(circles) -> mcode print_string circles | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp and statement arity s = match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> rule_elem arity lbrace; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.IfThen(header,branch,(_,_,_,aft)) -> rule_elem arity header; statement arity branch; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) -> rule_elem arity header; statement arity branch1; print_string " "; rule_elem arity els; statement arity branch2; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.While(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Do(header,body,tail) -> rule_elem arity header; statement arity body; rule_elem arity tail | Ast.For(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Iterator(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Switch(header,lb,decls,cases,rb) -> rule_elem arity header; rule_elem arity lb; dots force_newline (statement arity) decls; List.iter (function x -> case_line arity x; force_newline()) cases; rule_elem arity rb | Ast.Atomic(re) -> rule_elem arity re | Ast.FunDecl(header,lbrace,body,rbrace) -> rule_elem arity header; rule_elem arity lbrace; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.Disj([stmt_dots]) -> print_string arity; dots (function _ -> if !print_newlines_disj then force_newline()) (statement arity) stmt_dots | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *) print_string arity; force_newline(); print_string "("; force_newline(); print_between (function _ -> force_newline();print_string "|"; force_newline()) (dots force_newline (statement arity)) stmt_dots_list; force_newline(); print_string ")" | Ast.Define(header,body) -> rule_elem arity header; print_string " "; dots force_newline (statement arity) body | Ast.AsStmt(stm,asstm) -> statement arity stm; print_string "@"; statement arity asstm | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) -> print_string arity; nest_dots starter ender (statement arity) (function _ -> open_box 0; print_between force_newline (whencode (dots force_newline (statement "")) (statement "")) whn; close_box(); force_newline()) stmt_dots | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> print_string arity; mcode print_string d; open_box 0; print_between force_newline (whencode (dots force_newline (statement "")) (statement "")) whn; close_box(); force_newline() | Ast.OptStm(s) -> statement "?" s | Ast.UniqueStm(s) -> statement "!" s and print_statement_when whencode = print_string " WHEN != "; open_box 0; print_between (function _ -> print_string " &"; force_newline()) (dots force_newline (statement "")) whencode; close_box() and whencode notfn alwaysfn = function Ast.WhenNot a -> print_string " WHEN != "; open_box 0; notfn a; close_box() | Ast.WhenAlways a -> print_string " WHEN = "; open_box 0; alwaysfn a; close_box() | Ast.WhenModifier x -> print_string " WHEN "; print_when_modif x | Ast.WhenNotTrue a -> print_string " WHEN != TRUE "; open_box 0; rule_elem "" a; close_box() | Ast.WhenNotFalse a -> print_string " WHEN != FALSE "; open_box 0; rule_elem "" a; close_box() and print_when_modif = function | Ast.WhenAny -> print_string "ANY" | Ast.WhenStrict -> print_string "STRICT" | Ast.WhenForall -> print_string "FORALL" | Ast.WhenExists -> print_string "EXISTS" and case_line arity c = match Ast.unwrap c with Ast.CaseLine(header,code) -> rule_elem arity header; print_string " "; dots force_newline (statement arity) code | Ast.OptCase(case) -> case_line "?" case (* --------------------------------------------------------------------- *) (* CPP code *) and inc_file = function Ast.Local(elems) -> print_string "\""; print_between (function _ -> print_string "/") inc_elem elems; print_string "\"" | Ast.NonLocal(elems) -> print_string "<"; print_between (function _ -> print_string "/") inc_elem elems; print_string ">" and inc_elem = function Ast.IncPath s -> print_string s | Ast.IncDots -> print_string "..." (* for export only *) let statement_dots l = dots force_newline (statement "") l let top_level t = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> print_string "--- "; mcode print_string old_file; force_newline(); print_string "+++ "; mcode print_string new_file | Ast.NONDECL(stmt) -> statement "" stmt | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots | Ast.ERRORWORDS(exps) -> print_string "error words = ["; print_between (function _ -> print_string ", ") expression exps; print_string "]" let rule = print_between (function _ -> force_newline(); force_newline()) top_level let pp_print_anything x = !anything x let _ = anything := function Ast.FullTypeTag(x) -> fullType x | Ast.BaseTypeTag(x) -> baseType x | Ast.StructUnionTag(x) -> structUnion x | Ast.SignTag(x) -> sign x | Ast.IdentTag(x) -> ident x | Ast.ExpressionTag(x) -> expression x | Ast.ConstantTag(x) -> constant x | Ast.UnaryOpTag(x) -> unaryOp x | Ast.AssignOpTag(x) -> assignOp x | Ast.FixOpTag(x) -> fixOp x | Ast.BinaryOpTag(x) -> binaryOp x | Ast.ArithOpTag(x) -> arithOp x | Ast.LogicalOpTag(x) -> logicalOp x | Ast.InitTag(x) -> initialiser x | Ast.DeclarationTag(x) -> declaration x | Ast.StorageTag(x) -> storage x | Ast.IncFileTag(x) -> inc_file x | Ast.Rule_elemTag(x) -> rule_elem "" x | Ast.StatementTag(x) -> statement "" x | Ast.ForInfoTag(x) -> forinfo x | Ast.CaseLineTag(x) -> case_line "" x | Ast.ConstVolTag(x) -> const_vol x | Ast.Token(x,Some info) -> print_string_befaft print_string x info | Ast.Token(x,None) -> print_string x | Ast.Directive(xs) -> let print = function Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in print_between force_newline print xs | Ast.Code(x) -> let _ = top_level x in () | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x | Ast.ParamDotsTag(x) -> parameter_list x | Ast.StmtDotsTag(x) -> dots (function _ -> ()) (statement "") x | Ast.DeclDotsTag(x) -> dots (function _ -> ()) declaration x | Ast.TypeCTag(x) -> typeC x | Ast.ParamTag(x) -> parameterTypeDef x | Ast.SgrepStartTag(x) -> print_string x | Ast.SgrepEndTag(x) -> print_string x let rec dep in_and = function Ast.Dep(s) -> print_string s | Ast.AntiDep(s) -> print_string "!"; print_string s | Ast.EverDep(s) -> print_string "ever "; print_string s | Ast.NeverDep(s) -> print_string "never "; print_string s | Ast.AndDep(s1,s2) -> let print_and _ = dep true s1; print_string " && "; dep true s2 in if in_and then print_and () else (print_string "("; print_and(); print_string ")") | Ast.OrDep(s1,s2) -> let print_or _ = dep false s1; print_string " || "; dep false s2 in if not in_and then print_or () else (print_string "("; print_or(); print_string ")") | Ast.NoDep -> print_string "no_dep" | Ast.FailDep -> print_string "fail_dep" let script_header str lang deps code = print_string "@@"; force_newline(); print_string (str ^ ":" ^ lang); (match deps with Ast.NoDep -> () | _ -> print_string " depends on "; dep true deps); force_newline(); print_string "@@"; force_newline(); let code = String.concat "\n" (Str.split (Str.regexp "[\n\r\011\012]#.*[\n\r\011\012]") code) in print_string code; force_newline() let unparse z = match z with Ast.InitialScriptRule (name,lang,deps,code) -> script_header "initialize" lang deps code | Ast.FinalScriptRule (name,lang,deps,code) -> script_header "finalize" lang deps code | Ast.ScriptRule (name,lang,deps,bindings,script_vars,code) -> script_header "script" lang deps code | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) -> print_string "@@"; force_newline(); print_string nm; (match deps with Ast.NoDep -> () | _ -> print_string " depends on "; dep true deps); (* print_string "line "; print_int (Ast.get_line (List.hd x)); *) force_newline(); print_string "@@"; print_newlines_disj := true; force_newline(); force_newline(); rule x; force_newline() let rule_elem_to_string x = print_newlines_disj := true; Common.format_to_string (function _ -> rule_elem "" x) let ident_to_string x = print_newlines_disj := true; Common.format_to_string (function _ -> ident x) let unparse_to_string x = print_newlines_disj := true; Common.format_to_string (function _ -> unparse x) let print_rule_elem re = let nl = !print_newlines_disj in print_newlines_disj := false; rule_elem "" re; print_newlines_disj := nl coccinelle-1.0.0-rc19/parsing_cocci/single_statement.ml0000644000175000017500000006333612247442616022101 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./single_statement.ml" (* detect statements that are between dots in the minus code, because they may need a special treatment if they are if branches *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Helpers *) let left_dots f l = match Ast0.undots l with [] -> false | x::xs -> f x let right_dots f l = match List.rev (Ast0.undots l) with [] -> false | x::xs -> f x let modif_before_mcode mc = match Ast0.get_mcode_mcodekind mc with Ast0.MINUS mc -> true (*conservative; don't want to hunt right for + code*) | Ast0.PLUS _ -> failwith "not possible" | Ast0.CONTEXT mc -> (match !mc with (Ast.BEFORE _,_,_) -> true | (Ast.BEFOREAFTER _,_,_) -> true | _ -> false) | Ast0.MIXED mc -> true (* don't think mcode can be mixed *) let modif_after_mcodekind = function Ast0.MINUS mc -> true (*conservative; don't want to hunt right for + code*) | Ast0.PLUS _ -> failwith "not possible" | Ast0.CONTEXT mc -> (match !mc with (Ast.AFTER _,_,_) -> true | (Ast.BEFOREAFTER _,_,_) -> true | _ -> false) | Ast0.MIXED mc -> true (* don't think mcode can be mixed *) let modif_after_mcode mc = modif_after_mcodekind (Ast0.get_mcode_mcodekind mc) let any_statements = List.exists (List.exists (function Ast.StatementTag(_) | Ast.StmtDotsTag(_) | Ast.DeclarationTag(_) | Ast.DeclDotsTag(_) -> true | _ -> false)) let modif_before x = match Ast0.get_mcodekind x with Ast0.PLUS _ -> failwith "not possible" | Ast0.MINUS mc -> (match !mc with (* do better for the common case of replacing a stmt by another one *) ((Ast.REPLACEMENT([[Ast.StatementTag(s)]],c)) as old,ti) -> (match Ast.unwrap s with Ast.IfThen(_,_,_) -> true (* potentially dangerous *) | _ -> mc := (old,ti); false) | (_,_) -> true) | Ast0.CONTEXT mc | Ast0.MIXED mc -> (match !mc with (Ast.BEFORE _,_,_) -> true | (Ast.BEFOREAFTER _,_,_) -> true | _ -> false) let modif_after x = match Ast0.get_mcodekind x with Ast0.PLUS _ -> failwith "not possible" | Ast0.MINUS mc -> (match !mc with (* do better for the common case of replacing a stmt by another one *) ((Ast.REPLACEMENT([[Ast.StatementTag(s)]],count)) as old,ti) -> (match Ast.unwrap s with Ast.IfThen(_,_,_) -> true (* potentially dangerous *) | _ -> mc := (old,ti); false) | (Ast.REPLACEMENT(l,_),_) when any_statements l -> true | (l,ti) -> mc := (l,ti); false) | Ast0.CONTEXT mc | Ast0.MIXED mc -> (match !mc with (Ast.AFTER _,_,_) -> true | (Ast.BEFOREAFTER _,_,_) -> true | _ -> false) (* Identifier *) let rec left_ident i = modif_before i or match Ast0.unwrap i with Ast0.Id(name) -> modif_before_mcode name | Ast0.MetaId(name,_,_,_) -> modif_before_mcode name | Ast0.MetaFunc(name,_,_) -> modif_before_mcode name | Ast0.MetaLocalFunc(name,_,_) -> modif_before_mcode name | Ast0.DisjId(_,id_list,_,_) -> List.exists left_ident id_list | Ast0.OptIdent(id) -> left_ident id | Ast0.UniqueIdent(id) -> left_ident id | Ast0.AsIdent _ -> failwith "not possible" let rec right_ident i = modif_after i or match Ast0.unwrap i with Ast0.Id(name) -> modif_after_mcode name | Ast0.MetaId(name,_,_,_) -> modif_after_mcode name | Ast0.MetaFunc(name,_,_) -> modif_after_mcode name | Ast0.MetaLocalFunc(name,_,_) -> modif_after_mcode name | Ast0.DisjId(_,id_list,_,_) -> List.exists right_ident id_list | Ast0.OptIdent(id) -> right_ident id | Ast0.UniqueIdent(id) -> right_ident id | Ast0.AsIdent _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Expression *) let rec left_expression e = modif_before e or match Ast0.unwrap e with Ast0.Ident(id) -> left_ident id | Ast0.Constant(const) -> modif_before_mcode const | Ast0.StringConstant(lq,str,rq) -> modif_before_mcode lq | Ast0.FunCall(fn,lp,args,rp) -> left_expression fn | Ast0.Assignment(left,op,right,_) -> left_expression left | Ast0.Sequence(left,op,right) -> left_expression left | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> left_expression exp1 | Ast0.Postfix(exp,op) -> left_expression exp | Ast0.Infix(exp,op) -> modif_before_mcode op | Ast0.Unary(exp,op) -> modif_before_mcode op | Ast0.Binary(left,op,right) -> left_expression left | Ast0.Nested(left,op,right) -> left_expression left | Ast0.Paren(lp,exp,rp) -> modif_before_mcode lp | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> left_expression exp1 | Ast0.RecordAccess(exp,pt,field) -> left_expression exp | Ast0.RecordPtAccess(exp,ar,field) -> left_expression exp | Ast0.Cast(lp,ty,rp,exp) -> modif_before_mcode lp | Ast0.SizeOfExpr(szf,exp) -> modif_before_mcode szf | Ast0.SizeOfType(szf,lp,ty,rp) -> modif_before_mcode szf | Ast0.TypeExp(ty) -> left_typeC ty | Ast0.Constructor(lp,ty,rp,init) -> modif_before_mcode lp | Ast0.MetaErr(name,_,_) -> modif_before_mcode name | Ast0.MetaExpr(name,_,ty,_,_) -> modif_before_mcode name | Ast0.MetaExprList(name,_,_) -> modif_before_mcode name | Ast0.EComma(cm) -> modif_before_mcode cm | Ast0.DisjExpr(_,exp_list,_,_) -> List.exists left_expression exp_list | Ast0.NestExpr(starter,expr_dots,ender,_,multi) -> left_dots left_expression expr_dots | Ast0.Edots(dots,_) | Ast0.Ecircles(dots,_) | Ast0.Estars(dots,_) -> false | Ast0.OptExp(exp) -> left_expression exp | Ast0.UniqueExp(exp) -> left_expression exp | Ast0.AsExpr _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Types *) and left_typeC t = modif_before t or match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> modif_before_mcode cv | Ast0.BaseType(ty,strings) -> modif_before_mcode (List.hd strings) | Ast0.Signed(sgn,ty) -> modif_before_mcode sgn | Ast0.Pointer(ty,star) -> left_typeC ty | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> left_typeC ty | Ast0.FunctionType(Some ty,lp1,params,rp1) -> left_typeC ty | Ast0.FunctionType(None,lp1,params,rp1) -> modif_before_mcode lp1 | Ast0.Array(ty,lb,size,rb) -> left_typeC ty | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> modif_before_mcode dec | Ast0.EnumName(kind,name) -> modif_before_mcode kind | Ast0.EnumDef(ty,lb,ids,rb) -> left_typeC ty | Ast0.StructUnionName(kind,name) -> modif_before_mcode kind | Ast0.StructUnionDef(ty,lb,decls,rb) -> left_typeC ty | Ast0.TypeName(name) -> modif_before_mcode name | Ast0.MetaType(name,_) -> modif_before_mcode name | Ast0.DisjType(lp,types,mids,rp) -> List.exists left_typeC types | Ast0.OptType(ty) -> left_typeC ty | Ast0.UniqueType(ty) -> left_typeC ty | Ast0.AsType _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and left_declaration d = modif_before d or match Ast0.unwrap d with Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) | Ast0.MetaFieldList(name,_,_) -> modif_before_mcode name | Ast0.Init(Some stg,ty,id,eq,ini,sem) -> modif_before_mcode stg | Ast0.Init(None,ty,id,eq,ini,sem) -> left_typeC ty | Ast0.UnInit(Some stg,ty,id,sem) -> modif_before_mcode stg | Ast0.UnInit(None,ty,id,sem) -> left_typeC ty | Ast0.MacroDecl(name,lp,args,rp,sem) -> left_ident name | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> left_ident name | Ast0.TyDecl(ty,sem) -> left_typeC ty | Ast0.Typedef(stg,ty,id,sem) -> modif_before_mcode stg | Ast0.DisjDecl(_,decls,_,_) -> List.exists left_declaration decls | Ast0.Ddots(dots,_) -> false | Ast0.OptDecl(decl) -> left_declaration decl | Ast0.UniqueDecl(decl) -> left_declaration decl | Ast0.AsDecl _ -> failwith "not possible" and right_declaration d = modif_before d or match Ast0.unwrap d with Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) | Ast0.MetaFieldList(name,_,_) -> modif_before_mcode name | Ast0.Init(_,ty,id,eq,ini,sem) -> modif_after_mcode sem | Ast0.UnInit(_,ty,id,sem) -> modif_after_mcode sem | Ast0.MacroDecl(name,lp,args,rp,sem) -> modif_after_mcode sem | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> modif_after_mcode sem | Ast0.TyDecl(ty,sem) -> modif_after_mcode sem | Ast0.Typedef(stg,ty,id,sem) -> modif_after_mcode sem | Ast0.DisjDecl(_,decls,_,_) -> List.exists right_declaration decls | Ast0.Ddots(dots,_) -> false | Ast0.OptDecl(decl) -> right_declaration decl | Ast0.UniqueDecl(decl) -> right_declaration decl | Ast0.AsDecl _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Top-level code *) (* These functions seem to be never used and left_statement s = modif_before s or match Ast0.unwrap s with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (* irrelevant *) false | Ast0.Decl(_,decl) -> left_declaration decl | Ast0.Seq(lbrace,body,rbrace) -> modif_before_mcode lbrace | Ast0.ExprStatement(Some exp,sem) -> left_expression exp | Ast0.ExprStatement(None,sem) -> modif_before_mcode sem | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> modif_before_mcode iff | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> modif_before_mcode iff | Ast0.While(whl,lp,exp,rp,body,aft) -> modif_before_mcode whl | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> modif_before_mcode d | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> modif_before_mcode fr | Ast0.Iterator(nm,lp,args,rp,body,aft) -> left_ident nm | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> modif_before_mcode switch | Ast0.Break(br,sem) -> modif_before_mcode br | Ast0.Continue(cont,sem) -> modif_before_mcode cont | Ast0.Label(l,dd) -> left_ident l | Ast0.Goto(goto,l,sem) -> modif_before_mcode goto | Ast0.Return(ret,sem) -> modif_before_mcode ret | Ast0.ReturnExpr(ret,exp,sem) -> modif_before_mcode ret | Ast0.MetaStmt(name,pure) -> modif_before_mcode name | Ast0.MetaStmtList(name,_) -> modif_before_mcode name | Ast0.Disj(_,statement_dots_list,_,_) -> List.exists (left_dots left_statement) statement_dots_list | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> left_dots left_statement stmt_dots | Ast0.Exp(exp) -> false (* can only be replaced by an expression *) | Ast0.TopExp(exp) -> false (* as above *) | Ast0.Ty(ty) -> false (* can only be replaced by a type *) | Ast0.TopInit(init) -> false (* can only be replaced by an init *) | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> false | Ast0.Include(inc,s) -> modif_before_mcode inc | Ast0.Undef(def,id) -> modif_before_mcode def | Ast0.Define(def,id,params,body) -> modif_before_mcode def | Ast0.Pragma(prg,id,body) -> modif_before_mcode prg | Ast0.OptStm(re) -> left_statement re | Ast0.UniqueStm(re) -> left_statement re | Ast0.AsStmt _ -> failwith "not possible" and right_statement s = modif_after s or match Ast0.unwrap s with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (* irrelevant *) false | Ast0.Decl(_,decl) -> right_declaration decl | Ast0.Seq(lbrace,body,rbrace) -> modif_after_mcode rbrace | Ast0.ExprStatement(exp,sem) -> modif_after_mcode sem | Ast0.IfThen(iff,lp,exp,rp,branch1,(_,aft,_)) -> modif_after_mcodekind aft | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft,_)) -> modif_after_mcodekind aft | Ast0.While(whl,lp,exp,rp,body,(_,aft,_)) -> modif_after_mcodekind aft | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> modif_after_mcode sem | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,(_,aft,_)) -> modif_after_mcodekind aft | Ast0.Iterator(nm,lp,args,rp,body,(_,aft,_)) -> modif_after_mcodekind aft | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> modif_after_mcode rb | Ast0.Break(br,sem) -> modif_after_mcode sem | Ast0.Continue(cont,sem) -> modif_after_mcode sem | Ast0.Label(l,dd) -> modif_after_mcode dd | Ast0.Goto(goto,l,sem) -> modif_after_mcode sem | Ast0.Return(ret,sem) -> modif_after_mcode sem | Ast0.ReturnExpr(ret,exp,sem) -> modif_after_mcode sem | Ast0.MetaStmt(name,pure) -> modif_after_mcode name | Ast0.MetaStmtList(name,_) -> modif_after_mcode name | Ast0.Disj(_,statement_dots_list,_,_) -> List.exists (right_dots right_statement) statement_dots_list | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> right_dots right_statement stmt_dots | Ast0.Exp(exp) -> false (* can only be replaced by an expression *) | Ast0.TopExp(exp) -> false (* as above *) | Ast0.Ty(ty) -> false (* can only be replaced by a type *) | Ast0.TopInit(init) -> false (* can only be replaced by an init *) | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> false | Ast0.Include(inc,s) -> modif_after_mcode s | Ast0.Undef(def,id) -> right_ident id | Ast0.Define(def,id,params,body) -> right_dots right_statement body | Ast0.Pragma(prg,id,body) -> right_pragma body -- not defined, b/c not used | Ast0.OptStm(re) -> right_statement re | Ast0.UniqueStm(re) -> right_statement re | Ast0.AsStmt _ -> failwith "not possible" *) (* --------------------------------------------------------------------- *) (* A very coarse approximation. We would really only like to return true if a new statement is added. For this it would be best to correlate with the plus slice. Or at least be sure that the new stuff is on the far left or far right. *) let rec adding_something s = match Ast0.get_mcodekind s with Ast0.MINUS(mc) -> (match !mc with (* do better for the common case of replacing a stmt by another one *) ((Ast.REPLACEMENT([[Ast.StatementTag(s)]],c)) as old,ti) -> (match Ast.unwrap s with Ast.IfThen(_,_,_) -> true (* potentially dangerous *) | _ -> mc := (old,ti); false) | (_,_) -> true) | Ast0.CONTEXT(mc) -> let (text,tinfo1,tinfo2) = !mc in (match text with Ast.NOTHING -> false | _ -> true) | Ast0.MIXED(_) -> not(contains_only_minus.VT0.combiner_rec_statement s) (*&& (left_statement s) or (right_statement s)*) | _ -> failwith "unexpected plus code" (* why do we need this; MINUS should mean the same thing *) and contains_only_minus = let bind x y = x && y in let option_default = true in let mcodekind = function Ast0.MINUS(mc) -> (match !mc with (Ast.NOREPLACEMENT,_) -> true | _ -> false) | Ast0.CONTEXT(mc) -> false | _ -> false in let mcode (_,_,_,mc,_,_) = mcodekind mc in let donothing r k e = mcodekind (Ast0.get_mcodekind e) && k e in let dots r k e = match Ast0.unwrap e with Ast0.DOTS([]) | Ast0.CIRCLES([]) | Ast0.STARS([]) -> true | _ -> k e in let identifier r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.DisjId(starter,id_list,mids,ender) -> List.for_all r.VT0.combiner_rec_ident id_list | _ -> k e in let expression r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.DisjExpr(starter,expr_list,mids,ender) -> List.for_all r.VT0.combiner_rec_expression expr_list | _ -> k e in let declaration r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.DisjDecl(starter,decls,mids,ender) -> List.for_all r.VT0.combiner_rec_declaration decls | _ -> k e in let typeC r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.DisjType(starter,types,mids,ender) -> List.for_all r.VT0.combiner_rec_typeC types | _ -> k e in let statement r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.Disj(starter,statement_dots_list,mids,ender) -> List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list | _ -> k e in let case_line r k e = mcodekind (Ast0.get_mcodekind e) && match Ast0.unwrap e with Ast0.DisjCase(starter,case_list,mids,ender) -> List.for_all r.VT0.combiner_rec_case_line case_list | _ -> k e in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode dots dots dots dots dots dots identifier expression typeC donothing donothing declaration statement donothing case_line donothing (* needs a special case when there is a Disj or an empty DOTS *) (* ---------------------------------------------------------------------- *) (* Doesn't really work: if (acpi_device_dir(device)) + { remove_proc_entry(acpi_device_bid(device), acpi_ac_dir); + acpi_device_dir(device) = NULL; + } The last two + lines get associated with the end of the if, not with the branch, so the braces get added in oddly. *) let add_braces orig_s = let s = (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement orig_s in let new_mcodekind = let add_times = Ast.ONE in match Ast0.get_mcodekind s with Ast0.MINUS(mc) -> let (text,tinfo) = !mc in let inner_text = match text with Ast.NOREPLACEMENT -> [[Ast.mkToken "{}"]] | Ast.REPLACEMENT(anythings,Ast.ONE) -> [Ast.mkToken "{"]::anythings@[[Ast.mkToken "}"]] | Ast.REPLACEMENT(anythings,Ast.MANY) -> failwith "++ not supported when braces must be added" in Ast0.MINUS(ref(Ast.REPLACEMENT(inner_text,Ast.ONE),tinfo)) | Ast0.CONTEXT(mc) -> let (text,tinfo1,tinfo2) = !mc in let new_text = (* this is going to be a mess if we allow it to be iterable... there would be one level of braces for every added things. need to come up with something better, or just add {} in the source code. *) match text with Ast.BEFORE(bef,_) -> Ast.BEFOREAFTER([Ast.mkToken "{"]::bef,[[Ast.mkToken "}"]], add_times) | Ast.AFTER(aft,_) -> Ast.BEFOREAFTER([[Ast.mkToken "{"]],aft@[[Ast.mkToken "}"]], add_times) | Ast.BEFOREAFTER(bef,aft,_) -> Ast.BEFOREAFTER([Ast.mkToken "{"]::bef,aft@[[Ast.mkToken "}"]], add_times) | Ast.NOTHING -> Ast.BEFOREAFTER([[Ast.mkToken "{"]],[[Ast.mkToken "}"]], add_times) in Ast0.CONTEXT(ref(new_text,tinfo1,tinfo2)) | Ast0.MIXED(mc) -> let (text,tinfo1,tinfo2) = !mc in let new_text = match text with Ast.BEFORE(bef,_) -> Ast.BEFOREAFTER([Ast.mkToken "{"]::bef,[[Ast.mkToken "}"]], add_times) | Ast.AFTER(aft,_) -> Ast.BEFOREAFTER([[Ast.mkToken "{"]],aft@[[Ast.mkToken "}"]], add_times) | Ast.BEFOREAFTER(bef,aft,_) -> Ast.BEFOREAFTER([Ast.mkToken "{"]::bef,aft@[[Ast.mkToken "}"]], add_times) | Ast.NOTHING -> Ast.BEFOREAFTER([[Ast.mkToken "{"]],[[Ast.mkToken "}"]], add_times) in Ast0.MIXED(ref(new_text,tinfo1,tinfo2)) | _ -> failwith "unexpected plus code" in Ast0.set_mcodekind s new_mcodekind; Compute_lines.compute_statement_lines true s (* ---------------------------------------------------------------------- *) let is_dots x = match Ast0.unwrap x with Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) | Ast0.Nest(_,_,_,_,_) -> true | _ -> false let all_minus s = match Ast0.get_mcodekind s with Ast0.MINUS(_) -> true | _ -> false let rec unchanged_minus s = match Ast0.get_mcodekind s with Ast0.MINUS(mc) -> (match !mc with (Ast.NOREPLACEMENT,_) -> true | _ -> false) | _ -> false let rec do_branch s = if unchanged_minus s then Ast0.set_dots_bef_aft s (Ast0.DroppingBetweenDots(add_braces s)) else match Ast0.unwrap s with Ast0.Disj(starter,statement_dots_list,mids,ender) -> let stmts = List.map (function s -> match Ast0.unwrap s with Ast0.DOTS([s]) -> Ast0.rewrap s (Ast0.DOTS([do_branch s])) | Ast0.DOTS(_) -> s | _ -> failwith "not supported") statement_dots_list in Ast0.rewrap s (Ast0.Disj(starter,stmts,mids,ender)) | _ -> s let rec statement dots_before dots_after s = let do_one s = if dots_before && dots_after then if unchanged_minus s then (let with_braces = add_braces s in Ast0.set_dots_bef_aft s (Ast0.DroppingBetweenDots(with_braces))) else if adding_something s then let with_braces = add_braces s in Ast0.set_dots_bef_aft s (Ast0.AddingBetweenDots(with_braces)) else s else s in match Ast0.unwrap s with Ast0.FunDecl(x,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (* true for close brace, because that represents any way we can exit the function, which is not necessarily followed by an explicit close brace. *) Ast0.rewrap s (Ast0.FunDecl(x,fninfo,name,lp,params,rp,lbrace, statement_dots false true body, rbrace)) | Ast0.Decl(_,_) -> s | Ast0.Seq(lbrace,body,rbrace) -> Ast0.rewrap s (Ast0.Seq(lbrace,statement_dots false false body,rbrace)) | Ast0.ExprStatement(exp,sem) -> do_one s | Ast0.IfThen(iff,lp,exp,rp,branch1,x) -> do_one (Ast0.rewrap s (Ast0.IfThen(iff,lp,exp,rp,statement false false branch1,x))) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,x) -> do_one (Ast0.rewrap s (Ast0.IfThenElse (iff,lp,exp,rp, statement false false branch1,els, statement false false branch2,x))) | Ast0.While(whl,lp,exp,rp,body,x) -> do_one (Ast0.rewrap s (Ast0.While(whl,lp,exp,rp,statement false false body,x))) | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> do_one (Ast0.rewrap s (Ast0.Do(d,statement false false body,whl,lp,exp,rp,sem))) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,x) -> do_one (Ast0.rewrap s (Ast0.For(fr,lp,first,e2,sem2,e3,rp, statement false false body,x))) | Ast0.Iterator(nm,lp,args,rp,body,x) -> do_one (Ast0.rewrap s (Ast0.Iterator(nm,lp,args,rp,statement false false body,x))) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> do_one (Ast0.rewrap s (Ast0.Switch(switch,lp,exp,rp,lb,decls, Ast0.rewrap cases (Ast0.DOTS (List.map case_line (Ast0.undots cases))), rb))) | Ast0.Break(br,sem) -> do_one s | Ast0.Continue(cont,sem) -> do_one s | Ast0.Label(l,dd) -> do_one s | Ast0.Goto(goto,l,sem) -> do_one s | Ast0.Return(ret,sem) -> do_one s | Ast0.ReturnExpr(ret,exp,sem) -> do_one s | Ast0.MetaStmt(name,_) -> do_one s | Ast0.MetaStmtList(name,_) -> do_one s | Ast0.Disj(starter,statement_dots_list,mids,ender) -> Ast0.rewrap s (Ast0.Disj(starter, List.map (statement_dots dots_before dots_after) statement_dots_list, mids,ender)) | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> (match Ast0.get_mcode_mcodekind starter with Ast0.MINUS _ -> (* everything removed, like -... *) s | _ -> Ast0.rewrap s (Ast0.Nest (starter,statement_dots true true stmt_dots,ender, whencode,multi))) | Ast0.Exp(exp) -> s | Ast0.TopExp(exp) -> s | Ast0.Ty(ty) -> s | Ast0.TopInit(init) -> s | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> s | Ast0.Include(inc,string) -> s (* doesn't affect the need for braces *) | Ast0.Undef(def,id) -> s (* same as include *) | Ast0.Define(def,id,params,body) -> s (* same as include *) | Ast0.Pragma(prg,id,body) -> s (* same as include *) | Ast0.OptStm(re) -> Ast0.rewrap s (Ast0.OptStm(statement dots_before dots_after re)) | Ast0.UniqueStm(re) -> Ast0.rewrap s (Ast0.UniqueStm(statement dots_before dots_after re)) | Ast0.AsStmt _ -> failwith "not possible" and case_line c = Ast0.rewrap c (match Ast0.unwrap c with Ast0.Default(def,colon,code) -> Ast0.Default(def,colon,statement_dots false false code) | Ast0.Case(case,exp,colon,code) -> Ast0.Case(case,exp,colon,statement_dots false false code) | Ast0.DisjCase(starter,case_lines,mids,ender) -> Ast0.DisjCase(starter,List.map case_line case_lines,mids,ender) | Ast0.OptCase(case) -> Ast0.OptCase(case_line c)) and do_statement_dots dots_before dots_after = function [] -> [] | [x] -> [statement dots_before dots_after x] | dots::rest when is_dots dots -> dots::(do_statement_dots true dots_after rest) | x::(dots::_ as rest) when is_dots dots -> (statement dots_before true x):: do_statement_dots false dots_after rest | x::rest -> (statement dots_before false x):: do_statement_dots false dots_after rest and statement_dots dots_before dots_after d = Ast0.rewrap d (match Ast0.unwrap d with Ast0.DOTS(l) -> Ast0.DOTS(do_statement_dots dots_before dots_after l) | Ast0.CIRCLES(l) -> Ast0.CIRCLES(do_statement_dots dots_before dots_after l) | Ast0.STARS(l) -> Ast0.STARS(do_statement_dots dots_before dots_after l)) let top_level t = Ast0.rewrap t (match Ast0.unwrap t with Ast0.NONDECL(stmt_dots) -> Ast0.NONDECL(statement true true stmt_dots) | Ast0.CODE(stmt_dots) -> Ast0.CODE(statement_dots true true stmt_dots) | t -> t) let single_statement l = if !Flag_parsing_cocci.sgrep_mode then l else List.map top_level l coccinelle-1.0.0-rc19/parsing_cocci/get_metas.mli0000644000175000017500000000224412247442616020644 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_metas.mli" val process : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/free_vars.ml0000644000175000017500000011664512247442615020511 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./free_vars.ml" (* For each rule return the list of variables that are used after it. Also augment various parts of each rule with unitary, inherited, and freshness informations *) (* metavar decls should be better integrated into computations of free variables in plus code *) module Ast = Ast_cocci module V = Visitor_ast module TC = Type_cocci let rec nub = function [] -> [] | (x::xs) when (List.mem x xs) -> nub xs | (x::xs) -> x::(nub xs) (* Collect all variable references in a minirule. For a disj, we collect the maximum number (2 is enough) of references in any branch. *) let collect_unitary_nonunitary free_usage = let free_usage = List.sort compare free_usage in let rec loop1 todrop = function (* skips multiple occurrences *) [] -> [] | (x::xs) as all -> if x = todrop then loop1 todrop xs else all in let rec loop2 = function [] -> ([],[]) | [x] -> ([x],[]) | x::y::xs -> if x = y (* occurs more than once in free_usage *) then let (unitary,non_unitary) = loop2(loop1 x xs) in (unitary,x::non_unitary) else (* occurs only once in free_usage *) let (unitary,non_unitary) = loop2 (y::xs) in (x::unitary,non_unitary) in loop2 free_usage let collect_refs include_constraints = let bind x y = x @ y in let option_default = [] in let donothing recursor k e = k e in (* just combine in the normal way *) let donothing_a recursor k e = (* anything is not wrapped *) k e in (* just combine in the normal way *) (* the following considers that anything that occurs non-unitarily in one branch occurs nonunitarily in all branches. This is not optimal, but doing better seems to require a breadth-first traversal, which is perhaps better to avoid. Also, unitarily is represented as occurring once, while nonunitarily is represented as twice - more is irrelevant *) (* cases for disjs and metavars *) let bind_disj refs_branches = let (unitary,nonunitary) = List.split (List.map collect_unitary_nonunitary refs_branches) in let unitary = nub (List.concat unitary) in let nonunitary = nub (List.concat nonunitary) in let unitary = List.filter (function x -> not (List.mem x nonunitary)) unitary in unitary@nonunitary@nonunitary in let metaid (x,_,_,_) = x in let astfvident recursor k i = bind (k i) (match Ast.unwrap i with Ast.MetaId(name,idconstraint,_,_) | Ast.MetaFunc(name,idconstraint,_,_) | Ast.MetaLocalFunc(name,idconstraint,_,_) -> let metas = if include_constraints then match idconstraint with Ast.IdNegIdSet (_,metas) -> metas | _ -> [] else [] in bind (List.rev metas) [metaid name] | Ast.DisjId(ids) -> bind_disj (List.map k ids) | _ -> option_default) in let rec type_collect res = function TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | TC.Array(ty) -> type_collect res ty | TC.EnumName(TC.MV(tyname,_,_)) -> bind [tyname] res | TC.StructUnionName(_,TC.MV(tyname,_,_)) -> bind [tyname] res | TC.MetaType(tyname,_,_) -> bind [tyname] res | TC.Decimal(e1,e2) -> let e2mv = function TC.MV(mv,_,_) -> [mv] | _ -> [] in bind (e2mv e1) (e2mv e2) | TC.SignedT(_,Some ty) -> type_collect res ty | ty -> res in let astfvexpr recursor k e = bind (k e) (match Ast.unwrap e with Ast.MetaExpr(name,constraints,_,Some type_list,_,_) -> let types = List.fold_left type_collect option_default type_list in let extra = if include_constraints then match constraints with Ast.SubExpCstrt l -> l | _ -> [] else [] in bind extra (bind [metaid name] types) | Ast.MetaErr(name,constraints,_,_) | Ast.MetaExpr(name,constraints,_,_,_,_) -> let extra = if include_constraints then match constraints with Ast.SubExpCstrt l -> l | _ -> [] else [] in bind extra [metaid name] | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) -> [metaid name;metaid lenname] | Ast.MetaExprList(name,_,_,_) -> [metaid name] | Ast.DisjExpr(exps) -> bind_disj (List.map k exps) | _ -> option_default) in let astfvfrag recursor k ft = bind (k ft) (match Ast.unwrap ft with Ast.MetaFormatList(pct,name,Ast.MetaListLen (lenname,_,_),_,_) -> [metaid name;metaid lenname] | Ast.MetaFormatList(pct,name,_,_,_) -> [metaid name] | _ -> option_default) in let astfvfmt recursor k ft = bind (k ft) (match Ast.unwrap ft with Ast.MetaFormat(name,_,_,_) -> (* constraint can only be a regexp, so no need to check include_constraints or check for Ast.IdNegIdSet *) [metaid name] | _ -> option_default) in let astfvdecls recursor k d = bind (k d) (match Ast.unwrap d with Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> [metaid name] | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) -> [metaid name;metaid lenname] | Ast.MetaFieldList(name,_,_,_) -> [metaid name] | Ast.DisjDecl(decls) -> bind_disj (List.map k decls) | _ -> option_default) in let astfvfullType recursor k ty = bind (k ty) (match Ast.unwrap ty with Ast.DisjType(types) -> bind_disj (List.map k types) | _ -> option_default) in let astfvtypeC recursor k ty = bind (k ty) (match Ast.unwrap ty with Ast.MetaType(name,_,_) -> [metaid name] | _ -> option_default) in let astfvinit recursor k ty = bind (k ty) (match Ast.unwrap ty with Ast.MetaInit(name,_,_) -> [metaid name] | Ast.MetaInitList(name,Ast.MetaListLen(lenname,_,_),_,_) -> [metaid name;metaid lenname] | Ast.MetaInitList(name,_,_,_) -> [metaid name] | _ -> option_default) in let astfvparam recursor k p = bind (k p) (match Ast.unwrap p with Ast.MetaParam(name,_,_) -> [metaid name] | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) -> [metaid name;metaid lenname] | Ast.MetaParamList(name,_,_,_) -> [metaid name] | _ -> option_default) in let astfvrule_elem recursor k re = (*within a rule_elem, pattern3 manages the coherence of the bindings*) bind (k re) (nub (match Ast.unwrap re with Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_) | Ast.MetaStmtList(name,_,_) -> [metaid name] | _ -> option_default)) in let astfvstatement recursor k s = bind (k s) (match Ast.unwrap s with Ast.Disj(stms) -> bind_disj (List.map recursor.V.combiner_statement_dots stms) | _ -> option_default) in let mcode r mc = if include_constraints then List.concat (List.map (function Ast.MetaPos(name,constraints,_,_,_) -> (metaid name)::constraints) (Ast.get_pos_var mc)) else option_default in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing astfvident astfvexpr astfvfrag astfvfmt astfvfullType astfvtypeC astfvinit astfvparam astfvdecls astfvrule_elem astfvstatement donothing donothing donothing_a let collect_all_refs = collect_refs true let collect_non_constraint_refs = collect_refs false let collect_all_rule_refs minirules = List.fold_left (@) [] (List.map collect_all_refs.V.combiner_top_level minirules) let collect_all_minirule_refs = collect_all_refs.V.combiner_top_level (* ---------------------------------------------------------------- *) let collect_saved = let bind = Common.union_set in let option_default = [] in let donothing recursor k e = k e in (* just combine in the normal way *) let metaid (x,_,_,_) = x in (* cases for metavariables *) let astfvident recursor k i = bind (k i) (match Ast.unwrap i with Ast.MetaId(name,_,TC.Saved,_) | Ast.MetaFunc(name,_,TC.Saved,_) | Ast.MetaLocalFunc(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let rec type_collect res = function TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | TC.Array(ty) -> type_collect res ty | TC.EnumName(TC.MV(tyname,TC.Saved,_)) -> bind [tyname] res | TC.StructUnionName(_,TC.MV(tyname,TC.Saved,_)) -> bind [tyname] res | TC.MetaType(tyname,TC.Saved,_) -> bind [tyname] res | TC.Decimal(e1,e2) -> let e2mv = function TC.MV(mv,TC.Saved,_) -> [mv] | _ -> [] in bind (e2mv e1) (e2mv e2) | TC.SignedT(_,Some ty) -> type_collect res ty | ty -> res in let astfvexpr recursor k e = let tymetas = match Ast.unwrap e with Ast.MetaExpr(name,_,_,Some type_list,_,_) -> List.fold_left type_collect option_default type_list | _ -> [] in let vars = bind (k e) (match Ast.unwrap e with Ast.MetaErr(name,_,TC.Saved,_) | Ast.MetaExpr(name,_,TC.Saved,_,_,_) -> [metaid name] | Ast.MetaExprList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> let namesaved = match ns with TC.Saved -> [metaid name] | _ -> [] in let lensaved = match ls with TC.Saved -> [metaid lenname] | _ -> [] in lensaved @ namesaved | Ast.MetaExprList(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in bind tymetas vars in let astfvfrag recursor k ft = bind (k ft) (match Ast.unwrap ft with Ast.MetaFormatList(pct,name,Ast.MetaListLen (lenname,_,_), TC.Saved,_) -> [metaid name;metaid lenname] | Ast.MetaFormatList(pct,name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvfmt recursor k ft = bind (k ft) (match Ast.unwrap ft with Ast.MetaFormat(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvtypeC recursor k ty = bind (k ty) (match Ast.unwrap ty with Ast.MetaType(name,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvinit recursor k ty = bind (k ty) (match Ast.unwrap ty with Ast.MetaInit(name,TC.Saved,_) -> [metaid name] | Ast.MetaInitList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> let namesaved = match ns with TC.Saved -> [metaid name] | _ -> [] in let lensaved = match ls with TC.Saved -> [metaid lenname] | _ -> [] in lensaved @ namesaved | _ -> option_default) in let astfvparam recursor k p = bind (k p) (match Ast.unwrap p with Ast.MetaParam(name,TC.Saved,_) -> [metaid name] | Ast.MetaParamList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> let namesaved = match ns with TC.Saved -> [metaid name] | _ -> [] in let lensaved = match ls with TC.Saved -> [metaid lenname] | _ -> [] in lensaved @ namesaved | Ast.MetaParamList(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvdecls recursor k d = bind (k d) (match Ast.unwrap d with Ast.MetaDecl(name,TC.Saved,_) | Ast.MetaField(name,TC.Saved,_) -> [metaid name] | Ast.MetaFieldList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> let namesaved = match ns with TC.Saved -> [metaid name] | _ -> [] in let lensaved = match ls with TC.Saved -> [metaid lenname] | _ -> [] in lensaved @ namesaved | Ast.MetaFieldList(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvrule_elem recursor k re = (*within a rule_elem, pattern3 manages the coherence of the bindings*) bind (k re) (nub (match Ast.unwrap re with Ast.MetaRuleElem(name,TC.Saved,_) | Ast.MetaStmt(name,TC.Saved,_,_) | Ast.MetaStmtList(name,TC.Saved,_) -> [metaid name] | _ -> option_default)) in let mcode r e = List.fold_left (function acc -> function Ast.MetaPos(name,_,_,TC.Saved,_) -> (metaid name) :: acc | _ -> acc) option_default (Ast.get_pos_var e) in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing astfvident astfvexpr astfvfrag astfvfmt donothing astfvtypeC astfvinit astfvparam astfvdecls astfvrule_elem donothing donothing donothing donothing (* ---------------------------------------------------------------- *) (* For the rules under a given metavariable declaration, collect all of the variables that occur in the plus code *) let cip_mcodekind r mck = let process_anything_list_list anythings = let astfvs = collect_all_refs.V.combiner_anything in List.fold_left (@) [] (List.map (function l -> List.fold_left (@) [] (List.map astfvs l)) anythings) in match mck with Ast.MINUS(_,_,_,replacement) -> (match replacement with Ast.REPLACEMENT(anythings,_) -> process_anything_list_list anythings | Ast.NOREPLACEMENT -> []) | Ast.CONTEXT(_,befaft) -> (match befaft with Ast.BEFORE(ll,_) -> process_anything_list_list ll | Ast.AFTER(ll,_) -> process_anything_list_list ll | Ast.BEFOREAFTER(llb,lla,_) -> (process_anything_list_list lla) @ (process_anything_list_list llb) | Ast.NOTHING -> []) | Ast.PLUS _ -> [] let collect_fresh_seed_env metavars l = let fresh = List.fold_left (function prev -> function Ast.MetaFreshIdDecl(_,seed) as x -> ((Ast.get_meta_name x),seed)::prev | _ -> prev) [] metavars in let (seed_env,seeds) = List.fold_left (function (seed_env,seeds) as prev -> function x -> try (let v = List.assoc x fresh in match v with Ast.ListSeed l -> let ids = List.fold_left (function prev -> function Ast.SeedId(id) -> id::prev | _ -> prev) [] l in ((x,ids)::seed_env,Common.union_set ids seeds) | _ -> ((x,[])::seed_env,seeds)) with Not_found -> prev) ([],l) l in (List.rev seed_env,List.rev seeds) let collect_fresh_seed metavars l = let (_,seeds) = collect_fresh_seed_env metavars l in seeds let collect_in_plus_term = let bind x y = x @ y in let option_default = [] in let donothing r k e = k e in (* no positions in the + code *) let mcode r (_,_,mck,_) = cip_mcodekind r mck in (* case for things with bef/aft mcode *) let astfvrule_elem recursor k re = match Ast.unwrap re with Ast.FunHeader(bef,_,fi,nm,_,params,_) -> let fi_metas = List.concat (List.map (function Ast.FType(ty) -> collect_all_refs.V.combiner_fullType ty | _ -> []) fi) in let nm_metas = collect_all_refs.V.combiner_ident nm in let param_metas = match Ast.unwrap params with Ast.DOTS(params) | Ast.CIRCLES(params) -> List.concat (List.map (function p -> match Ast.unwrap p with Ast.VoidParam(t) | Ast.Param(t,_) -> collect_all_refs.V.combiner_fullType t | _ -> []) params) | _ -> failwith "not allowed for params" in bind fi_metas (bind nm_metas (bind param_metas (bind (cip_mcodekind recursor bef) (k re)))) | Ast.Decl(bef,_,_) -> bind (cip_mcodekind recursor bef) (k re) | _ -> k re in let astfvstatement recursor k s = match Ast.unwrap s with Ast.IfThen(_,_,(_,_,_,aft)) | Ast.IfThenElse(_,_,_,_,(_,_,_,aft)) | Ast.While(_,_,(_,_,_,aft)) | Ast.For(_,_,(_,_,_,aft)) | Ast.Iterator(_,_,(_,_,_,aft)) -> bind (k s) (cip_mcodekind recursor aft) | _ -> k s in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing astfvrule_elem astfvstatement donothing donothing donothing let collect_in_plus metavars minirules = nub (collect_fresh_seed metavars (List.concat (List.map collect_in_plus_term.V.combiner_top_level minirules))) (* ---------------------------------------------------------------- *) (* For the rules under a given metavariable declaration, collect all of the variables that occur only once and more than once in the minus code *) let collect_all_multirefs minirules = let refs = List.map collect_all_refs.V.combiner_top_level minirules in collect_unitary_nonunitary (List.concat refs) (* ---------------------------------------------------------------- *) (* classify as unitary (no binding) or nonunitary (env binding) or saved (witness binding) *) let classify_variables metavar_decls minirules used_after = let metavars = List.map Ast.get_meta_name metavar_decls in let (unitary,nonunitary) = collect_all_multirefs minirules in let inplus = collect_in_plus metavar_decls minirules in let donothing r k e = k e in let check_unitary name inherited = if List.mem name inplus or List.mem name used_after then TC.Saved else if not inherited && List.mem name unitary then TC.Unitary else TC.Nonunitary in let get_option f = function Some x -> Some (f x) | None -> None in let classify (name,_,_,_) = let inherited = not (List.mem name metavars) in (check_unitary name inherited,inherited) in let mcode mc = let p = List.map (function Ast.MetaPos(name,constraints,per,unitary,inherited) -> let (unitary,inherited) = classify name in Ast.MetaPos(name,constraints,per,unitary,inherited)) (Ast.get_pos_var mc) in Ast.set_pos_var p mc in let ident r k e = let e = k e in match Ast.unwrap e with Ast.MetaId(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaId(name,constraints,unitary,inherited)) | Ast.MetaFunc(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaFunc(name,constraints,unitary,inherited)) | Ast.MetaLocalFunc(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaLocalFunc(name,constraints,unitary,inherited)) | _ -> e in let rec type_infos = function TC.ConstVol(cv,ty) -> TC.ConstVol(cv,type_infos ty) | TC.Pointer(ty) -> TC.Pointer(type_infos ty) | TC.FunctionPointer(ty) -> TC.FunctionPointer(type_infos ty) | TC.Array(ty) -> TC.Array(type_infos ty) | TC.EnumName(TC.MV(name,_,_)) -> let (unitary,inherited) = classify (name,(),(),[]) in TC.EnumName(TC.MV(name,unitary,inherited)) | TC.StructUnionName(su,TC.MV(name,_,_)) -> let (unitary,inherited) = classify (name,(),(),[]) in TC.StructUnionName(su,TC.MV(name,unitary,inherited)) | TC.MetaType(name,_,_) -> let (unitary,inherited) = classify (name,(),(),[]) in Type_cocci.MetaType(name,unitary,inherited) | TC.Decimal(e1,e2) -> let e2mv = function TC.MV(mv,_,_) -> let (unitary,inherited) = classify (mv,(),(),[]) in TC.MV(mv,unitary,inherited) | e -> e in TC.Decimal(e2mv e1,e2mv e2) | TC.SignedT(sgn,Some ty) -> TC.SignedT(sgn,Some (type_infos ty)) | ty -> ty in let expression r k e = let e = k e in match Ast.unwrap e with Ast.MetaErr(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaErr(name,constraints,unitary,inherited)) | Ast.MetaExpr(name,constraints,_,ty,form,_) -> let (unitary,inherited) = classify name in let ty = get_option (List.map type_infos) ty in Ast.rewrap e (Ast.MetaExpr(name,constraints,unitary,ty,form,inherited)) | Ast.MetaExprList(name,Ast.MetaListLen(lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap e (Ast.MetaExprList (name, Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaExprList(name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaExprList(name,lenname,unitary,inherited)) | _ -> e in let string_fragment r k ft = let ft = k ft in match Ast.unwrap ft with Ast.MetaFormatList(pct,name,Ast.MetaListLen (lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap ft (Ast.MetaFormatList (pct,name, Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaFormatList(pct,name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap ft (Ast.MetaFormatList(pct,name,lenname,unitary,inherited)) | _ -> ft in let string_format r k ft = let ft = k ft in match Ast.unwrap ft with Ast.MetaFormat(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap ft (Ast.MetaFormat(name,constraints,unitary,inherited)) | _ -> ft in let typeC r k e = let e = k e in match Ast.unwrap e with Ast.MetaType(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaType(name,unitary,inherited)) | _ -> e in let init r k e = let e = k e in match Ast.unwrap e with Ast.MetaInit(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaInit(name,unitary,inherited)) | Ast.MetaInitList(name,Ast.MetaListLen (lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap e (Ast.MetaInitList (name,Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaInitList(name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaInitList(name,lenname,unitary,inherited)) | _ -> e in let param r k e = let e = k e in match Ast.unwrap e with Ast.MetaParam(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaParam(name,unitary,inherited)) | Ast.MetaParamList(name,Ast.MetaListLen (lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap e (Ast.MetaParamList (name,Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaParamList(name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaParamList(name,lenname,unitary,inherited)) | _ -> e in let decl r k e = let e = k e in match Ast.unwrap e with Ast.MetaDecl(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaDecl(name,unitary,inherited)) | Ast.MetaField(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaField(name,unitary,inherited)) | Ast.MetaFieldList(name,Ast.MetaListLen (lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap e (Ast.MetaFieldList (name,Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaFieldList(name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaFieldList(name,lenname,unitary,inherited)) | _ -> e in let rule_elem r k e = let e = k e in match Ast.unwrap e with Ast.MetaStmt(name,_,msi,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaStmt(name,unitary,msi,inherited)) | Ast.MetaStmtList(name,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaStmtList(name,unitary,inherited)) | _ -> e in let fn = V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression string_fragment string_format donothing typeC init param decl rule_elem donothing donothing donothing donothing in List.map fn.V.rebuilder_top_level minirules (* ---------------------------------------------------------------- *) (* For a minirule, collect the set of non-local (not in "bound") variables that are referenced. Store them in a hash table. *) (* bound means the metavariable was declared previously, not locally *) (* Highly inefficient, because we call collect_all_refs on nested code multiple times. But we get the advantage of not having too many variants of the same functions. *) (* Inherited doesn't include position constraints. If they are not bound then there is no constraint. *) let astfvs metavars bound = let fresh = List.fold_left (function prev -> function Ast.MetaFreshIdDecl(_,seed) as x -> ((Ast.get_meta_name x),seed)::prev | _ -> prev) [] metavars in let collect_fresh l = let (matched,freshvars) = List.fold_left (function (matched,freshvars) -> function x -> try let v = List.assoc x fresh in (matched,(x,v)::freshvars) with Not_found -> (x::matched,freshvars)) ([],[]) l in (List.rev matched, List.rev freshvars) in (* cases for the elements of anything *) let simple_setup getter k re = let minus_free = nub (getter collect_all_refs re) in let minus_nc_free = nub (getter collect_non_constraint_refs re) in let plus_free = collect_fresh_seed metavars (getter collect_in_plus_term re) in let free = Common.union_set minus_free plus_free in let nc_free = Common.union_set minus_nc_free plus_free in let unbound = List.filter (function x -> not(List.mem x bound)) free in let inherited = List.filter (function x -> List.mem x bound) nc_free in let munbound = List.filter (function x -> not(List.mem x bound)) minus_free in let (matched,fresh) = collect_fresh unbound in {(k re) with Ast.free_vars = matched; Ast.minus_free_vars = munbound; Ast.fresh_vars = fresh; Ast.inherited = inherited; Ast.saved_witness = []} in let astfvrule_elem recursor k re = simple_setup (function x -> x.V.combiner_rule_elem) k re in let astfvstatement recursor k s = let minus_free = nub (collect_all_refs.V.combiner_statement s) in let minus_nc_free = nub (collect_non_constraint_refs.V.combiner_statement s) in let plus_free = collect_fresh_seed metavars (collect_in_plus_term.V.combiner_statement s) in let free = Common.union_set minus_free plus_free in let nc_free = Common.union_set minus_nc_free plus_free in let classify free minus_free = let (unbound,inherited) = List.partition (function x -> not(List.mem x bound)) free in let munbound = List.filter (function x -> not(List.mem x bound)) minus_free in let (matched,fresh) = collect_fresh unbound in (matched,munbound,fresh,inherited) in let res = k s in let s = let cip_plus aft = collect_fresh_seed metavars (cip_mcodekind collect_in_plus_term aft) in match Ast.unwrap res with Ast.IfThen(header,branch,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.IfThen(header,branch,(unbound,fresh,inherited,aft)) | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.IfThenElse(header,branch1,els,branch2, (unbound,fresh,inherited,aft)) | Ast.While(header,body,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.While(header,body,(unbound,fresh,inherited,aft)) | Ast.For(header,body,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.For(header,body,(unbound,fresh,inherited,aft)) | Ast.Iterator(header,body,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.Iterator(header,body,(unbound,fresh,inherited,aft)) | s -> s in let (matched,munbound,fresh,_) = classify free minus_free in let inherited = List.filter (function x -> List.mem x bound) nc_free in {res with Ast.node = s; Ast.free_vars = matched; Ast.minus_free_vars = munbound; Ast.fresh_vars = fresh; Ast.inherited = inherited; Ast.saved_witness = []} in let astfvstatement_dots recursor k sd = simple_setup (function x -> x.V.combiner_statement_dots) k sd in let astfvcase_line recursor k cl = simple_setup (function x -> x.V.combiner_case_line) k cl in let astfvtoplevel recursor k tl = let saved = collect_saved.V.combiner_top_level tl in {(k tl) with Ast.saved_witness = saved} in let mcode x = x in let donothing r k e = k e in V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing astfvstatement_dots donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing astfvrule_elem astfvstatement astfvcase_line astfvtoplevel donothing (* let collect_astfvs rules = let rec loop bound = function [] -> [] | (metavars,(nm,rule_info,minirules))::rules -> let bound = Common.minus_set bound (List.map Ast.get_meta_name metavars) in (nm,rule_info, (List.map (astfvs metavars bound).V.rebuilder_top_level minirules)):: (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in loop [] rules *) let collect_astfvs rules = let rec loop bound = function [] -> [] | (metavars, rule)::rules -> match rule with Ast.ScriptRule (_,_,_,_,script_vars,_) -> (* why are metavars in rule, but outside for cocci rule??? *) let bound = script_vars @ bound in rule::(loop bound rules) | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) -> (* bound stays as is because script rules have no names, so no inheritance is possible *) rule::(loop bound rules) | Ast.CocciRule (nm, rule_info, minirules, isexp, ruletype) -> let bound = Common.minus_set bound (List.map Ast.get_meta_name metavars) in (Ast.CocciRule (nm, rule_info, (List.map (astfvs metavars bound).V.rebuilder_top_level minirules), isexp, ruletype)):: (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in loop [] rules (* ---------------------------------------------------------------- *) (* position variables that appear as a constraint on another position variable. a position variable also cannot appear both positively and negatively in a single rule. *) let get_neg_pos_list (_,rule) used_after_list = let donothing r k e = k e in let bind (p1,np1) (p2,np2) = (Common.union_set p1 p2, Common.union_set np1 np2) in let option_default = ([],[]) in let metaid (x,_,_,_) = x in let mcode r mc = List.fold_left (function (a,b) -> (function Ast.MetaPos(name,constraints,Ast.PER,_,_) -> ((metaid name)::a,constraints@b) | Ast.MetaPos(name,constraints,Ast.ALL,_,_) -> (a,(metaid name)::constraints@b))) option_default (Ast.get_pos_var mc) in let v = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in match rule with Ast.CocciRule(_,_,minirules,_,_) -> List.map (function toplevel -> let (positions,neg_positions) = v.V.combiner_top_level toplevel in (if List.exists (function p -> List.mem p neg_positions) positions then failwith "a variable cannot be used both as a position and a constraint"); neg_positions) minirules | Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> (*no negated positions*) [] (* ---------------------------------------------------------------- *) (* collect used after lists, per minirule *) (* defined is a list of variables that were declared in a previous metavar declaration *) (* Top-level used after: For each rule collect the set of variables that are inherited, ie used but not defined. These are accumulated back to their point of definition. *) let collect_top_level_used_after metavar_rule_list = let drop_virt = List.filter (function ("virtual",_) -> false | _ -> true) in let (used_after,used_after_lists) = List.fold_right (function (metavar_list,r) -> function (used_after,used_after_lists) -> let locally_defined = match r with Ast.ScriptRule (_,_,_,_,free_vars,_) -> free_vars | _ -> List.map Ast.get_meta_name metavar_list in let continue_propagation = List.filter (function x -> not(List.mem x locally_defined)) used_after in let free_vars = match r with Ast.ScriptRule (_,_,_,mv,_,_) -> drop_virt(List.map (function (_,(r,v),_) -> (r,v)) mv) | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) -> [] | Ast.CocciRule (_,_,rule,_,_) -> drop_virt (Common.union_set (nub (collect_all_rule_refs rule)) (collect_in_plus metavar_list rule)) in let inherited = List.filter (function x -> not (List.mem x locally_defined)) free_vars in (Common.union_set inherited continue_propagation, used_after::used_after_lists)) metavar_rule_list ([],[]) in match used_after with [] -> used_after_lists | _ -> failwith (Printf.sprintf "collect_top_level_used_after: unbound variables %s" (String.concat " " (List.map (function (_,x) -> x) used_after))) let collect_local_used_after metavars minirules used_after = let locally_defined = List.map Ast.get_meta_name metavars in let rec loop = function [] -> (used_after,[],[],[],[]) | minirule::rest -> (* In a rule there are three kinds of local variables: 1. Variables referenced in the minus or context code. These get a value by matching. This value can be used in subsequent rules. 2. Fresh variables referenced in the plus code. 3. Variables referenced in the seeds of the fresh variables. There are also non-local variables. These may either be variables referenced in the minus, context, or plus code, or they may be variables referenced in the seeds of the fresh variables. *) (* Step 1: collect all references in minus/context, plus, seed code *) let variables_referenced_in_minus_context_code = nub (collect_all_minirule_refs minirule) in let variables_referenced_in_plus_code = collect_in_plus_term.V.combiner_top_level minirule in let (env_of_fresh_seeds,seeds_and_plus) = collect_fresh_seed_env metavars variables_referenced_in_plus_code in let all_free_vars = Common.union_set variables_referenced_in_minus_context_code seeds_and_plus in (* Step 2: identify locally defined ones *) let local_fresh = List.map fst env_of_fresh_seeds in let is_local = List.partition (function x -> List.mem x locally_defined) in let local_env_of_fresh_seeds = (* these have to be restricted to only one value if the associated fresh variable is used after *) List.map (function (f,ss) -> (f,is_local ss)) env_of_fresh_seeds in let (local_all_free_vars,nonlocal_all_free_vars) = is_local all_free_vars in (* Step 3, recurse on the rest of the rules, making available whatever has been defined in this one *) let (mini_used_after,fvs_lists,mini_used_after_lists, mini_fresh_used_after_lists,mini_fresh_used_after_seeds) = loop rest in (* Step 4: collect the results. These are: 1. All of the variables used non-locally in the rules starting with this one 2. All of the free variables to the end of the semantic patch 3. The variables that are used afterwards and defined here by matching (minus or context code) 4. The variables that are used afterwards and are defined here as fresh 5. The variables that are used as seeds in computing the bindings of the variables collected in part 4. *) let (local_used_after, nonlocal_used_after) = is_local mini_used_after in let (fresh_local_used_after(*4*),matched_local_used_after) = List.partition (function x -> List.mem x local_fresh) local_used_after in let matched_local_used_after(*3*) = Common.union_set matched_local_used_after nonlocal_used_after in let new_used_after = (*1*) Common.union_set nonlocal_all_free_vars nonlocal_used_after in let fresh_local_used_after_seeds = List.filter (* no point to keep variables that already are gtd to have only one value *) (function x -> not (List.mem x matched_local_used_after)) (List.fold_left (function p -> function c -> Common.union_set c p) [] (List.map (function fua -> fst (List.assoc fua local_env_of_fresh_seeds)) fresh_local_used_after)) in (new_used_after,all_free_vars::fvs_lists(*2*), matched_local_used_after::mini_used_after_lists, fresh_local_used_after::mini_fresh_used_after_lists, fresh_local_used_after_seeds::mini_fresh_used_after_seeds) in let (_,fvs_lists,used_after_lists(*ua*), fresh_used_after_lists(*fua*),fresh_used_after_lists_seeds(*fuas*)) = loop minirules in (fvs_lists,used_after_lists, fresh_used_after_lists,fresh_used_after_lists_seeds) let collect_used_after metavar_rule_list = let used_after_lists = collect_top_level_used_after metavar_rule_list in List.map2 (function (metavars,r) -> function used_after -> match r with Ast.ScriptRule (_,_,_,_,_,_) (* no minirules, so nothing to do? *) | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) -> ([], [used_after], [[]], []) | Ast.CocciRule (name, rule_info, minirules, _,_) -> collect_local_used_after metavars minirules used_after ) metavar_rule_list used_after_lists let rec split4 = function [] -> ([],[],[],[]) | (a,b,c,d)::l -> let (a1,b1,c1,d1) = split4 l in (a::a1,b::b1,c::c1,d::d1) (* ---------------------------------------------------------------- *) (* entry point *) let free_vars rules = let metavars = List.map (function (mv,rule) -> mv) rules in let (fvs_lists,used_after_matched_lists, fresh_used_after_lists,fresh_used_after_lists_seeds) = split4 (collect_used_after rules) in let neg_pos_lists = List.map2 get_neg_pos_list rules used_after_matched_lists in let positions_list = (* for all rules, assume all positions are used after *) List.map (function (mv, r) -> match r with Ast.ScriptRule _ (* doesn't declare position variables *) | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> [] | Ast.CocciRule (_,_,rule,_,_) -> let positions = List.fold_left (function prev -> function Ast.MetaPosDecl(_,nm) -> nm::prev | _ -> prev) [] mv in List.map (function _ -> positions) rule) rules in let new_rules = List.map2 (function (mv,r) -> function (ua,fua) -> match r with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> r | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) -> Ast.CocciRule (nm, rule_info, classify_variables mv r ((List.concat ua) @ (List.concat fua)), is_exp,ruletype)) rules (List.combine used_after_matched_lists fresh_used_after_lists) in let new_rules = collect_astfvs (List.combine metavars new_rules) in (metavars,new_rules, fvs_lists,neg_pos_lists, (used_after_matched_lists, fresh_used_after_lists,fresh_used_after_lists_seeds), positions_list) coccinelle-1.0.0-rc19/parsing_cocci/pretty_print_cocci.mli0000644000175000017500000000505112247442616022576 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./pretty_print_cocci.mli" val unparse : Ast_cocci.rule -> unit val unparse_to_string : Ast_cocci.rule -> string val expression : Ast_cocci.expression -> unit val ident : Ast_cocci.ident -> unit val ident_to_string : Ast_cocci.ident -> string val declaration : Ast_cocci.declaration -> unit val statement : string -> Ast_cocci.statement -> unit val statement_dots : Ast_cocci.statement Ast_cocci.dots -> unit val rule_elem : string -> Ast_cocci.rule_elem -> unit val rule_elem_to_string : Ast_cocci.rule_elem -> string val print_mcodekind : Ast_cocci.mcodekind -> unit val constant : Ast_cocci.constant -> unit val assignOp : Ast_cocci.assignOp -> unit val fixOp : Ast_cocci.fixOp -> unit val unaryOp : Ast_cocci.unaryOp -> unit val binaryOp : Ast_cocci.binaryOp -> unit val const_vol : Ast_cocci.const_vol -> unit val sign : Ast_cocci.sign -> unit val structUnion : Ast_cocci.structUnion -> unit val storage : Ast_cocci.storage -> unit val baseType : Ast_cocci.baseType -> unit val fullType : Ast_cocci.fullType -> unit val typeC : Ast_cocci.typeC -> unit val inc_file : Ast_cocci.inc_file -> unit val print_around : ('a -> unit) -> 'a -> Ast_cocci.anything Ast_cocci.befaft -> unit val print_anything : string -> Ast_cocci.anything list list -> unit val pp_print_anything : Ast_cocci.anything -> unit val print_plus_flag : bool ref val print_minus_flag : bool ref val print_rule_elem : Ast_cocci.rule_elem -> unit val print_when_modif : Ast_cocci.when_modifier -> unit coccinelle-1.0.0-rc19/parsing_cocci/obsolete/0000755000175000017500000000000012247437436020007 5ustar eugeneugencoccinelle-1.0.0-rc19/parsing_cocci/obsolete/parser_cocci.mly0000644000175000017500000014704312247437436023177 0ustar eugeneugen%{ (* Not clear how to allow function declarations to specify a return type and how to allow both to be specified as static, because they are in different rules. The rules seem to have to be combined, which would allow functions to be declared as local variables *) (* Not clear how to let a function have a parameter of type void. At the moment, void is allowed to be the type of a variable, which is wrong, and a parameter needs both a type and an identifier *) module Ast0 = Ast0_cocci module Ast = Ast_cocci (*let warning s v = if !Flag.verbose_parsing then Common.warning s v else v*) let make_info line logical_line = { Ast.line = line; Ast.logical_line = logical_line } let clt2info (_,line,logical_line) = make_info line logical_line let clt2mcode str = function (Data.MINUS,line,lline) -> (str,Ast0.NONE, (Ast.MINUS({Ast.line=line;Ast.logical_line=lline},ref[]))) | (Data.OPTMINUS,line,lline) -> (str,Ast0.OPT, (Ast.MINUS({Ast.line=line;Ast.logical_line=lline},ref[]))) | (Data.UNIQUEMINUS,line,lline) -> (str,Ast0.UNIQUE, (Ast.MINUS({Ast.line=line;Ast.logical_line=lline},ref[]))) | (Data.MULTIMINUS,line,lline) -> (str,Ast0.MULTI, (Ast.MINUS({Ast.line=line;Ast.logical_line=lline},ref[]))) | (Data.PLUS,line,lline) -> (str,Ast0.NONE,Ast.PLUS({Ast.line=line;Ast.logical_line=lline})) | (Data.CONTEXT,line,lline) -> (str,Ast0.NONE, Ast.CONTEXT({Ast.line=line;Ast.logical_line=lline},ref Ast.NOTHING)) | (Data.OPT,line,lline) -> (str,Ast0.OPT, Ast.CONTEXT({Ast.line=line;Ast.logical_line=lline},ref Ast.NOTHING)) | (Data.UNIQUE,line,lline) -> (str,Ast0.UNIQUE, Ast.CONTEXT({Ast.line=line;Ast.logical_line=lline},ref Ast.NOTHING)) | (Data.MULTI,line,lline) -> (str,Ast0.MULTI, Ast.CONTEXT({Ast.line=line;Ast.logical_line=lline},ref Ast.NOTHING)) let id2name (name, clt) = name let id2clt (name, clt) = clt let id2info (name, clt) = clt2info clt let id2mcode (name, clt) = clt2mcode name clt let arith_op ast_op left op right = Ast0.Binary(left, clt2mcode (Ast.Arith ast_op) op, right) let logic_op ast_op left op right = Ast0.Binary(left, clt2mcode (Ast.Logical ast_op) op, right) let top_dots l = if List.exists (function Ast0.Circles(_) -> true | _ -> false) l then Ast0.CIRCLES(l) else if List.exists (function Ast0.Stars(_) -> true | _ -> false) l then Ast0.STARS(l) else Ast0.DOTS(l) %} %token EOF %token TIdentifier TExpression TStatement TFunction TLocal TType TParameter %token TWhy0 TPlus0 TBang0 Tlist TFresh TConstant TError TWords %token Tchar Tshort Tint Tdouble Tfloat Tlong Tvoid %token Tstruct Tunion %token Tunsigned Tsigned %token Tstatic Tconst Tvolatile %token TIf TElse TWhile TFor TDo TReturn %token TIdent TFunName TMetaFunName %token TMetaId TMetaType TMetaErr %token TMetaParam TMetaParamList %token TMetaStm TMetaStmList TMetaFunc %token TMetaLocalFunc TMetaExpList %token TMetaExp TMetaConst %token TArobArob %token TEllipsis TOEllipsis TCEllipsis %token TWhen %token TLineEnd %token TCircles TOCircles TCCircles %token TStars TOStars TCStars %token TWhy TDotDot TBang TOPar TOPar0 TMid %token TMid0 TCPar TCPar0 %token TInclude TMinusFile TPlusFile %token TInc TDec %token TString TChar TFloat TInt %token TOrLog %token TAndLog %token TOr %token TXor %token TAnd %token TEqEq TNotEq %token TInf TSup TInfEq TSupEq %token TShl TShr %token TPlus TMinus %token TMul TDiv TMod %token TOBrace TCBrace %token TOCro TCCro %token TPtrOp %token TEq TDot TComma TPtVirg %token TAssign /* operator precedence */ %nonassoc TIf %nonassoc TElse %left TOrLog %left TAndLog %left TOr %left TXor %left TAnd %left TEqEq TNotEq %left TInf TSup TInfEq TSupEq %left TShl TShr %left TPlus TMinus %left TMul TDiv TMod %start main %type main %start meta_main %type meta_main %% main: body EOF { $1 } | body TArobArob { $1 } meta_main: meta_var_list_opt TArobArob { $1 } /***************************************************************************** * * *****************************************************************************/ meta_var: arity TIdentifier pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_id_meta name; Ast.MetaIdDecl($1,name)) $3 } | arity TFresh TIdentifier pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_id_meta name; Ast.MetaFreshIdDecl($1,name)) $4 } | arity TType pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_type_meta name; Ast.MetaTypeDecl($1,name)) $3 } | arity TParameter pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_param_meta name; Ast.MetaParamDecl($1,name)) $3 } | arity TParameter Tlist pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_paramlist_meta name; Ast.MetaParamListDecl($1,name)) $4 } | arity TError pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_err_meta name; Ast.MetaErrDecl($1,name)) $3 } | arity TExpression pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_exp_meta None name; Ast.MetaExpDecl($1,name)) $3 } | arity TExpression Tlist pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_explist_meta name; Ast.MetaExpListDecl($1,name)) $4 } | arity TStatement pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_stm_meta name; Ast.MetaStmDecl($1,name)) $3 } | arity TStatement Tlist pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_stmlist_meta name; Ast.MetaStmListDecl($1,name)) $4 } | arity TFunction pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_func_meta name; Ast.MetaFuncDecl($1,name)) $3 } | arity TLocal TFunction pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_local_func_meta name; Ast.MetaLocalFuncDecl($1,name)) $4 } | arity meta_exp_type pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_exp_meta (Some $2) name; Ast.MetaExpDecl($1,name)) $3 } | arity TConstant meta_exp_type pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_const_meta (Some $3) name; Ast.MetaConstDecl($1,name)) $4 } | arity TConstant pure_ident_or_meta_ident_list TPtVirg { List.map (function name -> !Data.add_const_meta None name; Ast.MetaConstDecl($1,name)) $3 } meta_exp_type: ctype { [$1] } | TOBrace ctype_list TCBrace { $2 } arity: TBang0 { Ast.UNIQUE } | TWhy0 { Ast.OPT } | TPlus0 { Ast.MULTI } | /* empty */ { Ast.NONE } ctype: Tvoid { Ast0.BaseType(clt2mcode Ast.VoidType $1, None) } | ctype_qualif Tchar { Ast0.BaseType(clt2mcode Ast.CharType $2, $1) } | ctype_qualif Tshort { Ast0.BaseType(clt2mcode Ast.ShortType $2, $1) } | ctype_qualif Tint { Ast0.BaseType(clt2mcode Ast.IntType $2, $1) } | Tdouble { Ast0.BaseType(clt2mcode Ast.DoubleType $1, None) } | Tfloat { Ast0.BaseType(clt2mcode Ast.FloatType $1, None) } | ctype_qualif Tlong { Ast0.BaseType(clt2mcode Ast.LongType $2, $1) } | Tstruct pure_ident { Ast0.StructUnionName(id2mcode $2,clt2mcode Ast.Struct $1) } | Tunion pure_ident { Ast0.StructUnionName(id2mcode $2,clt2mcode Ast.Union $1) } | ctype TMul { Ast0.Pointer($1,clt2mcode "*" $2) } | TMetaType { let (nm,clt) = $1 in Ast0.MetaType(clt2mcode nm clt) } ctype_qualif: Tunsigned { Some (clt2mcode Ast.Unsigned $1) } | Tsigned { Some (clt2mcode Ast.Signed $1) } | /* empty */ { None } param_ctype: Tvoid { Ast0.BaseType(clt2mcode Ast.VoidType $1, None) } | ctype_qualif Tchar { Ast0.BaseType(clt2mcode Ast.CharType $2, $1) } | ctype_qualif Tshort { Ast0.BaseType(clt2mcode Ast.ShortType $2, $1) } | ctype_qualif Tint { Ast0.BaseType(clt2mcode Ast.IntType $2, $1) } | Tdouble { Ast0.BaseType(clt2mcode Ast.DoubleType $1, None) } | Tfloat { Ast0.BaseType(clt2mcode Ast.FloatType $1, None) } | ctype_qualif Tlong { Ast0.BaseType(clt2mcode Ast.LongType $2, $1) } | Tstruct pure_ident { Ast0.StructUnionName(id2mcode $2,clt2mcode Ast.Struct $1) } | Tunion pure_ident { Ast0.StructUnionName(id2mcode $2,clt2mcode Ast.Union $1) } | pure_ident { Ast0.TypeName(id2mcode $1) } | param_ctype TMul { Ast0.Pointer($1,clt2mcode "*" $2) } | TMetaType { let (nm,clt) = $1 in Ast0.MetaType(clt2mcode nm clt) } /*****************************************************************************/ /* have to inline everything to avoid conflicts? switch to proper declarations, statements, and expressions for the subterms */ body: function_decl_statement_or_expression { Top_level.top_level $1 } | /* empty */ { [] } /*****************************************************************************/ fundecl: storage TFunName TOPar decl_list TCPar TOBrace pre_post_decl_statement_and_expression_opt TCBrace { Ast0.FunDecl($1, Ast0.Id(id2mcode $2), clt2mcode "(" $3, $4, clt2mcode ")" $5, clt2mcode "{" $6, $7, clt2mcode "}" $8) } | storage TMetaFunName TOPar decl_list TCPar TOBrace pre_post_decl_statement_and_expression_opt TCBrace { Ast0.FunDecl($1, Ast0.MetaFunc(id2mcode $2), clt2mcode "(" $3, $4, clt2mcode ")" $5, clt2mcode "{" $6, $7, clt2mcode "}" $8) } storage: Tstatic { Some (clt2mcode Ast.Static $1) } | /* empty */ { None } decl: decl_qualif param_ctype ident { Ast0.Param($3, $1, $2) } | TMetaParam { let (nm,clt) = $1 in Ast0.MetaParam(clt2mcode nm clt) } decl_qualif: Tconst { Some (clt2mcode Ast.Const $1) } | Tvolatile { Some (clt2mcode Ast.Volatile $1) } | /* empty */ { None } /*****************************************************************************/ statement: TMetaStm { let (nm,clt) = $1 in Ast0.MetaStmt(clt2mcode nm clt) } | expr TPtVirg { Ast0.ExprStatement ($1, clt2mcode ";" $2) } | TIf TOPar eexpr TCPar single_statement %prec TIf { Ast0.IfThen(clt2mcode "if" $1, clt2mcode "(" $2,$3,clt2mcode ")" $4,$5) } | TIf TOPar eexpr TCPar single_statement TElse single_statement { Ast0.IfThenElse(clt2mcode "if" $1, clt2mcode "(" $2,$3,clt2mcode ")" $4,$5, clt2mcode "else" $6,$7) } | TFor TOPar eexpr_opt TPtVirg eexpr_opt TPtVirg eexpr_opt TCPar single_statement { Ast0.For(clt2mcode "for" $1,clt2mcode "(" $2,$3, clt2mcode ";" $4,$5,clt2mcode ";" $6,$7,clt2mcode ")" $8,$9) } | TWhile TOPar eexpr TCPar single_statement { Ast0.While(clt2mcode "while" $1, clt2mcode "(" $2,$3,clt2mcode ")" $4,$5) } | TDo single_statement TWhile TOPar eexpr TCPar TPtVirg { Ast0.Do(clt2mcode "do" $1,$2,clt2mcode "while" $3, clt2mcode "(" $4,$5,clt2mcode ")" $6, clt2mcode ";" $7) } | TReturn eexpr TPtVirg { Ast0.ReturnExpr(clt2mcode "return" $1,$2,clt2mcode ";" $3) } | TReturn TPtVirg { Ast0.Return(clt2mcode "return" $1,clt2mcode ";" $2) } | TOBrace pre_post_decl_statement_and_expression_opt TCBrace { Ast0.Seq(clt2mcode "{" $1,$2,clt2mcode "}" $3) } | TOEllipsis decl_statement_or_expression_dots TCEllipsis { Ast0.Nest(Ast0.DOTS($2)) } | TOCircles decl_statement_or_expression_circles TCCircles { Ast0.Nest(Ast0.CIRCLES($2)) } | TOStars decl_statement_or_expression_stars TCStars { Ast0.Nest(Ast0.STARS($2)) } /* In the following, an identifier as a type is not fully supported. Indeed, the language is ambiguous: what is foo * bar; */ decl_var: ctype d_ident_list TPtVirg { (List.map (function (id,fn) -> Ast0.UnInit(fn $1,id,clt2mcode ";" $3)) $2) } | ctype d_ident TEq eexpr TPtVirg { let (id,fn) = $2 in [Ast0.Init(fn $1,id,clt2mcode "=" $3,$4,clt2mcode ";" $5)] } | pure_ident d_ident TPtVirg { let (id,fn) = $2 in [Ast0.UnInit(fn (Ast0.TypeName(id2mcode $1)),id,clt2mcode ";" $3)] } | pure_ident d_ident TEq eexpr TPtVirg { let (id,fn) = $2 in [Ast0.Init(fn(Ast0.TypeName(id2mcode $1)),id, clt2mcode "=" $3,$4,clt2mcode ";" $5)] } d_ident: ident { ($1,function x -> x) } | ident TOCro eexpr_opt TCCro { ($1,function x -> Ast0.Array(x,clt2mcode "[" $2,$3,clt2mcode "]" $4)) } /* a statement on its own */ single_statement: statement { $1 } | TOPar0 statement_mid TCPar0 { Ast0.Disj($2) } /* a statement that is part of a list */ decl_statement: TMetaStmList { let (nm,clt) = $1 in [Ast0.MetaStmt(clt2mcode nm clt)] } | decl_var { List.map (function x -> Ast0.Decl(x)) $1 } | statement { [$1] } | TOPar0 pre_post_decl_statement_and_expression_opt_mid TCPar0 { if List.for_all (function Ast0.DOTS([]) -> true | _ -> false) $2 then [] else [Ast0.Disj($2)] } /*****************************************************************************/ /*****************************************************************************/ /* The following cannot contain <... ...> at the top level. This can only be allowed as an expression when the expression is delimited on both sides by expression-specific markers. In that case, the rule eexpr is used, which allows <... ...> anywhere. Hopefully, this will not be too much of a problem in practice. */ expr: assign_expr { $1 } assign_expr: cond_expr { $1 } | unary_expr TAssign assign_expr { let (op,clt) = $2 in Ast0.Assignment($1,clt2mcode op clt,$3) } | unary_expr TEq assign_expr { Ast0.Assignment($1,clt2mcode Ast.SimpleAssign $2,$3) } cond_expr: arith_expr { $1 } | arith_expr TWhy eexpr_opt TDotDot cond_expr { Ast0.CondExpr ($1, clt2mcode "?" $2, $3, clt2mcode "?" $4, $5) } arith_expr: cast_expr { $1 } | arith_expr TMul arith_expr { arith_op Ast.Mul $1 $2 $3 } | arith_expr TDiv arith_expr { arith_op Ast.Div $1 $2 $3 } | arith_expr TMod arith_expr { arith_op Ast.Mod $1 $2 $3 } | arith_expr TPlus arith_expr { arith_op Ast.Plus $1 $2 $3 } | arith_expr TMinus arith_expr { arith_op Ast.Minus $1 $2 $3 } | arith_expr TShl arith_expr { arith_op Ast.DecLeft $1 $2 $3 } | arith_expr TShr arith_expr { arith_op Ast.DecRight $1 $2 $3 } | arith_expr TInf arith_expr { logic_op Ast.Inf $1 $2 $3 } | arith_expr TSup arith_expr { logic_op Ast.Sup $1 $2 $3 } | arith_expr TInfEq arith_expr { logic_op Ast.InfEq $1 $2 $3 } | arith_expr TSupEq arith_expr { logic_op Ast.SupEq $1 $2 $3 } | arith_expr TEqEq arith_expr { logic_op Ast.Eq $1 $2 $3 } | arith_expr TNotEq arith_expr { logic_op Ast.NotEq $1 $2 $3 } | arith_expr TAnd arith_expr { arith_op Ast.And $1 $2 $3 } | arith_expr TOr arith_expr { arith_op Ast.Or $1 $2 $3 } | arith_expr TXor arith_expr { arith_op Ast.Xor $1 $2 $3 } | arith_expr TAndLog arith_expr { logic_op Ast.AndLog $1 $2 $3 } | arith_expr TOrLog arith_expr { logic_op Ast.OrLog $1 $2 $3 } cast_expr: unary_expr { $1 } | TOPar ctype TCPar cast_expr { Ast0.Cast (clt2mcode "(" $1, $2, clt2mcode ")" $3, $4) } unary_expr: postfix_expr { $1 } | TInc unary_expr { Ast0.Infix ($2, clt2mcode Ast.Inc $1) } | TDec unary_expr { Ast0.Infix ($2, clt2mcode Ast.Dec $1) } | unary_op unary_expr { let mcode = $1 in Ast0.Unary($2, mcode) } unary_op: TAnd { clt2mcode Ast.GetRef $1 } | TMul { clt2mcode Ast.DeRef $1 } | TPlus { clt2mcode Ast.UnPlus $1 } | TMinus { clt2mcode Ast.UnMinus $1 } | TBang { clt2mcode Ast.Not $1 } postfix_expr: primary_expr { $1 } | postfix_expr TOCro eexpr TCCro { Ast0.ArrayAccess ($1,clt2mcode "[" $2,$3,clt2mcode "]" $4) } | postfix_expr TDot ident { Ast0.RecordAccess($1, clt2mcode "." $2, $3) } | postfix_expr TPtrOp ident { Ast0.RecordPtAccess($1, clt2mcode "->" $2, $3) } | postfix_expr TInc { Ast0.Postfix ($1, clt2mcode Ast.Inc $2) } | postfix_expr TDec { Ast0.Postfix ($1, clt2mcode Ast.Dec $2) } | postfix_expr TOPar eexpr_list_opt TCPar { Ast0.FunCall($1,clt2mcode "(" $2,$3,clt2mcode ")" $4) } primary_expr: ident { Ast0.Ident($1) } | TInt { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Int x) clt) } | TFloat { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Float x) clt) } | TString { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.String x) clt) } | TChar { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Char x) clt) } | TMetaConst { let (nm,ty,clt) = $1 in Ast0.MetaConst(clt2mcode nm clt,ty) } | TMetaErr { let (nm,clt) = $1 in Ast0.MetaErr(clt2mcode nm clt) } | TMetaExp { let (nm,ty,clt) = $1 in Ast0.MetaExpr(clt2mcode nm clt,ty) } | TOPar eexpr TCPar { Ast0.Paren(clt2mcode "(" $1,$2,clt2mcode ")" $3) } | TOPar0 expr_mid TCPar0 { Ast0.DisjExpr($2) } /*****************************************************************************/ eexpr: eassign_expr { $1 } eassign_expr: econd_expr { $1 } | eunary_expr TAssign eassign_expr { let (op,clt) = $2 in Ast0.Assignment($1,clt2mcode op clt,$3) } | eunary_expr TEq eassign_expr { Ast0.Assignment($1,clt2mcode Ast.SimpleAssign $2,$3) } econd_expr: earith_expr { $1 } | earith_expr TWhy eexpr_opt TDotDot econd_expr { Ast0.CondExpr ($1, clt2mcode "?" $2, $3, clt2mcode "?" $4, $5) } earith_expr: ecast_expr { $1 } | earith_expr TMul earith_expr { arith_op Ast.Mul $1 $2 $3 } | earith_expr TDiv earith_expr { arith_op Ast.Div $1 $2 $3 } | earith_expr TMod earith_expr { arith_op Ast.Mod $1 $2 $3 } | earith_expr TPlus earith_expr { arith_op Ast.Plus $1 $2 $3 } | earith_expr TMinus earith_expr { arith_op Ast.Minus $1 $2 $3 } | earith_expr TShl earith_expr { arith_op Ast.DecLeft $1 $2 $3 } | earith_expr TShr earith_expr { arith_op Ast.DecRight $1 $2 $3 } | earith_expr TInf earith_expr { logic_op Ast.Inf $1 $2 $3 } | earith_expr TSup earith_expr { logic_op Ast.Sup $1 $2 $3 } | earith_expr TInfEq earith_expr { logic_op Ast.InfEq $1 $2 $3 } | earith_expr TSupEq earith_expr { logic_op Ast.SupEq $1 $2 $3 } | earith_expr TEqEq earith_expr { logic_op Ast.Eq $1 $2 $3 } | earith_expr TNotEq earith_expr { logic_op Ast.NotEq $1 $2 $3 } | earith_expr TAnd earith_expr { arith_op Ast.And $1 $2 $3 } | earith_expr TOr earith_expr { arith_op Ast.Or $1 $2 $3 } | earith_expr TXor earith_expr { arith_op Ast.Xor $1 $2 $3 } | earith_expr TAndLog earith_expr { logic_op Ast.AndLog $1 $2 $3 } | earith_expr TOrLog earith_expr { logic_op Ast.OrLog $1 $2 $3 } ecast_expr: eunary_expr { $1 } | TOPar ctype TCPar ecast_expr { Ast0.Cast (clt2mcode "(" $1, $2, clt2mcode ")" $3, $4) } eunary_expr: epostfix_expr { $1 } | TInc eunary_expr { Ast0.Infix ($2, clt2mcode Ast.Inc $1) } | TDec eunary_expr { Ast0.Infix ($2, clt2mcode Ast.Dec $1) } | unary_op eunary_expr { let mcode = $1 in Ast0.Unary($2, mcode) } epostfix_expr: eprimary_expr { $1 } | epostfix_expr TOCro eexpr TCCro { Ast0.ArrayAccess ($1,clt2mcode "[" $2,$3,clt2mcode "]" $4) } | epostfix_expr TDot ident { Ast0.RecordAccess($1, clt2mcode "." $2, $3) } | epostfix_expr TPtrOp ident { Ast0.RecordPtAccess($1, clt2mcode "->" $2, $3) } | epostfix_expr TInc { Ast0.Postfix ($1, clt2mcode Ast.Inc $2) } | epostfix_expr TDec { Ast0.Postfix ($1, clt2mcode Ast.Dec $2) } | epostfix_expr TOPar eexpr_list_opt TCPar { Ast0.FunCall($1,clt2mcode "(" $2,$3,clt2mcode ")" $4) } eprimary_expr: ident { Ast0.Ident($1) } | TEllipsis { Ast0.Edots(clt2mcode "..." $1,None) } | TInt { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Int x) clt) } | TFloat { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Float x) clt) } | TString { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.String x) clt) } | TChar { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Char x) clt) } | TMetaConst { let (nm,ty,clt) = $1 in Ast0.MetaConst(clt2mcode nm clt,ty) } | TMetaErr { let (nm,clt) = $1 in Ast0.MetaErr(clt2mcode nm clt) } | TMetaExp { let (nm,ty,clt) = $1 in Ast0.MetaExpr(clt2mcode nm clt,ty) } | TOPar eexpr TCPar { Ast0.Paren(clt2mcode "(" $1,$2,clt2mcode ")" $3) } | TOPar0 eexpr_mid TCPar0 { Ast0.DisjExpr($2) } | TOEllipsis expr_dots TCEllipsis { Ast0.NestExpr(Ast0.DOTS($2)) } | TOCircles expr_circles TCCircles { Ast0.NestExpr(Ast0.CIRCLES($2)) } | TOStars expr_stars TCStars { Ast0.NestExpr(Ast0.STARS($2)) } /*****************************************************************************/ dexpr: dassign_expr { $1 } dassign_expr: dcond_expr { $1 } | dunary_expr TAssign dassign_expr { let (op,clt) = $2 in Ast0.Assignment($1,clt2mcode op clt,$3) } | dunary_expr TEq dassign_expr { Ast0.Assignment($1,clt2mcode Ast.SimpleAssign $2,$3) } dcond_expr: darith_expr { $1 } | darith_expr TWhy eexpr_opt TDotDot dcond_expr { Ast0.CondExpr ($1, clt2mcode "?" $2, $3, clt2mcode "?" $4, $5) } darith_expr: dcast_expr { $1 } | darith_expr TMul darith_expr { arith_op Ast.Mul $1 $2 $3 } | darith_expr TDiv darith_expr { arith_op Ast.Div $1 $2 $3 } | darith_expr TMod darith_expr { arith_op Ast.Mod $1 $2 $3 } | darith_expr TPlus darith_expr { arith_op Ast.Plus $1 $2 $3 } | darith_expr TMinus darith_expr { arith_op Ast.Minus $1 $2 $3 } | darith_expr TShl darith_expr { arith_op Ast.DecLeft $1 $2 $3 } | darith_expr TShr darith_expr { arith_op Ast.DecRight $1 $2 $3 } | darith_expr TInf darith_expr { logic_op Ast.Inf $1 $2 $3 } | darith_expr TSup darith_expr { logic_op Ast.Sup $1 $2 $3 } | darith_expr TInfEq darith_expr { logic_op Ast.InfEq $1 $2 $3 } | darith_expr TSupEq darith_expr { logic_op Ast.SupEq $1 $2 $3 } | darith_expr TEqEq darith_expr { logic_op Ast.Eq $1 $2 $3 } | darith_expr TNotEq darith_expr { logic_op Ast.NotEq $1 $2 $3 } | darith_expr TAnd darith_expr { arith_op Ast.And $1 $2 $3 } | darith_expr TOr darith_expr { arith_op Ast.Or $1 $2 $3 } | darith_expr TXor darith_expr { arith_op Ast.Xor $1 $2 $3 } | darith_expr TAndLog darith_expr { logic_op Ast.AndLog $1 $2 $3 } | darith_expr TOrLog darith_expr { logic_op Ast.OrLog $1 $2 $3 } dcast_expr: dunary_expr { $1 } | TOPar ctype TCPar dcast_expr { Ast0.Cast (clt2mcode "(" $1, $2, clt2mcode ")" $3, $4) } dunary_expr: dpostfix_expr { $1 } | TInc dunary_expr { Ast0.Infix ($2, clt2mcode Ast.Inc $1) } | TDec dunary_expr { Ast0.Infix ($2, clt2mcode Ast.Dec $1) } | unary_op dunary_expr { let mcode = $1 in Ast0.Unary($2, mcode) } dpostfix_expr: dprimary_expr { $1 } | dpostfix_expr TOCro eexpr TCCro { Ast0.ArrayAccess ($1,clt2mcode "[" $2,$3,clt2mcode "]" $4) } | dpostfix_expr TDot ident { Ast0.RecordAccess($1, clt2mcode "." $2, $3) } | dpostfix_expr TPtrOp ident { Ast0.RecordPtAccess($1, clt2mcode "->" $2, $3) } | dpostfix_expr TInc { Ast0.Postfix ($1, clt2mcode Ast.Inc $2) } | dpostfix_expr TDec { Ast0.Postfix ($1, clt2mcode Ast.Dec $2) } | dpostfix_expr TOPar eexpr_list_opt TCPar { Ast0.FunCall($1,clt2mcode "(" $2,$3,clt2mcode ")" $4) } dprimary_expr: ident { Ast0.Ident($1) } | TInt { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Int x) clt) } | TFloat { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Float x) clt) } | TString { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.String x) clt) } | TChar { let (x,clt) = $1 in Ast0.Constant (clt2mcode (Ast.Char x) clt) } | TMetaConst { let (nm,ty,clt) = $1 in Ast0.MetaConst(clt2mcode nm clt,ty) } | TMetaErr { let (nm,clt) = $1 in Ast0.MetaErr(clt2mcode nm clt) } | TMetaExp { let (nm,ty,clt) = $1 in Ast0.MetaExpr(clt2mcode nm clt,ty) } | TOPar eexpr TCPar { Ast0.Paren(clt2mcode "(" $1,$2,clt2mcode ")" $3) } | TOPar0 eexpr_mid TCPar0 { Ast0.DisjExpr($2) } | TOEllipsis expr_dots TCEllipsis { Ast0.NestExpr(Ast0.DOTS($2)) } | TOCircles expr_circles TCCircles { Ast0.NestExpr(Ast0.CIRCLES($2)) } | TOStars expr_stars TCStars { Ast0.NestExpr(Ast0.STARS($2)) } expr_dots: dexpr { [$1] } | dexpr TEllipsis expr_dots { $1 :: Ast0.Edots(clt2mcode "..." $2,None) :: $3 } | dexpr TEllipsis TWhen TNotEq eexpr TLineEnd expr_dots { $1 :: Ast0.Edots(clt2mcode "..." $2,Some $5) :: $7 } expr_circles: dexpr { [$1] } | dexpr TCircles expr_circles { $1 :: Ast0.Ecircles(clt2mcode "ooo" $2,None) :: $3 } | dexpr TCircles TWhen TNotEq eexpr TLineEnd expr_dots { $1 :: Ast0.Ecircles(clt2mcode "ooo" $2,Some $5) :: $7 } expr_stars: dexpr { [$1] } | dexpr TStars expr_stars { $1 :: Ast0.Estars(clt2mcode "***" $2,None) :: $3 } | dexpr TStars TWhen TNotEq eexpr TLineEnd expr_dots { $1 :: Ast0.Estars(clt2mcode "***" $2,Some $5) :: $7 } /*****************************************************************************/ pure_ident: TIdent { $1 } /* allows redeclaring metavariables. used in @@ @@ */ pure_ident_or_meta_ident: TIdent { $1 } | TMetaId { $1 } | TMetaType { $1 } | TMetaParam { $1 } | TMetaParamList { $1 } | TMetaStm { $1 } | TMetaStmList { $1 } | TMetaFunc { $1 } | TMetaLocalFunc { $1 } | TMetaExpList { $1 } | TMetaConst { let (name,_,info) = $1 in (name,info) } | TMetaExp { let (name,_,info) = $1 in (name,info) } | TMetaErr { $1 } ident: TIdent { Ast0.Id(id2mcode $1) } | TMetaId { Ast0.MetaId(id2mcode $1) } | TMetaFunc { Ast0.MetaFunc(id2mcode $1) } | TMetaLocalFunc { Ast0.MetaLocalFunc(id2mcode $1) } /*****************************************************************************/ meta_var_list: meta_var { $1 } | meta_var meta_var_list { $1@$2 } meta_var_list_opt: meta_var_list { $1 } | /* empty */ { [] } d_ident_list: d_ident { [$1] } | d_ident TComma d_ident_list { $1::$3 } ctype_list: ctype { [$1] } | ctype TComma ctype_list { $1::$3 } pure_ident_or_meta_ident_list: pure_ident_or_meta_ident { [id2name $1] } | pure_ident_or_meta_ident TComma pure_ident_or_meta_ident_list { (id2name $1)::$3 } decl_list: decl_list_start { if List.exists (function Ast0.Pcircles(_) -> true | _ -> false) $1 then Ast0.CIRCLES($1) else Ast0.DOTS($1) } decl_list_start: decl { [$1] } | TMetaParamList { let (nm,clt) = $1 in [Ast0.MetaParamList(clt2mcode nm clt)] } | TEllipsis { [Ast0.Pdots(clt2mcode "..." $1)] } | TCircles { [Ast0.Pcircles(clt2mcode "ooo" $1)] } | decl TComma decl_list_start { $1::Ast0.PComma(clt2mcode "," $2)::$3 } | TMetaParamList TComma decl_list_start { let (nm,clt) = $1 in Ast0.MetaParamList(clt2mcode nm clt):: Ast0.PComma(clt2mcode "," $2)::$3 } | TEllipsis TComma decl_list_dots { Ast0.Pdots(clt2mcode "..." $1):: Ast0.PComma(clt2mcode "," $2):: $3 } | TCircles TComma decl_list_circles { Ast0.Pcircles(clt2mcode "ooo" $1):: Ast0.PComma(clt2mcode "," $2):: $3 } decl_list_dots: decl { [$1] } | TMetaParamList { let (nm,clt) = $1 in [Ast0.MetaParamList(clt2mcode nm clt)] } | TEllipsis { [Ast0.Pdots(clt2mcode "..." $1)] } | decl TComma decl_list_dots { $1::Ast0.PComma(clt2mcode "," $2)::$3 } | TMetaParamList TComma decl_list_dots { let (nm,clt) = $1 in Ast0.MetaParamList(clt2mcode nm clt):: Ast0.PComma(clt2mcode "," $2)::$3 } | TEllipsis TComma decl_list_dots { Ast0.Pdots(clt2mcode "..." $1)::Ast0.PComma(clt2mcode "," $2):: $3 } decl_list_circles: decl { [$1] } | TMetaParamList { let (nm,clt) = $1 in [Ast0.MetaParamList(clt2mcode nm clt)] } | TCircles { [Ast0.Pcircles(clt2mcode "ooo" $1)] } | decl TComma decl_list_circles { $1::Ast0.PComma(clt2mcode "," $2)::$3 } | TMetaParamList TComma decl_list_circles { let (nm,clt) = $1 in Ast0.MetaParamList(clt2mcode nm clt):: Ast0.PComma(clt2mcode "," $2)::$3 } | TCircles TComma decl_list_circles { Ast0.Pcircles(clt2mcode "ooo" $1):: Ast0.PComma(clt2mcode "," $2):: $3 } /* must be a single statement */ statement_mid: statement { [Ast0.DOTS([$1])] } | statement TMid0 statement_mid { Ast0.DOTS([$1])::$3 } /* must be a list of declarations or statements, with no ... or expressions for "and" case */ pure_decl_statement_list: decl_statement { $1 } | decl_statement pure_decl_statement_list { $1@$2 } /* as above, but allows a single expression - for "or" case */ exp_decl_statement_list: expr { [Ast0.Exp($1)] } | decl_statement { $1 } | decl_statement pure_decl_statement_list { $1@$2 } fun_exp_decl_statement_list: expr { [Ast0.OTHER(Ast0.Exp($1))] } | decl_statement { List.map (function x -> Ast0.OTHER x) $1 } | fundecl { [Ast0.FUNCTION($1)] } | TInclude { [Ast0.INCLUDE(clt2mcode "#include" (id2clt $1),id2mcode $1)] } | TMinusFile TPlusFile { [Ast0.FILEINFO(id2mcode $1,id2mcode $2)] } | decl_statement fun_exp_decl_statement_list { (List.map (function x -> Ast0.OTHER x) $1)@$2 } | fundecl fun_exp_decl_statement_list { Ast0.FUNCTION($1)::$2 } | TInclude fun_exp_decl_statement_list { Ast0.INCLUDE(clt2mcode "#include" (id2clt $1),id2mcode $1)::$2 } | TMinusFile TPlusFile fun_exp_decl_statement_list { Ast0.FILEINFO(id2mcode $1,id2mcode $2)::$3 } /* ---------------------------------------------------------------------- */ error_words: TError TWords TEq TOCro dotless_eexpr_list TCCro { Ast0.ERRORWORDS($5) } /* ---------------------------------------------------------------------- */ /* sequences of statements and expressions */ /* a mix of declarations, statements and expressions. an expression may appear by itself. always nonempty and cannot just be dots. */ function_decl_statement_or_expression: error_words /* only at the end */ { [$1] } | fun_exp_decl_statement_list { $1 } | fun_exp_decl_statement_list TEllipsis function_decl_statement_or_expression_dots { $1@Ast0.OTHER(Ast0.Dots(clt2mcode "..." $2,None))::$3 } | TEllipsis function_decl_statement_or_expression_dots { Ast0.OTHER(Ast0.Dots(clt2mcode "..." $1,None))::$2 } | fun_exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_dots { $1@Ast0.OTHER(Ast0.Dots(clt2mcode "..." $2,Some $5))::$7 } | TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_dots { Ast0.OTHER(Ast0.Dots(clt2mcode "..." $2,Some $4))::$6 } | fun_exp_decl_statement_list TCircles function_decl_statement_or_expression_circles { $1@Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $2,None))::$3 } | TCircles function_decl_statement_or_expression_circles { Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $1,None))::$2 } | fun_exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_circles { $1@Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $2,Some $5))::$7 } | TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_circles { Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $1,Some $4))::$6 } | fun_exp_decl_statement_list TStars function_decl_statement_or_expression_stars { $1@Ast0.OTHER(Ast0.Stars(clt2mcode "***" $2,None))::$3 } | TStars function_decl_statement_or_expression_stars { Ast0.OTHER(Ast0.Stars(clt2mcode "***" $1,None))::$2 } | fun_exp_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_stars { $1@Ast0.OTHER(Ast0.Stars(clt2mcode "***" $2,Some $5))::$7 } | TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_stars { Ast0.OTHER(Ast0.Stars(clt2mcode "***" $1,Some $4))::$6 } function_decl_statement_or_expression_dots: /* empty */ { [] } | fun_exp_decl_statement_list { $1 } | fun_exp_decl_statement_list TEllipsis function_decl_statement_or_expression_dots { $1@Ast0.OTHER(Ast0.Dots(clt2mcode "..." $2,None))::$3 } | fun_exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_dots { $1@Ast0.OTHER(Ast0.Dots(clt2mcode "..." $2,Some $5))::$7 } function_decl_statement_or_expression_circles: /* empty */ { [] } | fun_exp_decl_statement_list { $1 } | fun_exp_decl_statement_list TCircles function_decl_statement_or_expression_circles { $1@Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $2,None))::$3 } | fun_exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_circles { $1@Ast0.OTHER(Ast0.Circles(clt2mcode "ooo" $2,Some $5))::$7 } function_decl_statement_or_expression_stars: /* empty */ { [] } | fun_exp_decl_statement_list { $1 } | fun_exp_decl_statement_list TStars function_decl_statement_or_expression_stars { $1@Ast0.OTHER(Ast0.Stars(clt2mcode "***" $2,None))::$3 } | fun_exp_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd function_decl_statement_or_expression_stars { $1@Ast0.OTHER(Ast0.Stars(clt2mcode "***" $2,Some $5))::$7 } decl_statement_or_expression_dots: exp_decl_statement_list { $1 } | exp_decl_statement_list TEllipsis decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,None)::$3 } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } decl_statement_or_expression_circles: exp_decl_statement_list { $1 } | exp_decl_statement_list TCircles decl_statement_or_expression_circles { $1@Ast0.Dots(clt2mcode "..." $2,None)::$3 } | exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd decl_statement_or_expression_circles { $1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } decl_statement_or_expression_stars: exp_decl_statement_list { $1 } | exp_decl_statement_list TStars decl_statement_or_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,None)::$3 } | exp_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd decl_statement_or_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,Some $5)::$7 } post_decl_statement_or_expression: exp_decl_statement_list { $1 } | exp_decl_statement_list TEllipsis { $1@[Ast0.Dots(clt2mcode "..." $2,None)] } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Dots(clt2mcode "..." $2,Some $5)] } | exp_decl_statement_list TCircles { $1@[Ast0.Circles(clt2mcode "ooo" $2,None)] } | exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Circles(clt2mcode "ooo" $2,Some $5)] } | exp_decl_statement_list TStars { $1@[Ast0.Stars(clt2mcode "***" $2,None)] } | exp_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Stars(clt2mcode "***" $2,Some $5)] } | exp_decl_statement_list TEllipsis post_decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,None)::$3 } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } | exp_decl_statement_list TCircles post_decl_statement_or_expression_dots { $1@Ast0.Circles(clt2mcode "ooo" $2,None)::$3 } | exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_dots { $1@Ast0.Circles(clt2mcode "ooo" $2,Some $5)::$7 } | exp_decl_statement_list TStars post_decl_statement_or_expression_dots { $1@Ast0.Stars(clt2mcode "***" $2,None)::$3 } | exp_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_dots { $1@Ast0.Stars(clt2mcode "***" $2,Some $5)::$7 } post_decl_statement_or_expression_dots: exp_decl_statement_list { $1 } | exp_decl_statement_list TEllipsis { $1@[Ast0.Dots(clt2mcode "..." $2,None)] } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Dots(clt2mcode "..." $2,Some $5)] } | exp_decl_statement_list TEllipsis post_decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,None)::$3 } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } post_decl_statement_or_expression_circles: exp_decl_statement_list { $1 } | exp_decl_statement_list TCircles { $1@[Ast0.Circles(clt2mcode "ooo" $2,None)] } | exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Circles(clt2mcode "ooo" $2,Some $5)] } | exp_decl_statement_list TCircles post_decl_statement_or_expression_circles { $1@Ast0.Circles(clt2mcode "ooo" $2,None)::$3 } | exp_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_circles { $1@Ast0.Circles(clt2mcode "ooo" $2,Some $5)::$7 } post_decl_statement_or_expression_stars: exp_decl_statement_list { $1 } | exp_decl_statement_list TEllipsis { $1@[Ast0.Stars(clt2mcode "***" $2,None)] } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd { $1@[Ast0.Stars(clt2mcode "***" $2,Some $5)] } | exp_decl_statement_list TEllipsis post_decl_statement_or_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,None)::$3 } | exp_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,Some $5)::$7 } pre_post_decl_statement_or_expression: post_decl_statement_or_expression { if List.exists (function Ast0.Circles(_) -> true | _ -> false) $1 then Ast0.CIRCLES($1) else if List.exists (function Ast0.Stars(_) -> true | _ -> false) $1 then Ast0.STARS($1) else Ast0.DOTS($1) } | TEllipsis post_decl_statement_or_expression_dots { Ast0.DOTS(Ast0.Dots(clt2mcode "..." $1,None)::$2) } | TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_dots { Ast0.DOTS(Ast0.Dots(clt2mcode "..." $1,Some $4)::$6) } | TCircles post_decl_statement_or_expression_circles { Ast0.CIRCLES(Ast0.Circles(clt2mcode "ooo" $1,None)::$2) } | TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_circles { Ast0.CIRCLES(Ast0.Circles(clt2mcode "ooo" $1,Some $4)::$6) } | TStars post_decl_statement_or_expression_stars { Ast0.STARS(Ast0.Stars(clt2mcode "***" $1,None)::$2) } | TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_or_expression_stars { Ast0.STARS(Ast0.Stars(clt2mcode "***" $1,Some $4)::$6) } /* a mix of declarations, statements and expressions. an expression must be surrounded by ... */ post_decl_statement_and_expression_dots: /* empty */ { [] } | pure_decl_statement_list { $1 } | expr TEllipsis post_decl_statement_and_expression_dots { Ast0.Exp($1)::Ast0.Dots(clt2mcode "..." $2,None)::$3 } | expr TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_dots { Ast0.Exp($1)::Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } | pure_decl_statement_list TEllipsis post_decl_statement_and_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,None)::$3 } | pure_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_dots { $1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7 } post_decl_statement_and_expression_circles: /* empty */ { [] } | pure_decl_statement_list { $1 } | expr TCircles post_decl_statement_and_expression_circles { Ast0.Exp($1)::Ast0.Circles(clt2mcode "ooo" $2,None)::$3 } | expr TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_circles { Ast0.Exp($1)::Ast0.Circles(clt2mcode "ooo" $2,Some $5)::$7 } | pure_decl_statement_list TCircles post_decl_statement_and_expression_circles { $1@Ast0.Circles(clt2mcode "ooo" $2,None)::$3 } | pure_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_circles { $1@Ast0.Circles(clt2mcode "ooo" $2,Some $5)::$7 } post_decl_statement_and_expression_stars: /* empty */ { [] } | pure_decl_statement_list { $1 } | expr TStars post_decl_statement_and_expression_stars { Ast0.Exp($1)::Ast0.Stars(clt2mcode "***" $2,None)::$3 } | expr TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_stars { Ast0.Exp($1)::Ast0.Stars(clt2mcode "***" $2,Some $5)::$7 } | pure_decl_statement_list TStars post_decl_statement_and_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,None)::$3 } | pure_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_stars { $1@Ast0.Stars(clt2mcode "***" $2,Some $5)::$7 } pre_post_decl_statement_and_expression: pure_decl_statement_list { top_dots $1 } | pure_decl_statement_list TEllipsis post_decl_statement_and_expression_dots { Ast0.DOTS($1@Ast0.Dots(clt2mcode "..." $2,None)::$3) } | pure_decl_statement_list TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_dots { Ast0.DOTS($1@Ast0.Dots(clt2mcode "..." $2,Some $5)::$7) } | pure_decl_statement_list TCircles post_decl_statement_and_expression_circles { Ast0.CIRCLES($1@Ast0.Circles(clt2mcode "ooo" $2,None)::$3) } | pure_decl_statement_list TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_circles { Ast0.CIRCLES($1@Ast0.Circles(clt2mcode "ooo" $2,Some $5)::$7) } | pure_decl_statement_list TStars post_decl_statement_and_expression_stars { Ast0.STARS($1@Ast0.Stars(clt2mcode "***" $2,None)::$3) } | pure_decl_statement_list TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_stars { Ast0.STARS($1@Ast0.Stars(clt2mcode "***" $2,Some $5)::$7) } | TEllipsis post_decl_statement_and_expression_dots { Ast0.DOTS(Ast0.Dots(clt2mcode "..." $1,None)::$2) } | TEllipsis TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_dots { Ast0.DOTS(Ast0.Dots(clt2mcode "..." $1,Some $4)::$6) } | TCircles post_decl_statement_and_expression_circles { Ast0.CIRCLES(Ast0.Circles(clt2mcode "ooo" $1,None)::$2) } | TCircles TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_circles { Ast0.CIRCLES(Ast0.Circles(clt2mcode "ooo" $1,Some $4)::$6) } | TStars post_decl_statement_and_expression_stars { Ast0.STARS(Ast0.Stars(clt2mcode "***" $1,None)::$2) } | TStars TWhen TNotEq pre_post_decl_statement_or_expression TLineEnd post_decl_statement_and_expression_stars { Ast0.STARS(Ast0.Stars(clt2mcode "***" $1,Some $4)::$6) } pre_post_decl_statement_and_expression_opt: /* empty */ { Ast0.DOTS([]) } | pre_post_decl_statement_and_expression { $1 } pre_post_decl_statement_and_expression_opt_mid: pre_post_decl_statement_and_expression { [$1] } | /* empty */ { [Ast0.DOTS([])] } | pre_post_decl_statement_and_expression TMid0 pre_post_decl_statement_and_expression_opt_mid { $1::$3 } | TMid0 pre_post_decl_statement_and_expression_opt_mid { Ast0.DOTS([])::$2 } /* ---------------------------------------------------------------------- */ dotless_eexpr_list: dexpr { [$1] } | dexpr TComma dotless_eexpr_list { $1::Ast0.EComma(clt2mcode "," $2)::$3 } eexpr_list: eexpr_list_start { if List.exists (function Ast0.Ecircles(_) -> true | _ -> false) $1 then Ast0.CIRCLES($1) else if List.exists (function Ast0.Estars(_) -> true | _ -> false) $1 then Ast0.STARS($1) else Ast0.DOTS($1) } eexpr_list_start: dexpr { [$1] } | TMetaExpList { let (nm,clt) = $1 in [Ast0.MetaExprList(clt2mcode nm clt)] } | TEllipsis { [Ast0.Edots(clt2mcode "..." $1,None)] } | TEllipsis TWhen TNotEq eexpr TLineEnd { [Ast0.Edots(clt2mcode "..." $1,Some $4)] } | TCircles { [Ast0.Ecircles(clt2mcode "ooo" $1,None)] } | TCircles TWhen TNotEq eexpr TLineEnd { [Ast0.Ecircles(clt2mcode "ooo" $1,Some $4)] } | TStars { [Ast0.Estars(clt2mcode "***" $1,None)] } | TStars TWhen TNotEq eexpr TLineEnd { [Ast0.Estars(clt2mcode "***" $1,Some $4)] } | dexpr TComma eexpr_list_start { $1::Ast0.EComma(clt2mcode "," $2)::$3 } | TMetaExpList TComma eexpr_list_start { let (nm,clt) = $1 in Ast0.MetaExprList(clt2mcode nm clt)::Ast0.EComma(clt2mcode "," $2)::$3 } | TEllipsis TComma eexpr_list_dots { Ast0.Edots(clt2mcode "..." $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TEllipsis TWhen TNotEq eexpr TLineEnd TComma eexpr_list_dots { Ast0.Edots(clt2mcode "..." $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } | TCircles TComma eexpr_list_circles { Ast0.Ecircles(clt2mcode "ooo" $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TCircles TWhen TNotEq eexpr TLineEnd TComma eexpr_list_circles { Ast0.Ecircles(clt2mcode "ooo" $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } | TStars TComma eexpr_list_stars { Ast0.Estars(clt2mcode "***" $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TStars TWhen TNotEq eexpr TLineEnd TComma eexpr_list_stars { Ast0.Estars(clt2mcode "***" $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } eexpr_list_dots: dexpr { [$1] } | TMetaExpList { let (nm,clt) = $1 in [Ast0.MetaExprList(clt2mcode nm clt)] } | TEllipsis { [Ast0.Edots(clt2mcode "..." $1,None)] } | TEllipsis TWhen TNotEq eexpr TLineEnd { [Ast0.Edots(clt2mcode "..." $1,Some $4)] } | dexpr TComma eexpr_list_dots { $1::Ast0.EComma(clt2mcode "," $2)::$3 } | TMetaExpList TComma eexpr_list_dots { let (nm,clt) = $1 in Ast0.MetaExprList(clt2mcode nm clt)::Ast0.EComma(clt2mcode "," $2)::$3 } | TEllipsis TComma eexpr_list_dots { Ast0.Edots(clt2mcode "..." $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TEllipsis TWhen TNotEq eexpr TLineEnd TComma eexpr_list_dots { Ast0.Edots(clt2mcode "..." $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } eexpr_list_circles: dexpr { [$1] } | TMetaExpList { let (nm,clt) = $1 in [Ast0.MetaExprList(clt2mcode nm clt)] } | TCircles { [Ast0.Ecircles(clt2mcode "ooo" $1,None)] } | TCircles TWhen TNotEq eexpr TLineEnd { [Ast0.Ecircles(clt2mcode "ooo" $1,Some $4)] } | dexpr TComma eexpr_list_circles { $1::Ast0.EComma(clt2mcode "," $2)::$3 } | TMetaExpList TComma eexpr_list_circles { let (nm,clt) = $1 in Ast0.MetaExprList(clt2mcode nm clt)::Ast0.EComma(clt2mcode "," $2)::$3 } | TCircles TComma eexpr_list_circles { Ast0.Ecircles(clt2mcode "ooo" $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TCircles TWhen TNotEq eexpr TLineEnd TComma eexpr_list_circles { Ast0.Ecircles(clt2mcode "ooo" $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } eexpr_list_stars: dexpr { [$1] } | TMetaExpList { let (nm,clt) = $1 in [Ast0.MetaExprList(clt2mcode nm clt)] } | TStars { [Ast0.Estars(clt2mcode "***" $1,None)] } | TStars TWhen TNotEq eexpr TLineEnd { [Ast0.Estars(clt2mcode "***" $1,Some $4)] } | dexpr TComma eexpr_list_stars { $1::Ast0.EComma(clt2mcode "," $2)::$3 } | TMetaExpList TComma eexpr_list_stars { let (nm,clt) = $1 in Ast0.MetaExprList(clt2mcode nm clt)::Ast0.EComma(clt2mcode "," $2)::$3 } | TStars TComma eexpr_list_stars { Ast0.Estars(clt2mcode "***" $1,None):: Ast0.EComma(clt2mcode "," $2)::$3 } | TStars TWhen TNotEq eexpr TLineEnd TComma eexpr_list_stars { Ast0.Estars(clt2mcode "***" $1,Some $4):: Ast0.EComma(clt2mcode "," $6)::$7 } eexpr_list_opt: eexpr_list { $1 } | /* empty */ { Ast0.DOTS([]) } expr_mid: expr { [$1] } | expr TMid0 expr_mid { $1::$3 } eexpr_mid: eexpr { [$1] } | eexpr TMid0 eexpr_mid { $1::$3 } eexpr_opt: eexpr { Some ($1) } | /* empty */ { None } coccinelle-1.0.0-rc19/parsing_cocci/free_vars.mli0000644000175000017500000000345612247442615020655 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./free_vars.mli" (* Used after things can only have one binding. Positions can have many bindings. These are combined in ctlcocciintegration, ie after the CTL generation. *) val free_vars : Ast_cocci.rule_with_metavars list -> (Ast_cocci.metavar list list) * (Ast_cocci.rule list) * (((Ast_cocci.meta_name list) list) list) (*fvs of the rule*) * (((Ast_cocci.meta_name list) list) list) (*negated position vars*) * ((((Ast_cocci.meta_name list) list) list) (*used after list*) * (((Ast_cocci.meta_name list) list) list) (*fresh used after list*) * (((Ast_cocci.meta_name list) list)list)(*fresh used after list seeds*))* (((Ast_cocci.meta_name list) list) list) (*positions list*) coccinelle-1.0.0-rc19/parsing_cocci/get_metas.ml0000644000175000017500000010554512247442615020502 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_metas.ml" (* --------------------------------------------------------------------- *) (* creates AsExpr, etc *) (* @ attached metavariables can only be associated with positions, so nothing to do for them *) module Ast = Ast_cocci module Ast0 = Ast0_cocci let map_split f l = List.split(List.map f l) let rewrap x (n,e) = (n,Ast0.rewrap x e) let mcode x = let nonpos l = List.filter (function Ast0.MetaPosTag _ -> false | _ -> true) l in (nonpos(Ast0.get_pos x),x) let option_default = [] let bind l1 l2 = let oldnames = List.map Ast0.meta_pos_name l2 in List.fold_left (function prev -> function e1 -> if List.mem (Ast0.meta_pos_name e1) oldnames then prev else e1::prev) l2 l1 let multibind l = let rec loop = function [] -> option_default | [x] -> x | x::xs -> bind x (loop xs) in loop l let map_split_bind f l = let (n,e) = List.split(List.map f l) in (multibind n,e) let get_option f = function Some x -> let (n,e) = f x in (n,Some e) | None -> (option_default,None) let do_disj starter lst mids ender processor rebuilder = let (starter_n,starter) = mcode starter in let (lst_n,lst) = map_split processor lst in let (mids_n,mids) = map_split mcode mids in let (ender_n,ender) = mcode ender in (multibind [starter_n;List.hd lst_n; multibind (List.map2 bind mids_n (List.tl lst_n));ender_n], rebuilder starter lst mids ender) let dots fn d = rewrap d (match Ast0.unwrap d with Ast0.DOTS(l) -> let (n,l) = map_split_bind fn l in (n, Ast0.DOTS(l)) | Ast0.CIRCLES(l) -> let (n,l) = map_split_bind fn l in (n, Ast0.CIRCLES(l)) | Ast0.STARS(l) -> let (n,l) = map_split_bind fn l in (n, Ast0.STARS(l))) let rec ident i = let (metas,i) = rewrap i (match Ast0.unwrap i with Ast0.Id(name) -> let (n,name) = mcode name in (n,Ast0.Id(name)) | Ast0.MetaId(name,constraints,seed,pure) -> let (n,name) = mcode name in (n,Ast0.MetaId(name,constraints,seed,pure)) | Ast0.MetaFunc(name,constraints,pure) -> let (n,name) = mcode name in (n,Ast0.MetaFunc(name,constraints,pure)) | Ast0.MetaLocalFunc(name,constraints,pure) -> let (n,name) = mcode name in (n,Ast0.MetaLocalFunc(name,constraints,pure)) | Ast0.AsIdent _ -> failwith "not possible" | Ast0.DisjId(starter,id_list,mids,ender) -> do_disj starter id_list mids ender ident (fun starter id_list mids ender -> Ast0.DisjId(starter,id_list,mids,ender)) | Ast0.OptIdent(id) -> let (n,id) = ident id in (n,Ast0.OptIdent(id)) | Ast0.UniqueIdent(id) -> let (n,id) = ident id in (n,Ast0.UniqueIdent(id))) in List.fold_left (function (other_metas,id) -> function Ast0.IdentTag(id_meta) -> (other_metas,Ast0.rewrap id (Ast0.AsIdent(id,id_meta))) | x -> (x::other_metas,id)) ([],i) metas and expression e = let (metas,e) = rewrap e (match Ast0.unwrap e with Ast0.Ident(id) -> let (n,id) = ident id in (n,Ast0.Ident(id)) | Ast0.Constant(const) -> let (n,const) = mcode const in (n,Ast0.Constant(const)) | Ast0.StringConstant(lq,str,rq) -> let (lq_n,lq) = mcode lq in let (str_n,str) = dots string_fragment str in let (rq_n,rq) = mcode rq in (multibind [lq_n;str_n;rq_n],Ast0.StringConstant(lq,str,rq)) | Ast0.FunCall(fn,lp,args,rp) -> let (fn_n,fn) = expression fn in let (lp_n,lp) = mcode lp in let (args_n,args) = dots expression args in let (rp_n,rp) = mcode rp in (multibind [fn_n;lp_n;args_n;rp_n], Ast0.FunCall(fn,lp,args,rp)) | Ast0.Assignment(left,op,right,simple) -> let (left_n,left) = expression left in let (op_n,op) = mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Assignment(left,op,right,simple)) | Ast0.Sequence(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Sequence(left,op,right)) | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let (exp1_n,exp1) = expression exp1 in let (why_n,why) = mcode why in let (exp2_n,exp2) = get_option expression exp2 in let (colon_n,colon) = mcode colon in let (exp3_n,exp3) = expression exp3 in (multibind [exp1_n;why_n;exp2_n;colon_n;exp3_n], Ast0.CondExpr(exp1,why,exp2,colon,exp3)) | Ast0.Postfix(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = mcode op in (bind exp_n op_n, Ast0.Postfix(exp,op)) | Ast0.Infix(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = mcode op in (bind op_n exp_n, Ast0.Infix(exp,op)) | Ast0.Unary(exp,op) -> let (exp_n,exp) = expression exp in let (op_n,op) = mcode op in (bind op_n exp_n, Ast0.Unary(exp,op)) | Ast0.Binary(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Binary(left,op,right)) | Ast0.Nested(left,op,right) -> let (left_n,left) = expression left in let (op_n,op) = mcode op in let (right_n,right) = expression right in (multibind [left_n;op_n;right_n], Ast0.Nested(left,op,right)) | Ast0.Paren(lp,exp,rp) -> let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in (multibind [lp_n;exp_n;rp_n], Ast0.Paren(lp,exp,rp)) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> let (exp1_n,exp1) = expression exp1 in let (lb_n,lb) = mcode lb in let (exp2_n,exp2) = expression exp2 in let (rb_n,rb) = mcode rb in (multibind [exp1_n;lb_n;exp2_n;rb_n], Ast0.ArrayAccess(exp1,lb,exp2,rb)) | Ast0.RecordAccess(exp,pt,field) -> let (exp_n,exp) = expression exp in let (pt_n,pt) = mcode pt in let (field_n,field) = ident field in (multibind [exp_n;pt_n;field_n], Ast0.RecordAccess(exp,pt,field)) | Ast0.RecordPtAccess(exp,ar,field) -> let (exp_n,exp) = expression exp in let (ar_n,ar) = mcode ar in let (field_n,field) = ident field in (multibind [exp_n;ar_n;field_n], Ast0.RecordPtAccess(exp,ar,field)) | Ast0.Cast(lp,ty,rp,exp) -> let (lp_n,lp) = mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = mcode rp in let (exp_n,exp) = expression exp in (multibind [lp_n;ty_n;rp_n;exp_n], Ast0.Cast(lp,ty,rp,exp)) | Ast0.SizeOfExpr(szf,exp) -> let (szf_n,szf) = mcode szf in let (exp_n,exp) = expression exp in (multibind [szf_n;exp_n],Ast0.SizeOfExpr(szf,exp)) | Ast0.SizeOfType(szf,lp,ty,rp) -> let (szf_n,szf) = mcode szf in let (lp_n,lp) = mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = mcode rp in (multibind [szf_n;lp_n;ty_n;rp_n], Ast0.SizeOfType(szf,lp,ty,rp)) | Ast0.TypeExp(ty) -> let (ty_n,ty) = typeC ty in (ty_n,Ast0.TypeExp(ty)) | Ast0.Constructor(lp,ty,rp,init) -> let (lp_n,lp) = mcode lp in let (ty_n,ty) = typeC ty in let (rp_n,rp) = mcode rp in let (init_n,init) = initialiser init in (multibind [lp_n;ty_n;rp_n;init_n], Ast0.Constructor(lp,ty,rp,init)) | Ast0.MetaErr(name,constraints,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaErr(name,constraints,pure)) | Ast0.MetaExpr(name,constraints,ty,form,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaExpr(name,constraints,ty,form,pure)) | Ast0.MetaExprList(name,lenname,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaExprList(name,lenname,pure)) | Ast0.AsExpr _ -> failwith "not possible" | Ast0.EComma(cm) -> let (cm_n,cm) = mcode cm in (cm_n,Ast0.EComma(cm)) | Ast0.DisjExpr(starter,expr_list,mids,ender) -> do_disj starter expr_list mids ender expression (fun starter expr_list mids ender -> Ast0.DisjExpr(starter,expr_list,mids,ender)) | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> let (starter_n,starter) = mcode starter in let (expr_dots_n,expr_dots) = dots expression expr_dots in let (ender_n,ender) = mcode ender in let (whencode_n,whencode) = get_option expression whencode in (multibind [starter_n;expr_dots_n;ender_n;whencode_n], Ast0.NestExpr(starter,expr_dots,ender,whencode,multi)) | Ast0.Edots(dots,whencode) -> let (dots_n,dots) = mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Edots(dots,whencode)) | Ast0.Ecircles(dots,whencode) -> let (dots_n,dots) = mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Ecircles(dots,whencode)) | Ast0.Estars(dots,whencode) -> let (dots_n,dots) = mcode dots in let (whencode_n,whencode) = get_option expression whencode in (bind dots_n whencode_n,Ast0.Estars(dots,whencode)) | Ast0.OptExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.OptExp(exp)) | Ast0.UniqueExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.UniqueExp(exp))) in List.fold_left (function (other_metas,exp) -> function Ast0.ExprTag(exp_meta) -> (other_metas,Ast0.rewrap exp (Ast0.AsExpr(exp,exp_meta))) | Ast0.IdentTag(id_meta) -> (other_metas, Ast0.rewrap exp (Ast0.AsExpr(exp,Ast0.rewrap exp (Ast0.Ident(id_meta))))) | x -> (x::other_metas,exp)) ([],e) metas and string_fragment e = rewrap e (match Ast0.unwrap e with Ast0.ConstantFragment(str) -> let (str_n,str) = mcode str in (str_n,Ast0.ConstantFragment(str)) | Ast0.FormatFragment(pct,fmt) -> let (pct_n,pct) = mcode pct in let (fmt_n,fmt) = string_format fmt in (multibind [pct_n;fmt_n],Ast0.FormatFragment(pct,fmt)) | Ast0.Strdots(dots) -> let (dots_n,dots) = mcode dots in (dots_n,Ast0.Strdots(dots)) | Ast0.MetaFormatList(pct,name,lenname) -> let (pct_n,pct) = mcode pct in let (name_n,name) = mcode name in (bind pct_n name_n,Ast0.MetaFormatList(pct,name,lenname))) and string_format e = rewrap e (match Ast0.unwrap e with Ast0.ConstantFormat(str) -> let (str_n,str) = mcode str in (str_n,Ast0.ConstantFormat str) | Ast0.MetaFormat(name,constraints) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaFormat(name,constraints))) and typeC t = let (metas,t) = rewrap t (match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> let (cv_n,cv) = mcode cv in let (ty_n,ty) = typeC ty in (bind cv_n ty_n, Ast0.ConstVol(cv,ty)) | Ast0.BaseType(ty,strings) -> let (strings_n,strings) = map_split_bind mcode strings in (strings_n, Ast0.BaseType(ty,strings)) | Ast0.Signed(sign,ty) -> let (sign_n,sign) = mcode sign in let (ty_n,ty) = get_option typeC ty in (bind sign_n ty_n, Ast0.Signed(sign,ty)) | Ast0.Pointer(ty,star) -> let (ty_n,ty) = typeC ty in let (star_n,star) = mcode star in (bind ty_n star_n, Ast0.Pointer(ty,star)) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [] | Ast0.FunctionType(ty,lp1,params,rp1) -> function_type (ty,lp1,params,rp1) [] | Ast0.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [] | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> let (dec_n,dec) = mcode dec in let (lp_n,lp) = mcode lp in let (length_n,length) = expression length in let (comma_n,comma) = get_option mcode comma in let (precision_n,precision) = get_option expression precision_opt in let (rp_n,rp) = mcode rp in (multibind [dec_n; lp_n; length_n; comma_n; precision_n; rp_n], Ast0.Decimal(dec,lp,length,comma,precision_opt,rp)) | Ast0.EnumName(kind,name) -> let (kind_n,kind) = mcode kind in let (name_n,name) = get_option ident name in (bind kind_n name_n, Ast0.EnumName(kind,name)) | Ast0.EnumDef(ty,lb,ids,rb) -> let (ty_n,ty) = typeC ty in let (lb_n,lb) = mcode lb in let (ids_n,ids) = dots expression ids in let (rb_n,rb) = mcode rb in (multibind [ty_n;lb_n;ids_n;rb_n], Ast0.EnumDef(ty,lb,ids,rb)) | Ast0.StructUnionName(kind,name) -> let (kind_n,kind) = mcode kind in let (name_n,name) = get_option ident name in (bind kind_n name_n, Ast0.StructUnionName(kind,name)) | Ast0.StructUnionDef(ty,lb,decls,rb) -> let (ty_n,ty) = typeC ty in let (lb_n,lb) = mcode lb in let (decls_n,decls) = dots declaration decls in let (rb_n,rb) = mcode rb in (multibind [ty_n;lb_n;decls_n;rb_n], Ast0.StructUnionDef(ty,lb,decls,rb)) | Ast0.TypeName(name) -> let (name_n,name) = mcode name in (name_n,Ast0.TypeName(name)) | Ast0.MetaType(name,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaType(name,pure)) | Ast0.AsType _ -> failwith "not possible" | Ast0.DisjType(starter,types,mids,ender) -> do_disj starter types mids ender typeC (fun starter types mids ender -> Ast0.DisjType(starter,types,mids,ender)) | Ast0.OptType(ty) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.OptType(ty)) | Ast0.UniqueType(ty) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.UniqueType(ty))) in List.fold_left (function (other_metas,ty) -> function Ast0.TypeCTag(ty_meta) -> (other_metas,Ast0.rewrap ty (Ast0.AsType(ty,ty_meta))) | x -> (x::other_metas,ty)) ([],t) metas and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra = let (ty_n,ty) = typeC ty in let (lp1_n,lp1) = mcode lp1 in let (star_n,star) = mcode star in let (rp1_n,rp1) = mcode rp1 in let (lp2_n,lp2) = mcode lp2 in let (params_n,params) = dots parameterTypeDef params in let (rp2_n,rp2) = mcode rp2 in (* have to put the treatment of the identifier into the right position *) (multibind ([ty_n;lp1_n;star_n] @ extra @ [rp1_n;lp2_n;params_n;rp2_n]), Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) and function_type (ty,lp1,params,rp1) extra = let (ty_n,ty) = get_option typeC ty in let (lp1_n,lp1) = mcode lp1 in let (params_n,params) = dots parameterTypeDef params in let (rp1_n,rp1) = mcode rp1 in (* have to put the treatment of the identifier into the right position *) (multibind (ty_n :: extra @ [lp1_n;params_n;rp1_n]), Ast0.FunctionType(ty,lp1,params,rp1)) and array_type (ty,lb,size,rb) extra = let (ty_n,ty) = typeC ty in let (lb_n,lb) = mcode lb in let (size_n,size) = get_option expression size in let (rb_n,rb) = mcode rb in (multibind (ty_n :: extra @ [lb_n;size_n;rb_n]), Ast0.Array(ty,lb,size,rb)) and named_type ty id = let (id_n,id) = ident id in match Ast0.unwrap ty with Ast0.FunctionPointer(rty,lp1,star,rp1,lp2,params,rp2) -> let tyres = function_pointer (rty,lp1,star,rp1,lp2,params,rp2) [id_n] in (rewrap ty tyres, id) | Ast0.FunctionType(rty,lp1,params,rp1) -> let tyres = function_type (rty,lp1,params,rp1) [id_n] in (rewrap ty tyres, id) | Ast0.Array(rty,lb,size,rb) -> let tyres = array_type (rty,lb,size,rb) [id_n] in (rewrap ty tyres, id) | _ -> let (ty_n,ty) = typeC ty in ((bind ty_n id_n, ty), id) and declaration d = let (metas,d) = rewrap d (match Ast0.unwrap d with Ast0.MetaDecl(name,pure) -> let (n,name) = mcode name in (n,Ast0.MetaDecl(name,pure)) | Ast0.MetaField(name,pure) -> let (n,name) = mcode name in (n,Ast0.MetaField(name,pure)) | Ast0.MetaFieldList(name,lenname,pure) -> let (n,name) = mcode name in (n,Ast0.MetaFieldList(name,lenname,pure)) | Ast0.AsDecl _ -> failwith "not possible" | Ast0.Init(stg,ty,id,eq,ini,sem) -> let (stg_n,stg) = get_option mcode stg in let ((ty_id_n,ty),id) = named_type ty id in let (eq_n,eq) = mcode eq in let (ini_n,ini) = initialiser ini in let (sem_n,sem) = mcode sem in (multibind [stg_n;ty_id_n;eq_n;ini_n;sem_n], Ast0.Init(stg,ty,id,eq,ini,sem)) | Ast0.UnInit(stg,ty,id,sem) -> let (stg_n,stg) = get_option mcode stg in let ((ty_id_n,ty),id) = named_type ty id in let (sem_n,sem) = mcode sem in (multibind [stg_n;ty_id_n;sem_n], Ast0.UnInit(stg,ty,id,sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let (name_n,name) = ident name in let (lp_n,lp) = mcode lp in let (args_n,args) = dots expression args in let (rp_n,rp) = mcode rp in let (sem_n,sem) = mcode sem in (multibind [name_n;lp_n;args_n;rp_n;sem_n], Ast0.MacroDecl(name,lp,args,rp,sem)) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> let (name_n,name) = ident name in let (lp_n,lp) = mcode lp in let (args_n,args) = dots expression args in let (rp_n,rp) = mcode rp in let (eq_n,eq) = mcode eq in let (ini_n,ini) = initialiser ini in let (sem_n,sem) = mcode sem in (multibind [name_n;lp_n;args_n;rp_n;eq_n;ini_n;sem_n], Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) | Ast0.TyDecl(ty,sem) -> let (ty_n,ty) = typeC ty in let (sem_n,sem) = mcode sem in (bind ty_n sem_n, Ast0.TyDecl(ty,sem)) | Ast0.Typedef(stg,ty,id,sem) -> let (stg_n,stg) = mcode stg in let (ty_n,ty) = typeC ty in let (id_n,id) = typeC id in let (sem_n,sem) = mcode sem in (multibind [stg_n;ty_n;id_n;sem_n], Ast0.Typedef(stg,ty,id,sem)) | Ast0.DisjDecl(starter,decls,mids,ender) -> do_disj starter decls mids ender declaration (fun starter decls mids ender -> Ast0.DisjDecl(starter,decls,mids,ender)) | Ast0.Ddots(dots,whencode) -> let (dots_n,dots) = mcode dots in let (whencode_n,whencode) = get_option declaration whencode in (bind dots_n whencode_n, Ast0.Ddots(dots,whencode)) | Ast0.OptDecl(decl) -> let (n,decl) = declaration decl in (n,Ast0.OptDecl(decl)) | Ast0.UniqueDecl(decl) -> let (n,decl) = declaration decl in (n,Ast0.UniqueDecl(decl))) in List.fold_left (function (other_metas,decl) -> function Ast0.DeclTag(decl_meta) -> (other_metas,Ast0.rewrap decl (Ast0.AsDecl(decl,decl_meta))) | x -> (x::other_metas,decl)) ([],d) metas and initialiser i = let (metas,i) = rewrap i (match Ast0.unwrap i with Ast0.MetaInit(name,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaInit(name,pure)) | Ast0.MetaInitList(name,lenname,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaInitList(name,lenname,pure)) | Ast0.AsInit _ -> failwith "not possible" | Ast0.InitExpr(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.InitExpr(exp)) | Ast0.InitList(lb,initlist,rb,ordered) -> let (lb_n,lb) = mcode lb in let (initlist_n,initlist) = dots initialiser initlist in let (rb_n,rb) = mcode rb in (multibind [lb_n;initlist_n;rb_n], Ast0.InitList(lb,initlist,rb,ordered)) | Ast0.InitGccExt(designators,eq,ini) -> let (dn,designators) = map_split_bind designator designators in let (eq_n,eq) = mcode eq in let (ini_n,ini) = initialiser ini in (multibind [dn;eq_n;ini_n], Ast0.InitGccExt(designators,eq,ini)) | Ast0.InitGccName(name,eq,ini) -> let (name_n,name) = ident name in let (eq_n,eq) = mcode eq in let (ini_n,ini) = initialiser ini in (multibind [name_n;eq_n;ini_n], Ast0.InitGccName(name,eq,ini)) | Ast0.IComma(cm) -> let (n,cm) = mcode cm in (n,Ast0.IComma(cm)) | Ast0.Idots(d,whencode) -> let (d_n,d) = mcode d in let (whencode_n,whencode) = get_option initialiser whencode in (bind d_n whencode_n, Ast0.Idots(d,whencode)) | Ast0.OptIni(i) -> let (n,i) = initialiser i in (n,Ast0.OptIni(i)) | Ast0.UniqueIni(i) -> let (n,i) = initialiser i in (n,Ast0.UniqueIni(i))) in List.fold_left (function (other_metas,init) -> function Ast0.InitTag(init_meta) -> (other_metas,Ast0.rewrap init (Ast0.AsInit(init,init_meta))) | x -> (x::other_metas,init)) ([],i) metas and designator = function Ast0.DesignatorField(dot,id) -> let (dot_n,dot) = mcode dot in let (id_n,id) = ident id in (bind dot_n id_n, Ast0.DesignatorField(dot,id)) | Ast0.DesignatorIndex(lb,exp,rb) -> let (lb_n,lb) = mcode lb in let (exp_n,exp) = expression exp in let (rb_n,rb) = mcode rb in (multibind [lb_n;exp_n;rb_n], Ast0.DesignatorIndex(lb,exp,rb)) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> let (lb_n,lb) = mcode lb in let (min_n,min) = expression min in let (dots_n,dots) = mcode dots in let (max_n,max) = expression max in let (rb_n,rb) = mcode rb in (multibind [lb_n;min_n;dots_n;max_n;rb_n], Ast0.DesignatorRange(lb,min,dots,max,rb)) and parameterTypeDef p = match Ast0.unwrap p with Ast0.MetaParamList(name,lenname,pure) -> let (metas,p) = rewrap p (let (n,name) = mcode name in (n,Ast0.MetaParamList(name,lenname,pure))) in List.fold_left (function (other_metas,id) -> function ((Ast0.ExprTag(exp_meta)) as x) -> (match Ast0.unwrap exp_meta with Ast0.MetaExprList _ -> (other_metas,Ast0.rewrap p (Ast0.AsParam(p,exp_meta))) | _ -> (x::other_metas,id)) | x -> (x::other_metas,id)) ([],p) metas | _ -> rewrap p (match Ast0.unwrap p with Ast0.VoidParam(ty) -> let (n,ty) = typeC ty in (n,Ast0.VoidParam(ty)) | Ast0.Param(ty,Some id) -> let ((ty_id_n,ty),id) = named_type ty id in (ty_id_n, Ast0.Param(ty,Some id)) | Ast0.Param(ty,None) -> let (ty_n,ty) = typeC ty in (ty_n, Ast0.Param(ty,None)) | Ast0.MetaParam(name,pure) -> let (n,name) = mcode name in (n,Ast0.MetaParam(name,pure)) | Ast0.MetaParamList(name,lenname,pure) -> failwith "not possible" | Ast0.AsParam _ -> failwith "not possible" | Ast0.PComma(cm) -> let (n,cm) = mcode cm in (n,Ast0.PComma(cm)) | Ast0.Pdots(dots) -> let (n,dots) = mcode dots in (n,Ast0.Pdots(dots)) | Ast0.Pcircles(dots) -> let (n,dots) = mcode dots in (n,Ast0.Pcircles(dots)) | Ast0.OptParam(param) -> let (n,param) = parameterTypeDef param in (n,Ast0.OptParam(param)) | Ast0.UniqueParam(param) -> let (n,param) = parameterTypeDef param in (n,Ast0.UniqueParam(param))) and statement s = let (metas,s) = rewrap s (match Ast0.unwrap s with Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> let (fi_n,fi) = map_split_bind fninfo fi in let (name_n,name) = ident name in let (lp_n,lp) = mcode lp in let (params_n,params) = dots parameterTypeDef params in let (rp_n,rp) = mcode rp in let (lbrace_n,lbrace) = mcode lbrace in let (body_n,body) = dots statement body in let (rbrace_n,rbrace) = mcode rbrace in (multibind [fi_n;name_n;lp_n;params_n;rp_n;lbrace_n;body_n;rbrace_n], Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace)) | Ast0.Decl(bef,decl) -> let (decl_n,decl) = declaration decl in (decl_n,Ast0.Decl(bef,decl)) | Ast0.Seq(lbrace,body,rbrace) -> let (lbrace_n,lbrace) = mcode lbrace in let (body_n,body) = dots statement body in let (rbrace_n,rbrace) = mcode rbrace in (multibind [lbrace_n;body_n;rbrace_n], Ast0.Seq(lbrace,body,rbrace)) | Ast0.ExprStatement(exp,sem) -> let (exp_n,exp) = get_option expression exp in let (sem_n,sem) = mcode sem in (bind exp_n sem_n, Ast0.ExprStatement(exp,sem)) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> let (iff_n,iff) = mcode iff in let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in let (branch1_n,branch1) = statement branch1 in (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n], Ast0.IfThen(iff,lp,exp,rp,branch1,aft)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> let (iff_n,iff) = mcode iff in let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in let (branch1_n,branch1) = statement branch1 in let (els_n,els) = mcode els in let (branch2_n,branch2) = statement branch2 in (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n;els_n;branch2_n], Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft)) | Ast0.While(whl,lp,exp,rp,body,aft) -> let (whl_n,whl) = mcode whl in let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in let (body_n,body) = statement body in (multibind [whl_n;lp_n;exp_n;rp_n;body_n], Ast0.While(whl,lp,exp,rp,body,aft)) | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> let (d_n,d) = mcode d in let (body_n,body) = statement body in let (whl_n,whl) = mcode whl in let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in let (sem_n,sem) = mcode sem in (multibind [d_n;body_n;whl_n;lp_n;exp_n;rp_n;sem_n], Ast0.Do(d,body,whl,lp,exp,rp,sem)) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> let (fr_n,fr) = mcode fr in let (lp_n,lp) = mcode lp in let (first_n,first) = match Ast0.unwrap first with Ast0.ForExp(e1,sem1) -> let (e1_n,e1) = get_option expression e1 in let (sem1_n,sem1) = mcode sem1 in (bind e1_n sem1_n, Ast0.rewrap first (Ast0.ForExp(e1,sem1))) | Ast0.ForDecl (bef,decl) -> let (decl_n,decl) = declaration decl in (decl_n,Ast0.rewrap first (Ast0.ForDecl (bef,decl))) in let (e2_n,e2) = get_option expression e2 in let (sem2_n,sem2) = mcode sem2 in let (e3_n,e3) = get_option expression e3 in let (rp_n,rp) = mcode rp in let (body_n,body) = statement body in (multibind [fr_n;lp_n;first_n;e2_n;sem2_n;e3_n;rp_n;body_n], Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft)) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> let (nm_n,nm) = ident nm in let (lp_n,lp) = mcode lp in let (args_n,args) = dots expression args in let (rp_n,rp) = mcode rp in let (body_n,body) = statement body in (multibind [nm_n;lp_n;args_n;rp_n;body_n], Ast0.Iterator(nm,lp,args,rp,body,aft)) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> let (switch_n,switch) = mcode switch in let (lp_n,lp) = mcode lp in let (exp_n,exp) = expression exp in let (rp_n,rp) = mcode rp in let (lb_n,lb) = mcode lb in let (decls_n,decls) = dots statement decls in let (cases_n,cases) = dots case_line cases in let (rb_n,rb) = mcode rb in (multibind [switch_n;lp_n;exp_n;rp_n;lb_n;decls_n;cases_n;rb_n], Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) | Ast0.Break(br,sem) -> let (br_n,br) = mcode br in let (sem_n,sem) = mcode sem in (bind br_n sem_n, Ast0.Break(br,sem)) | Ast0.Continue(cont,sem) -> let (cont_n,cont) = mcode cont in let (sem_n,sem) = mcode sem in (bind cont_n sem_n, Ast0.Continue(cont,sem)) | Ast0.Label(l,dd) -> let (l_n,l) = ident l in let (dd_n,dd) = mcode dd in (bind l_n dd_n, Ast0.Label(l,dd)) | Ast0.Goto(goto,l,sem) -> let (goto_n,goto) = mcode goto in let (l_n,l) = ident l in let (sem_n,sem) = mcode sem in (bind goto_n (bind l_n sem_n), Ast0.Goto(goto,l,sem)) | Ast0.Return(ret,sem) -> let (ret_n,ret) = mcode ret in let (sem_n,sem) = mcode sem in (bind ret_n sem_n, Ast0.Return(ret,sem)) | Ast0.ReturnExpr(ret,exp,sem) -> let (ret_n,ret) = mcode ret in let (exp_n,exp) = expression exp in let (sem_n,sem) = mcode sem in (multibind [ret_n;exp_n;sem_n], Ast0.ReturnExpr(ret,exp,sem)) | Ast0.MetaStmt(name,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,pure) -> let (name_n,name) = mcode name in (name_n,Ast0.MetaStmtList(name,pure)) | Ast0.AsStmt _ -> failwith "not possible" | Ast0.Disj(starter,statement_dots_list,mids,ender) -> do_disj starter statement_dots_list mids ender (dots statement) (fun starter statement_dots_list mids ender -> Ast0.Disj(starter,statement_dots_list,mids,ender)) | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> let (starter_n,starter) = mcode starter in let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in let (ender_n,ender) = mcode ender in let (whn_n,whn) = map_split_bind (whencode (dots statement) statement) whn in (multibind [starter_n;stmt_dots_n;ender_n;whn_n], Ast0.Nest(starter,stmt_dots,ender,whn,multi)) | Ast0.Exp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.Exp(exp)) | Ast0.TopExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.TopExp(exp)) | Ast0.Ty(ty) -> let (ty_n,ty) = typeC ty in (ty_n,Ast0.Ty(ty)) | Ast0.TopInit(init) -> let (init_n,init) = initialiser init in (init_n,Ast0.TopInit(init)) | Ast0.Dots(d,whn) -> let (d_n,d) = mcode d in let (whn_n,whn) = map_split_bind (whencode (dots statement) statement) whn in (bind d_n whn_n, Ast0.Dots(d,whn)) | Ast0.Circles(d,whn) -> let (d_n,d) = mcode d in let (whn_n,whn) = map_split_bind (whencode (dots statement) statement) whn in (bind d_n whn_n, Ast0.Circles(d,whn)) | Ast0.Stars(d,whn) -> let (d_n,d) = mcode d in let (whn_n,whn) = map_split_bind (whencode (dots statement) statement) whn in (bind d_n whn_n, Ast0.Stars(d,whn)) | Ast0.Include(inc,name) -> let (inc_n,inc) = mcode inc in let (name_n,name) = mcode name in (bind inc_n name_n, Ast0.Include(inc,name)) | Ast0.Undef(def,id) -> let (def_n,def) = mcode def in let (id_n,id) = ident id in (multibind [def_n;id_n],Ast0.Undef(def,id)) | Ast0.Define(def,id,params,body) -> let (def_n,def) = mcode def in let (id_n,id) = ident id in let (params_n,params) = define_parameters params in let (body_n,body) = dots statement body in (multibind [def_n;id_n;params_n;body_n], Ast0.Define(def,id,params,body)) | Ast0.Pragma(prg,id,body) -> let (prg_n,prg) = mcode prg in let (id_n,id) = ident id in let (body_n,body) = pragmainfo body in (multibind [prg_n;id_n;body_n],Ast0.Pragma(prg,id,body)) | Ast0.OptStm(re) -> let (re_n,re) = statement re in (re_n,Ast0.OptStm(re)) | Ast0.UniqueStm(re) -> let (re_n,re) = statement re in (re_n,Ast0.UniqueStm(re))) in List.fold_left (function (other_metas,stmt) -> function Ast0.StmtTag(stmt_meta) -> (other_metas,Ast0.rewrap stmt (Ast0.AsStmt(stmt,stmt_meta))) | x -> (x::other_metas,stmt)) ([],s) metas and pragmainfo pi = rewrap pi (match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> let (lp_n,lp) = mcode lp in let (args_n,args) = dots expression args in let (rp_n,rp) = mcode rp in (multibind [lp_n;args_n;rp_n], Ast0.PragmaTuple(lp,args,rp)) | Ast0.PragmaIdList(ids) -> let (ids_n,ids) = dots ident ids in (ids_n, Ast0.PragmaIdList(ids)) | Ast0.PragmaDots (dots) -> let (dots_n,dots) = mcode dots in (dots_n,Ast0.PragmaDots dots)) (* not parameterizable for now... *) and define_parameters p = rewrap p (match Ast0.unwrap p with Ast0.NoParams -> (option_default,Ast0.NoParams) | Ast0.DParams(lp,params,rp) -> let (lp_n,lp) = mcode lp in let (params_n,params) = dots define_param params in let (rp_n,rp) = mcode rp in (multibind [lp_n;params_n;rp_n], Ast0.DParams(lp,params,rp))) and define_param p = rewrap p (match Ast0.unwrap p with Ast0.DParam(id) -> let (n,id) = ident id in (n,Ast0.DParam(id)) | Ast0.DPComma(comma) -> let (n,comma) = mcode comma in (n,Ast0.DPComma(comma)) | Ast0.DPdots(d) -> let (n,d) = mcode d in (n,Ast0.DPdots(d)) | Ast0.DPcircles(c) -> let (n,c) = mcode c in (n,Ast0.DPcircles(c)) | Ast0.OptDParam(dp) -> let (n,dp) = define_param dp in (n,Ast0.OptDParam(dp)) | Ast0.UniqueDParam(dp) -> let (n,dp) = define_param dp in (n,Ast0.UniqueDParam(dp))) and fninfo = function Ast0.FStorage(stg) -> let (n,stg) = mcode stg in (n,Ast0.FStorage(stg)) | Ast0.FType(ty) -> let (n,ty) = typeC ty in (n,Ast0.FType(ty)) | Ast0.FInline(inline) -> let (n,inline) = mcode inline in (n,Ast0.FInline(inline)) | Ast0.FAttr(init) -> let (n,init) = mcode init in (n,Ast0.FAttr(init)) and whencode notfn alwaysfn = function Ast0.WhenNot a -> let (n,a) = notfn a in (n,Ast0.WhenNot(a)) | Ast0.WhenAlways a -> let (n,a) = alwaysfn a in (n,Ast0.WhenAlways(a)) | Ast0.WhenModifier(x) -> (option_default,Ast0.WhenModifier(x)) | Ast0.WhenNotTrue(e) -> let (n,e) = expression e in (n,Ast0.WhenNotTrue(e)) | Ast0.WhenNotFalse(e) -> let (n,e) = expression e in (n,Ast0.WhenNotFalse(e)) and case_line c = rewrap c (match Ast0.unwrap c with Ast0.Default(def,colon,code) -> let (def_n,def) = mcode def in let (colon_n,colon) = mcode colon in let (code_n,code) = dots statement code in (multibind [def_n;colon_n;code_n], Ast0.Default(def,colon,code)) | Ast0.Case(case,exp,colon,code) -> let (case_n,case) = mcode case in let (exp_n,exp) = expression exp in let (colon_n,colon) = mcode colon in let (code_n,code) = dots statement code in (multibind [case_n;exp_n;colon_n;code_n], Ast0.Case(case,exp,colon,code)) | Ast0.DisjCase(starter,case_lines,mids,ender) -> do_disj starter case_lines mids ender case_line (fun starter case_lines mids ender -> Ast0.DisjCase(starter,case_lines,mids,ender)) | Ast0.OptCase(case) -> let (n,case) = case_line case in (n,Ast0.OptCase(case))) and top_level t = rewrap t (match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> let (old_file_n,old_file) = mcode old_file in let (new_file_n,new_file) = mcode new_file in (bind old_file_n new_file_n,Ast0.FILEINFO(old_file,new_file)) | Ast0.NONDECL(statement_dots) -> let (n,statement_dots) = statement statement_dots in (n,Ast0.NONDECL(statement_dots)) | Ast0.CODE(stmt_dots) -> let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in (stmt_dots_n, Ast0.CODE(stmt_dots)) | Ast0.TOPCODE(stmt_dots) -> let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in (stmt_dots_n, Ast0.TOPCODE(stmt_dots)) | Ast0.ERRORWORDS(exps) -> let (n,exps) = map_split_bind expression exps in (n, Ast0.ERRORWORDS(exps)) | Ast0.OTHER(_) -> failwith "unexpected code") let process t = List.map (function x -> match top_level x with ([],code) -> code | (l,_) -> failwith (Printf.sprintf "rule starting on line %d contains unattached metavariables: %s" (Ast0.get_line x) (String.concat ", " (List.map (function nm -> let (r,n) = Ast0.unwrap_mcode nm in r^"."^n) (List.map Ast0.meta_pos_name l))))) t coccinelle-1.0.0-rc19/parsing_cocci/test_exps.ml0000644000175000017500000000711712247442616020545 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./test_exps.ml" module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* call set_test_pos on test expressions *) (* The goal of this is to identify test expressions in the SmPL file, so that isomorphisms like X != NULL => X are only applied in a test expression context. There is a related check in cocci_vs_c3.ml that in x || ..., a match without the || is only accepted in a test expression context. This uses the annotations in the C file. *) let rec process_exp e = let e = Ast0.set_test_pos e in(* allow test isos *) let e = Ast0.set_test_exp e in(* require that a test expression is matched *) match Ast0.unwrap e with Ast0.Paren(lp,e1,rp) -> Ast0.rewrap e (Ast0.Paren(lp,process_exp e1,rp)) | _ -> e let set_test_poss = let expression r k e = let e = k e in match Ast0.unwrap e with Ast0.CondExpr(e1,q,e2,c,e3) -> Ast0.rewrap e (Ast0.CondExpr(process_exp e1,q,e2,c,e3)) | Ast0.Binary(e1,op,e2) -> (match Ast0.unwrap_mcode op with Ast.Logical(Ast.AndLog) | Ast.Logical(Ast.OrLog) -> Ast0.rewrap e (Ast0.Binary(process_exp e1,op,process_exp e2)) | _ -> e) | Ast0.Unary(e1,op) -> (match Ast0.unwrap_mcode op with Ast.Not -> Ast0.rewrap e (Ast0.Unary(process_exp e1,op)) | _ -> e) | _ -> e in let process_wc = function Ast0.WhenNotTrue(e) -> Ast0.WhenNotTrue(process_exp e) | Ast0.WhenNotFalse(e) -> Ast0.WhenNotFalse(process_exp e) | wc -> wc in let statement r k s = let s = k s in match Ast0.unwrap s with Ast0.IfThen(i,lp,e,rp,s1,aft) -> Ast0.rewrap s (Ast0.IfThen(i,lp,process_exp e,rp,s1,aft)) | Ast0.IfThenElse(i,lp,e,rp,s1,e1,s2,aft) -> Ast0.rewrap s (Ast0.IfThenElse(i,lp,process_exp e,rp,s1,e1,s2,aft)) | Ast0.While(i,lp,e,rp,s1,aft) -> Ast0.rewrap s (Ast0.While(i,lp,process_exp e,rp,s1,aft)) | Ast0.Do(d,s1,w,lp,e,rp,sc) -> Ast0.rewrap s (Ast0.Do(d,s1,w,lp,process_exp e,rp,sc)) | Ast0.For(f,lp,first,Some e2,sc2,e3,rp,s1,aft) -> Ast0.rewrap s (Ast0.For(f,lp,first,Some (process_exp e2),sc2,e3,rp,s1,aft)) | Ast0.Dots(d,wc) -> Ast0.rewrap s (Ast0.Dots(d,List.map process_wc wc)) | Ast0.Nest(l,s1,r,wc,m) -> Ast0.rewrap s (Ast0.Nest(l,s1,r,List.map process_wc wc,m)) | _ -> s in V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_exprfn = expression; VT0.rebuilder_stmtfn = statement} let process = List.map set_test_poss.VT0.rebuilder_rec_top_level let process_anything = set_test_poss.VT0.rebuilder_rec_anything coccinelle-1.0.0-rc19/parsing_cocci/parse_cocci.ml0000644000175000017500000024430612247442615021003 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./parse_cocci.ml" (* splits the entire file into minus and plus fragments, and parses each separately (thus duplicating work for the parsing of the context elements) *) module D = Data module PC = Parser_cocci_menhir module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module Ast = Ast_cocci module Ast0 = Ast0_cocci exception Bad_virt of string let pr = Printf.sprintf (*let pr2 s = prerr_string s; prerr_string "\n"; flush stderr*) let pr2 s = Printf.printf "%s\n" s (* for isomorphisms. all should be at the front!!! *) let reserved_names = ["all";"optional_storage";"optional_qualifier";"value_format";"comm_assoc"] (* ----------------------------------------------------------------------- *) (* Debugging... *) let line_type (d,_,_,_,_,_,_,_) = d let line_type2c tok = match line_type tok with D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ":-" | D.PLUS -> ":+" | D.PLUSPLUS -> ":++" | D.CONTEXT | D.UNIQUE | D.OPT -> "" let token2c (tok,_) = match tok with PC.TMetavariable -> "metavariable" | PC.TIdentifier -> "identifier" | PC.TType -> "type" | PC.TParameter -> "parameter" | PC.TConstant -> "constant" | PC.TExpression -> "expression" | PC.TIdExpression -> "idexpression" | PC.TInitialiser -> "initialiser" | PC.TSymbol -> "symbol" | PC.TDeclaration -> "declaration" | PC.TField -> "field" | PC.TStatement -> "statement" | PC.TPosition -> "position" | PC.TFormat -> "format" | PC.TAnalysis -> "analysis" | PC.TPosAny -> "any" | PC.TFunction -> "function" | PC.TLocal -> "local" | PC.Tlist -> "list" | PC.TFresh -> "fresh" | PC.TCppConcatOp -> "##" | PC.TPure -> "pure" | PC.TContext -> "context" | PC.TTypedef -> "typedef" | PC.TDeclarer -> "declarer" | PC.TIterator -> "iterator" | PC.TName -> "name" | PC.TRuleName str -> "rule_name-"^str | PC.TUsing -> "using" | PC.TVirtual -> "virtual" | PC.TPathIsoFile str -> "path_iso_file-"^str | PC.TDisable -> "disable" | PC.TExtends -> "extends" | PC.TDepends -> "depends" | PC.TOn -> "on" | PC.TEver -> "ever" | PC.TNever -> "never" | PC.TExists -> "exists" | PC.TForall -> "forall" | PC.TError -> "error" | PC.TWords -> "words" | PC.TGenerated -> "generated" | PC.TNothing -> "nothing" | PC.Tchar(clt) -> "char"^(line_type2c clt) | PC.Tshort(clt) -> "short"^(line_type2c clt) | PC.Tint(clt) -> "int"^(line_type2c clt) | PC.Tdouble(clt) -> "double"^(line_type2c clt) | PC.Tfloat(clt) -> "float"^(line_type2c clt) | PC.Tlong(clt) -> "long"^(line_type2c clt) | PC.Tvoid(clt) -> "void"^(line_type2c clt) | PC.Tsize_t(clt) -> "size_t"^(line_type2c clt) | PC.Tssize_t(clt) -> "ssize_t"^(line_type2c clt) | PC.Tptrdiff_t(clt) -> "ptrdiff_t"^(line_type2c clt) | PC.Tstruct(clt) -> "struct"^(line_type2c clt) | PC.Tunion(clt) -> "union"^(line_type2c clt) | PC.Tenum(clt) -> "enum"^(line_type2c clt) | PC.Tunsigned(clt) -> "unsigned"^(line_type2c clt) | PC.Tsigned(clt) -> "signed"^(line_type2c clt) | PC.Tstatic(clt) -> "static"^(line_type2c clt) | PC.Tinline(clt) -> "inline"^(line_type2c clt) | PC.Ttypedef(clt) -> "typedef"^(line_type2c clt) | PC.Tattr(s,clt) -> s^(line_type2c clt) | PC.Tauto(clt) -> "auto"^(line_type2c clt) | PC.Tregister(clt) -> "register"^(line_type2c clt) | PC.Textern(clt) -> "extern"^(line_type2c clt) | PC.Tconst(clt) -> "const"^(line_type2c clt) | PC.Tvolatile(clt) -> "volatile"^(line_type2c clt) | PC.Tdecimal(clt) -> "decimal"^(line_type2c clt) | PC.TDirective(Ast.Noindent s,_) -> s | PC.TDirective(Ast.Indent s,_) -> s | PC.TDirective(Ast.Space s,_) -> s | PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt) | PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt) | PC.TUndef(clt,_) -> "#undef"^(line_type2c clt) | PC.TDefine(clt,_) -> "#define"^(line_type2c clt) | PC.TDefineParam(clt,_,_,_) -> "#define_param"^(line_type2c clt) | PC.TPragma(clt) -> "#pragma"^(line_type2c clt) | PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt) | PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt) | PC.TInc(clt) -> "++"^(line_type2c clt) | PC.TDec(clt) -> "--"^(line_type2c clt) | PC.TIf(clt) -> "if"^(line_type2c clt) | PC.TElse(clt) -> "else"^(line_type2c clt) | PC.TWhile(clt) -> "while"^(line_type2c clt) | PC.TFor(clt) -> "for"^(line_type2c clt) | PC.TDo(clt) -> "do"^(line_type2c clt) | PC.TSwitch(clt) -> "switch"^(line_type2c clt) | PC.TCase(clt) -> "case"^(line_type2c clt) | PC.TDefault(clt) -> "default"^(line_type2c clt) | PC.TReturn(clt) -> "return"^(line_type2c clt) | PC.TBreak(clt) -> "break"^(line_type2c clt) | PC.TContinue(clt) -> "continue"^(line_type2c clt) | PC.TGoto(clt) -> "goto"^(line_type2c clt) | PC.TIdent(s,clt) -> (pr "ident-%s" s)^(line_type2c clt) | PC.TTypeId(s,clt) -> (pr "typename-%s" s)^(line_type2c clt) | PC.TDeclarerId(s,clt) -> (pr "declarername-%s" s)^(line_type2c clt) | PC.TIteratorId(s,clt) -> (pr "iteratorname-%s" s)^(line_type2c clt) | PC.TSymId(s,clt) -> (pr "symbol-%s" s)^(line_type2c clt) | PC.TMetaDeclarer(_,_,_,clt) -> "declmeta"^(line_type2c clt) | PC.TMetaIterator(_,_,_,clt) -> "itermeta"^(line_type2c clt) | PC.TSizeof(clt) -> "sizeof"^(line_type2c clt) | PC.TString(x,clt) -> x^(line_type2c clt) | PC.TChar(x,clt) -> x^(line_type2c clt) | PC.TFloat(x,clt) -> x^(line_type2c clt) | PC.TInt(x,clt) -> x^(line_type2c clt) | PC.TDecimalCst(x,len,prc,clt) -> x^(line_type2c clt) | PC.TOrLog(clt) -> "||"^(line_type2c clt) | PC.TAndLog(clt) -> "&&"^(line_type2c clt) | PC.TOr(clt) -> "|"^(line_type2c clt) | PC.TXor(clt) -> "^"^(line_type2c clt) | PC.TAnd (clt) -> "&"^(line_type2c clt) | PC.TEqEq(clt) -> "=="^(line_type2c clt) | PC.TNotEq(clt) -> "!="^(line_type2c clt) | PC.TSub(clt) -> "<="^(line_type2c clt) | PC.TTildeEq(clt) -> "~="^(line_type2c clt) | PC.TTildeExclEq(clt) -> "~!="^(line_type2c clt) | PC.TLogOp(op,clt) -> (match op with Ast.Inf -> "<" | Ast.InfEq -> "<=" | Ast.Sup -> ">" | Ast.SupEq -> ">=" | _ -> failwith "not possible") ^(line_type2c clt) | PC.TShLOp(op,clt) -> "<<"^(line_type2c clt) | PC.TShROp(op,clt) -> ">>"^(line_type2c clt) | PC.TPlus(clt) -> "+"^(line_type2c clt) | PC.TMinus(clt) -> "-"^(line_type2c clt) | PC.TMul(clt) -> "*"^(line_type2c clt) | PC.TDmOp(op,clt) -> (match op with Ast.Div -> "/" | Ast.Min -> " ">?" | Ast.Mod -> "%" | _ -> failwith "not possible") ^(line_type2c clt) | PC.TTilde (clt) -> "~"^(line_type2c clt) | PC.TMeta(_,_,clt) -> "meta"^(line_type2c clt) | PC.TMetaParam(_,_,clt) -> "parammeta"^(line_type2c clt) | PC.TMetaParamList(_,_,_,clt) -> "paramlistmeta"^(line_type2c clt) | PC.TMetaConst(_,_,_,_,clt) -> "constmeta"^(line_type2c clt) | PC.TMetaErr(_,_,_,clt) -> "errmeta"^(line_type2c clt) | PC.TMetaExp(_,_,_,_,clt) -> "expmeta"^(line_type2c clt) | PC.TMetaIdExp(_,_,_,_,clt) -> "idexpmeta"^(line_type2c clt) | PC.TMetaLocalIdExp(_,_,_,_,clt) -> "localidexpmeta"^(line_type2c clt) | PC.TMetaExpList(_,_,_,clt) -> "explistmeta"^(line_type2c clt) | PC.TMetaId(nm,_,_,_,clt) -> "idmeta-"^(Dumper.dump nm)^(line_type2c clt) | PC.TMetaType(_,_,clt) -> "typemeta"^(line_type2c clt) | PC.TMetaInit(_,_,clt) -> "initmeta"^(line_type2c clt) | PC.TMetaInitList(_,_,_,clt) -> "initlistmeta"^(line_type2c clt) | PC.TMetaDecl(_,_,clt) -> "declmeta"^(line_type2c clt) | PC.TMetaField(_,_,clt) -> "fieldmeta"^(line_type2c clt) | PC.TMetaFieldList(_,_,_,clt) -> "fieldlistmeta"^(line_type2c clt) | PC.TMetaStm(_,_,clt) -> "stmmeta"^(line_type2c clt) | PC.TMetaStmList(_,_,clt) -> "stmlistmeta"^(line_type2c clt) | PC.TMetaFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt) | PC.TMetaLocalFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt) | PC.TMetaPos(_,_,_,clt) -> "posmeta" | PC.TMPtVirg -> ";" | PC.TArobArob -> "@@" | PC.TArob -> "@" | PC.TPArob clt -> "P@" | PC.TScript -> "script" | PC.TInitialize -> "initialize" | PC.TFinalize -> "finalize" | PC.TWhen(clt) -> "WHEN"^(line_type2c clt) | PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt) | PC.TWhenFalse(clt) -> "WHEN FALSE"^(line_type2c clt) | PC.TAny(clt) -> "ANY"^(line_type2c clt) | PC.TStrict(clt) -> "STRICT"^(line_type2c clt) | PC.TEllipsis(clt) -> "..."^(line_type2c clt) (* | PC.TCircles(clt) -> "ooo"^(line_type2c clt) | PC.TStars(clt) -> "***"^(line_type2c clt) *) | PC.TOEllipsis(clt) -> "<..."^(line_type2c clt) | PC.TCEllipsis(clt) -> "...>"^(line_type2c clt) | PC.TPOEllipsis(clt) -> "<+..."^(line_type2c clt) | PC.TPCEllipsis(clt) -> "...+>"^(line_type2c clt) (* | PC.TOCircles(clt) -> " "ooo>"^(line_type2c clt) | PC.TOStars(clt) -> "<***"^(line_type2c clt) | PC.TCStars(clt) -> "***>"^(line_type2c clt) *) | PC.TBang0 -> "!" | PC.TPlus0 -> "+" | PC.TWhy0 -> "?" | PC.TWhy(clt) -> "?"^(line_type2c clt) | PC.TDotDot(clt) -> ":"^(line_type2c clt) | PC.TBang(clt) -> "!"^(line_type2c clt) | PC.TOPar(clt) -> "("^(line_type2c clt) | PC.TOPar0(clt) -> "("^(line_type2c clt) | PC.TMid0(clt) -> "|"^(line_type2c clt) | PC.TCPar(clt) -> ")"^(line_type2c clt) | PC.TCPar0(clt) -> ")"^(line_type2c clt) | PC.TOBrace(clt) -> "{"^(line_type2c clt) | PC.TCBrace(clt) -> "}"^(line_type2c clt) | PC.TOCro(clt) -> "["^(line_type2c clt) | PC.TCCro(clt) -> "]"^(line_type2c clt) | PC.TOInit(clt) -> "{"^(line_type2c clt) | PC.TPtrOp(clt) -> "->"^(line_type2c clt) | PC.TEq(clt) -> "="^(line_type2c clt) | PC.TAssign(_,clt) -> "=op"^(line_type2c clt) | PC.TDot(clt) -> "."^(line_type2c clt) | PC.TComma(clt) -> ","^(line_type2c clt) | PC.TPtVirg(clt) -> ";"^(line_type2c clt) | PC.EOF -> "eof" | PC.TLineEnd(clt) -> "line end" | PC.TInvalid -> "invalid" | PC.TFunDecl(clt) -> "fundecl" | PC.TIso -> "<=>" | PC.TRightIso -> "=>" | PC.TIsoTopLevel -> "TopLevel" | PC.TIsoExpression -> "Expression" | PC.TIsoArgExpression -> "ArgExpression" | PC.TIsoTestExpression -> "TestExpression" | PC.TIsoToTestExpression -> "ToTestExpression" | PC.TIsoStatement -> "Statement" | PC.TIsoDeclaration -> "Declaration" | PC.TIsoType -> "Type" | PC.TUnderscore -> "_" | PC.TScriptData s -> s let print_tokens s tokens = Printf.printf "%s\n" s; List.iter (function x -> Printf.printf "|%s| " (token2c x)) tokens; Printf.printf "\n\n"; flush stdout type plus = PLUS | NOTPLUS | SKIP let plus_attachable only_plus (tok,_) = match tok with PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt) | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tsize_t(clt) | PC.Tssize_t(clt) | PC.Tptrdiff_t(clt) | PC.Tstruct(clt) | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt) | PC.Tdecimal(clt) | PC.Tstatic(clt) | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt) | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TUndef(clt,_) | PC.TDefine(clt,_) | PC.TPragma(clt) | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt) | PC.TInc(clt) | PC.TDec(clt) | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt) | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt) | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt) | PC.TSizeof(clt) | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) | PC.TDecimalCst(_,_,_,clt) | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt) | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TLogOp(_,clt) | PC.TShLOp(_,clt) | PC.TShROp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt) | PC.TDmOp(_,clt) | PC.TTilde (clt) | PC.TMeta(_,_,clt) | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt) | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt) | PC.TMetaExpList(_,_,_,clt) | PC.TMetaId(_,_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaInitList(_,_,_,clt) | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaDecl(_,_,clt) | PC.TMetaField(_,_,clt) | PC.TMetaFieldList(_,_,_,clt) | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt) | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt) | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt) | PC.TCPar(clt) | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt) | PC.TOInit(clt) | PC.TPtrOp(clt) | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt) | PC.TPtVirg(clt) -> if List.mem (line_type clt) [D.PLUS;D.PLUSPLUS] then PLUS else if only_plus then NOTPLUS else if line_type clt = D.CONTEXT then PLUS else NOTPLUS | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt) -> NOTPLUS | PC.TMetaPos(nm,_,_,_) -> NOTPLUS | PC.TSub(clt) -> NOTPLUS | _ -> SKIP let get_clt (tok,_) = match tok with PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt) | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tsize_t(clt) | PC.Tssize_t(clt) | PC.Tptrdiff_t(clt) | PC.Tstruct(clt) | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt) | PC.Tdecimal(clt) | PC.Tstatic(clt) | PC.Tinline(clt) | PC.Tattr(_,clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt) | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TUndef(clt,_) | PC.TDefine(clt,_) | PC.TPragma(clt) | PC.TDefineParam(clt,_,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt) | PC.TInc(clt) | PC.TDec(clt) | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt) | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt) | PC.TTypeId(_,clt) | PC.TSymId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt) | PC.TSizeof(clt) | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) | PC.TDecimalCst(_,_,_,clt) | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt) | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TSub(clt) | PC.TLogOp(_,clt) | PC.TShLOp(_,clt) | PC.TShROp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt) | PC.TDmOp(_,clt) | PC.TTilde (clt) | PC.TMeta(_,_,clt) | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt) | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt) | PC.TMetaExpList(_,_,_,clt) | PC.TMetaId(_,_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaInitList(_,_,_,clt) | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaDecl(_,_,clt) | PC.TMetaField(_,_,clt) | PC.TMetaFieldList(_,_,_,clt) | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt) | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt) | PC.TCPar(clt) | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt) | PC.TOInit(clt) | PC.TPtrOp(clt) | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt) | PC.TPArob(clt) | PC.TPtVirg(clt) | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt) | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> clt | _ -> failwith "no clt" let update_clt (tok,x) clt = match tok with PC.Tchar(_) -> (PC.Tchar(clt),x) | PC.Tshort(_) -> (PC.Tshort(clt),x) | PC.Tint(_) -> (PC.Tint(clt),x) | PC.Tdouble(_) -> (PC.Tdouble(clt),x) | PC.Tfloat(_) -> (PC.Tfloat(clt),x) | PC.Tlong(_) -> (PC.Tlong(clt),x) | PC.Tvoid(_) -> (PC.Tvoid(clt),x) | PC.Tsize_t(_) -> (PC.Tsize_t(clt),x) | PC.Tssize_t(_) -> (PC.Tssize_t(clt),x) | PC.Tptrdiff_t(_) -> (PC.Tptrdiff_t(clt),x) | PC.Tstruct(_) -> (PC.Tstruct(clt),x) | PC.Tunion(_) -> (PC.Tunion(clt),x) | PC.Tenum(_) -> (PC.Tenum(clt),x) | PC.Tdecimal(_) -> (PC.Tdecimal(clt),x) | PC.Tunsigned(_) -> (PC.Tunsigned(clt),x) | PC.Tsigned(_) -> (PC.Tsigned(clt),x) | PC.Tstatic(_) -> (PC.Tstatic(clt),x) | PC.Tinline(_) -> (PC.Tinline(clt),x) | PC.Ttypedef(_) -> (PC.Ttypedef(clt),x) | PC.Tattr(s,_) -> (PC.Tattr(s,clt),x) | PC.Tauto(_) -> (PC.Tauto(clt),x) | PC.Tregister(_) -> (PC.Tregister(clt),x) | PC.Textern(_) -> (PC.Textern(clt),x) | PC.Tconst(_) -> (PC.Tconst(clt),x) | PC.Tvolatile(_) -> (PC.Tvolatile(clt),x) | PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x) | PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x) | PC.TUndef(_,a) -> (PC.TUndef(clt,a),x) | PC.TDefine(_,a) -> (PC.TDefine(clt,a),x) | PC.TDefineParam(_,a,b,c) -> (PC.TDefineParam(clt,a,b,c),x) | PC.TPragma(_) -> (PC.TPragma(clt),x) | PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x) | PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x) | PC.TInc(_) -> (PC.TInc(clt),x) | PC.TDec(_) -> (PC.TDec(clt),x) | PC.TIf(_) -> (PC.TIf(clt),x) | PC.TElse(_) -> (PC.TElse(clt),x) | PC.TWhile(_) -> (PC.TWhile(clt),x) | PC.TFor(_) -> (PC.TFor(clt),x) | PC.TDo(_) -> (PC.TDo(clt),x) | PC.TSwitch(_) -> (PC.TSwitch(clt),x) | PC.TCase(_) -> (PC.TCase(clt),x) | PC.TDefault(_) -> (PC.TDefault(clt),x) | PC.TReturn(_) -> (PC.TReturn(clt),x) | PC.TBreak(_) -> (PC.TBreak(clt),x) | PC.TContinue(_) -> (PC.TContinue(clt),x) | PC.TGoto(_) -> (PC.TGoto(clt),x) | PC.TIdent(s,_) -> (PC.TIdent(s,clt),x) | PC.TTypeId(s,_) -> (PC.TTypeId(s,clt),x) | PC.TDeclarerId(s,_) -> (PC.TDeclarerId(s,clt),x) | PC.TIteratorId(s,_) -> (PC.TIteratorId(s,clt),x) | PC.TSymId(a,_) -> (PC.TSymId(a,clt),x) | PC.TSizeof(_) -> (PC.TSizeof(clt),x) | PC.TString(s,_) -> (PC.TString(s,clt),x) | PC.TChar(s,_) -> (PC.TChar(s,clt),x) | PC.TFloat(s,_) -> (PC.TFloat(s,clt),x) | PC.TInt(s,_) -> (PC.TInt(s,clt),x) | PC.TDecimalCst(s,l,p,_) -> (PC.TDecimalCst(s,l,p,clt),x) | PC.TOrLog(_) -> (PC.TOrLog(clt),x) | PC.TAndLog(_) -> (PC.TAndLog(clt),x) | PC.TOr(_) -> (PC.TOr(clt),x) | PC.TXor(_) -> (PC.TXor(clt),x) | PC.TAnd (_) -> (PC.TAnd (clt),x) | PC.TEqEq(_) -> (PC.TEqEq(clt),x) | PC.TNotEq(_) -> (PC.TNotEq(clt),x) | PC.TTildeEq(_) -> (PC.TTildeEq(clt),x) | PC.TSub(_) -> (PC.TSub(clt),x) | PC.TLogOp(op,_) -> (PC.TLogOp(op,clt),x) | PC.TShLOp(op,_) -> (PC.TShLOp(op,clt),x) | PC.TShROp(op,_) -> (PC.TShROp(op,clt),x) | PC.TPlus(_) -> (PC.TPlus(clt),x) | PC.TMinus(_) -> (PC.TMinus(clt),x) | PC.TMul(_) -> (PC.TMul(clt),x) | PC.TDmOp(op,_) -> (PC.TDmOp(op,clt),x) | PC.TTilde (_) -> (PC.TTilde (clt),x) | PC.TMeta(a,b,_) -> (PC.TMeta(a,b,clt),x) | PC.TMetaParam(a,b,_) -> (PC.TMetaParam(a,b,clt),x) | PC.TMetaParamList(a,b,c,_) -> (PC.TMetaParamList(a,b,c,clt),x) | PC.TMetaConst(a,b,c,d,_) -> (PC.TMetaConst(a,b,c,d,clt),x) | PC.TMetaErr(a,b,c,_) -> (PC.TMetaErr(a,b,c,clt),x) | PC.TMetaExp(a,b,c,d,_) -> (PC.TMetaExp(a,b,c,d,clt),x) | PC.TMetaIdExp(a,b,c,d,_) -> (PC.TMetaIdExp(a,b,c,d,clt),x) | PC.TMetaLocalIdExp(a,b,c,d,_) -> (PC.TMetaLocalIdExp(a,b,c,d,clt),x) | PC.TMetaExpList(a,b,c,_) -> (PC.TMetaExpList(a,b,c,clt),x) | PC.TMetaId(a,b,c,d,_) -> (PC.TMetaId(a,b,c,d,clt),x) | PC.TMetaType(a,b,_) -> (PC.TMetaType(a,b,clt),x) | PC.TMetaInit(a,b,_) -> (PC.TMetaInit(a,b,clt),x) | PC.TMetaInitList(a,b,c,_) -> (PC.TMetaInitList(a,b,c,clt),x) | PC.TMetaDecl(a,b,_) -> (PC.TMetaDecl(a,b,clt),x) | PC.TMetaField(a,b,_) -> (PC.TMetaField(a,b,clt),x) | PC.TMetaFieldList(a,b,c,_) -> (PC.TMetaFieldList(a,b,c,clt),x) | PC.TMetaStm(a,b,_) -> (PC.TMetaStm(a,b,clt),x) | PC.TMetaStmList(a,b,_) -> (PC.TMetaStmList(a,b,clt),x) | PC.TMetaFunc(a,b,c,_) -> (PC.TMetaFunc(a,b,c,clt),x) | PC.TMetaLocalFunc(a,b,c,_) -> (PC.TMetaLocalFunc(a,b,c,clt),x) | PC.TMetaDeclarer(a,b,c,_) -> (PC.TMetaDeclarer(a,b,c,clt),x) | PC.TMetaIterator(a,b,c,_) -> (PC.TMetaIterator(a,b,c,clt),x) | PC.TWhen(_) -> (PC.TWhen(clt),x) | PC.TWhenTrue(_) -> (PC.TWhenTrue(clt),x) | PC.TWhenFalse(_) -> (PC.TWhenFalse(clt),x) | PC.TAny(_) -> (PC.TAny(clt),x) | PC.TStrict(_) -> (PC.TStrict(clt),x) | PC.TEllipsis(_) -> (PC.TEllipsis(clt),x) (* | PC.TCircles(_) -> (PC.TCircles(clt),x) | PC.TStars(_) -> (PC.TStars(clt),x) *) | PC.TOEllipsis(_) -> (PC.TOEllipsis(clt),x) | PC.TCEllipsis(_) -> (PC.TCEllipsis(clt),x) | PC.TPOEllipsis(_) -> (PC.TPOEllipsis(clt),x) | PC.TPCEllipsis(_) -> (PC.TPCEllipsis(clt),x) (* | PC.TOCircles(_) -> (PC.TOCircles(clt),x) | PC.TCCircles(_) -> (PC.TCCircles(clt),x) | PC.TOStars(_) -> (PC.TOStars(clt),x) | PC.TCStars(_) -> (PC.TCStars(clt),x) *) | PC.TWhy(_) -> (PC.TWhy(clt),x) | PC.TDotDot(_) -> (PC.TDotDot(clt),x) | PC.TBang(_) -> (PC.TBang(clt),x) | PC.TOPar(_) -> (PC.TOPar(clt),x) | PC.TOPar0(_) -> (PC.TOPar0(clt),x) | PC.TMid0(_) -> (PC.TMid0(clt),x) | PC.TCPar(_) -> (PC.TCPar(clt),x) | PC.TCPar0(_) -> (PC.TCPar0(clt),x) | PC.TOBrace(_) -> (PC.TOBrace(clt),x) | PC.TCBrace(_) -> (PC.TCBrace(clt),x) | PC.TOCro(_) -> (PC.TOCro(clt),x) | PC.TCCro(_) -> (PC.TCCro(clt),x) | PC.TOInit(_) -> (PC.TOInit(clt),x) | PC.TPtrOp(_) -> (PC.TPtrOp(clt),x) | PC.TEq(_) -> (PC.TEq(clt),x) | PC.TAssign(s,_) -> (PC.TAssign(s,clt),x) | PC.TDot(_) -> (PC.TDot(clt),x) | PC.TComma(_) -> (PC.TComma(clt),x) | PC.TPArob(_) -> (PC.TPArob(clt),x) | PC.TPtVirg(_) -> (PC.TPtVirg(clt),x) | PC.TLineEnd(_) -> (PC.TLineEnd(clt),x) | PC.TFunDecl(_) -> (PC.TFunDecl(clt),x) | _ -> failwith "no clt" (* ----------------------------------------------------------------------- *) let make_name prefix ln = Printf.sprintf "%s starting on line %d" prefix ln (* ----------------------------------------------------------------------- *) (* Read tokens *) let wrap_lexbuf_info lexbuf = (Lexing.lexeme lexbuf, Lexing.lexeme_start lexbuf) let tokens_all_full token table file get_ats lexbuf end_predicate : (bool * ((PC.token * (string * (int * int) * (int * int))) list)) = try let rec aux () = let result = token lexbuf in let info = (Lexing.lexeme lexbuf, (table.(Lexing.lexeme_start lexbuf)), (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) in if result = PC.EOF then if get_ats then failwith "unexpected end of file in a metavariable declaration" else (false,[(result,info)]) else if end_predicate result then (true,[(result,info)]) else let (more,rest) = aux() in (more,(result, info)::rest) in aux () with e -> pr2 (Common.error_message file (wrap_lexbuf_info lexbuf) ); raise e let in_list list tok = List.mem tok list let tokens_all table file get_ats lexbuf end_markers : (bool * ((PC.token * (string * (int * int) * (int * int))) list)) = tokens_all_full Lexer_cocci.token table file get_ats lexbuf end_markers let tokens_script_all table file get_ats lexbuf end_markers : (bool * ((PC.token * (string * (int * int) * (int * int))) list)) = tokens_all_full Lexer_script.token table file get_ats lexbuf end_markers (* ----------------------------------------------------------------------- *) (* Split tokens into minus and plus fragments *) let split t clt = let (d,_,_,_,_,_,_,_) = clt in match d with D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ([t],[]) | D.PLUS | D.PLUSPLUS -> ([],[t]) | D.CONTEXT | D.UNIQUE | D.OPT -> ([t],[t]) let split_token ((tok,_) as t) = match tok with PC.TMetavariable | PC.TIdentifier | PC.TConstant | PC.TExpression | PC.TIdExpression | PC.TDeclaration | PC.TField | PC.TStatement | PC.TPosition | PC.TFormat | PC.TAnalysis | PC.TPosAny | PC.TInitialiser | PC.TSymbol | PC.TFunction | PC.TTypedef | PC.TDeclarer | PC.TIterator | PC.TName | PC.TType | PC.TParameter | PC.TLocal | PC.Tlist | PC.TFresh | PC.TCppConcatOp | PC.TPure | PC.TContext | PC.TRuleName(_) | PC.TUsing | PC.TVirtual | PC.TDisable | PC.TExtends | PC.TPathIsoFile(_) | PC.TDepends | PC.TOn | PC.TEver | PC.TNever | PC.TExists | PC.TForall | PC.TError | PC.TWords | PC.TGenerated | PC.TNothing -> ([t],[t]) | PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt) | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tsize_t(clt) | PC.Tssize_t(clt) | PC.Tptrdiff_t(clt) | PC.Tstruct(clt) | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tdecimal(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt) | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt) | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt) | PC.Tconst(clt) | PC.Tvolatile(clt) -> split t clt | PC.TDirective(s,_) -> ([],[t]) (* only allowed in + *) | PC.TPlusFile(s,clt) | PC.TMinusFile(s,clt) | PC.TIncludeL(s,clt) | PC.TIncludeNL(s,clt) -> split t clt | PC.TUndef(clt,_) | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_) | PC.TPragma(clt) -> split t clt | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt) | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TSizeof(clt) | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt) | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt) | PC.TSymId(_,clt) | PC.TMeta(_,_,clt) | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt) | PC.TMetaExpList(_,_,_,clt) | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt) | PC.TMetaId(_,_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaInitList(_,_,_,clt) | PC.TMetaDecl(_,_,clt) | PC.TMetaField(_,_,clt) | PC.TMetaFieldList(_,_,_,clt) | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaErr(_,_,_,clt) | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript | PC.TInitialize | PC.TFinalize -> ([t],[t]) | PC.TPArob clt | PC.TMetaPos(_,_,_,clt) -> split t clt | PC.TFunDecl(clt) | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) | PC.TAny(clt) | PC.TStrict(clt) | PC.TLineEnd(clt) | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) -> split t clt (* | PC.TOCircles(_) | PC.TCCircles(_) (* clt must be context *) | PC.TOStars(_) | PC.TCStars(_) (* clt must be context *) *) | PC.TBang0 | PC.TPlus0 | PC.TWhy0 -> ([t],[t]) | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt) | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar(clt) | PC.TCPar0(clt) -> split t clt | PC.TInc(clt) | PC.TDec(clt) -> split t clt | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) | PC.TDecimalCst(_,_,_,clt) -> split t clt | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt) | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TTildeExclEq(clt) | PC.TSub(clt) | PC.TLogOp(_,clt) | PC.TShLOp(_,clt) | PC.TShROp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt) | PC.TDmOp(_,clt) | PC.TTilde (clt) -> split t clt | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOInit(clt) -> split t clt | PC.TOCro(clt) | PC.TCCro(clt) -> split t clt | PC.TPtrOp(clt) -> split t clt | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt) | PC.TPtVirg(clt) -> split t clt | PC.EOF | PC.TInvalid | PC.TUnderscore -> ([t],[t]) | PC.TIso | PC.TRightIso | PC.TIsoExpression | PC.TIsoStatement | PC.TIsoDeclaration | PC.TIsoType | PC.TIsoTopLevel | PC.TIsoArgExpression | PC.TIsoTestExpression | PC.TIsoToTestExpression -> failwith "unexpected tokens" | PC.TScriptData s -> ([t],[t]) let split_token_stream tokens = let rec loop = function [] -> ([],[]) | token::tokens -> let (minus,plus) = split_token token in let (minus_stream,plus_stream) = loop tokens in (minus@minus_stream,plus@plus_stream) in loop tokens (* ----------------------------------------------------------------------- *) (* Find function names *) (* This addresses a shift-reduce problem in the parser, allowing us to distinguish a function declaration from a function call even if the latter has no return type. Undoubtedly, this is not very nice, but it doesn't seem very convenient to refactor the grammar to get around the problem. *) exception Irrelevant let rec find_function_names l = let is_ident = function (PC.TIdent(_,clt),info) | (PC.TMeta(_,_,clt),info) | (PC.TMetaId(_,_,_,_,clt),info) | (PC.TMetaFunc(_,_,_,clt),info) | (PC.TMetaLocalFunc(_,_,_,clt),info) -> true | _ -> false in let is_mid = function (PC.TMid0(_),info) -> true | _ -> false in let is_par = function (PC.TOPar0(_),info) -> true | _ -> false in let rec split acc = function [] | [_] -> raise Irrelevant | ((PC.TCPar(_),_) as t1) :: ((PC.TOBrace(_),_) as t2) :: rest -> (List.rev (t1::acc),(t2::rest)) | x::xs -> split (x::acc) xs in let rec balanced_name level = function [] -> raise Irrelevant | (PC.TCPar0(_),_)::rest -> let level = level - 1 in if level = 0 then rest else balanced_name level rest | (PC.TOPar0(_),_)::rest -> let level = level + 1 in balanced_name level rest | (PC.TArobArob,_)::_ | (PC.TArob,_)::_ | (PC.EOF,_)::_ -> raise Irrelevant | t::rest when is_ident t && level = 0 -> rest | t::rest when is_ident t or is_mid t -> balanced_name level rest | _ -> raise Irrelevant in let rec balanced_args level = function [] -> raise Irrelevant | (PC.TCPar(_),_)::rest -> let level = level - 1 in if level = 0 then rest else balanced_args level rest | (PC.TOPar(_),_)::rest -> let level = level + 1 in balanced_args level rest | (PC.TArobArob,_)::_ | (PC.TArob,_)::_ | (PC.EOF,_)::_ -> raise Irrelevant | t::rest -> balanced_args level rest in let rec loop = function [] -> [] | t :: rest -> if is_par t or is_mid t or is_ident t then let (t,rest) = try let (bef,aft) = split [] (t::rest) in let rest = balanced_name 0 bef in (match rest with (PC.TOPar(_),_)::_ -> (match balanced_args 0 rest with [] -> let (_,info) as h = List.hd bef in let clt = get_clt h in (((PC.TFunDecl(clt),info) :: bef), aft) | _ -> raise Irrelevant) | _ -> raise Irrelevant) with Irrelevant -> ([t],rest) in t @ (loop rest) else t :: (loop rest) in loop l (* ----------------------------------------------------------------------- *) (* an attribute is an identifier that precedes another identifier and begins with __ *) let rec detect_attr l = let is_id = function (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_) | (PC.TMetaLocalFunc(_,_,_,_),_) -> true | _ -> false in let rec loop = function [] -> [] | [x] -> [x] | ((PC.Tstruct _,_) as t1)::x::rest -> t1::x::loop rest | ((PC.Tunion _,_) as t1)::x::rest -> t1::x::loop rest | ((PC.TIdent(nm,clt),info) as t1)::id::rest when is_id id -> if String.length nm > 2 && String.sub nm 0 2 = "__" then (PC.Tattr(nm,clt),info)::(loop (id::rest)) else t1::(loop (id::rest)) | x::xs -> x::(loop xs) in loop l (* ----------------------------------------------------------------------- *) (* Look for variable declarations where the name is a typedef name. We assume that C code does not contain a multiplication as a top-level statement. *) (* bug: once a type, always a type, even if the same name is later intended to be used as a real identifier *) let detect_types in_meta_decls l = let is_delim infn = function (PC.TOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *) | (PC.TPOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *) | (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *) | (PC.TPtVirg(_),_) | (PC.TOBrace(_),_) | (PC.TOInit(_),_) | (PC.TCBrace(_),_) | (PC.TPure,_) | (PC.TContext,_) | (PC.Tstatic(_),_) | (PC.Textern(_),_) | (PC.Tinline(_),_) | (PC.Ttypedef(_),_) | (PC.Tattr(_),_) -> true | (PC.TComma(_),_) when infn > 0 or in_meta_decls -> true | (PC.TDotDot(_),_) when in_meta_decls -> true | _ -> false in let is_choices_delim = function (PC.TOBrace(_),_) | (PC.TComma(_),_) -> true | _ -> false in let is_id = function (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_) | (PC.TMetaLocalFunc(_,_,_,_),_) -> true | (PC.TMetaParam(_,_,_),_) | (PC.TMetaParamList(_,_,_,_),_) | (PC.TMetaConst(_,_,_,_,_),_) | (PC.TMetaErr(_,_,_,_),_) | (PC.TMetaExp(_,_,_,_,_),_) | (PC.TMetaIdExp(_,_,_,_,_),_) | (PC.TMetaLocalIdExp(_,_,_,_,_),_) | (PC.TMetaExpList(_,_,_,_),_) | (PC.TMetaType(_,_,_),_) | (PC.TMetaInit(_,_,_),_) | (PC.TMetaInitList(_,_,_,_),_) | (PC.TMetaDecl(_,_,_),_) | (PC.TMetaField(_,_,_),_) | (PC.TMetaFieldList(_,_,_,_),_) | (PC.TMetaStm(_,_,_),_) | (PC.TMetaStmList(_,_,_),_) | (PC.TMetaPos(_,_,_,_),_) -> in_meta_decls | _ -> false in let redo_id ident clt v = !Data.add_type_name ident; (PC.TTypeId(ident,clt),v) in let rec loop start infn type_names = function (* infn: 0 means not in a function header > 0 means in a function header, after infn - 1 unmatched open parens*) [] -> [] | ((PC.TOBrace(clt),v)::_) as all when in_meta_decls -> collect_choices type_names all (* never a function header *) | delim::(PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest when is_delim infn delim -> let newid = redo_id ident clt v in delim::newid::x::(loop false infn (ident::type_names) rest) | delim::(PC.TIdent(ident,clt),v)::id::rest when is_delim infn delim && is_id id -> let newid = redo_id ident clt v in delim::newid::id::(loop false infn (ident::type_names) rest) | ((PC.TFunDecl(_),_) as fn)::rest -> fn::(loop false 1 type_names rest) | ((PC.TOPar(_),_) as lp)::rest when infn > 0 -> lp::(loop false (infn + 1) type_names rest) | ((PC.TCPar(_),_) as rp)::rest when infn > 0 -> if infn - 1 = 1 then rp::(loop false 0 type_names rest) (* 0 means not in fn header *) else rp::(loop false (infn - 1) type_names rest) | (PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest when start -> let newid = redo_id ident clt v in newid::x::(loop false infn (ident::type_names) rest) | (PC.TIdent(ident,clt),v)::id::rest when start && is_id id -> let newid = redo_id ident clt v in newid::id::(loop false infn (ident::type_names) rest) | (PC.TIdent(ident,clt),v)::rest when List.mem ident type_names -> (PC.TTypeId(ident,clt),v)::(loop false infn type_names rest) | ((PC.TIdent(ident,clt),v) as x)::rest -> x::(loop false infn type_names rest) | x::rest -> x::(loop false infn type_names rest) and collect_choices type_names = function [] -> [] (* should happen, but let the parser detect that *) | (PC.TCBrace(clt),v)::rest -> (PC.TCBrace(clt),v)::(loop false 0 type_names rest) | delim::(PC.TIdent(ident,clt),v)::rest when is_choices_delim delim -> let newid = redo_id ident clt v in delim::newid::(collect_choices (ident::type_names) rest) | x::rest -> x::(collect_choices type_names rest) in loop true 0 [] l (* ----------------------------------------------------------------------- *) (* Insert TLineEnd tokens at the end of a line that contains a WHEN. WHEN is restricted to a single line, to avoid ambiguity in eg: ... WHEN != x +3 *) let token2line (tok,_) = match tok with PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt) | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tsize_t(clt) | PC.Tssize_t(clt) | PC.Tptrdiff_t(clt) | PC.Tstruct(clt) | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tdecimal(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt) | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt) | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt) | PC.Tconst(clt) | PC.Tvolatile(clt) | PC.TInc(clt) | PC.TDec(clt) | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt) | PC.TSwitch (clt) | PC.TCase (clt) | PC.TDefault (clt) | PC.TSizeof (clt) | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt) | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt) | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) | PC.TSymId(_,clt) | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) | PC.TDecimalCst(_,_,_,clt) | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt) | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt) | PC.TShLOp(_,clt) | PC.TShROp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt) | PC.TDmOp(_,clt) | PC.TTilde (clt) | PC.TMeta(_,_,clt) | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt) | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt) | PC.TMetaExpList(_,_,_,clt) | PC.TMetaId(_,_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaInitList(_,_,_,clt) | PC.TMetaDecl(_,_,clt) | PC.TMetaField(_,_,clt) | PC.TMetaFieldList(_,_,_,clt) | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt) | PC.TFunDecl(clt) | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (*| PC.TOCircles(clt) | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt) | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar(clt) | PC.TCPar0(clt) | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt) | PC.TOInit(clt) | PC.TPtrOp(clt) | PC.TUndef(clt,_) | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_,_) | PC.TPragma(clt) | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt) | PC.TPArob(clt) | PC.TPtVirg(clt) -> let (_,line,_,_,_,_,_,_) = clt in Some line | _ -> None let rec insert_line_end = function [] -> [] | (((PC.TWhen(clt),q) as x)::xs) -> x::(find_line_end true (token2line x) clt q xs) | (((PC.TUndef(clt,_),q) as x)::xs) | (((PC.TDefine(clt,_),q) as x)::xs) | (((PC.TDefineParam(clt,_,_,_),q) as x)::xs) | (((PC.TPragma(clt),q) as x)::xs) -> x::(find_line_end false (token2line x) clt q xs) | x::xs -> x::(insert_line_end xs) and find_line_end inwhen line clt q = function (* don't know what 2nd component should be so just use the info of the When. Also inherit - of when, if any *) [] -> [(PC.TLineEnd(clt),q)] | ((PC.TIdent("strict",clt),a) as x)::xs when token2line x = line -> (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs) | ((PC.TIdent("STRICT",clt),a) as x)::xs when token2line x = line -> (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs) | ((PC.TIdent("any",clt),a) as x)::xs when token2line x = line -> (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs) | ((PC.TIdent("ANY",clt),a) as x)::xs when token2line x = line -> (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs) | ((PC.TIdent("forall",clt),a) as x)::xs when token2line x = line -> (PC.TForall,a) :: (find_line_end inwhen line clt q xs) | ((PC.TIdent("exists",clt),a) as x)::xs when token2line x = line -> (PC.TExists,a) :: (find_line_end inwhen line clt q xs) | ((PC.TComma(clt),a) as x)::xs when token2line x = line -> (PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs) | ((PC.TPArob(clt),a) as x)::xs when token2line x = line -> (PC.TPArob(clt),a) :: (find_line_end inwhen line clt q xs) | x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs) | xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs) let rec translate_when_true_false = function [] -> [] | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("true",_),_)::xs -> (PC.TWhenTrue(clt),q)::x::(translate_when_true_false xs) | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("false",_),_)::xs -> (PC.TWhenFalse(clt),q)::x::(translate_when_true_false xs) | x::xs -> x :: (translate_when_true_false xs) (* ----------------------------------------------------------------------- *) (* In a nest, if the nest is -, all of the nested code must also be -. *) let check_nests tokens = let is_minus t = let (line_type,a,b,c,d,e,f,g) = get_clt t in List.mem line_type [D.MINUS;D.OPTMINUS;D.UNIQUEMINUS] in let check_minus t = match fst t with PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt) -> t | _ -> let clt = try Some(get_clt t) with Failure _ -> None in match clt with Some (line_type,l,ll,c,d,e,f,g) -> (match line_type with D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> t | _ -> failwith (Printf.sprintf "minus expected, on %s, line %d" (token2c t) l)) | None -> t in let rec outside = function [] -> [] | ((PC.TPOEllipsis(clt),q) as t)::r when is_minus t -> t :: inside 0 r | t::r -> t :: outside r and inside stack = function [] -> failwith "missing nest end" | ((PC.TPCEllipsis(clt),q) as t)::r -> (check_minus t) :: (if stack = 0 then outside r else inside (stack - 1) r) | ((PC.TPOEllipsis(clt),q) as t)::r -> (check_minus t) :: (inside (stack + 1) r) | t :: r -> (check_minus t) :: (inside stack r) in outside tokens let check_parentheses tokens = let clt2line (_,line,_,_,_,_,_,_) = line in let rec loop seen_open = function [] -> tokens | (PC.TOPar(clt),q) :: rest | (PC.TDefineParam(clt,_,_,_),q) :: rest -> loop (Common.Left (clt2line clt) :: seen_open) rest | (PC.TOPar0(clt),q) :: rest -> loop (Common.Right (clt2line clt) :: seen_open) rest | (PC.TCPar(clt),q) :: rest -> (match seen_open with [] -> failwith (Printf.sprintf "unexpected close parenthesis in line %d\n" (clt2line clt)) | Common.Left _ :: seen_open -> loop seen_open rest | Common.Right open_line :: _ -> failwith (Printf.sprintf "disjunction parenthesis in line %d column 0 matched to normal parenthesis on line %d\n" open_line (clt2line clt))) | (PC.TCPar0(clt),q) :: rest -> (match seen_open with [] -> failwith (Printf.sprintf "unexpected close parenthesis in line %d\n" (clt2line clt)) | Common.Right _ :: seen_open -> loop seen_open rest | Common.Left open_line :: _ -> failwith (Printf.sprintf "normal parenthesis in line %d matched to disjunction parenthesis on line %d column 0\n" open_line (clt2line clt))) | x::rest -> loop seen_open rest in loop [] tokens (* ----------------------------------------------------------------------- *) (* top level initializers: a sequence of braces followed by a dot *) let find_top_init tokens = match tokens with (PC.TOBrace(clt),q) :: rest -> let rec dot_start acc = function ((PC.TOBrace(_),_) as x) :: rest -> dot_start (x::acc) rest | ((PC.TDot(_),_) :: rest) as x -> Some ((PC.TOInit(clt),q) :: (List.rev acc) @ x) | l -> None in let rec comma_end acc = function ((PC.TCBrace(_),_) as x) :: rest -> comma_end (x::acc) rest | ((PC.TComma(_),_) :: rest) as x -> Some ((PC.TOInit(clt),q) :: (List.rev x) @ acc) | l -> None in (match dot_start [] rest with Some x -> x | None -> (match List.rev rest with (* not super sure what this does, but EOF, @, and @@ should be the same, markind the end of a rule *) ((PC.EOF,_) as x)::rest | ((PC.TArob,_) as x)::rest | ((PC.TArobArob,_) as x)::rest -> (match comma_end [x] rest with Some x -> x | None -> tokens) | _ -> failwith "unexpected empty token list")) | _ -> tokens (* ----------------------------------------------------------------------- *) (* Integrate pragmas into some adjacent token. + tokens are preferred. Dots are not allowed. *) let rec collect_all_pragmas collected = function (PC.TDirective(s,(_,line,logical_line,offset,col,_,_,pos)),_)::rest -> let i = { Ast0.line_start = line; Ast0.line_end = line; Ast0.logical_start = logical_line; Ast0.logical_end = logical_line; Ast0.column = col; Ast0.offset = offset; } in collect_all_pragmas ((s,i)::collected) rest | l -> (List.rev collected,l) let rec collect_pass = function [] -> ([],[]) | x::xs -> match plus_attachable false x with SKIP -> let (pass,rest) = collect_pass xs in (x::pass,rest) | _ -> ([],x::xs) let plus_attach strict = function None -> NOTPLUS | Some x -> plus_attachable strict x let add_bef = function Some x -> [x] | None -> [] (*skips should be things like line end skips is things before pragmas that can't be attached to, pass is things after. pass is used immediately. skips accumulates. When stuff is added before some + code, the logical line of the + code becomes that of the pragma. context_neg relies on things that are adjacent having sequential logical lines. Not sure that this is good enough, as it might result in later gaps in the logical lines... *) let rec process_pragmas bef skips = function [] -> add_bef bef @ List.rev skips | ((PC.TDirective(s,i),_)::_) as l -> let (pragmas,rest) = collect_all_pragmas [] l in let (pass,rest0) = collect_pass rest in let (_,_,prag_lline,_,_,_,_,_) = i in let (next,rest) = match rest0 with [] -> (None,[]) | next::rest -> (Some next,rest) in (match (bef,plus_attach true bef,next,plus_attach true next) with (Some bef,PLUS,_,_) -> let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@ pass@process_pragmas None [] rest0 | (_,_,Some next,PLUS) -> let (a,b,lline,d,e,strbef,straft,pos) = get_clt next in (add_bef bef) @ List.rev skips @ pass @ (process_pragmas (Some (update_clt next (a,b,prag_lline,d,e,pragmas,straft,pos))) [] rest) | _ -> (match (bef,plus_attach false bef,next,plus_attach false next) with (Some bef,PLUS,_,_) -> let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::List.rev skips@ pass@process_pragmas None [] rest0 | (_,_,Some next,PLUS) -> let (a,b,lline,d,e,strbef,straft,pos) = get_clt next in (add_bef bef) @ List.rev skips @ pass @ (process_pragmas (Some (update_clt next (a,b,prag_lline,d,e,pragmas,straft,pos))) [] rest) | _ -> failwith "nothing to attach pragma to")) | x::xs -> (match plus_attachable false x with SKIP -> process_pragmas bef (x::skips) xs | _ -> (add_bef bef) @ List.rev skips @ (process_pragmas (Some x) [] xs)) (* ----------------------------------------------------------------------- *) (* Drop ... ... . This is only allowed in + code, and arises when there is some - code between the ... *) (* drop whens as well - they serve no purpose in + code and they cause problems for drop_double_dots *) let rec drop_when = function [] -> [] | (PC.TWhen(clt),info)::xs -> let rec loop = function [] -> [] | (PC.TLineEnd(_),info)::xs -> drop_when xs | x::xs -> loop xs in loop xs | x::xs -> x::drop_when xs (* instead of dropping the double dots, we put TNothing in between them. these vanish after the parser, but keeping all the ...s in the + code makes it easier to align the + and - code in context_neg and in preparation for the isomorphisms. This shouldn't matter because the context code of the + slice is mostly ignored anyway *) let minus_to_nothing l = (* for cases like | <..., which may or may not arise from removing minus code, depending on whether <... is a statement or expression *) let is_minus tok = try let (d,_,_,_,_,_,_,_) = get_clt tok in (match d with D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> true | D.PLUS | D.PLUSPLUS -> false | D.CONTEXT | D.UNIQUE | D.OPT -> false) with _ -> false in let rec minus_loop = function [] -> [] | (d::ds) as l -> if is_minus d then minus_loop ds else l in let rec loop = function [] -> [] | ((PC.TMid0(clt),i) as x)::t1::ts when is_minus t1 -> (match minus_loop ts with ((PC.TOEllipsis(_),_)::_) | ((PC.TPOEllipsis(_),_)::_) | ((PC.TEllipsis(_),_)::_) as l -> x::(PC.TNothing,i)::(loop l) | l -> x::(loop l)) | t::ts -> t::(loop ts) in loop l let rec drop_double_dots l = let start = function (PC.TOEllipsis(_),_) | (PC.TPOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *) -> true | _ -> false in let middle = function (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *) -> true | _ -> false in let whenline = function (PC.TLineEnd(_),_) -> true (*| (PC.TMid0(_),_) -> true*) | _ -> false in let final = function (PC.TCEllipsis(_),_) | (PC.TPCEllipsis(_),_) (* | (PC.TCCircles(_),_) | (PC.TCStars(_),_) *) -> true | _ -> false in let any_before x = start x or middle x or final x or whenline x in let any_after x = start x or middle x or final x in let rec loop ((_,i) as prev) = function [] -> [] | x::rest when any_before prev && any_after x -> (PC.TNothing,i)::x::(loop x rest) | ((PC.TComma(_),_) as c)::x::rest when any_before prev && any_after x -> c::(PC.TNothing,i)::x::(loop x rest) | x::rest -> x :: (loop x rest) in match l with [] -> [] | (x::xs) -> x :: loop x xs (* ignore uncomparable pcre regular expressions *) let strip_for_fix l = List.map (function (PC.TMetaId(nm,_,seed,pure,clt),info) -> (PC.TMetaId(nm,Ast.IdNoConstraint,seed,pure,clt),info) | (PC.TMetaFunc(nm,_,pure,clt),info) -> (PC.TMetaFunc(nm,Ast.IdNoConstraint,pure,clt),info) | (PC.TMetaLocalFunc(nm,_,pure,clt),info) -> (PC.TMetaLocalFunc(nm,Ast.IdNoConstraint,pure,clt),info) | (PC.TMetaErr(nm,_,pure,clt),info) -> (PC.TMetaErr(nm,Ast0.NoConstraint,pure,clt),info) | (PC.TMetaExp(nm,_,pure,ty,clt),info) -> (PC.TMetaExp(nm,Ast0.NoConstraint,pure,ty,clt),info) | (PC.TMetaIdExp(nm,_,pure,ty,clt),info) -> (PC.TMetaIdExp(nm,Ast0.NoConstraint,pure,ty,clt),info) | (PC.TMetaLocalIdExp(nm,_,pure,ty,clt),info) -> (PC.TMetaLocalIdExp(nm,Ast0.NoConstraint,pure,ty,clt),info) | (PC.TMetaConst(nm,_,pure,ty,clt),info) -> (PC.TMetaConst(nm,Ast0.NoConstraint,pure,ty,clt),info) | t -> t) l let fix f l = let rec loop f l stripped_l = let cur = f l in let stripped_cur = strip_for_fix cur in if stripped_l = stripped_cur then l else loop f cur stripped_cur in loop f l (strip_for_fix l) (* ( | ... | ) also causes parsing problems *) exception Not_empty let rec drop_empty_thing starter middle ender = function [] -> [] | hd::rest when starter hd -> let rec loop = function x::rest when middle x -> loop rest | x::rest when ender x -> rest | _ -> raise Not_empty in (match try Some(loop rest) with Not_empty -> None with Some x -> drop_empty_thing starter middle ender x | None -> hd :: drop_empty_thing starter middle ender rest) | x::rest -> x :: drop_empty_thing starter middle ender rest let drop_empty_or = drop_empty_thing (function (PC.TOPar0(_),_) -> true | _ -> false) (function (PC.TMid0(_),_) -> true | _ -> false) (function (PC.TCPar0(_),_) -> true | _ -> false) let drop_empty_nest = drop_empty_thing (* ----------------------------------------------------------------------- *) (* Read tokens *) let get_s_starts (_, (s,_,(starts, ends))) = Printf.printf "%d %d\n" starts ends; (s, starts) let pop2 l = let v = List.hd !l in l := List.tl !l; v let reinit _ = PC.reinit (function _ -> PC.TArobArob (* a handy token *)) (Lexing.from_function (function buf -> function n -> raise (Common.Impossible 157))) let parse_one str parsefn file toks = let all_tokens = ref toks in let cur_tok = ref (List.hd !all_tokens) in let lexer_function _ = let (v, info) = pop2 all_tokens in cur_tok := (v, info); v in let lexbuf_fake = Lexing.from_function (function buf -> function n -> raise (Common.Impossible 158)) in reinit(); try parsefn lexer_function lexbuf_fake with Lexer_cocci.Lexical s -> failwith (Printf.sprintf "%s: lexical error: %s\n =%s\n" str s (Common.error_message file (get_s_starts !cur_tok) )) | Parser_cocci_menhir.Error -> failwith (Printf.sprintf "%s: parse error: \n = %s\n" str (Common.error_message file (get_s_starts !cur_tok) )) | Semantic_cocci.Semantic s -> failwith (Printf.sprintf "%s: semantic error: %s\n =%s\n" str s (Common.error_message file (get_s_starts !cur_tok) )) | e -> raise e let prepare_tokens tokens = find_top_init (translate_when_true_false (* after insert_line_end *) (insert_line_end (detect_types false (find_function_names (detect_attr (check_nests (check_parentheses tokens))))))) let prepare_mv_tokens tokens = detect_types false (detect_attr tokens) let unminus (d,x1,x2,x3,x4,x5,x6,x7) = (* for hidden variables *) match d with D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7) | D.PLUS -> failwith "unexpected plus code" | D.PLUSPLUS -> failwith "unexpected plus code" | D.CONTEXT | D.UNIQUE | D.OPT -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7) let process_minus_positions x name clt meta = let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in let name = Parse_aux.clt2mcode name (unminus clt) in update_clt x (arity,ln,lln,offset,col,strbef,straft,meta name::pos) (* first attach positions, then the others, so that positions can refer to the larger term represented by the preceding metavariable *) let rec consume_minus_positions toks = let rec loop_pos = function [] -> [] | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs | ((PC.TMid0(_),_) as x)::xs -> x::loop_pos xs | x::(PC.TPArob _,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,per))) in (loop_pos (x::xs)) | x::xs -> x::loop_pos xs in let rec loop_other = function [] -> [] | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs | ((PC.TMid0(_),_) as x)::xs -> x::loop_other xs | x::(PC.TPArob _,_)::(PC.TMetaId(name,constraints,seed,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.IdentTag (Ast0.wrap (Ast0.MetaId(name,constraints,seed,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaExp(name,constraints,pure,ty,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.ExprTag (Ast0.wrap (Ast0.MetaExpr(name,constraints,ty,Ast.ANY,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaExpList(name,len,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> let len = match len with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(Parse_aux.clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in Ast0.ExprTag (Ast0.wrap (Ast0.MetaExprList(name,len,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaInit(name,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.InitTag(Ast0.wrap(Ast0.MetaInit(name,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaType(name,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.TypeCTag(Ast0.wrap(Ast0.MetaType(name,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaDecl(name,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.DeclTag(Ast0.wrap(Ast0.MetaDecl(name,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaStm(name,pure,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.StmtTag(Ast0.wrap(Ast0.MetaStmt(name,pure)))) in (loop_other (x::xs)) | x::(PC.TPArob _,_)::(PC.TMetaIdExp(name,constraints,pure,ty,clt),_)::xs -> let x = process_minus_positions x name clt (function name -> Ast0.ExprTag (Ast0.wrap (Ast0.MetaExpr(name,constraints,ty,Ast.ANY,pure)))) in (loop_other (x::xs)) | x::((PC.TPArob _,_) as x')::x''::xs -> x::loop_other (x'::x''::xs) | x::xs -> x::loop_other xs in loop_other(loop_pos toks) let rec consume_plus_positions = function [] -> [] | (PC.TPArob _,_)::x::xs -> consume_plus_positions xs | x::xs -> x::consume_plus_positions xs let any_modif rule = let mcode x = match Ast0.get_mcode_mcodekind x with Ast0.MINUS _ | Ast0.PLUS _ -> true | _ -> false in let donothing r k e = k e in let bind x y = x or y in let option_default = false in let fn = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in List.exists fn.VT0.combiner_rec_top_level rule let eval_virt virt = List.iter (function x -> if not (List.mem x virt) then raise (Bad_virt x)) !Flag.defined_virtual_rules let drop_last extra l = List.rev(extra@(List.tl(List.rev l))) let partition_either l = let rec part_either left right = function | [] -> (List.rev left, List.rev right) | x :: l -> (match x with | Common.Left e -> part_either (e :: left) right l | Common.Right e -> part_either left (e :: right) l) in part_either [] [] l let rec collect_script_tokens = function [(PC.EOF,_)] | [(PC.TArobArob,_)] | [(PC.TArob,_)] -> "" | (PC.TScriptData(s),_)::[] -> s | (PC.TScriptData(s),_)::xs -> s^(collect_script_tokens xs) | toks -> List.iter (function x -> Printf.printf "%s\n" (token2c x)) toks; failwith "Malformed script rule" let get_metavars parse_fn table file lexbuf = Lexer_cocci.reinit(); (* string metavariable initializations *) let rec meta_loop acc (* read one decl at a time *) = let (_,tokens) = Data.call_in_meta (function _ -> tokens_all table file true lexbuf (in_list [PC.TArobArob;PC.TMPtVirg;PC.TAnalysis])) in let tokens = prepare_mv_tokens tokens in match tokens with [(PC.TArobArob,_)] -> List.rev acc | (PC.TAnalysis _, _) :: tl -> Lexer_script.file := file; Lexer_script.language := "ocaml"; let get_tokens = tokens_script_all table file false lexbuf in let rec loop n toks = let (more, newtoks) = get_tokens (in_list [PC.TScriptData ")"]) in (* we stop at the first close paren*) let n = n - 1 in (* count open parens *) let count str toks = List.fold_left (fun n (t, _) -> if t = PC.TScriptData str then n + 1 else n) 0 toks in let n = n + count "(" newtoks in (* continue parsing *) if n = 0 then toks @ newtoks else loop n (toks @ newtoks) in begin match get_tokens (in_list [PC.TScriptData "("]) with | (_, ([(s, _)] as toks)) -> let data = collect_script_tokens (loop 1 toks) in let (_,tokens) = Data.call_in_meta (function _ -> tokens_all table file true lexbuf (in_list [PC.TArobArob;PC.TMPtVirg])) in begin match tokens with | [(PC.TIdent (id, _), _); (PC.TMPtVirg, _)] -> let metavar = Common.Left (Ast.MetaAnalysisDecl (data, (!Ast0.rule_name, id))) in meta_loop (metavar :: acc) | _ -> failwith "'analysis' can only have one variable" end | (_, toks) -> failwith ("'analysis' should be followed by an '(', but was followed by:\n"^(collect_script_tokens toks)) end | _ -> let metavars = parse_one "meta" parse_fn file tokens in meta_loop (metavars@acc) in partition_either (meta_loop []) let get_script_metavars parse_fn table file lexbuf = let rec meta_loop acc = let (_, tokens) = tokens_all table file true lexbuf (in_list [PC.TArobArob; PC.TMPtVirg]) in let tokens = prepare_tokens tokens in match tokens with [(PC.TArobArob, _)] -> List.rev acc | _ -> let metavar = parse_one "scriptmeta" parse_fn file tokens in meta_loop (metavar :: acc) in meta_loop [] let get_rule_name parse_fn starts_with_name get_tokens file prefix = Data.in_rule_name := true; let mknm _ = make_name prefix (!Lexer_cocci.line) in let name_res = if starts_with_name then let (_,tokens) = get_tokens (in_list [PC.TArob]) in let check_name = function None -> Some (mknm()) | Some nm -> (if List.mem nm reserved_names then failwith (Printf.sprintf "invalid name %s\n" nm)); Some nm in match parse_one "rule name" parse_fn file tokens with Ast.CocciRulename (nm,a,b,c,d,e) -> Ast.CocciRulename (check_name nm,a,b,c,d,e) | Ast.GeneratedRulename (nm,a,b,c,d,e) -> Ast.GeneratedRulename (check_name nm,a,b,c,d,e) | Ast.ScriptRulename(nm,s,deps) -> Ast.ScriptRulename(check_name nm,s,deps) | Ast.InitialScriptRulename(_,s,deps) -> Ast.InitialScriptRulename(check_name None,s,deps) | Ast.FinalScriptRulename(_,s,deps) -> Ast.FinalScriptRulename(check_name None,s,deps) else Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined, Ast.AnyP) in Data.in_rule_name := false; name_res let parse_iso file = let table = Common.full_charpos_to_pos file in Common.with_open_infile file (fun channel -> let lexbuf = Lexing.from_channel channel in let get_tokens = tokens_all table file false lexbuf in let res = match get_tokens (in_list [PC.TArobArob;PC.TArob]) with (true,start) -> let parse_start start = let rev = List.rev start in let (arob,_) = List.hd rev in (arob = PC.TArob,List.rev(List.tl rev)) in let (starts_with_name,start) = parse_start start in let rec loop starts_with_name start = (!Data.init_rule)(); (* get metavariable declarations - have to be read before the rest *) let (rule_name,_,_,_,_,_) = match get_rule_name PC.iso_rule_name starts_with_name get_tokens file ("iso file "^file) with Ast.CocciRulename (Some n,a,b,c,d,e) -> (n,a,b,c,d,e) | _ -> failwith "Script rules cannot appear in isomorphism rules" in Ast0.rule_name := rule_name; let iso_metavars = match get_metavars PC.iso_meta_main table file lexbuf with (iso_metavars,[]) -> iso_metavars | _ -> failwith "unexpected inheritance in iso" in (* get the rule *) let (more,tokens) = get_tokens (in_list [PC.TIsoStatement;PC.TIsoExpression;PC.TIsoArgExpression; PC.TIsoTestExpression; PC.TIsoToTestExpression; PC.TIsoDeclaration;PC.TIsoType;PC.TIsoTopLevel]) in let next_start = List.hd(List.rev tokens) in let dummy_info = ("",(-1,-1),(-1,-1)) in let tokens = drop_last [(PC.EOF,dummy_info)] tokens in let tokens = prepare_tokens (start@tokens) in (* print_tokens "iso tokens" tokens; *) let entry = parse_one "iso main" PC.iso_main file tokens in let entry = List.map (List.map Test_exps.process_anything) entry in if more then (* The code below allows a header like Statement list, which is more than one word. We don't have that any more, but the code is left here in case it is put back. *) match get_tokens (in_list [PC.TArobArob;PC.TArob]) with (true,start) -> let (starts_with_name,start) = parse_start start in (iso_metavars,entry,rule_name) :: (loop starts_with_name (next_start::start)) | _ -> failwith "isomorphism ends early" else [(iso_metavars,entry,rule_name)] in loop starts_with_name start | (false,_) -> [] in List.iter Iso_compile.process res; res) let parse_iso_files existing_isos iso_files extra_path = let get_names = List.map (function (_,_,nm) -> nm) in let old_names = get_names existing_isos in Data.in_iso := true; let (res,_) = List.fold_left (function (prev,names) -> function file -> let file = match file with Common.Left(fl) -> Filename.concat extra_path fl | Common.Right(fl) -> Filename.concat Config.path fl in Lexer_cocci.init (); let current = parse_iso file in let new_names = get_names current in if List.exists (function x -> List.mem x names) new_names then failwith (Printf.sprintf "repeated iso name found in %s" file); (current::prev,new_names @ names)) ([],old_names) iso_files in Data.in_iso := false; existing_isos@(List.concat (List.rev res)) (* None = dependency not satisfied Some dep = dependency satisfied or unknown and dep has virts optimized away *) let eval_depend dep virt = let rec loop dep = match dep with Ast.Dep req | Ast.EverDep req -> if List.mem req virt then if List.mem req !Flag.defined_virtual_rules then Ast.NoDep else Ast.FailDep else dep | Ast.AntiDep antireq | Ast.NeverDep antireq -> if List.mem antireq virt then if not(List.mem antireq !Flag.defined_virtual_rules) then Ast.NoDep else Ast.FailDep else dep | Ast.AndDep(d1,d2) -> (match (loop d1, loop d2) with (Ast.NoDep,x) | (x,Ast.NoDep) -> x | (Ast.FailDep,x) | (x,Ast.FailDep) -> Ast.FailDep | (x,y) -> Ast.AndDep(x,y)) | Ast.OrDep(d1,d2) -> (match (loop d1, loop d2) with (Ast.NoDep,x) | (x,Ast.NoDep) -> Ast.NoDep | (Ast.FailDep,x) | (x,Ast.FailDep) -> x | (x,y) -> Ast.OrDep(x,y)) | Ast.NoDep | Ast.FailDep -> dep in loop dep let parse file = Lexer_cocci.init (); let rec parse_loop file = Lexer_cocci.include_init (); let table = Common.full_charpos_to_pos file in Common.with_open_infile file (fun channel -> let lexbuf = Lexing.from_channel channel in let get_tokens = tokens_all table file false lexbuf in Data.in_prolog := true; let initial_tokens = get_tokens (in_list [PC.TArobArob;PC.TArob]) in Data.in_prolog := false; let res = match initial_tokens with (true,data) -> (match List.rev data with ((PC.TArobArob as x),_)::_ | ((PC.TArob as x),_)::_ -> let include_and_iso_files = parse_one "include and iso file names" PC.include_main file data in let (include_files,iso_files,virt) = List.fold_left (function (include_files,iso_files,virt) -> function Data.Include s -> (s::include_files,iso_files,virt) | Data.Iso s -> (include_files,s::iso_files,virt) | Data.Virt l -> (include_files,iso_files,l@virt)) ([],[],[]) include_and_iso_files in List.iter (function x -> Hashtbl.add Lexer_cocci.rule_names x ()) virt; let (extra_iso_files, extra_rules, extra_virt, extra_metas) = let rec loop = function [] -> ([],[],[],[]) | (a,b,c,d)::rest -> let (x,y,z,zz) = loop rest in (a::x,b::y,c::z,d@zz) in loop (List.map parse_loop include_files) in let parse_cocci_rule ruletype old_metas (rule_name, dependencies, iso, dropiso, exists, is_expression) = let dropiso = !Flag_parsing_cocci.disabled_isos @ dropiso in Ast0.rule_name := rule_name; Data.inheritable_positions := rule_name :: !Data.inheritable_positions; (* get metavariable declarations *) let (metavars, inherited_metavars) = get_metavars PC.meta_main table file lexbuf in Hashtbl.add Data.all_metadecls rule_name metavars; Hashtbl.add Lexer_cocci.rule_names rule_name (); Hashtbl.add Lexer_cocci.all_metavariables rule_name (Hashtbl.fold (fun key v rest -> (key,v)::rest) Lexer_cocci.metavariables []); (* get transformation rules *) let (more, tokens) = get_tokens (in_list [PC.TArobArob; PC.TArob]) in let (minus_tokens, _) = split_token_stream tokens in let (_, plus_tokens) = split_token_stream (minus_to_nothing tokens) in (* print_tokens "minus tokens" minus_tokens; print_tokens "plus tokens" plus_tokens; *) let minus_tokens = consume_minus_positions minus_tokens in let plus_tokens = consume_plus_positions plus_tokens in let minus_tokens = prepare_tokens minus_tokens in let plus_tokens = prepare_tokens plus_tokens in (* print_tokens "minus tokens" minus_tokens; print_tokens "plus tokens" plus_tokens; *) let plus_tokens = process_pragmas None [] (fix (function x -> drop_double_dots (drop_empty_or x)) (drop_when plus_tokens)) in (* print_tokens "plus tokens" plus_tokens; Printf.printf "before minus parse\n"; *) let minus_res = let minus_parser = match is_expression with Ast.AnyP -> PC.minus_main | Ast.TyP -> PC.minus_ty_main | Ast.ExpP -> PC.minus_exp_main in parse_one "minus" minus_parser file minus_tokens in (* Unparse_ast0.unparse minus_res; Printf.printf "before plus parse\n"; *) let plus_res = (* put ignore_patch_or_match with * case, which is less constraining *) if !Flag.sgrep_mode2 or !D.ignore_patch_or_match then (* not actually used for anything, except context_neg *) List.map (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_top_level (Top_level.top_level false minus_res) else let plus_parser = match is_expression with Ast.AnyP -> PC.plus_main | Ast.TyP -> PC.plus_ty_main | Ast.ExpP -> PC.plus_exp_main in parse_one "plus" plus_parser file plus_tokens in let plus_res = Top_level.top_level false plus_res in (* minus code has to be CODE if the + code is CODE, otherwise doesn't matter if + code is CODE or DECL or TOPCODE *) let minus_res = let any_code = List.exists (function x -> match Ast0.unwrap x with Ast0.CODE _ -> true | _ -> false) plus_res in if any_code then Top_level.top_level true minus_res else Top_level.top_level false minus_res in let minus_res = Top_level.clean minus_res in let plus_res = Top_level.clean plus_res in (* Unparse_ast0.unparse plus_res; Printf.printf "after plus parse\n"; *) (if not !Flag.sgrep_mode2 && (any_modif minus_res or any_modif plus_res) && not(dependencies = Ast.FailDep) then Data.inheritable_positions := []); Check_meta.check_meta rule_name old_metas inherited_metavars metavars minus_res plus_res; (more, Ast0.CocciRule ((minus_res, metavars, (iso, dropiso, dependencies, rule_name, exists)), (plus_res, metavars), ruletype), metavars, tokens) in let parse_script_rule name language old_metas deps = Lexer_script.file := file; Lexer_script.language := language; let get_tokens = tokens_script_all table file false lexbuf in (* meta-variables *) let metavars = Data.call_in_meta (function _ -> get_script_metavars PC.script_meta_main table file lexbuf) in let (metavars,script_metavars) = List.fold_left (function (metavars,script_metavars) -> function (script_var,Some(parent,var)) -> ((script_var,parent,var) :: metavars, script_metavars) | ((Some script_var,None),None) -> (metavars, (name,script_var) :: script_metavars) | _ -> failwith "not possible") ([],[]) metavars in let metavars = List.rev metavars in let script_metavars = List.rev script_metavars in Hashtbl.add Data.all_metadecls name (List.map (function x -> Ast.MetaIdDecl(Ast.NONE,x)) script_metavars); Hashtbl.add Lexer_cocci.rule_names name (); (*TODOHashtbl.add Lexer_cocci.all_metavariables name script_metavars;*) (* let exists_in old_metas (py,(r,m)) = r = "virtual" or let test (rr,mr) x = let (ro,vo) = Ast.get_meta_name x in ro = rr && vo = mr in List.exists (test (r,m)) old_metas in List.iter (function x -> let meta2c (r,n) = Printf.sprintf "%s.%s" r n in if not (exists_in old_metas x) then failwith (Printf.sprintf "Script references unknown meta-variable: %s" (meta2c(snd x)))) metavars; *) (* script code *) let (more, tokens) = get_tokens (in_list [PC.TArobArob; PC.TArob]) in let data = collect_script_tokens tokens in (more, Ast0.ScriptRule(name, language, deps, metavars, script_metavars, data), [],tokens) in let parse_if_script_rule k name language _ deps = Lexer_script.file := file; Lexer_script.language := language; let get_tokens = tokens_script_all table file false lexbuf in (* script code *) let (more, tokens) = get_tokens (in_list [PC.TArobArob; PC.TArob]) in let data = collect_script_tokens tokens in (more,k (name, language, deps, data),[],tokens) in let parse_iscript_rule = parse_if_script_rule (function (name,language,deps,data) -> Ast0.InitialScriptRule(name,language,deps,data)) in let parse_fscript_rule = parse_if_script_rule (function (name,language,deps,data) -> Ast0.FinalScriptRule(name,language,deps,data)) in let do_parse_script_rule fn name l old_metas deps = fn name l old_metas (eval_depend deps virt) in let parse_rule old_metas starts_with_name = let rulename = get_rule_name PC.rule_name starts_with_name get_tokens file "rule" in match rulename with Ast.CocciRulename (Some s, dep, b, c, d, e) -> (match eval_depend dep virt with Ast.FailDep -> D.ignore_patch_or_match := true; let res = parse_cocci_rule Ast.Normal old_metas (s, Ast.FailDep, b, c, d, e) in D.ignore_patch_or_match := false; res | dep -> parse_cocci_rule Ast.Normal old_metas (s,dep,b,c,d,e)) | Ast.GeneratedRulename (Some s, dep, b, c, d, e) -> (match eval_depend dep virt with Ast.FailDep -> D.ignore_patch_or_match := true; Data.in_generating := true; let res = parse_cocci_rule Ast.Generated old_metas (s, Ast.FailDep, b, c, d, e) in D.ignore_patch_or_match := false; Data.in_generating := false; res | dep -> Data.in_generating := true; let res = parse_cocci_rule Ast.Generated old_metas (s,dep,b,c,d,e) in Data.in_generating := false; res) | Ast.ScriptRulename(Some s,l,deps) -> do_parse_script_rule parse_script_rule s l old_metas deps | Ast.InitialScriptRulename(Some s,l,deps) -> do_parse_script_rule parse_iscript_rule s l old_metas deps | Ast.FinalScriptRulename(Some s,l,deps) -> do_parse_script_rule parse_fscript_rule s l old_metas deps | _ -> failwith "Malformed rule name" in let rec loop old_metas starts_with_name = (!Data.init_rule)(); let gen_starts_with_name more tokens = more && (match List.hd (List.rev tokens) with (PC.TArobArob,_) -> false | (PC.TArob,_) -> true | _ -> failwith "unexpected token") in let (more, rule, metavars, tokens) = parse_rule old_metas starts_with_name in let all_metas = metavars @ old_metas in if more then let (all_rules,all_metas) = loop all_metas (gen_starts_with_name more tokens) in (rule::all_rules,all_metas) else ([rule],all_metas) in let (all_rules,all_metas) = loop extra_metas (x = PC.TArob) in (List.fold_left (function prev -> function cur -> Common.union_set cur prev) iso_files extra_iso_files, (* included rules first *) List.fold_left (function prev -> function cur -> cur@prev) all_rules (List.rev extra_rules), List.fold_left (@) virt extra_virt (*no dups allowed*), (all_metas : 'a list)) | _ -> failwith "unexpected code before the first rule\n") | (false,[(PC.TArobArob,_)]) | (false,[(PC.TArob,_)]) -> ([],([] : Ast0.parsed_rule list),[] (*virtual rules*), [] (*all metas*)) | _ -> failwith "unexpected code before the first rule\n" in res) in parse_loop file (* parse to ast0 and then convert to ast *) let process file isofile verbose = Parse_aux.contains_string_constant := false; let extra_path = Filename.dirname file in let (iso_files, rules, virt, _metas) = parse file in eval_virt virt; let std_isos = match isofile with None -> [] | Some iso_file -> parse_iso_files [] [Common.Left iso_file] "" in let global_isos = parse_iso_files std_isos iso_files extra_path in let rules = Unitary_ast0.do_unitary rules in let parsed = List.map (function Ast0.ScriptRule (a,b,c,d,fv,e) -> [([],Ast.ScriptRule (a,b,c,d,fv,e))] | Ast0.InitialScriptRule(a,b,c,d) -> [([],Ast.InitialScriptRule (a,b,c,d))] | Ast0.FinalScriptRule (a,b,c,d) -> [([],Ast.FinalScriptRule (a,b,c,d))] | Ast0.CocciRule ((minus, metavarsm, (iso, dropiso, dependencies, rule_name, exists)), (plus, metavars),ruletype) -> let chosen_isos = parse_iso_files global_isos (List.map (function x -> Common.Left x) iso) extra_path in let chosen_isos = (* check that dropped isos are actually available *) (try let iso_names = List.map (function (_,_,nm) -> nm) chosen_isos in let local_iso_names = reserved_names @ iso_names in let bad_dropped = List.find (function dropped -> not (List.mem dropped local_iso_names)) dropiso in failwith ("invalid iso name " ^ bad_dropped ^ " in " ^ rule_name) with Not_found -> ()); if List.mem "all" dropiso then if List.length dropiso = 1 then [] else failwith "disable all should only be by itself" else (* drop those isos *) List.filter (function (_,_,nm) -> not (List.mem nm dropiso)) chosen_isos in let dropped_isos = match reserved_names with "all"::others -> (match dropiso with ["all"] -> others | _ -> List.filter (function x -> List.mem x dropiso) others) | _ -> failwith "bad list of reserved names - all must be at start" in let minus = Test_exps.process minus in let minus = Compute_lines.compute_lines false minus in let plus = Compute_lines.compute_lines false plus in let is_exp = (* only relevant to Flag.make_hrule *) (* doesn't handle multiple minirules properly, but since we don't really handle them in lots of other ways, it doesn't seem very important *) match plus with [] -> [false] | p::_ -> [match Ast0.unwrap p with Ast0.CODE c -> (match List.map Ast0.unwrap (Ast0.undots c) with [Ast0.Exp e] -> true | _ -> false) | _ -> false] in let minus = Arity.minus_arity minus in let ((metavars,minus),function_prototypes) = Function_prototypes.process rule_name metavars dropped_isos minus plus ruletype in let plus = Adjust_pragmas.process plus in (* warning! context_neg side-effects its arguments *) let (m,p) = List.split (Context_neg.context_neg minus plus) in Type_infer.type_infer p; (if not (!Flag.sgrep_mode2 or dependencies = Ast.FailDep) then Insert_plus.insert_plus m p (chosen_isos = [])); Type_infer.type_infer minus; let (extra_meta, minus) = match (chosen_isos,ruletype) with (* separate case for [] because applying isos puts some restrictions on the -+ code *) ([],_) | (_,Ast.Generated) -> ([],minus) | _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in (* must be before adj *) let minus = Commas_on_lists.process minus in (* after iso, because iso can intro ... *) let minus = Adjacency.compute_adjacency minus in let minus = Comm_assoc.comm_assoc minus rule_name dropiso in let minus = if !Flag.sgrep_mode2 then minus else Single_statement.single_statement minus in let minus = Simple_assignments.simple_assignments minus in (* has to be last, introduced AsExpr, etc *) let minus = Get_metas.process minus in let minus_ast = Ast0toast.ast0toast rule_name dependencies dropped_isos exists minus is_exp ruletype in match function_prototypes with None -> [(extra_meta @ metavars, minus_ast)] | Some mv_fp -> [(extra_meta @ metavars, minus_ast); mv_fp]) (* Ast0.CocciRule ((minus, metavarsm, (iso, dropiso, dependencies, rule_name, exists)), (plus, metavars))*) rules in let parsed = List.concat parsed in let parsed = Safe_for_multi_decls.safe_for_multi_decls parsed in let disjd = Disjdistr.disj parsed in let (metavars,code,fvs,neg_pos,ua,pos) = Free_vars.free_vars disjd in if !Flag_parsing_cocci.show_SP then List.iter Pretty_print_cocci.unparse code; let search_tokens = Common.profile_code "get_glimpse_constants" (* for glimpse *) (fun () -> Get_constants2.get_constants code neg_pos) in (metavars,code,fvs,neg_pos,ua,pos,search_tokens, !Parse_aux.contains_string_constant) coccinelle-1.0.0-rc19/parsing_cocci/parsing_cocci.mllib0000644000175000017500000000105012247437436022013 0ustar eugeneugenFlag_parsing_cocci Type_cocci Ast_cocci Ast0_cocci Pretty_print_cocci Unparse_ast0 Visitor_ast0_types Visitor_ast Visitor_ast0 Compute_lines Comm_assoc Iso_pattern Iso_compile Single_statement Simple_assignments Get_metas Ast0toast Check_meta Top_level Type_infer Test_exps Unitary_ast0 Arity Index Context_neg Adjust_pragmas Insert_plus Function_prototypes Unify_ast Semantic_cocci Data Free_vars Safe_for_multi_decls Parse_aux Disjdistr Lexer_cocci Parser_cocci_menhir Lexer_cli Lexer_script Get_constants2 Id_utils Adjacency Parse_cocci Command_linecoccinelle-1.0.0-rc19/parsing_cocci/get_constants.ml0000644000175000017500000002727212247442615021405 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_constants.ml" (* get a list of all of the constants in the - slice of a SmPL file, to be used to select which files to process *) (* This could be made more efficient, by finding only the important things. eg, if we have a function and its arguments, we could just pick the function. And we could try to pick only the things annotated with -, and only pick something else if there is no -. In general, we only want the most important constant, not all the constants. *) module Ast = Ast_cocci module V = Visitor_ast module TC = Type_cocci let keep_some_bind x y = match x with [] -> y | _ -> x let or_bind x y = match x with [] -> [] | _ -> x let keep_all_bind = Common.union_set let get_minus_constants bind orbind = let donothing r k e = k e in let option_default = [] in let mcode _ _ = option_default in (* if one branch gives no information, then we have to take anything *) let disj_union_all l = if List.exists (function [] -> true | _ -> false) l then orbind [] (Common.union_all l) else Common.union_all l in (* need special cases for everything with a disj, because the bind above would throw away all but the first disj *) let ident r k e = match Ast.unwrap e with Ast.Id(name) -> (match Ast.unwrap_mcode name with "NULL" -> [] (* special case, because this is too generic *) | nm -> [nm]) | _ -> k e in let expression r k e = match Ast.unwrap e with Ast.RecordAccess(exp,_,fld) | Ast.RecordPtAccess(exp,_,fld) -> bind (Common.union_all (List.map (function id -> ["."^id;"->"^id]) (r.V.combiner_ident fld))) (r.V.combiner_expression exp) | Ast.SizeOfExpr(sizeof,_) | Ast.SizeOfType(sizeof,_,_,_) -> bind (k e) [Ast.unwrap_mcode sizeof] | Ast.DisjExpr(exps) -> disj_union_all (List.map r.V.combiner_expression exps) | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> [] | Ast.NestExpr(starter,expr_dots,ender,whencode,false) -> [] | Ast.NestExpr(starter,expr_dots,ender,whencode,true) -> r.V.combiner_expression_dots expr_dots | _ -> k e in let typeC r k e = match Ast.unwrap e with Ast.TypeName(ty) -> if !Flag.sgrep_mode2 then match ty with (_,_,Ast.MINUS(_,_,_,_),_) -> [Ast.unwrap_mcode ty] | _ -> [] else [Ast.unwrap_mcode ty] | _ -> k e in let fullType r k e = match Ast.unwrap e with Ast.DisjType(types) -> disj_union_all (List.map r.V.combiner_fullType types) | _ -> k e in let declaration r k e = match Ast.unwrap e with Ast.DisjDecl(decls) -> disj_union_all (List.map r.V.combiner_declaration decls) | Ast.Ddots(dots,whencode) -> [] | _ -> k e in let rule_elem r k e = match Ast.unwrap e with Ast.DisjRuleElem(res) -> disj_union_all (List.map r.V.combiner_rule_elem res) | _ -> k e in let statement r k e = match Ast.unwrap e with Ast.Disj(stmt_dots) -> disj_union_all (List.map r.V.combiner_statement_dots stmt_dots) | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> [] | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> [] | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) -> r.V.combiner_statement_dots stmt_dots | _ -> k e in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing ident expression fullType typeC donothing donothing declaration rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) let get_all_minus_constants = let donothing r k e = k e in let bind = Common.union_set in let option_default = [] in let mcode r (x,_,mcodekind,_) = match mcodekind with Ast.MINUS(_,_,_,_) -> [x] | _ -> [] in let other r (x,_,mcodekind,_) = [] in V.combiner bind option_default other mcode other other other other other other other other other other donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* ------------------------------------------------------------------------ *) let get_plus_constants = let donothing r k e = k e in let bind = Common.union_set in let option_default = [] in let mcode r (_,_,mcodekind,_) = let recurse l = List.fold_left (List.fold_left (function prev -> function cur -> let fn = get_minus_constants keep_all_bind keep_all_bind in bind (fn.V.combiner_anything cur) prev)) [] l in match mcodekind with Ast.MINUS(_,_,_,anythings) -> recurse anythings | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) -> Common.union_set (recurse a1) (recurse a2) | _ -> [] in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* ------------------------------------------------------------------------ *) (* see if there are any inherited variables that must be bound for this rule to match *) let check_inherited nm = let donothing r k e = k e in let option_default = false in let bind x y = x or y in let inherited (nm1,_) = not(nm = nm1) in let minherited mc = inherited (Ast.unwrap_mcode mc) in let mcode _ x = match Ast.get_pos_var x with Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name | _ -> option_default in (* a case for everything for there is a metavariable, also disjunctions or optional things *) let strictident recursor k i = match Ast.unwrap i with Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_) | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name) | _ -> k i in let rec type_collect res = function TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | TC.Array(ty) -> type_collect res ty | TC.MetaType(tyname,_,_) -> inherited tyname | ty -> res in let strictexpr recursor k e = match Ast.unwrap e with Ast.MetaExpr(name,_,_,Some type_list,_,_) -> let types = List.fold_left type_collect option_default type_list in bind (minherited name) types | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> bind (k e) (minherited name) | Ast.MetaExprList(name,None,_,_) -> bind (k e) (minherited name) | Ast.MetaExprList(name,Some (lenname,_,_),_,_) -> bind (k e) (bind (minherited name) (minherited lenname)) | Ast.DisjExpr(exps) -> (* could see if there are any variables that appear in all branches, but perhaps not worth it *) option_default | _ -> k e in let strictdecls recursor k d = match Ast.unwrap d with Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> bind (k p) (minherited name) | Ast.DisjDecl(decls) -> option_default | _ -> k d in let strictfullType recursor k ty = match Ast.unwrap ty with Ast.DisjType(types) -> option_default | _ -> k ty in let stricttypeC recursor k ty = match Ast.unwrap ty with Ast.MetaType(name,_,_) -> bind (k ty) (minherited name) | _ -> k ty in let strictparam recursor k p = match Ast.unwrap p with Ast.MetaParam(name,_,_) -> bind (k p) (minherited name) | Ast.MetaParamList(name,None,_,_) -> bind (k p) (minherited name) | Ast.MetaParamList(name,Some(lenname,_,_),_,_) -> bind (k p) (bind (minherited name) (minherited lenname)) | _ -> k p in let strictrule_elem recursor k re = (*within a rule_elem, pattern3 manages the coherence of the bindings*) match Ast.unwrap re with Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_) | Ast.MetaStmtList(name,_,_) -> bind (k re) (minherited name) | _ -> k re in let strictstatement recursor k s = match Ast.unwrap s with Ast.Disj(stms) -> option_default | _ -> k s in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing strictident strictexpr strictfullType stricttypeC donothing strictparam strictdecls strictrule_elem strictstatement donothing donothing donothing (* ------------------------------------------------------------------------ *) let rec dependent = function Ast.Dep s -> true | Ast.AntiDep s -> false | Ast.EverDep s -> true | Ast.NeverDep s -> false | Ast.AndDep (d1,d2) -> dependent d1 or dependent d2 | Ast.OrDep (d1,d2) -> dependent d1 && dependent d2 | Ast.NoDep -> false | Ast.FailDep -> true (* ------------------------------------------------------------------------ *) let rule_fn tls in_plus = List.fold_left (function (rest_info,in_plus) -> function cur -> let mfn = get_minus_constants keep_some_bind or_bind in let minuses = mfn.V.combiner_top_level cur in let all_minuses = if !Flag.sgrep_mode2 then [] (* nothing removed for sgrep *) else get_all_minus_constants.V.combiner_top_level cur in let plusses = get_plus_constants.V.combiner_top_level cur in (* the following is for eg -foo(2) +foo(x) then in another rule -foo(10); don't want to consider that foo is guaranteed to be created by the rule. not sure this works completely: what if foo is in both - and +, but in an or, so the cases aren't related? not sure this whole thing is a good idea. how do we know that something that is only in plus is really freshly created? *) let plusses = Common.minus_set plusses all_minuses in let new_minuses = Common.minus_set minuses in_plus in let new_plusses = Common.union_set plusses in_plus in (Common.union_set new_minuses rest_info, new_plusses)) ([],in_plus) tls exception No_info let get_constants rules = try let (info,_) = List.fold_left (function (rest_info,in_plus) -> function r -> match r with Ast.ScriptRule (_,_,_,_) | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) -> (rest_info, in_plus) | Ast.CocciRule (nm, (dep,_,_), cur, _, _) -> let (cur_info,cur_plus) = rule_fn cur in_plus in let cur_info = (* no dependencies if dependent on another rule; then we need to find the constants of that rule *) if dependent dep or List.for_all (check_inherited nm).V.combiner_top_level cur then [] else if cur_info = [] then raise No_info else cur_info in (Common.union_set [cur_info] rest_info,cur_plus)) ([],[]) rules in List.rev info with No_info -> List.map (function _ -> []) rules coccinelle-1.0.0-rc19/parsing_cocci/ast0_cocci.ml0000644000175000017500000010105012247442615020524 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast0_cocci.ml" module Ast = Ast_cocci module TC = Type_cocci (* --------------------------------------------------------------------- *) (* Modified code *) type arity = OPT | UNIQUE | NONE type token_info = { tline_start : int; tline_end : int; left_offset : int; right_offset : int } let default_token_info = { tline_start = -1; tline_end = -1; left_offset = -1; right_offset = -1 } (* MIXED is like CONTEXT, since sometimes MIXED things have to revert to CONTEXT - see insert_plus.ml *) type mcodekind = MINUS of (Ast.anything Ast.replacement * token_info) ref | PLUS of Ast.count | CONTEXT of (Ast.anything Ast.befaft * token_info * token_info) ref | MIXED of (Ast.anything Ast.befaft * token_info * token_info) ref type position_info = { line_start : int; line_end : int; logical_start : int; logical_end : int; column : int; offset : int; } type info = { pos_info : position_info; attachable_start : bool; attachable_end : bool; mcode_start : mcodekind list; mcode_end : mcodekind list; (* the following are only for + code *) strings_before : (Ast.added_string * position_info) list; strings_after : (Ast.added_string * position_info) list; isSymbolIdent : bool; (* is the token a symbol identifier or not *) } (* adjacency index is incremented when we skip over dots or nest delimiters it is used in deciding how much to remove, when two adjacent code tokens are removed. *) type adjacency = int type fake_mcode = info * mcodekind * adjacency type 'a mcode = 'a * arity * info * mcodekind * anything list ref (* pos, - only *) * adjacency (* adjacency_index *) (* int ref is an index *) and 'a wrap = { node : 'a; info : info; index : int ref; mcodekind : mcodekind ref; exp_ty : TC.typeC option ref; (* only for expressions *) bef_aft : dots_bef_aft; (* only for statements *) true_if_arg : bool; (* true if "arg_exp", only for exprs *) true_if_test : bool; (* true if "test position", only for exprs *) true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *) (*nonempty if this represents the use of an iso*) iso_info : (string*anything) list } and dots_bef_aft = NoDots | AddingBetweenDots of statement | DroppingBetweenDots of statement (* for iso metavariables, true if they can only match nonmodified terms with all metavariables unitary for SP metavariables, true if the metavariable is unitary (valid up to isomorphism phase only) In SP, the only options are impure and context *) and pure = Impure | Pure | Context | PureContext (* pure and only context *) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) and 'a base_dots = DOTS of 'a list | CIRCLES of 'a list | STARS of 'a list and 'a dots = 'a base_dots wrap (* --------------------------------------------------------------------- *) (* Identifier *) and base_ident = Id of string mcode | MetaId of Ast.meta_name mcode * Ast.idconstraint * Ast.seed * pure | MetaFunc of Ast.meta_name mcode * Ast.idconstraint * pure | MetaLocalFunc of Ast.meta_name mcode * Ast.idconstraint * pure | AsIdent of ident * ident (* as ident, always metavar *) | DisjId of string mcode * ident list * string mcode list (* the |s *) * string mcode | OptIdent of ident | UniqueIdent of ident and ident = base_ident wrap (* --------------------------------------------------------------------- *) (* Expression *) and base_expression = Ident of ident | Constant of Ast.constant mcode | StringConstant of string mcode (* quote *) * string_fragment dots * string mcode (* quote *) | FunCall of expression * string mcode (* ( *) * expression dots * string mcode (* ) *) | Assignment of expression * Ast.assignOp mcode * expression * bool (* true if it can match an initialization *) | Sequence of expression * string mcode (* , *) * expression | CondExpr of expression * string mcode (* ? *) * expression option * string mcode (* : *) * expression | Postfix of expression * Ast.fixOp mcode | Infix of expression * Ast.fixOp mcode | Unary of expression * Ast.unaryOp mcode | Binary of expression * Ast.binaryOp mcode * expression | Nested of expression * Ast.binaryOp mcode * expression | Paren of string mcode (* ( *) * expression * string mcode (* ) *) | ArrayAccess of expression * string mcode (* [ *) * expression * string mcode (* ] *) | RecordAccess of expression * string mcode (* . *) * ident | RecordPtAccess of expression * string mcode (* -> *) * ident | Cast of string mcode (* ( *) * typeC * string mcode (* ) *) * expression | SizeOfExpr of string mcode (* sizeof *) * expression | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) * typeC * string mcode (* ) *) | TypeExp of typeC (* type name used as an expression, only in args *) | Constructor of string mcode (* ( *) * typeC * string mcode (* ) *) * initialiser | MetaErr of Ast.meta_name mcode * constraints * pure | MetaExpr of Ast.meta_name mcode * constraints * TC.typeC list option * Ast.form * pure | MetaExprList of Ast.meta_name mcode (* only in arg lists *) * listlen * pure | AsExpr of expression * expression (* as expr, always metavar *) | EComma of string mcode (* only in arg lists *) | DisjExpr of string mcode * expression list * string mcode list (* the |s *) * string mcode | NestExpr of string mcode * expression dots * string mcode * expression option * Ast.multi | Edots of string mcode (* ... *) * expression option | Ecircles of string mcode (* ooo *) * expression option | Estars of string mcode (* *** *) * expression option | OptExp of expression | UniqueExp of expression and expression = base_expression wrap and constraints = NoConstraint | NotIdCstrt of Ast.reconstraint | NotExpCstrt of expression list | SubExpCstrt of Ast.meta_name list and listlen = MetaListLen of Ast.meta_name mcode | CstListLen of int | AnyListLen and base_string_fragment = ConstantFragment of string mcode | FormatFragment of string mcode (*%*) * string_format (* format *) | Strdots of string mcode | MetaFormatList of string mcode (*%*) * Ast.meta_name mcode * listlen and string_fragment = base_string_fragment wrap and base_string_format = ConstantFormat of string mcode | MetaFormat of Ast.meta_name mcode * Ast.idconstraint and string_format = base_string_format wrap (* --------------------------------------------------------------------- *) (* Types *) and base_typeC = ConstVol of Ast.const_vol mcode * typeC | BaseType of Ast.baseType * string mcode list | Signed of Ast.sign mcode * typeC option | Pointer of typeC * string mcode (* * *) | FunctionPointer of typeC * string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* string mcode (* ( *)*parameter_list*string mcode(* ) *) | FunctionType of typeC option * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Array of typeC * string mcode (* [ *) * expression option * string mcode (* ] *) | Decimal of string mcode (* decimal *) * string mcode (* ( *) * expression * string mcode option (* , *) * expression option * string mcode (* ) *) (* IBM C only *) | EnumName of string mcode (*enum*) * ident option (* name *) | EnumDef of typeC (* either StructUnionName or metavar *) * string mcode (* { *) * expression dots * string mcode (* } *) | StructUnionName of Ast.structUnion mcode * ident option (* name *) | StructUnionDef of typeC (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) | TypeName of string mcode | MetaType of Ast.meta_name mcode * pure | AsType of typeC * typeC (* as type, always metavar *) | DisjType of string mcode * typeC list * (* only after iso *) string mcode list (* the |s *) * string mcode | OptType of typeC | UniqueType of typeC and typeC = base_typeC wrap (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and base_declaration = MetaDecl of Ast.meta_name mcode * pure (* variables *) (* the following are kept separate from MetaDecls because ultimately they don't match the same thin at all. Consider whether there should be a separate type for fields, as in the C AST *) | MetaField of Ast.meta_name mcode * pure (* structure fields *) | MetaFieldList of Ast.meta_name mcode * listlen * pure (* structure fields *) | AsDecl of declaration * declaration | Init of Ast.storage mcode option * typeC * ident * string mcode (*=*) * initialiser * string mcode (*;*) | UnInit of Ast.storage mcode option * typeC * ident * string mcode (* ; *) | TyDecl of typeC * string mcode (* ; *) | MacroDecl of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (*=*) * initialiser * string mcode (* ; *) | Typedef of string mcode (* typedef *) * typeC * typeC * string mcode (*;*) | DisjDecl of string mcode * declaration list * string mcode list (* the |s *) * string mcode (* Ddots is for a structure declaration *) | Ddots of string mcode (* ... *) * declaration option (* whencode *) | OptDecl of declaration | UniqueDecl of declaration and declaration = base_declaration wrap (* --------------------------------------------------------------------- *) (* Initializers *) and base_initialiser = MetaInit of Ast.meta_name mcode * pure | MetaInitList of Ast.meta_name mcode * listlen * pure | AsInit of initialiser * initialiser (* as init, always metavar *) | InitExpr of expression | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) * (* true if ordered, as for array, false if unordered, as for struct *) bool | InitGccExt of designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) | InitGccName of ident (* name *) * string mcode (*:*) * initialiser | IComma of string mcode (* , *) | Idots of string mcode (* ... *) * initialiser option (* whencode *) | OptIni of initialiser | UniqueIni of initialiser and designator = DesignatorField of string mcode (* . *) * ident | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *) | DesignatorRange of string mcode (* [ *) * expression * string mcode (* ... *) * expression * string mcode (* ] *) and initialiser = base_initialiser wrap and initialiser_list = initialiser dots (* --------------------------------------------------------------------- *) (* Parameter *) and base_parameterTypeDef = VoidParam of typeC | Param of typeC * ident option | MetaParam of Ast.meta_name mcode * pure | MetaParamList of Ast.meta_name mcode * listlen * pure | AsParam of parameterTypeDef * expression (* expr, always metavar *) | PComma of string mcode | Pdots of string mcode (* ... *) | Pcircles of string mcode (* ooo *) | OptParam of parameterTypeDef | UniqueParam of parameterTypeDef and parameterTypeDef = base_parameterTypeDef wrap and parameter_list = parameterTypeDef dots (* --------------------------------------------------------------------- *) (* #define Parameters *) and base_define_param = DParam of ident | DPComma of string mcode | DPdots of string mcode (* ... *) | DPcircles of string mcode (* ooo *) | OptDParam of define_param | UniqueDParam of define_param and define_param = base_define_param wrap and base_define_parameters = NoParams | DParams of string mcode(*( *) * define_param dots * string mcode(* )*) and define_parameters = base_define_parameters wrap (* --------------------------------------------------------------------- *) (* Statement*) and base_statement = (*Decl and FunDecl don't need adjacency. Delete all comments in any case*) Decl of (info * mcodekind) (* before the decl *) * declaration | Seq of string mcode (* { *) * statement dots * string mcode (* } *) | ExprStatement of expression option * string mcode (*;*) | IfThen of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * fake_mcode (* after info *) | IfThenElse of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * string mcode (* else *) * statement * fake_mcode (* after info *) | While of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * statement * fake_mcode (* after info *) | Do of string mcode (* do *) * statement * string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* ; *) | For of string mcode (* for *) * string mcode (* ( *) * forinfo * expression option * string mcode (*;*) * expression option * string mcode (* ) *) * statement * fake_mcode (* after info *) | Iterator of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * statement * fake_mcode (* after info *) | Switch of string mcode (* switch *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* { *) * statement (*decl*) dots * case_line dots * string mcode (* } *) | Break of string mcode (* break *) * string mcode (* ; *) | Continue of string mcode (* continue *) * string mcode (* ; *) | Label of ident * string mcode (* : *) | Goto of string mcode (* goto *) * ident * string mcode (* ; *) | Return of string mcode (* return *) * string mcode (* ; *) | ReturnExpr of string mcode (* return *) * expression * string mcode (* ; *) | MetaStmt of Ast.meta_name mcode * pure | MetaStmtList of Ast.meta_name mcode(*only in statement lists*) * pure | AsStmt of statement * statement (* as statement, always metavar *) | Exp of expression (* only in dotted statement lists *) | TopExp of expression (* for macros body *) | Ty of typeC (* only at top level *) | TopInit of initialiser (* only at top level *) | Disj of string mcode * statement dots list * string mcode list (* the |s *) * string mcode | Nest of string mcode * statement dots * string mcode * (statement dots,statement) whencode list * Ast.multi | Dots of string mcode (* ... *) * (statement dots,statement) whencode list | Circles of string mcode (* ooo *) * (statement dots,statement) whencode list | Stars of string mcode (* *** *) * (statement dots,statement) whencode list | FunDecl of (info * mcodekind) (* before the function decl *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * string mcode (* ) *) * string mcode (* { *) * statement dots * string mcode (* } *) | Include of string mcode (* #include *) * Ast.inc_file mcode (* file *) | Undef of string mcode (* #define *) * ident (* name *) | Define of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) * statement dots | Pragma of string mcode (* #pragma *) * ident * pragmainfo | OptStm of statement | UniqueStm of statement and base_pragmainfo = PragmaTuple of string mcode(* ( *) * expression dots * string mcode(* ) *) | PragmaIdList of ident dots | PragmaDots of string mcode and pragmainfo = base_pragmainfo wrap and base_forinfo = ForExp of expression option * string mcode (*;*) | ForDecl of (info * mcodekind) (* before the decl *) * declaration and forinfo = base_forinfo wrap and fninfo = FStorage of Ast.storage mcode | FType of typeC | FInline of string mcode | FAttr of string mcode and ('a,'b) whencode = WhenNot of 'a | WhenAlways of 'b | WhenModifier of Ast.when_modifier | WhenNotTrue of expression | WhenNotFalse of expression and statement = base_statement wrap and base_case_line = Default of string mcode (* default *) * string mcode (*:*) * statement dots | Case of string mcode (* case *) * expression * string mcode (*:*) * statement dots | DisjCase of string mcode * case_line list * string mcode list (* the |s *) * string mcode | OptCase of case_line and case_line = base_case_line wrap (* --------------------------------------------------------------------- *) (* Positions *) and meta_pos = MetaPos of Ast.meta_name mcode * Ast.meta_name list * Ast.meta_collect (* --------------------------------------------------------------------- *) (* Top-level code *) and base_top_level = NONDECL of statement | TOPCODE of statement dots | CODE of statement dots | FILEINFO of string mcode (* old file *) * string mcode (* new file *) | ERRORWORDS of expression list | OTHER of statement (* temporary, disappears after top_level.ml *) and top_level = base_top_level wrap and rule = top_level list and parsed_rule = CocciRule of (rule * Ast.metavar list * (string list * string list * Ast.dependency * string * Ast.exists)) * (rule * Ast.metavar list) * Ast.ruletype | ScriptRule of string (* name *) * string * Ast.dependency * (Ast.script_meta_name * Ast.meta_name * Ast.metavar) list * Ast.meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) *string * Ast.dependency * string | FinalScriptRule of string (* name *) *string * Ast.dependency * string (* --------------------------------------------------------------------- *) and dependency = Dep of string (* rule applies for the current binding *) | AntiDep of dependency (* rule doesn't apply for the current binding *) | EverDep of string (* rule applies for some binding *) | NeverDep of string (* rule never applies for any binding *) | AndDep of dependency * dependency | OrDep of dependency * dependency | NoDep | FailDep (* --------------------------------------------------------------------- *) and anything = DotsExprTag of expression dots | DotsInitTag of initialiser dots | DotsParamTag of parameterTypeDef dots | DotsStmtTag of statement dots | DotsDeclTag of declaration dots | DotsCaseTag of case_line dots | IdentTag of ident | ExprTag of expression | ArgExprTag of expression (* for isos *) | TestExprTag of expression (* for isos *) | TypeCTag of typeC | ParamTag of parameterTypeDef | InitTag of initialiser | DeclTag of declaration | StmtTag of statement | ForInfoTag of forinfo | CaseLineTag of case_line | TopTag of top_level | IsoWhenTag of Ast.when_modifier | IsoWhenTTag of expression | IsoWhenFTag of expression | MetaPosTag of meta_pos | HiddenVarTag of anything list (* in iso_compile/pattern only *) let dotsExpr x = DotsExprTag x let dotsParam x = DotsParamTag x let dotsInit x = DotsInitTag x let dotsStmt x = DotsStmtTag x let dotsDecl x = DotsDeclTag x let dotsCase x = DotsCaseTag x let ident x = IdentTag x let expr x = ExprTag x let typeC x = TypeCTag x let param x = ParamTag x let ini x = InitTag x let decl x = DeclTag x let stmt x = StmtTag x let forinfo x = ForInfoTag x let case_line x = CaseLineTag x let top x = TopTag x (* --------------------------------------------------------------------- *) (* Avoid cluttering the parser. Calculated in compute_lines.ml. *) let pos_info = { line_start = -1; line_end = -1; logical_start = -1; logical_end = -1; column = -1; offset = -1; } let default_info _ = (* why is this a function? *) { pos_info = pos_info; attachable_start = true; attachable_end = true; mcode_start = []; mcode_end = []; strings_before = []; strings_after = []; isSymbolIdent = false; } let default_befaft _ = MIXED(ref (Ast.NOTHING,default_token_info,default_token_info)) let context_befaft _ = CONTEXT(ref (Ast.NOTHING,default_token_info,default_token_info)) let minus_befaft _ = MINUS(ref (Ast.NOREPLACEMENT,default_token_info)) let wrap x = { node = x; info = default_info(); index = ref (-1); mcodekind = ref (default_befaft()); exp_ty = ref None; bef_aft = NoDots; true_if_arg = false; true_if_test = false; true_if_test_exp = false; iso_info = [] } let context_wrap x = { node = x; info = default_info(); index = ref (-1); mcodekind = ref (context_befaft()); exp_ty = ref None; bef_aft = NoDots; true_if_arg = false; true_if_test = false; true_if_test_exp = false; iso_info = [] } let unwrap x = x.node let unwrap_mcode (x,_,_,_,_,_) = x let rewrap model x = { model with node = x } let rewrap_mcode (_,arity,info,mcodekind,pos,adj) x = (x,arity,info,mcodekind,pos,adj) let copywrap model x = { model with node = x; index = ref !(model.index); mcodekind = ref !(model.mcodekind); exp_ty = ref !(model.exp_ty)} let get_pos (_,_,_,_,x,_) = !x let get_pos_ref (_,_,_,_,x,_) = x let set_pos pos (m,arity,info,mcodekind,_,adj) = (m,arity,info,mcodekind,ref pos,adj) let get_info x = x.info let set_info x info = {x with info = info} let get_line x = x.info.pos_info.line_start let get_line_end x = x.info.pos_info.line_end let get_index x = !(x.index) let set_index x i = x.index := i let get_mcodekind x = !(x.mcodekind) let get_mcode_mcodekind (_,_,_,mcodekind,_,_) = mcodekind let get_mcodekind_ref x = x.mcodekind let set_mcodekind x mk = x.mcodekind := mk let set_type x t = x.exp_ty := t let get_type x = !(x.exp_ty) let get_dots_bef_aft x = x.bef_aft let set_dots_bef_aft x dots_bef_aft = {x with bef_aft = dots_bef_aft} let get_arg_exp x = x.true_if_arg let set_arg_exp x = {x with true_if_arg = true} let get_test_pos x = x.true_if_test let set_test_pos x = {x with true_if_test = true} let get_test_exp x = x.true_if_test_exp let set_test_exp x = {x with true_if_test_exp = true} let clear_test_exp x = {x with true_if_test_exp = false} let get_iso x = x.iso_info let set_iso x i = if !Flag.track_iso_usage then {x with iso_info = i} else x let set_mcode_data data (_,ar,info,mc,pos,adj) = (data,ar,info,mc,pos,adj) (* --------------------------------------------------------------------- *) let rec meta_pos_name = function HiddenVarTag(vars) -> (* totally fake, just drop the rest, only for isos *) meta_pos_name (List.hd vars) | MetaPosTag(MetaPos(name,constraints,_)) -> name | IdentTag(i) -> (match unwrap i with MetaId(name,constraints,seed,pure) -> name | _ -> failwith "bad metavariable") | ExprTag(e) -> (match unwrap e with MetaExpr(name,constraints,ty,form,pure) -> name | MetaExprList(name,len,pure) -> name | _ -> failwith "bad metavariable") | TypeCTag(t) -> (match unwrap t with MetaType(name,pure) -> name | _ -> failwith "bad metavariable") | DeclTag(d) -> (match unwrap d with MetaDecl(name,pure) -> name | _ -> failwith "bad metavariable") | InitTag(i) -> (match unwrap i with MetaInit(name,pure) -> name | _ -> failwith "bad metavariable") | StmtTag(s) -> (match unwrap s with MetaStmt(name,pure) -> name | _ -> failwith "bad metavariable") | _ -> failwith "bad metavariable" (* --------------------------------------------------------------------- *) (* unique indices, for mcode and tree nodes *) let index_counter = ref 0 let fresh_index _ = let cur = !index_counter in index_counter := cur + 1; cur (* --------------------------------------------------------------------- *) let undots d = match unwrap d with | DOTS e -> e | CIRCLES e -> e | STARS e -> e (* --------------------------------------------------------------------- *) let rec ast0_type_to_type ty = match unwrap ty with ConstVol(cv,ty) -> TC.ConstVol(const_vol cv,ast0_type_to_type ty) | BaseType(bty,strings) -> TC.BaseType(baseType bty) | Signed(sgn,None) -> TC.SignedT(sign sgn,None) | Signed(sgn,Some ty) -> let bty = ast0_type_to_type ty in TC.SignedT(sign sgn,Some bty) | Pointer(ty,_) -> TC.Pointer(ast0_type_to_type ty) | FunctionPointer(ty,_,_,_,_,params,_) -> TC.FunctionPointer(ast0_type_to_type ty) | FunctionType _ -> TC.Unknown (*failwith "not supported"*) | Array(ety,_,_,_) -> TC.Array(ast0_type_to_type ety) | Decimal(_, _, e1, _, e2, _) -> let e2tc e = match unwrap e with Constant(c) -> (match unwrap_mcode c with Ast.Int n -> TC.Num n | _ -> failwith "not possible") | Ident(id) -> (match unwrap id with Id n -> TC.Name (unwrap_mcode n) | _ -> failwith "not possible") | MetaExpr(name,NoConstraint,None,Ast.CONST,_) -> TC.MV(unwrap_mcode name,TC.Unitary,false) | _ -> failwith "unexpected argument to decimal" in let e2 = match e2 with None -> TC.Num "0" | Some e2 -> e2tc e2 in TC.Decimal(e2tc e1,e2) | EnumName(su,Some tag) -> (match unwrap tag with Id(tag) -> TC.EnumName(TC.Name(unwrap_mcode tag)) | MetaId(tag,_,_,_) -> (Common.pr2_once "warning: enum with a metavariable name detected."; Common.pr2_once "For type checking assuming the name of the metavariable is the name of the type\n"; TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false))) | _ -> failwith "unexpected enum type name") | EnumName(su,None) -> TC.EnumName TC.NoName | EnumDef(ty,_,_,_) -> ast0_type_to_type ty | StructUnionName(su,Some tag) -> (match unwrap tag with Id(tag) -> TC.StructUnionName(structUnion su,TC.Name(unwrap_mcode tag)) | MetaId(tag,Ast.IdNoConstraint,_,_) -> (Common.pr2_once "warning: struct/union with a metavariable name detected."; Common.pr2_once "For type checking assuming the name of the metavariable is the name of the type\n"; TC.StructUnionName(structUnion su, TC.MV(unwrap_mcode tag,TC.Unitary,false))) | MetaId(tag,_,_,_) -> (* would have to duplicate the type in type_cocci.ml? perhaps polymorphism would help? *) failwith "constraints not supported on struct type name" | _ -> failwith "unexpected struct/union type name") | StructUnionName(su,None) -> TC.StructUnionName(structUnion su,TC.NoName) | StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty | TypeName(name) -> TC.TypeName(unwrap_mcode name) | MetaType(name,_) -> TC.MetaType(unwrap_mcode name,TC.Unitary,false) | AsType(ty,asty) -> failwith "not created yet" | DisjType(_,types,_,_) -> Common.pr2_once "disjtype not supported in smpl type inference, assuming unknown"; TC.Unknown | OptType(ty) | UniqueType(ty) -> ast0_type_to_type ty and baseType = function Ast.VoidType -> TC.VoidType | Ast.CharType -> TC.CharType | Ast.ShortType -> TC.ShortType | Ast.ShortIntType -> TC.ShortIntType | Ast.IntType -> TC.IntType | Ast.DoubleType -> TC.DoubleType | Ast.LongDoubleType -> TC.LongDoubleType | Ast.FloatType -> TC.FloatType | Ast.LongType -> TC.LongType | Ast.LongIntType -> TC.LongIntType | Ast.LongLongType -> TC.LongLongType | Ast.LongLongIntType -> TC.LongLongIntType | Ast.SizeType -> TC.SizeType | Ast.SSizeType -> TC.SSizeType | Ast.PtrDiffType -> TC.PtrDiffType and structUnion t = match unwrap_mcode t with Ast.Struct -> TC.Struct | Ast.Union -> TC.Union and sign t = match unwrap_mcode t with Ast.Signed -> TC.Signed | Ast.Unsigned -> TC.Unsigned and const_vol t = match unwrap_mcode t with Ast.Const -> TC.Const | Ast.Volatile -> TC.Volatile (* --------------------------------------------------------------------- *) (* this function is a rather minimal attempt. the problem is that information has been lost. but since it is only used for metavariable types in the isos, perhaps it doesn't matter *) and make_mcode x = (x,NONE,default_info(),context_befaft(),ref [],-1) let make_mcode_info x info = (x,NONE,info,context_befaft(),ref [],-1) and make_minus_mcode x = (x,NONE,default_info(),minus_befaft(),ref [],-1) exception TyConv let rec reverse_type ty = match ty with TC.ConstVol(cv,ty) -> ConstVol(reverse_const_vol cv,context_wrap(reverse_type ty)) | TC.BaseType(bty) -> BaseType(reverse_baseType bty,[(* not used *)]) | TC.SignedT(sgn,None) -> Signed(reverse_sign sgn,None) | TC.SignedT(sgn,Some bty) -> Signed(reverse_sign sgn,Some (context_wrap(reverse_type ty))) | TC.Pointer(ty) -> Pointer(context_wrap(reverse_type ty),make_mcode "*") | TC.EnumName(TC.MV(name,_,_)) -> EnumName (make_mcode "enum", Some (context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,Ast.NoVal, Impure)))) | TC.EnumName(TC.Name tag) -> EnumName(make_mcode "enum",Some(context_wrap(Id(make_mcode tag)))) | TC.StructUnionName(su,TC.MV(name,_,_)) -> (* not right?... *) StructUnionName (reverse_structUnion su, Some(context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,Ast.NoVal, Impure(*not really right*))))) | TC.StructUnionName(su,TC.Name tag) -> StructUnionName (reverse_structUnion su, Some (context_wrap(Id(make_mcode tag)))) | TC.TypeName(name) -> TypeName(make_mcode name) | TC.MetaType(name,_,_) -> MetaType(make_mcode name,Impure(*not really right*)) | _ -> raise TyConv and reverse_baseType = function TC.VoidType -> Ast.VoidType | TC.CharType -> Ast.CharType | TC.BoolType -> Ast.IntType | TC.ShortType -> Ast.ShortType | TC.ShortIntType -> Ast.ShortIntType | TC.IntType -> Ast.IntType | TC.DoubleType -> Ast.DoubleType | TC.LongDoubleType -> Ast.LongDoubleType | TC.FloatType -> Ast.FloatType | TC.LongType -> Ast.LongType | TC.LongIntType -> Ast.LongIntType | TC.LongLongType -> Ast.LongLongType | TC.LongLongIntType -> Ast.LongLongIntType | TC.SizeType -> Ast.SizeType | TC.SSizeType -> Ast.SSizeType | TC.PtrDiffType -> Ast.PtrDiffType and reverse_structUnion t = make_mcode (match t with TC.Struct -> Ast.Struct | TC.Union -> Ast.Union) and reverse_sign t = make_mcode (match t with TC.Signed -> Ast.Signed | TC.Unsigned -> Ast.Unsigned) and reverse_const_vol t = make_mcode (match t with TC.Const -> Ast.Const | TC.Volatile -> Ast.Volatile) (* --------------------------------------------------------------------- *) let lub_pure x y = match (x,y) with (Impure,_) | (_,Impure) -> Impure | (Pure,Context) | (Context,Pure) -> Impure | (Pure,_) | (_,Pure) -> Pure | (_,Context) | (Context,_) -> Context | _ -> PureContext (* --------------------------------------------------------------------- *) let rule_name = ref "" (* for the convenience of the parser *) coccinelle-1.0.0-rc19/parsing_cocci/context_neg.mli0000644000175000017500000000262612247442615021214 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./context_neg.mli" val context_neg : Ast0_cocci.rule -> Ast0_cocci.rule -> (Ast0_cocci.top_level * Ast0_cocci.top_level) list val minus_table : (int list, Ast0_cocci.anything * int Common.set list) Hashtbl.t val plus_table : (int list, Ast0_cocci.anything * int Common.set list) Hashtbl.t coccinelle-1.0.0-rc19/parsing_cocci/index.mli0000644000175000017500000000410512247442616020001 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./index.mli" val expression_dots : Ast0_cocci.expression Ast0_cocci.dots -> int list val initialiser_dots : Ast0_cocci.initialiser Ast0_cocci.dots -> int list val parameter_dots : Ast0_cocci.parameterTypeDef Ast0_cocci.dots -> int list val statement_dots : Ast0_cocci.statement Ast0_cocci.dots -> int list val declaration_dots : Ast0_cocci.declaration Ast0_cocci.dots -> int list val case_line_dots : Ast0_cocci.case_line Ast0_cocci.dots -> int list val ident : Ast0_cocci.ident -> int list val expression : Ast0_cocci.expression -> int list val typeC : Ast0_cocci.typeC -> int list val declaration : Ast0_cocci.declaration -> int list val initialiser : Ast0_cocci.initialiser -> int list val parameterTypeDef : Ast0_cocci.parameterTypeDef -> int list val statement : Ast0_cocci.statement -> int list val forinfo : Ast0_cocci.forinfo -> int list val pragmainfo : Ast0_cocci.pragmainfo -> int list val case_line : Ast0_cocci.case_line -> int list val top_level : Ast0_cocci.top_level -> int list coccinelle-1.0.0-rc19/parsing_cocci/unitary_ast0.ml0000644000175000017500000002515112247442615021146 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unitary_ast0.ml" (* find unitary metavariables *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let set_minus s minus = List.filter (function n -> not (List.mem n minus)) s let rec nub = function [] -> [] | (x::xs) when (List.mem x xs) -> nub xs | (x::xs) -> x::(nub xs) (* ----------------------------------------------------------------------- *) (* Find the variables that occur free and occur free in a unitary way *) (* take everything *) let minus_checker name = let id = Ast0.unwrap_mcode name in [id] (* take only what is in the plus code *) let plus_checker (nm,_,_,mc,_,_) = match mc with Ast0.PLUS _ -> [nm] | _ -> [] let get_free checker t = let bind x y = x @ y in let option_default = [] in (* considers a single list *) let collect_unitary_nonunitary free_usage = let free_usage = List.sort compare free_usage in let rec loop1 todrop = function [] -> [] | (x::xs) as all -> if x = todrop then loop1 todrop xs else all in let rec loop2 = function [] -> ([],[]) | [x] -> ([x],[]) | x::y::xs -> if x = y then let (unitary,non_unitary) = loop2(loop1 x xs) in (unitary,x::non_unitary) else let (unitary,non_unitary) = loop2 (y::xs) in (x::unitary,non_unitary) in loop2 free_usage in (* considers a list of lists *) let detect_unitary_frees l = let (unitary,nonunitary) = List.split (List.map collect_unitary_nonunitary l) in let unitary = nub (List.concat unitary) in let nonunitary = nub (List.concat nonunitary) in let unitary = List.filter (function x -> not (List.mem x nonunitary)) unitary in unitary@nonunitary@nonunitary in let whencode afn bfn expression = function Ast0.WhenNot(a) -> afn a | Ast0.WhenAlways(b) -> bfn b | Ast0.WhenModifier(_) -> option_default | Ast0.WhenNotTrue(a) -> expression a | Ast0.WhenNotFalse(a) -> expression a in let ident r k i = match Ast0.unwrap i with Ast0.MetaId(name,_,_,_) | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) -> checker name | Ast0.DisjId(starter,id_list,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_ident id_list) | _ -> k i in let expression r k e = match Ast0.unwrap e with Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_) | Ast0.MetaExprList(name,_,_) -> checker name | Ast0.DisjExpr(starter,expr_list,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_expression expr_list) | _ -> k e in let typeC r k t = match Ast0.unwrap t with Ast0.MetaType(name,_) -> checker name | Ast0.DisjType(starter,types,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_typeC types) | _ -> k t in let parameter r k p = match Ast0.unwrap p with Ast0.MetaParam(name,_) | Ast0.MetaParamList(name,_,_) -> checker name | _ -> k p in let declaration r k d = match Ast0.unwrap d with Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) | Ast0.MetaFieldList(name,_,_) -> checker name | Ast0.DisjDecl(starter,decls,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_declaration decls) | _ -> k d in let case_line r k c = match Ast0.unwrap c with Ast0.DisjCase(starter,case_lines,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_case_line case_lines) | _ -> k c in let statement r k s = match Ast0.unwrap s with Ast0.MetaStmt(name,_) | Ast0.MetaStmtList(name,_) -> checker name | Ast0.Disj(starter,stmt_list,mids,ender) -> detect_unitary_frees (List.map r.VT0.combiner_rec_statement_dots stmt_list) | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> bind (r.VT0.combiner_rec_statement_dots stmt_dots) (detect_unitary_frees (List.map (whencode r.VT0.combiner_rec_statement_dots r.VT0.combiner_rec_statement r.VT0.combiner_rec_expression) whn)) | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> detect_unitary_frees (List.map (whencode r.VT0.combiner_rec_statement_dots r.VT0.combiner_rec_statement r.VT0.combiner_rec_expression) whn) | _ -> k s in let res = V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_identfn = ident; VT0.combiner_exprfn = expression; VT0.combiner_tyfn = typeC; VT0.combiner_paramfn = parameter; VT0.combiner_declfn = declaration; VT0.combiner_stmtfn = statement; VT0.combiner_casefn = case_line} in collect_unitary_nonunitary (List.concat (List.map res.VT0.combiner_rec_top_level t)) (* ----------------------------------------------------------------------- *) (* update the variables that are unitary *) let update_unitary unitary = let is_unitary name = match (List.mem (Ast0.unwrap_mcode name) unitary, !Flag.sgrep_mode2, Ast0.get_mcode_mcodekind name) with (true,true,_) | (true,_,Ast0.CONTEXT(_)) -> Ast0.PureContext | (true,_,_) -> Ast0.Pure | (false,true,_) | (false,_,Ast0.CONTEXT(_)) -> Ast0.Context | (false,_,_) -> Ast0.Impure in let ident r k i = match Ast0.unwrap i with Ast0.MetaId(name,constraints,seed,_) -> Ast0.rewrap i (Ast0.MetaId(name,constraints,seed,is_unitary name)) | Ast0.MetaFunc(name,constraints,_) -> Ast0.rewrap i (Ast0.MetaFunc(name,constraints,is_unitary name)) | Ast0.MetaLocalFunc(name,constraints,_) -> Ast0.rewrap i (Ast0.MetaLocalFunc(name,constraints,is_unitary name)) | _ -> k i in let expression r k e = match Ast0.unwrap e with Ast0.MetaErr(name,constraints,_) -> Ast0.rewrap e (Ast0.MetaErr(name,constraints,is_unitary name)) | Ast0.MetaExpr(name,constraints,ty,form,_) -> Ast0.rewrap e (Ast0.MetaExpr(name,constraints,ty,form,is_unitary name)) | Ast0.MetaExprList(name,lenname,_) -> Ast0.rewrap e (Ast0.MetaExprList(name,lenname,is_unitary name)) | _ -> k e in let typeC r k t = match Ast0.unwrap t with Ast0.MetaType(name,_) -> Ast0.rewrap t (Ast0.MetaType(name,is_unitary name)) | _ -> k t in let parameter r k p = match Ast0.unwrap p with Ast0.MetaParam(name,_) -> Ast0.rewrap p (Ast0.MetaParam(name,is_unitary name)) | Ast0.MetaParamList(name,lenname,_) -> Ast0.rewrap p (Ast0.MetaParamList(name,lenname,is_unitary name)) | _ -> k p in let statement r k s = match Ast0.unwrap s with Ast0.MetaStmt(name,_) -> Ast0.rewrap s (Ast0.MetaStmt(name,is_unitary name)) | Ast0.MetaStmtList(name,_) -> Ast0.rewrap s (Ast0.MetaStmtList(name,is_unitary name)) | _ -> k s in let res = V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_identfn = ident; VT0.rebuilder_exprfn = expression; VT0.rebuilder_tyfn = typeC; VT0.rebuilder_paramfn = parameter; VT0.rebuilder_stmtfn = statement} in List.map res.VT0.rebuilder_rec_top_level (* ----------------------------------------------------------------------- *) let rec split3 = function [] -> ([],[],[]) | (a,b,c)::xs -> let (l1,l2,l3) = split3 xs in (a::l1,b::l2,c::l3) let rec combine3 = function ([],[],[]) -> [] | (a::l1,b::l2,c::l3) -> (a,b,c) :: combine3 (l1,l2,l3) | _ -> failwith "not possible" (* ----------------------------------------------------------------------- *) (* process all rules *) let do_unitary rules = let rec loop = function [] -> ([],[]) | (r::rules) -> match r with Ast0.ScriptRule (_,_,_,_,_,_) | Ast0.InitialScriptRule (_,_,_,_) | Ast0.FinalScriptRule (_,_,_,_) -> let (x,rules) = loop rules in (x, r::rules) | Ast0.CocciRule ((minus,metavars,chosen_isos),((plus,_) as plusz),rt) -> let mm1 = List.map Ast.get_meta_name metavars in let (used_after, rest) = loop rules in let (m_unitary, m_nonunitary) = get_free minus_checker minus in let (p_unitary, p_nonunitary) = get_free plus_checker plus in let p_free = if !Flag.sgrep_mode2 then [] else p_unitary @ p_nonunitary in let (in_p, m_unitary) = List.partition (function x -> List.mem x p_free) m_unitary in let m_nonunitary = in_p @ m_nonunitary in let (m_unitary, not_local) = List.partition (function x -> List.mem x mm1) m_unitary in let m_unitary = List.filter (function x -> not (List.mem x used_after)) m_unitary in let rebuilt = update_unitary m_unitary minus in (set_minus (m_nonunitary @ used_after) mm1, (Ast0.CocciRule ((rebuilt, metavars, chosen_isos),plusz,rt))::rest) in let (_,rules) = loop rules in rules (* let do_unitary minus plus = let (minus,metavars,chosen_isos) = split3 minus in let (plus,_) = List.split plus in let rec loop = function ([],[],[]) -> ([],[]) | (mm1::metavars,m1::minus,p1::plus) -> let mm1 = List.map Ast.get_meta_name mm1 in let (used_after,rest) = loop (metavars,minus,plus) in let (m_unitary,m_nonunitary) = get_free minus_checker m1 in let (p_unitary,p_nonunitary) = get_free plus_checker p1 in let p_free = if !Flag.sgrep_mode2 then [] else p_unitary @ p_nonunitary in let (in_p,m_unitary) = List.partition (function x -> List.mem x p_free) m_unitary in let m_nonunitary = in_p@m_nonunitary in let (m_unitary,not_local) = List.partition (function x -> List.mem x mm1) m_unitary in let m_unitary = List.filter (function x -> not(List.mem x used_after)) m_unitary in let rebuilt = update_unitary m_unitary m1 in (set_minus (m_nonunitary @ used_after) mm1, rebuilt::rest) | _ -> failwith "not possible" in let (_,rules) = loop (metavars,minus,plus) in combine3 (rules,metavars,chosen_isos) *) coccinelle-1.0.0-rc19/parsing_cocci/simple_assignments.mli0000644000175000017500000000227012247442616022577 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./simple_assignments.mli" val simple_assignments : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/lexer_cocci.mll0000644000175000017500000011532312247442616021161 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lexer_cocci.mll" { open Parser_cocci_menhir module D = Data module Ast = Ast_cocci module Ast0 = Ast0_cocci module P = Parse_aux module FC = Flag_parsing_cocci exception Lexical of string let tok = Lexing.lexeme let line = ref 1 let logical_line = ref 0 (* ---------------------------------------------------------------------- *) (* control codes *) (* Defined in data.ml type line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | CONTEXT | UNIQUE | OPT *) let current_line_type = ref (D.CONTEXT,!line,!logical_line) let prev_plus = ref false let line_start = ref 0 (* offset of the beginning of the line *) let get_current_line_type lexbuf = let (c,l,ll) = !current_line_type in let lex_start = Lexing.lexeme_start lexbuf in let preceeding_spaces = if !line_start < 0 then 0 else lex_start - !line_start in (*line_start := -1;*) prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS); (c,l,ll,lex_start,preceeding_spaces,[],[],[]) let current_line_started = ref false let col_zero = ref true let contextify (c,l,ll,lex_start,preceeding_spaces,bef,aft,pos) = (D.CONTEXT,l,ll,lex_start,preceeding_spaces,bef,aft,pos) let reset_line lexbuf = line := !line + 1; current_line_type := (D.CONTEXT,!line,!logical_line); current_line_started := false; col_zero := true; line_start := Lexing.lexeme_start lexbuf + 1 let started_line = ref (-1) let start_line seen_char = current_line_started := true; col_zero := false; (if seen_char && not(!line = !started_line) then begin started_line := !line; logical_line := !logical_line + 1 end) let pass_zero _ = col_zero := false let lexerr s1 s2 = raise (Lexical (Printf.sprintf "%s%s" s1 s2)) let opt_reverse_token token = if !FC.interpret_inverted then match token with D.MINUS -> D.PLUSPLUS (* maybe too liberal *) | D.OPTMINUS -> lexerr "cannot invert token ?- (an optional minus line), which is needed for reversing the patch" "" | D.UNIQUEMINUS -> D.PLUS | D.PLUS -> D.MINUS | D.PLUSPLUS -> D.MINUS (* may not be sufficient *) | _ -> token else token let add_current_line_type x = match (opt_reverse_token x,!current_line_type) with (D.MINUS,(D.CONTEXT,ln,lln)) -> current_line_type := (D.MINUS,ln,lln) | (D.MINUS,(D.UNIQUE,ln,lln)) -> current_line_type := (D.UNIQUEMINUS,ln,lln) | (D.MINUS,(D.OPT,ln,lln)) -> current_line_type := (D.OPTMINUS,ln,lln) | (D.PLUS,(D.CONTEXT,ln,lln)) -> current_line_type := (D.PLUS,ln,lln) | (D.PLUSPLUS,(D.CONTEXT,ln,lln)) -> current_line_type := (D.PLUSPLUS,ln,lln) | (D.UNIQUE,(D.CONTEXT,ln,lln)) -> current_line_type := (D.UNIQUE,ln,lln) | (D.OPT,(D.CONTEXT,ln,lln)) -> current_line_type := (D.OPT,ln,lln) | _ -> lexerr "invalid control character combination" "" let check_minus_context_linetype s = match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> lexerr "invalid in a + context: " s | _ -> () let check_context_linetype s = match !current_line_type with (D.CONTEXT,_,_) -> () | _ -> lexerr "invalid in a nonempty context: " s let check_plus_linetype s = match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> () | _ -> lexerr "invalid in a non + context: " s let check_arity_context_linetype s = match !current_line_type with (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.PLUSPLUS,_,_) | (D.UNIQUE,_,_) | (D.OPT,_,_) -> () | _ -> lexerr "invalid in a nonempty context: " s let check_comment s = if not !current_line_started then lexerr "+ expected at the beginning of the line" s let process_include start finish str = (match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> (try let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in lexerr "... not allowed in + include" "" with Not_found -> ()) | _ -> ()); String.sub str (start + 1) (finish - start - 1) (* ---------------------------------------------------------------------- *) type pm = PATCH | MATCH | UNKNOWN let pm = ref UNKNOWN let patch_or_match = function PATCH -> if not !D.ignore_patch_or_match then (match !pm with MATCH -> lexerr "- or + not allowed in the first column for a match" "" | PATCH -> () | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH) | MATCH -> if not !D.ignore_patch_or_match then (match !pm with PATCH -> lexerr "* not allowed in the first column for a patch" "" | MATCH -> () | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH) | _ -> failwith "unexpected argument" (* ---------------------------------------------------------------------- *) (* identifiers, including metavariables *) let metavariables = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) let all_metavariables = (Hashtbl.create(100) : (string,(string * (D.clt -> token)) list) Hashtbl.t) let type_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) let declarer_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) let iterator_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) let symbol_names = (Hashtbl.create(15) : (string, D.clt -> token) Hashtbl.t) let rule_names = (Hashtbl.create(100) : (string, unit) Hashtbl.t) let check_var s linetype = let fail _ = if (!Data.in_prolog || !Data.in_rule_name) && Str.string_match (Str.regexp "<.*>") s 0 then TPathIsoFile s else try (Hashtbl.find metavariables s) linetype with Not_found -> (try (Hashtbl.find type_names s) linetype with Not_found -> (try (Hashtbl.find declarer_names s) linetype with Not_found -> (try (Hashtbl.find iterator_names s) linetype with Not_found -> (try (Hashtbl.find symbol_names s) linetype with Not_found -> TIdent (s,linetype))))) in if !Data.in_meta or !Data.in_rule_name then (try Hashtbl.find rule_names s; TRuleName s with Not_found -> fail()) else fail() let id_tokens lexbuf = let s = tok lexbuf in let linetype = get_current_line_type lexbuf in let in_rule_name = !Data.in_rule_name in let in_meta = !Data.in_meta && not !Data.saw_struct in let in_iso = !Data.in_iso in let in_prolog = !Data.in_prolog in (if s = "identifer" && in_meta then Common.pr2 "Warning: should identifer be identifier?"); match s with "metavariable" when in_meta -> check_arity_context_linetype s; TMetavariable | "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier | "type" when in_meta -> check_arity_context_linetype s; TType | "parameter" when in_meta -> check_arity_context_linetype s; TParameter | "constant" when in_meta -> check_arity_context_linetype s; TConstant | "generated" when in_rule_name && not (!Flag.make_hrule = None) -> check_arity_context_linetype s; TGenerated | "expression" when in_meta || in_rule_name -> check_arity_context_linetype s; TExpression | "declaration" when in_meta || in_rule_name -> check_arity_context_linetype s; TDeclaration | "field" when in_meta || in_rule_name -> check_arity_context_linetype s; TField | "initialiser" when in_meta || in_rule_name -> check_arity_context_linetype s; TInitialiser | "initializer" when in_meta || in_rule_name -> check_arity_context_linetype s; TInitialiser | "idexpression" when in_meta -> check_arity_context_linetype s; TIdExpression | "statement" when in_meta -> check_arity_context_linetype s; TStatement | "function" when in_meta -> check_arity_context_linetype s; TFunction | "local" when in_meta -> check_arity_context_linetype s; TLocal | "list" when in_meta -> check_arity_context_linetype s; Tlist | "fresh" when in_meta -> check_arity_context_linetype s; TFresh | "typedef" when in_meta -> check_arity_context_linetype s; TTypedef | "declarer" when in_meta -> check_arity_context_linetype s; TDeclarer | "iterator" when in_meta -> check_arity_context_linetype s; TIterator | "name" when in_meta -> check_arity_context_linetype s; TName | "position" when in_meta -> check_arity_context_linetype s; TPosition | "format" when in_meta -> check_arity_context_linetype s; TFormat | "analysis" when in_meta -> check_arity_context_linetype s; TAnalysis | "any" when in_meta -> check_arity_context_linetype s; TPosAny | "pure" when in_meta && in_iso -> check_arity_context_linetype s; TPure | "context" when in_meta && in_iso -> check_arity_context_linetype s; TContext | "error" when in_meta -> check_arity_context_linetype s; TError | "words" when in_meta -> check_context_linetype s; TWords | "symbol" when in_meta -> check_arity_context_linetype s; TSymbol | "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing | "virtual" when in_prolog or in_rule_name or in_meta -> (* don't want to allow virtual as a rule name *) check_context_linetype s; TVirtual | "disable" when in_rule_name -> check_context_linetype s; TDisable | "extends" when in_rule_name -> check_context_linetype s; TExtends | "depends" when in_rule_name -> check_context_linetype s; TDepends | "on" when in_rule_name -> check_context_linetype s; TOn | "ever" when in_rule_name -> check_context_linetype s; TEver | "never" when in_rule_name -> check_context_linetype s; TNever (* exists and forall for when are reparsed in parse_cocci.ml *) | "exists" when in_rule_name -> check_context_linetype s; TExists | "forall" when in_rule_name -> check_context_linetype s; TForall | "script" when in_rule_name -> check_context_linetype s; TScript | "initialize" when in_rule_name -> check_context_linetype s; TInitialize | "finalize" when in_rule_name -> check_context_linetype s; TFinalize | "char" -> Tchar linetype | "short" -> Tshort linetype | "int" -> Tint linetype | "double" -> Tdouble linetype | "float" -> Tfloat linetype | "long" -> Tlong linetype | "void" -> Tvoid linetype | "size_t" -> Tsize_t linetype | "ssize_t" -> Tssize_t linetype | "ptrdiff_t" -> Tptrdiff_t linetype (* in_meta is only for the first keyword; drop it now to allow any type name *) | "struct" -> Data.saw_struct := true; Tstruct linetype | "union" -> Data.saw_struct := true; Tunion linetype | "enum" -> Data.saw_struct := true; Tenum linetype | "unsigned" -> Tunsigned linetype | "signed" -> Tsigned linetype | "decimal" when !Flag.ibm -> Tdecimal linetype | "auto" -> Tauto linetype | "register" -> Tregister linetype | "extern" -> Textern linetype | "static" -> Tstatic linetype | "inline" -> Tinline linetype | "typedef" -> Ttypedef linetype | "const" -> Tconst linetype | "volatile" -> Tvolatile linetype | "if" -> TIf linetype | "else" -> TElse linetype | "while" -> TWhile linetype | "do" -> TDo linetype | "for" -> TFor linetype | "switch" -> TSwitch linetype | "case" -> TCase linetype | "default" -> TDefault linetype | "return" -> TReturn linetype | "break" -> TBreak linetype | "continue" -> TContinue linetype | "goto" -> TGoto linetype | "sizeof" -> TSizeof linetype | "Expression" when !Data.in_iso -> TIsoExpression | "ArgExpression" when !Data.in_iso -> TIsoArgExpression | "TestExpression" when !Data.in_iso -> TIsoTestExpression | "ToTestExpression" when !Data.in_iso -> TIsoToTestExpression | "Statement" when !Data.in_iso -> TIsoStatement | "Declaration" when !Data.in_iso -> TIsoDeclaration | "Type" when !Data.in_iso -> TIsoType | "TopLevel" when !Data.in_iso -> TIsoTopLevel | "_" when !Data.in_meta -> TUnderscore | s -> check_var s linetype let mkassign op lexbuf = TAssign (Ast.OpAssign op, (get_current_line_type lexbuf)) let init _ = line := 1; logical_line := 0; prev_plus := false; line_start := 0; current_line_started := false; current_line_type := (D.CONTEXT,0,0); col_zero := true; pm := UNKNOWN; Data.in_rule_name := false; Data.in_meta := false; Data.in_prolog := false; Data.saw_struct := false; Data.inheritable_positions := []; Hashtbl.clear all_metavariables; Hashtbl.clear Data.all_metadecls; Hashtbl.clear metavariables; Hashtbl.clear type_names; Hashtbl.clear rule_names; Hashtbl.clear iterator_names; Hashtbl.clear declarer_names; Hashtbl.clear symbol_names; let get_name (_,x) = x in Data.add_meta_meta := (fun name pure -> let fn clt = TMeta(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_id_meta := (fun name constraints pure -> let fn clt = TMetaId(name,constraints,Ast.NoVal,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_virt_id_meta_found := (fun name vl -> let fn clt = TIdent(vl,clt) in Hashtbl.replace metavariables name fn); Data.add_virt_id_meta_not_found := (fun name pure -> let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast.NoVal,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_fresh_id_meta := (fun name seed -> let fn clt = TMetaId(name,Ast.IdNoConstraint,seed,Ast0.Impure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_type_meta := (fun name pure -> let fn clt = TMetaType(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_init_meta := (fun name pure -> let fn clt = TMetaInit(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_initlist_meta := (function name -> function lenname -> function pure -> let fn clt = TMetaInitList(name,lenname,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_param_meta := (function name -> function pure -> let fn clt = TMetaParam(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_paramlist_meta := (function name -> function lenname -> function pure -> let fn clt = TMetaParamList(name,lenname,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_const_meta := (fun tyopt name constraints pure -> let fn clt = TMetaConst(name,constraints,pure,tyopt,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_err_meta := (fun name constraints pure -> let fn clt = TMetaErr(name,constraints,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_exp_meta := (fun tyopt name constraints pure -> let fn clt = TMetaExp(name,constraints,pure,tyopt,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_idexp_meta := (fun tyopt name constraints pure -> let fn clt = TMetaIdExp(name,constraints,pure,tyopt,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_local_idexp_meta := (fun tyopt name constraints pure -> let fn clt = TMetaLocalIdExp(name,constraints,pure,tyopt,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_explist_meta := (function name -> function lenname -> function pure -> let fn clt = TMetaExpList(name,lenname,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_decl_meta := (function name -> function pure -> let fn clt = TMetaDecl(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_field_meta := (function name -> function pure -> let fn clt = TMetaField(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_field_list_meta := (function name -> function lenname -> function pure -> let fn clt = TMetaFieldList(name,lenname,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_fmt_meta := (function name -> function iconstraints -> let fn clt = failwith "format metavariable only allowed in a string" in Data.format_metavariables := (get_name name,(name,iconstraints)) :: !Data.format_metavariables; Hashtbl.replace metavariables (get_name name) fn); Data.add_fmtlist_meta := (function name -> function lenname -> let fn clt = failwith "format list metavariable only allowed in a string" in Data.format_list_metavariables := (get_name name,(name,lenname)) :: !Data.format_list_metavariables; Hashtbl.replace metavariables (get_name name) fn); Data.add_stm_meta := (function name -> function pure -> let fn clt = TMetaStm(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_stmlist_meta := (function name -> function pure -> let fn clt = TMetaStmList(name,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_func_meta := (fun name constraints pure -> let fn clt = TMetaFunc(name,constraints,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_local_func_meta := (fun name constraints pure -> let fn clt = TMetaLocalFunc(name,constraints,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_iterator_meta := (fun name constraints pure -> let fn clt = TMetaIterator(name,constraints,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_declarer_meta := (fun name constraints pure -> let fn clt = TMetaDeclarer(name,constraints,pure,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_pos_meta := (fun name constraints any -> let fn ((d,ln,_,_,_,_,_,_) as clt) = (if d = Data.PLUS then failwith (Printf.sprintf "%d: positions only allowed in minus code" ln)); TMetaPos(name,constraints,any,clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_type_name := (function name -> let fn clt = TTypeId(name,clt) in Hashtbl.replace type_names name fn); Data.add_declarer_name := (function name -> let fn clt = TDeclarerId(name,clt) in Hashtbl.replace declarer_names name fn); Data.add_iterator_name := (function name -> let fn clt = TIteratorId(name,clt) in Hashtbl.replace iterator_names name fn); Data.add_symbol_meta := (function name -> let fn clt = TSymId (name,clt) in Hashtbl.replace symbol_names name fn); Data.init_rule := (function _ -> Hashtbl.clear metavariables); Data.install_bindings := (function parent -> List.iter (function (name,fn) -> Hashtbl.add metavariables name fn) (Hashtbl.find all_metavariables parent)) (* initialization for each cocci rule *) let reinit _ = Data.format_metavariables := []; Data.format_list_metavariables := [] (* the following is needed to properly tokenize include files. Because an include file is included after seeing a @, so current_line_started is true. Current_line_started is not important for parsing the name of a rule, so we don't have to reset this value to true after parsing an included file. *) let include_init _ = current_line_started := false let drop_spaces s = let len = String.length s in let rec loop n = if n = len then n else if List.mem (String.get s n) [' ';'\t'] then loop (n+1) else n in let start = loop 0 in String.sub s start (len - start) } (* ---------------------------------------------------------------------- *) (* tokens *) let letter = ['A'-'Z' 'a'-'z' '_'] let digit = ['0'-'9'] let dec = ['0'-'9'] let oct = ['0'-'7'] let hex = ['0'-'9' 'a'-'f' 'A'-'F'] let decimal = ('0' | (['1'-'9'] dec*)) let octal = ['0'] oct+ let hexa = ("0x" |"0X") hex+ let pent = dec+ let pfract = dec+ let sign = ['-' '+'] let exp = ['e''E'] sign? dec+ let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?) rule token = parse | [' ' '\t']* ['\n' '\r' '\011' '\012'] { let cls = !current_line_started in if not cls then begin match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> let info = get_current_line_type lexbuf in reset_line lexbuf; TDirective (Ast.Noindent "", info) | _ -> reset_line lexbuf; token lexbuf end else (reset_line lexbuf; token lexbuf) } | [' ' '\t' ]+ { start_line false; token lexbuf } | [' ' '\t' ]* (("//" [^ '\n']*) as after) { match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> let str = if !current_line_started then (tok lexbuf) else after in start_line true; TDirective (Ast.Indent str, get_current_line_type lexbuf) | _ -> start_line false; token lexbuf } | "__attribute__" [' ' '\t']* "((" _* "))" { match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> start_line true; TDirective (Ast.Space (tok lexbuf), get_current_line_type lexbuf) | _ -> failwith "attributes only allowed in + code" } | "@@" { start_line true; TArobArob } | "@" { pass_zero(); if !Data.in_rule_name or not !current_line_started then (start_line true; TArob) else (check_minus_context_linetype "@"; TPArob (get_current_line_type lexbuf)) } | "=~" { start_line true; TTildeEq (get_current_line_type lexbuf) } | "!~" { start_line true; TTildeExclEq (get_current_line_type lexbuf) } | "WHEN" | "when" { start_line true; check_minus_context_linetype (tok lexbuf); TWhen (get_current_line_type lexbuf) } | "..." { start_line true; check_minus_context_linetype (tok lexbuf); TEllipsis (get_current_line_type lexbuf) } (* | "ooo" { start_line true; check_minus_context_linetype (tok lexbuf); TCircles (get_current_line_type lexbuf) } | "***" { start_line true; check_minus_context_linetype (tok lexbuf); TStars (get_current_line_type lexbuf) } *) | "<..." { start_line true; check_context_linetype (tok lexbuf); TOEllipsis (get_current_line_type lexbuf) } | "...>" { start_line true; check_context_linetype (tok lexbuf); TCEllipsis (get_current_line_type lexbuf) } | "<+..." { start_line true; check_minus_context_linetype (tok lexbuf); TPOEllipsis (get_current_line_type lexbuf) } | "...+>" { start_line true; check_minus_context_linetype (tok lexbuf); TPCEllipsis (get_current_line_type lexbuf) } (* | "" { start_line true; check_context_linetype (tok lexbuf); TCCircles (get_current_line_type lexbuf) } | "<***" { start_line true; check_context_linetype (tok lexbuf); TOStars (get_current_line_type lexbuf) } | "***>" { start_line true; check_context_linetype (tok lexbuf); TCStars (get_current_line_type lexbuf) } *) | "-" { pass_zero(); if !current_line_started then (start_line true; TMinus (get_current_line_type lexbuf)) else (patch_or_match PATCH; add_current_line_type D.MINUS; token lexbuf) } | "+" { pass_zero(); if !current_line_started then (start_line true; TPlus (get_current_line_type lexbuf)) else if !Data.in_meta then TPlus0 else (patch_or_match PATCH; add_current_line_type D.PLUS; token lexbuf) } | "?" { pass_zero(); if !current_line_started then (start_line true; TWhy (get_current_line_type lexbuf)) else if !Data.in_meta then TWhy0 else (add_current_line_type D.OPT; token lexbuf) } | "!" { pass_zero(); if !current_line_started then (start_line true; TBang (get_current_line_type lexbuf)) else if !Data.in_meta then TBang0 else (add_current_line_type D.UNIQUE; token lexbuf) } | "(" { if !Data.in_meta or not !col_zero then (start_line true; TOPar (get_current_line_type lexbuf)) else (start_line true; check_context_linetype (tok lexbuf); TOPar0 (get_current_line_type lexbuf))} | "\\(" { start_line true; TOPar0 (contextify(get_current_line_type lexbuf)) } | "|" { if not (!col_zero) then (start_line true; TOr(get_current_line_type lexbuf)) else (start_line true; check_context_linetype (tok lexbuf); TMid0 (get_current_line_type lexbuf))} | "\\|" { start_line true; TMid0 (contextify(get_current_line_type lexbuf)) } | ")" { if not !col_zero then (start_line true; TCPar (get_current_line_type lexbuf)) else (start_line true; check_context_linetype (tok lexbuf); TCPar0 (get_current_line_type lexbuf))} | "\\)" { start_line true; TCPar0 (contextify(get_current_line_type lexbuf)) } | '[' { start_line true; TOCro (get_current_line_type lexbuf) } | ']' { start_line true; TCCro (get_current_line_type lexbuf) } | '{' { start_line true; TOBrace (get_current_line_type lexbuf) } | '}' { start_line true; TCBrace (get_current_line_type lexbuf) } | "->" { start_line true; TPtrOp (get_current_line_type lexbuf) } | '.' { start_line true; TDot (get_current_line_type lexbuf) } | ',' { start_line true; TComma (get_current_line_type lexbuf) } | ";" { start_line true; if !Data.in_meta then TMPtVirg (* works better with tokens_all *) else TPtVirg (get_current_line_type lexbuf) } | '*' { pass_zero(); if !current_line_started then (start_line true; TMul (get_current_line_type lexbuf)) else (patch_or_match MATCH; add_current_line_type D.MINUS; token lexbuf) } | '/' { start_line true; TDmOp (Ast.Div,get_current_line_type lexbuf) } | "?" { start_line true; TDmOp (Ast.Max,get_current_line_type lexbuf) } | '%' { start_line true; TDmOp (Ast.Mod,get_current_line_type lexbuf) } | '~' { start_line true; TTilde (get_current_line_type lexbuf) } | "++" { pass_zero(); if !current_line_started then (start_line true; TInc (get_current_line_type lexbuf)) else (patch_or_match PATCH; add_current_line_type D.PLUSPLUS; token lexbuf) } | "--" { start_line true; TDec (get_current_line_type lexbuf) } | "=" { start_line true; TEq (get_current_line_type lexbuf) } | "-=" { start_line true; mkassign Ast.Minus lexbuf } | "+=" { start_line true; mkassign Ast.Plus lexbuf } | "*=" { start_line true; mkassign Ast.Mul lexbuf } | "/=" { start_line true; mkassign Ast.Div lexbuf } | "%=" { start_line true; mkassign Ast.Mod lexbuf } | "&=" { start_line true; mkassign Ast.And lexbuf } | "|=" { start_line true; mkassign Ast.Or lexbuf } | "^=" { start_line true; mkassign Ast.Xor lexbuf } | ">?=" { start_line true; mkassign Ast.Max lexbuf } | ">=" { start_line true; mkassign Ast.DecRight lexbuf } | ":" { start_line true; TDotDot (get_current_line_type lexbuf) } | "==" { start_line true; TEqEq (get_current_line_type lexbuf) } | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) } | ">=" { start_line true; TLogOp(Ast.SupEq,get_current_line_type lexbuf) } | "<=" { start_line true; if !Data.in_meta then TSub(get_current_line_type lexbuf) else TLogOp(Ast.InfEq,get_current_line_type lexbuf) } | "<" { start_line true; TLogOp(Ast.Inf,get_current_line_type lexbuf) } | ">" { start_line true; TLogOp(Ast.Sup,get_current_line_type lexbuf) } | "&&" { start_line true; TAndLog (get_current_line_type lexbuf) } | "||" { start_line true; TOrLog (get_current_line_type lexbuf) } | ">>" { start_line true; TShROp(Ast.DecRight,get_current_line_type lexbuf) } | "<<" { start_line true; TShLOp(Ast.DecLeft,get_current_line_type lexbuf) } | "&" { start_line true; TAnd (get_current_line_type lexbuf) } | "^" { start_line true; TXor(get_current_line_type lexbuf) } | "##" { start_line true; TCppConcatOp } | (( ("#" [' ' '\t']* "undef" [' ' '\t']+)) as def) ( (letter (letter |digit)*) as ident) { start_line true; let (arity,line,lline,offset,col,strbef,straft,pos) as lt = get_current_line_type lexbuf in let off = String.length def in (* -1 in the code below because the ident is not at the line start *) TUndef (lt, check_var ident (arity,line,lline,offset+off,col+off,[],[],[])) } | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def) ( (letter (letter |digit)*) as ident) { start_line true; let (arity,line,lline,offset,col,strbef,straft,pos) as lt = get_current_line_type lexbuf in let off = String.length def in (* -1 in the code below because the ident is not at the line start *) TDefine (lt, check_var ident (arity,line,lline,offset+off,col+off,[],[],[])) } | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def) ( (letter (letter | digit)*) as ident) '(' { start_line true; let (arity,line,lline,offset,col,strbef,straft,pos) as lt = get_current_line_type lexbuf in let off = String.length def in TDefineParam (lt, check_var ident (* why pos here but not above? *) (arity,line,lline,offset+off,col+off,strbef,straft,pos), offset + off + (String.length ident), col + off + (String.length ident)) } | ("#" [' ' '\t']* "pragma") { start_line true; TPragma(get_current_line_type lexbuf) } | "#" [' ' '\t']* "include" [' ' '\t']* '\"' [^ '\"']+ '\"' { TIncludeL (let str = tok lexbuf in let start = String.index str '\"' in let finish = String.rindex str '\"' in start_line true; (process_include start finish str,get_current_line_type lexbuf)) } | "#" [' ' '\t']* "include" [' ' '\t']* '<' [^ '>']+ '>' { TIncludeNL (let str = tok lexbuf in let start = String.index str '<' in let finish = String.rindex str '>' in start_line true; (process_include start finish str,get_current_line_type lexbuf)) } | "#" [' ' '\t']* "if" [^'\n']* | "#" [' ' '\t']* "ifdef" [^'\n']* | "#" [' ' '\t']* "ifndef" [^'\n']* | "#" [' ' '\t']* "else" [^'\n']* | "#" [' ' '\t']* "elif" [^'\n']* | "#" [' ' '\t']* "endif" [^'\n']* | "#" [' ' '\t']* "error" [^'\n']* | "#" [' ' '\t']* "line" [^'\n']* { start_line true; check_plus_linetype (tok lexbuf); TDirective (Ast.Noindent(tok lexbuf), get_current_line_type lexbuf) } | "/*" { match !current_line_type with (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> start_line true; (* second argument to TDirective is not quite right, because it represents only the first token of the comment, but that should be good enough *) TDirective (Ast.Indent("/*"^(comment check_comment lexbuf)), get_current_line_type lexbuf) | _ -> let _ = comment (fun _ -> ()) lexbuf in token lexbuf } | "---" [^'\n']* { (if !current_line_started then lexerr "--- must be at the beginning of the line" ""); start_line true; TMinusFile (let str = tok lexbuf in (drop_spaces(String.sub str 3 (String.length str - 3)), (get_current_line_type lexbuf))) } | "+++" [^'\n']* { (if !current_line_started then lexerr "+++ must be at the beginning of the line" ""); start_line true; TPlusFile (let str = tok lexbuf in (drop_spaces(String.sub str 3 (String.length str - 3)), (get_current_line_type lexbuf))) } | letter (letter | digit)* { start_line true; id_tokens lexbuf } (* christia: testing *) | (letter | '$') (letter | digit | '$') * { start_line true; id_tokens lexbuf } | (letter | '$') (letter | digit | '$') * ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ? ("::~" (letter | '$') (letter | digit | '$') * ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ?) + { start_line true; if not !Flag.c_plus_plus then Common.pr2_once "< and > not allowed in C identifiers, try -c++ option"; id_tokens lexbuf } | ((letter | '$') (letter | digit | '$') * ) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') { start_line true; if not !Flag.c_plus_plus then Common.pr2_once "< and > not allowed in C identifiers, try -c++ option"; id_tokens lexbuf } | (((letter | '$') (letter | digit | '$') * )) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ? "::" (((letter | '$') (letter | digit | '$') * )) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ? ("::" ((letter | '$') (letter | digit | '$') * ) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ?) * { start_line true; if not !Flag.c_plus_plus then Common.pr2_once "~ and :: not allowed in C identifiers, try -c++ option"; id_tokens lexbuf } | "::" ((letter | '$') (letter | digit | '$') * ) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ? ("::" ((letter | '$') (letter | digit | '$') * ) ('<' (letter | '$' | '~') (letter | digit | '$' | '~') * '>') ?) * { start_line true; if not !Flag.c_plus_plus then Common.pr2_once "~ and :: not allowed in C identifiers, try -c++ option"; id_tokens lexbuf } (* christia: end *) | "'" { start_line true; TChar(char lexbuf,get_current_line_type lexbuf) } | '\"' { start_line true; TString(string lexbuf,(get_current_line_type lexbuf)) } | (real as x) { start_line true; TFloat(x,(get_current_line_type lexbuf)) } | ((( decimal | hexa | octal) ( ['u' 'U'] | ['l' 'L'] | (['l' 'L'] ['u' 'U']) | (['u' 'U'] ['l' 'L']) | (['u' 'U'] ['l' 'L'] ['l' 'L']) | (['l' 'L'] ['l' 'L']) )? ) as x) { start_line true; TInt(x,(get_current_line_type lexbuf)) } | (decimal ['d' 'D']) as x { if !Flag.ibm then begin start_line true; let len = string_of_int(String.length x - 1) in TDecimalCst(x,len,"0",(get_current_line_type lexbuf)) end else failwith "unrecognized constant modifier d/D" } | "<=>" { TIso } | "=>" { TRightIso } | eof { EOF } | _ { lexerr "unrecognised symbol, in token rule: " (tok lexbuf) } and char = parse | (_ as x) { String.make 1 x ^ restchars lexbuf } (* todo?: as for octal, do exception beyond radix exception ? *) | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf } (* this rule must be after the one with octal, lex try first longest * and when \7 we want an octal, not an exn. *) | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf } | (("\\" (_ as v)) as x ) { (match v with (* Machine specific ? *) | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () (* linuxext: ? *) | _ -> Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); ); x ^ restchars lexbuf } | _ { Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); tok lexbuf ^ restchars lexbuf } and restchars = parse | "'" { "" } | (_ as x) { String.make 1 x ^ restchars lexbuf } (* todo?: as for octal, do exception beyond radix exception ? *) | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf } (* this rule must be after the one with octal, lex try first longest * and when \7 we want an octal, not an exn. *) | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf } | (("\\" (_ as v)) as x ) { (match v with (* Machine specific ? *) | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () (* linuxext: ? *) | _ -> Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); ); x ^ restchars lexbuf } | _ { Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf); tok lexbuf ^ restchars lexbuf } and string = parse | '\"' { "" } | (_ as x) { Common.string_of_char x ^ string lexbuf } | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf } | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf } | ("\\" (_ as v)) as x { (match v with | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () | 'f' -> () | 'a' -> () | '\\' -> () | '?' -> () | '\'' -> () | '\"' -> () | 'e' -> () | '\n' -> () | '(' -> () | '|' -> () | ')' -> () | _ -> lexerr "unrecognised symbol:" (tok lexbuf) ); x ^ string lexbuf } | _ { lexerr "unrecognised symbol: " (tok lexbuf) } and comment check_comment = parse | "*/" { let s = tok lexbuf in check_comment s; start_line true; s } | ['\n' '\r' '\011' '\012'] { let s = tok lexbuf in (* even blank line should have a + *) check_comment s; reset_line lexbuf; s ^ comment check_comment lexbuf } | "+" { pass_zero(); if !current_line_started then (start_line true; let s = tok lexbuf in s^(comment check_comment lexbuf)) else (start_line true; comment check_comment lexbuf) } (* noteopti: *) | [^ '*'] { let s = tok lexbuf in check_comment s; start_line true; s ^ comment check_comment lexbuf } | [ '*'] { let s = tok lexbuf in check_comment s; start_line true; s ^ comment check_comment lexbuf } | _ { start_line true; let s = tok lexbuf in Common.pr2 ("LEXER: unrecognised symbol in comment:"^s); s ^ comment check_comment lexbuf } coccinelle-1.0.0-rc19/parsing_cocci/ast_cocci.mli0000644000175000017500000007006612247442615020631 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast_cocci.mli" (* --------------------------------------------------------------------- *) (* Modified code *) type added_string = Noindent of string | Indent of string | Space of string type info = { line : int; column : int; strbef : (added_string * int (* line *) * int (* col *)) list; straft : (added_string * int (* line *) * int (* col *)) list } type line = int type meta_name = string * string type 'a wrap = {node : 'a; node_line : line; free_vars : meta_name list; (*free vars*) minus_free_vars : meta_name list; (*minus free vars*) fresh_vars : (meta_name * seed) list; (*fresh vars*) inherited : meta_name list; (*inherited vars*) saved_witness : meta_name list; (*witness vars*) bef_aft : dots_bef_aft; pos_info : meta_name mcode option; (* pos info, try not to duplicate *) true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *) (* the following is only for declarations *) safe_for_multi_decls : bool; (* isos relevant to the term; ultimately only used for rule_elems *) iso_info : (string*anything) list } and 'a befaft = BEFORE of 'a list list * count | AFTER of 'a list list * count | BEFOREAFTER of 'a list list * 'a list list * count | NOTHING and 'a replacement = REPLACEMENT of 'a list list * count | NOREPLACEMENT and 'a mcode = 'a * info * mcodekind * meta_pos list (* pos variables *) (* pos is an offset indicating where in the C code the mcodekind has an effect *) and adjacency = ALLMINUS | ADJ of int and mcodekind = MINUS of pos * int list * adjacency * anything replacement | CONTEXT of pos * anything befaft | PLUS of count and count = ONE (* + *) | MANY (* ++ *) and fixpos = Real of int (* charpos *) | Virt of int * int (* charpos + offset *) and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos) and dots_bef_aft = NoDots | AddingBetweenDots of statement * int (*index of let var*) | DroppingBetweenDots of statement * int (*index of let var*) and inherited = Type_cocci.inherited and keep_binding = Type_cocci.keep_binding and multi = bool (*true if a nest is one or more, false if it is zero or more*) and end_info = meta_name list (*free vars*) * (meta_name * seed) list (*fresh*) * meta_name list (*inherited vars*) * mcodekind (* --------------------------------------------------------------------- *) (* Metavariables *) and arity = UNIQUE | OPT | MULTI | NONE and metavar = MetaMetaDecl of arity * meta_name (* name *) | MetaIdDecl of arity * meta_name (* name *) | MetaFreshIdDecl of meta_name (* name *) * seed (* seed *) | MetaTypeDecl of arity * meta_name (* name *) | MetaInitDecl of arity * meta_name (* name *) | MetaInitListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaListlenDecl of meta_name (* name *) | MetaParamDecl of arity * meta_name (* name *) | MetaParamListDecl of arity * meta_name (*name*) * list_len (*len*) | MetaConstDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaErrDecl of arity * meta_name (* name *) | MetaExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaIdExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaLocalIdExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaExpListDecl of arity * meta_name (*name*) * list_len (*len*) | MetaDeclDecl of arity * meta_name (* name *) | MetaFieldDecl of arity * meta_name (* name *) | MetaFieldListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaStmDecl of arity * meta_name (* name *) | MetaStmListDecl of arity * meta_name (* name *) | MetaFuncDecl of arity * meta_name (* name *) | MetaLocalFuncDecl of arity * meta_name (* name *) | MetaPosDecl of arity * meta_name (* name *) | MetaFmtDecl of arity * meta_name (* name *) | MetaFragListDecl of arity * meta_name (* name *) * list_len (*len*) | MetaAnalysisDecl of string * meta_name (* name *) | MetaDeclarerDecl of arity * meta_name (* name *) | MetaIteratorDecl of arity * meta_name (* name *) and list_len = AnyLen | MetaLen of meta_name | CstLen of int and seed = NoVal | StringSeed of string | ListSeed of seed_elem list and seed_elem = SeedString of string | SeedId of meta_name (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) and 'a base_dots = DOTS of 'a list | CIRCLES of 'a list | STARS of 'a list and 'a dots = 'a base_dots wrap (* --------------------------------------------------------------------- *) (* Identifier *) and base_ident = Id of string mcode | MetaId of meta_name mcode * idconstraint * keep_binding * inherited | MetaFunc of meta_name mcode * idconstraint * keep_binding * inherited | MetaLocalFunc of meta_name mcode * idconstraint * keep_binding * inherited | AsIdent of ident * ident (* as ident, always metavar *) | DisjId of ident list | OptIdent of ident | UniqueIdent of ident and ident = base_ident wrap (* --------------------------------------------------------------------- *) (* Expression *) and base_expression = Ident of ident | Constant of constant mcode | StringConstant of string mcode (* quote *) * string_fragment dots * string mcode (* quote *) | FunCall of expression * string mcode (* ( *) * expression dots * string mcode (* ) *) | Assignment of expression * assignOp mcode * expression * bool | Sequence of expression * string mcode (* , *) * expression | CondExpr of expression * string mcode (* ? *) * expression option * string mcode (* : *) * expression | Postfix of expression * fixOp mcode | Infix of expression * fixOp mcode | Unary of expression * unaryOp mcode | Binary of expression * binaryOp mcode * expression | Nested of expression * binaryOp mcode * expression | ArrayAccess of expression * string mcode (* [ *) * expression * string mcode (* ] *) | RecordAccess of expression * string mcode (* . *) * ident | RecordPtAccess of expression * string mcode (* -> *) * ident | Cast of string mcode (* ( *) * fullType * string mcode (* ) *) * expression | SizeOfExpr of string mcode (* sizeof *) * expression | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) * fullType * string mcode (* ) *) | TypeExp of fullType | Paren of string mcode (* ( *) * expression * string mcode (* ) *) | Constructor of string mcode (* ( *) * fullType * string mcode (* ) *) * initialiser | MetaErr of meta_name mcode * constraints * keep_binding * inherited | MetaExpr of meta_name mcode * constraints * keep_binding * Type_cocci.typeC list option * form * inherited | MetaExprList of meta_name mcode * listlen * keep_binding * inherited (* only in arg lists *) | AsExpr of expression * expression (* as expr, always metavar *) | EComma of string mcode (* only in arg lists *) | DisjExpr of expression list | NestExpr of string mcode (* <.../<+... *) * expression dots * string mcode (* ...>/...+> *) * expression option * multi (* can appear in arg lists, and also inside Nest, as in: if(< ... X ... Y ...>) In the following, the expression option is the WHEN *) | Edots of string mcode (* ... *) * expression option | Ecircles of string mcode (* ooo *) * expression option | Estars of string mcode (* *** *) * expression option | OptExp of expression | UniqueExp of expression and constraints = NoConstraint | NotIdCstrt of reconstraint | NotExpCstrt of expression list | SubExpCstrt of meta_name list (* Constraints on Meta-* Identifiers, Functions *) and idconstraint = IdNoConstraint | IdNegIdSet of string list * meta_name list | IdRegExpConstraint of reconstraint and reconstraint = | IdRegExp of string * Regexp.regexp | IdNotRegExp of string * Regexp.regexp and form = ANY | ID | LocalID | CONST (* form for MetaExp *) and expression = base_expression wrap and listlen = MetaListLen of meta_name mcode * keep_binding * inherited | CstListLen of int | AnyListLen and base_string_fragment = ConstantFragment of string mcode | FormatFragment of string mcode (*%*) * string_format (* format *) | Strdots of string mcode | MetaFormatList of string mcode (*%*) * meta_name mcode * listlen * keep_binding * inherited and string_fragment = base_string_fragment wrap and base_string_format = ConstantFormat of string mcode | MetaFormat of meta_name mcode * idconstraint * keep_binding * inherited and string_format = base_string_format wrap and unaryOp = GetRef | GetRefLabel | DeRef | UnPlus | UnMinus | Tilde | Not and assignOp = SimpleAssign | OpAssign of arithOp and fixOp = Dec | Inc and binaryOp = Arith of arithOp | Logical of logicalOp and arithOp = Plus | Minus | Mul | Div | Mod | DecLeft | DecRight | And | Or | Xor | Min | Max and logicalOp = Inf | Sup | InfEq | SupEq | Eq | NotEq | AndLog | OrLog and constant = String of string | Char of string | Int of string | Float of string | DecimalConst of (string * string * string) (* --------------------------------------------------------------------- *) (* Types *) and base_fullType = Type of bool (* true if all minus *) * const_vol mcode option * typeC | AsType of fullType * fullType (* as type, always metavar *) | DisjType of fullType list (* only after iso *) | OptType of fullType | UniqueType of fullType and base_typeC = BaseType of baseType * string mcode list (* Yoann style *) | SignedT of sign mcode * typeC option | Pointer of fullType * string mcode (* * *) | FunctionPointer of fullType * string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* string mcode (* ( *)*parameter_list*string mcode(* ) *) | FunctionType of bool (* true if all minus for dropping return type *) * fullType option * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Array of fullType * string mcode (* [ *) * expression option * string mcode (* ] *) | Decimal of string mcode (* decimal *) * string mcode (* ( *) * expression * string mcode option (* , *) * expression option * string mcode (* ) *) (* IBM C only *) | EnumName of string mcode (*enum*) * ident option (* name *) | EnumDef of fullType (* either EnumName or metavar *) * string mcode (* { *) * expression dots * string mcode (* } *) | StructUnionName of structUnion mcode * ident option (* name *) | StructUnionDef of fullType (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) | TypeName of string mcode | MetaType of meta_name mcode * keep_binding * inherited and fullType = base_fullType wrap and typeC = base_typeC wrap and baseType = VoidType | CharType | ShortType | ShortIntType | IntType | DoubleType | LongDoubleType | FloatType | LongType | LongIntType | LongLongType | LongLongIntType | SizeType | SSizeType | PtrDiffType and structUnion = Struct | Union and sign = Signed | Unsigned and const_vol = Const | Volatile (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and base_declaration = Init of storage mcode option * fullType * ident * string mcode (*=*) * initialiser * string mcode (*;*) | UnInit of storage mcode option * fullType * ident * string mcode (* ; *) | TyDecl of fullType * string mcode (* ; *) | MacroDecl of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (*=*) * initialiser * string mcode (* ; *) | Typedef of string mcode (*typedef*) * fullType * typeC * string mcode (*;*) | DisjDecl of declaration list | Ddots of string mcode (* ... *) * declaration option (* whencode *) | MetaDecl of meta_name mcode * keep_binding * inherited | MetaField of meta_name mcode * keep_binding * inherited | MetaFieldList of meta_name mcode * listlen * keep_binding * inherited | AsDecl of declaration * declaration | OptDecl of declaration | UniqueDecl of declaration and declaration = base_declaration wrap (* --------------------------------------------------------------------- *) (* Initializers *) and base_initialiser = MetaInit of meta_name mcode * keep_binding * inherited | MetaInitList of meta_name mcode * listlen * keep_binding * inherited | AsInit of initialiser * initialiser (* as init, always metavar *) | InitExpr of expression | ArInitList of string mcode (*{*) * initialiser dots * string mcode (*}*) | StrInitList of bool (* true if all are - *) * string mcode (*{*) * initialiser list * string mcode (*}*) * initialiser list (* whencode: elements that shouldn't appear in init *) | InitGccExt of designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) | InitGccName of ident (* name *) * string mcode (*:*) * initialiser | IComma of string mcode (* , *) | Idots of string mcode (* ... *) * initialiser option (* whencode *) | OptIni of initialiser | UniqueIni of initialiser and designator = DesignatorField of string mcode (* . *) * ident | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *) | DesignatorRange of string mcode (* [ *) * expression * string mcode (* ... *) * expression * string mcode (* ] *) and initialiser = base_initialiser wrap (* --------------------------------------------------------------------- *) (* Parameter *) and base_parameterTypeDef = VoidParam of fullType | Param of fullType * ident option | MetaParam of meta_name mcode * keep_binding * inherited | MetaParamList of meta_name mcode * listlen * keep_binding * inherited | AsParam of parameterTypeDef * expression (* expr, always metavar *) | PComma of string mcode | Pdots of string mcode (* ... *) | Pcircles of string mcode (* ooo *) | OptParam of parameterTypeDef | UniqueParam of parameterTypeDef and parameterTypeDef = base_parameterTypeDef wrap and parameter_list = parameterTypeDef dots (* --------------------------------------------------------------------- *) (* #define Parameters *) and base_define_param = DParam of ident | DPComma of string mcode | DPdots of string mcode (* ... *) | DPcircles of string mcode (* ooo *) | OptDParam of define_param | UniqueDParam of define_param and define_param = base_define_param wrap and base_define_parameters = NoParams | DParams of string mcode(*( *) * define_param dots * string mcode(* )*) and define_parameters = base_define_parameters wrap (* --------------------------------------------------------------------- *) (* positions *) (* PER = keep bindings separate, ANY = collect them *) and meta_collect = PER | ALL and meta_pos = MetaPos of meta_name mcode * meta_name list * meta_collect * keep_binding * inherited (* --------------------------------------------------------------------- *) (* Function declaration *) and storage = Static | Auto | Register | Extern (* --------------------------------------------------------------------- *) (* Top-level code *) and base_rule_elem = FunHeader of mcodekind (* before the function header *) * bool (* true if all minus, for dropping static, etc *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * string mcode (* ) *) | Decl of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration | SeqStart of string mcode (* { *) | SeqEnd of string mcode (* } *) | ExprStatement of expression option * string mcode (*;*) | IfHeader of string mcode (* if *) * string mcode (* ( *) * expression * string mcode (* ) *) | Else of string mcode (* else *) | WhileHeader of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) | DoHeader of string mcode (* do *) | WhileTail of string mcode (* while *) * string mcode (* ( *) * expression * string mcode (* ) *) * string mcode (* ; *) | ForHeader of string mcode (* for *) * string mcode (* ( *) * forinfo * expression option * string mcode (*;*) * expression option * string mcode (* ) *) | IteratorHeader of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) | SwitchHeader of string mcode (* switch *) * string mcode (* ( *) * expression * string mcode (* ) *) | Break of string mcode (* break *) * string mcode (* ; *) | Continue of string mcode (* continue *) * string mcode (* ; *) | Label of ident * string mcode (* : *) | Goto of string mcode (* goto *) * ident * string mcode (* ; *) | Return of string mcode (* return *) * string mcode (* ; *) | ReturnExpr of string mcode (* return *) * expression * string mcode (* ; *) | MetaRuleElem of meta_name mcode * keep_binding * inherited | MetaStmt of meta_name mcode * keep_binding * metaStmtInfo * inherited | MetaStmtList of meta_name mcode * keep_binding * inherited | Exp of expression | TopExp of expression (* for macros body *) | Ty of fullType (* only at top level *) | TopInit of initialiser (* only at top level *) | Include of string mcode (*#include*) * inc_file mcode (*file *) | Undef of string mcode (* #define *) * ident (* name *) | DefineHeader of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) | Pragma of string mcode (* #pragma *) * ident * pragmainfo | Case of string mcode (* case *) * expression * string mcode (*:*) | Default of string mcode (* default *) * string mcode (*:*) | DisjRuleElem of rule_elem list and base_pragmainfo = PragmaTuple of string mcode(* ( *) * expression dots * string mcode(* ) *) | PragmaIdList of ident dots | PragmaDots of string mcode and pragmainfo = base_pragmainfo wrap and forinfo = ForExp of expression option * string mcode (*;*) | ForDecl of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration and fninfo = FStorage of storage mcode | FType of fullType | FInline of string mcode | FAttr of string mcode and metaStmtInfo = NotSequencible | SequencibleAfterDots of dots_whencode list | Sequencible and rule_elem = base_rule_elem wrap and base_statement = Seq of rule_elem (* { *) * statement dots * rule_elem (* } *) | IfThen of rule_elem (* header *) * statement * end_info | IfThenElse of rule_elem (* header *) * statement * rule_elem (* else *) * statement * end_info | While of rule_elem (* header *) * statement * end_info | Do of rule_elem (* do *) * statement * rule_elem (* tail *) | For of rule_elem (* header *) * statement * end_info | Iterator of rule_elem (* header *) * statement * end_info (*enditer*) | Switch of rule_elem (* header *) * rule_elem (* { *) * statement (*decl*) dots * case_line list * rule_elem(*}*) | Atomic of rule_elem | Disj of statement dots list | Nest of string mcode (* <.../<+... *) * statement dots * string mcode (* ...>/...+> *) * (statement dots,statement) whencode list * multi * dots_whencode list * dots_whencode list | FunDecl of rule_elem (* header *) * rule_elem (* { *) * statement dots * rule_elem (* } *) | Define of rule_elem (* header *) * statement dots | AsStmt of statement * statement (* as statement, always metavar *) | Dots of string mcode (* ... *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | Circles of string mcode (* ooo *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | Stars of string mcode (* *** *) * (statement dots,statement) whencode list * dots_whencode list * dots_whencode list | OptStm of statement | UniqueStm of statement and ('a,'b) whencode = WhenNot of 'a | WhenAlways of 'b | WhenModifier of when_modifier | WhenNotTrue of rule_elem | WhenNotFalse of rule_elem and when_modifier = WhenAny | WhenStrict | WhenForall | WhenExists and dots_whencode = WParen of rule_elem * meta_name (*pren_var*) | Other of statement | Other_dots of statement dots and statement = base_statement wrap and base_case_line = CaseLine of rule_elem (* case/default header *) * statement dots | OptCase of case_line and case_line = base_case_line wrap and inc_file = Local of inc_elem list | NonLocal of inc_elem list and inc_elem = IncPath of string | IncDots and base_top_level = NONDECL of statement (* cannot match all of a top-level declaration *) | CODE of statement dots | FILEINFO of string mcode (* old file *) * string mcode (* new file *) | ERRORWORDS of expression list and top_level = base_top_level wrap and parser_kind = ExpP | TyP | AnyP and rulename = CocciRulename of string option * dependency * string list * string list * exists * parser_kind | GeneratedRulename of string option * dependency * string list * string list * exists * parser_kind | ScriptRulename of string option (* name *) * string (* language *) * dependency | InitialScriptRulename of string option (* name *) * string (* language *) * dependency | FinalScriptRulename of string option (* name *) * string (* language *) * dependency and ruletype = Normal | Generated and rule = CocciRule of string (* name *) * (dependency * string list (* dropped isos *) * exists) * top_level list * bool list (* true if generates an exp *) * ruletype | ScriptRule of string (* name *) * string * dependency * (script_meta_name * meta_name * metavar) list * meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string * dependency * string | FinalScriptRule of string (* name *) * string * dependency * string and script_meta_name = string option (*string*) * string option (*ast*) and dependency = Dep of string (* rule applies for the current binding *) | AntiDep of string (* rule doesn't apply for the current binding *) | EverDep of string (* rule applies for some binding *) | NeverDep of string (* rule never applies for any binding *) | AndDep of dependency * dependency | OrDep of dependency * dependency | NoDep | FailDep and rule_with_metavars = metavar list * rule and anything = FullTypeTag of fullType | BaseTypeTag of baseType | StructUnionTag of structUnion | SignTag of sign | IdentTag of ident | ExpressionTag of expression | ConstantTag of constant | UnaryOpTag of unaryOp | AssignOpTag of assignOp | FixOpTag of fixOp | BinaryOpTag of binaryOp | ArithOpTag of arithOp | LogicalOpTag of logicalOp | DeclarationTag of declaration | InitTag of initialiser | StorageTag of storage | IncFileTag of inc_file | Rule_elemTag of rule_elem | StatementTag of statement | ForInfoTag of forinfo | CaseLineTag of case_line | ConstVolTag of const_vol | Token of string * info option | Directive of added_string list | Code of top_level | ExprDotsTag of expression dots | ParamDotsTag of parameterTypeDef dots | StmtDotsTag of statement dots | DeclDotsTag of declaration dots | TypeCTag of typeC | ParamTag of parameterTypeDef | SgrepStartTag of string | SgrepEndTag of string (* --------------------------------------------------------------------- *) and exists = Exists | Forall | Undetermined (* --------------------------------------------------------------------- *) val mkToken : string -> anything val undots : 'a dots -> 'a list val lub_count : count -> count -> count (* --------------------------------------------------------------------- *) val rewrap : 'a wrap -> 'b -> 'b wrap val rewrap_mcode : 'a mcode -> 'a -> 'a mcode val unwrap : 'a wrap -> 'a val unwrap_mcode : 'a mcode -> 'a val get_mcodekind : 'a mcode -> mcodekind val get_line : 'a wrap -> line val get_mcode_line : 'a mcode -> line val get_mcode_col : 'a mcode -> int val get_fvs : 'a wrap -> meta_name list val get_wcfvs : ('a wrap,'b wrap) whencode list -> meta_name list val set_fvs : meta_name list -> 'a wrap -> 'a wrap val get_mfvs : 'a wrap -> meta_name list val set_mfvs : meta_name list -> 'a wrap -> 'a wrap val get_fresh : 'a wrap -> (meta_name * seed) list val get_inherited : 'a wrap -> meta_name list val get_saved : 'a wrap -> meta_name list val get_dots_bef_aft : statement -> dots_bef_aft val set_dots_bef_aft : dots_bef_aft -> statement -> statement val get_pos : 'a wrap -> meta_name mcode option val set_pos : 'a wrap -> meta_name mcode option -> 'a wrap val get_test_exp : 'a wrap -> bool val set_test_exp : expression -> expression val get_safe_decl : 'a wrap -> bool val get_isos : 'a wrap -> (string*anything) list val set_isos : 'a wrap -> (string*anything) list -> 'a wrap val get_pos_var : 'a mcode -> meta_pos list val set_pos_var : meta_pos list -> 'a mcode -> 'a mcode val drop_pos : 'a mcode -> 'a mcode val get_meta_name : metavar -> meta_name val tag2c : anything -> string val no_info : info val make_meta_rule_elem : string -> mcodekind -> (meta_name list * (meta_name * seed) list * meta_name list) -> rule_elem val make_meta_decl : string -> mcodekind -> (meta_name list * (meta_name * seed) list * meta_name list) -> declaration val make_term : 'a -> 'a wrap val make_inherited_term : 'a -> meta_name list (* inherited vars *) -> 'a wrap val make_mcode : 'a -> 'a mcode val equal_pos : fixpos -> fixpos -> bool coccinelle-1.0.0-rc19/parsing_cocci/disjdistr.mli0000644000175000017500000000231112247442615020665 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./disjdistr.mli" val disj : Ast_cocci.rule_with_metavars list -> Ast_cocci.rule_with_metavars list coccinelle-1.0.0-rc19/parsing_cocci/function_prototypes.mli0000644000175000017500000000257112247442615023033 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./function_prototypes.mli" val process : string (* name *) -> Ast_cocci.metavar list -> string list (* dropped isos *) -> Ast0_cocci.rule -> Ast0_cocci.rule -> Ast_cocci.ruletype -> ((Ast_cocci.metavar list * Ast0_cocci.rule) * Ast_cocci.rule_with_metavars option) coccinelle-1.0.0-rc19/parsing_cocci/safe_for_multi_decls.mli0000644000175000017500000000235212247442615023043 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./safe_for_multi_decls.mli" val safe_for_multi_decls : Ast_cocci.rule_with_metavars list -> Ast_cocci.rule_with_metavars list coccinelle-1.0.0-rc19/parsing_cocci/command_line.mli0000644000175000017500000000224412247442615021320 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./command_line.mli" val command_line : string list -> string list coccinelle-1.0.0-rc19/parsing_cocci/simple_assignments.ml0000644000175000017500000000752112247442615022431 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./simple_assignments.ml" module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* find assignments that can match an initialization *) let pure_mcodekind = function Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> true | _ -> false) | _ -> false let is_simple_assign left op = (match Ast0.unwrap left with Ast0.Ident(_) | Ast0.MetaExpr(_,_,_,_,_) -> true | _ -> false) && ((Ast0.unwrap_mcode op) = Ast.SimpleAssign) let is_simple_ast_assign left op minus_left = (match Ast.unwrap left with Ast.Ident(_) -> true | Ast.MetaExpr(name,_,_,_,_,_) -> (match Ast0.unwrap minus_left with Ast0.MetaExpr(name1,_,_,_,_) -> Ast.unwrap_mcode name = Ast0.unwrap_mcode name1 | _ -> false) | _ -> false) && ((Ast.unwrap_mcode op) = Ast.SimpleAssign) let warning e msg = if not !Flag.sgrep_mode2 then Common.pr2 ("the simple assignment expression on line "^ (string_of_int (Ast0.get_line e))^ " contains transformations\n"^ "that prevent it from matching a declaration ("^msg^")\n"); e let rebuild e1 left right op simple = Ast0.rewrap e1 (Ast0.Assignment(left,op,right,simple)) let rec exp mc e1 = match Ast0.unwrap e1 with Ast0.Assignment(left,op,right,_) -> if is_simple_assign left op then (if !Flag.sgrep_mode2 then rebuild e1 left right op true else match mc with Ast0.MINUS(mc) -> (match !mc with (Ast.REPLACEMENT([[Ast.ExpressionTag(e2)]],_),_) -> (match Ast.unwrap e2 with Ast.Assignment(left',op',_,_) -> if is_simple_ast_assign left' op' left then rebuild e1 left right op true else warning e1 "replacement is not simple" | _ -> warning e1 "replacement is not an assignment") | _ -> warning e1 "multiple replacements") | m -> let pure = (pure_mcodekind m) && (pure_mcodekind (Ast0.get_mcodekind left)) && (pure_mcodekind (Ast0.get_mcode_mcodekind op)) in if not pure then warning e1 "not pure" else rebuild e1 left right op pure) else e1 | Ast0.DisjExpr(lp,exps,mids,rp) -> Ast0.rewrap e1 (Ast0.DisjExpr (lp,List.map (function x -> exp (Ast0.get_mcodekind x) x) exps, mids,rp)) | Ast0.OptExp(e) -> Ast0.rewrap e1 (Ast0.OptExp(exp (Ast0.get_mcodekind e) e)) | Ast0.UniqueExp(e) -> Ast0.rewrap e1 (Ast0.UniqueExp(exp (Ast0.get_mcodekind e) e)) | _ -> e1 let simple_assignments l = let statement r k e = match Ast0.unwrap e with Ast0.Exp(e1) -> Ast0.rewrap e (Ast0.Exp(exp (Ast0.get_mcodekind e) e1)) | _ -> k e in let fn = V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_stmtfn = statement} in List.map fn.VT0.rebuilder_rec_top_level l coccinelle-1.0.0-rc19/parsing_cocci/adjust_pragmas.ml0000644000175000017500000003455412247442615021537 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./adjust_pragmas.ml" (* Find a directive or comment at the end of a statement. Things with aft given None, because they can accomodate their own directives or comments *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let call_right processor data s cont = match processor data with None -> None | Some(pragmas,data) -> Some (pragmas,Ast0.rewrap s (cont data)) let left_mcode (a,b,info,mcodekind,d,e) = match (info.Ast0.strings_before,mcodekind) with ([],_) | (_,Ast0.PLUS _) -> None | (l,_) -> Some(l,(a,b,{info with Ast0.strings_before = []},mcodekind,d,e)) let right_mcode (a,b,info,mcodekind,d,e) = match (info.Ast0.strings_after,mcodekind) with ([],_) | (_,Ast0.PLUS _) -> None | (l,_) -> Some(l,(a,b,{info with Ast0.strings_after = []},mcodekind,d,e)) let update_before pragmas (info,x,adj) = ({info with Ast0.strings_before = pragmas @ info.Ast0.strings_before}, Ast0.PLUS Ast.ONE,adj)(*not sure what the arg should be... one seems safe*) let update_after pragmas (info,x) = ({info with Ast0.strings_after = info.Ast0.strings_after @ pragmas}, Ast0.PLUS Ast.ONE) (*not sure what the arg should be... one seems safe*) let rec right_decl d = match Ast0.unwrap d with Ast0.MetaDecl(name,pure) -> call_right right_mcode name d (function name -> Ast0.MetaDecl(name,pure)) | Ast0.MetaField(name,pure) -> call_right right_mcode name d (function name -> Ast0.MetaField(name,pure)) | Ast0.MetaFieldList(name,lenname,pure) -> call_right right_mcode name d (function name -> Ast0.MetaFieldList(name,lenname,pure)) | Ast0.AsDecl(decl,asdecl) -> failwith "not possible" | Ast0.Init(Some stg,ty,id,eq,ini,sem) -> call_right right_mcode sem d (function sem -> Ast0.Init(Some stg,ty,id,eq,ini,sem)) | Ast0.Init(None,ty,id,eq,ini,sem) -> call_right right_mcode sem d (function sem -> Ast0.Init(None,ty,id,eq,ini,sem)) | Ast0.UnInit(Some stg,ty,id,sem) -> call_right right_mcode sem d (function sem -> Ast0.UnInit(Some stg,ty,id,sem)) | Ast0.UnInit(None,ty,id,sem) -> call_right right_mcode sem d (function sem -> Ast0.UnInit(None,ty,id,sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> call_right right_mcode sem d (function sem -> Ast0.MacroDecl(name,lp,args,rp,sem)) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> call_right right_mcode sem d (function sem -> Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) | Ast0.TyDecl(ty,sem) -> call_right right_mcode sem d (function sem -> Ast0.TyDecl(ty,sem)) | Ast0.Typedef(stg,ty,id,sem) -> call_right right_mcode sem d (function sem -> Ast0.Typedef(stg,ty,id,sem)) | Ast0.DisjDecl(starter,decls,mids,ender) -> None | Ast0.Ddots(dots,whencode) -> None | Ast0.OptDecl(decl) -> call_right right_decl decl d (function decl -> Ast0.OptDecl(decl)) | Ast0.UniqueDecl(decl) -> call_right right_decl decl d (function decl -> Ast0.UniqueDecl(decl)) let rec right_statement s = match Ast0.unwrap s with Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> None | Ast0.Decl(bef,decl) -> call_right right_decl decl s (function decl -> Ast0.Decl(bef,decl)) | Ast0.Seq(lbrace,body,rbrace) -> call_right right_mcode rbrace s (function rbrace -> Ast0.Seq(lbrace,body,rbrace)) | Ast0.ExprStatement(exp,sem) -> call_right right_mcode sem s (function sem -> Ast0.ExprStatement(exp,sem)) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> None | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> None | Ast0.While(whl,lp,exp,rp,body,aft) -> None | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> call_right right_mcode sem s (function sem -> Ast0.Do(d,body,whl,lp,exp,rp,sem)) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> None | Ast0.Iterator(nm,lp,args,rp,body,aft) -> None | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> call_right right_mcode rb s (function rb -> Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb)) | Ast0.Break(br,sem) -> call_right right_mcode sem s (function sem -> Ast0.Break(br,sem)) | Ast0.Continue(cont,sem) -> call_right right_mcode sem s (function sem -> Ast0.Continue(cont,sem)) | Ast0.Label(l,dd) -> call_right right_mcode dd s (function dd -> Ast0.Label(l,dd)) | Ast0.Goto(goto,l,sem) -> call_right right_mcode sem s (function sem -> Ast0.Goto(goto,l,sem)) | Ast0.Return(ret,sem) -> call_right right_mcode sem s (function sem -> Ast0.Return(ret,sem)) | Ast0.ReturnExpr(ret,exp,sem) -> call_right right_mcode sem s (function sem -> Ast0.ReturnExpr(ret,exp,sem)) | Ast0.MetaStmt(name,pure) -> call_right right_mcode name s (function name -> Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,pure) -> call_right right_mcode name s (function name -> Ast0.MetaStmtList(name,pure)) | Ast0.AsStmt(stm,asstm) -> failwith "not possible" | Ast0.Disj(starter,statement_dots_list,mids,ender) -> None | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> None (* the following are None, because they can't be adjacent to an aft node *) | Ast0.Exp(exp) -> None | Ast0.TopExp(exp) -> None | Ast0.Ty(ty) -> None | Ast0.TopInit(init) -> None | Ast0.Dots(d,whn) -> None | Ast0.Circles(d,whn) -> None | Ast0.Stars(d,whn) -> None | Ast0.Include(inc,name) -> call_right right_mcode name s (function name -> Ast0.Include(inc,name)) | Ast0.Undef(def,id) -> (* nothing available for ident, and not sure code can appear here anyway *) None | Ast0.Define(def,id,params,body) -> call_right right_statement_dots body s (function body -> Ast0.Define(def,id,params,body)) | Ast0.Pragma(prg,id,body) -> (* seems safe; let the code go with the enclosing statement, if any *) None | Ast0.OptStm(re) -> call_right right_statement re s (function re -> Ast0.OptStm(re)) | Ast0.UniqueStm(re) -> call_right right_statement re s (function re -> Ast0.UniqueStm(re)) and right_statement_dots sd = match Ast0.unwrap sd with Ast0.DOTS([]) -> failwith "empty statement dots" | Ast0.DOTS(s::r) -> call_right right_statement s sd (function s -> Ast0.DOTS(List.rev(s::r))) | _ -> failwith "circles and stars not supported" let rec left_ty t = match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> call_right left_mcode cv t (function cv -> Ast0.ConstVol(cv,ty)) | Ast0.BaseType(ty,strings) -> (match strings with [] -> failwith "empty strings in type" | s::r -> call_right left_mcode s t (function s -> Ast0.BaseType(ty,s::r))) | Ast0.Signed(sign,ty) -> call_right left_mcode sign t (function sign -> Ast0.Signed(sign,ty)) | Ast0.Pointer(ty,star) -> call_right left_ty ty t (function ty -> Ast0.Pointer(ty,star)) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> call_right left_ty ty t (function ty -> Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)) | Ast0.FunctionType(Some ty,lp1,params,rp1) -> call_right left_ty ty t (function ty -> Ast0.FunctionType(Some ty,lp1,params,rp1)) | Ast0.FunctionType(None,lp1,params,rp1) -> call_right left_mcode lp1 t (function lp1 -> Ast0.FunctionType(None,lp1,params,rp1)) | Ast0.Array(ty,lb,size,rb) -> call_right left_ty ty t (function ty -> Ast0.Array(ty,lb,size,rb)) | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> call_right left_mcode dec t (function dec -> Ast0.Decimal(dec,lp,length,comma,precision_opt,rp)) | Ast0.EnumName(kind,name) -> call_right left_mcode kind t (function kind -> Ast0.EnumName(kind,name)) | Ast0.EnumDef(ty,lb,ids,rb) -> call_right left_ty ty t (function ty -> Ast0.EnumDef(ty,lb,ids,rb)) | Ast0.StructUnionName(kind,name) -> call_right left_mcode kind t (function kind -> Ast0.StructUnionName(kind,name)) | Ast0.StructUnionDef(ty,lb,decls,rb) -> call_right left_ty ty t (function ty -> Ast0.StructUnionDef(ty,lb,decls,rb)) | Ast0.TypeName(name) -> call_right left_mcode name t (function name -> Ast0.TypeName(name)) | Ast0.MetaType(name,x) -> call_right left_mcode name t (function name -> Ast0.MetaType(name,x)) | Ast0.AsType(ty,asty) -> failwith "not possible" | Ast0.DisjType(starter,types,mids,ender) -> None | Ast0.OptType(ty) -> call_right left_ty ty t (function ty -> Ast0.OptType(ty)) | Ast0.UniqueType(ty) -> call_right left_ty ty t (function ty -> Ast0.UniqueType(ty)) let rec left_ident i = match Ast0.unwrap i with Ast0.Id(name) -> call_right left_mcode name i (function name -> Ast0.Id(name)) | Ast0.MetaId(name,a,b,c) -> call_right left_mcode name i (function name -> Ast0.MetaId(name,a,b,c)) | Ast0.MetaFunc(name,a,b) -> call_right left_mcode name i (function name -> Ast0.MetaFunc(name,a,b)) | Ast0.MetaLocalFunc(name,a,b) -> call_right left_mcode name i (function name -> Ast0.MetaLocalFunc(name,a,b)) | Ast0.DisjId(starter,ids,mids,ender) -> None | Ast0.OptIdent(id) -> call_right left_ident id i (function id -> Ast0.OptIdent(id)) | Ast0.UniqueIdent(id) -> call_right left_ident id i (function id -> Ast0.UniqueIdent(id)) | Ast0.AsIdent(id,asid) -> failwith "not possible" let left_fundecl name fninfo = let fncall_right processor data cont = match processor data with None -> None | Some(pragmas,data) -> Some (pragmas,cont data,name) in match fninfo with [] -> (match left_ident name with None -> None | Some(pragmas,name) -> Some(pragmas,fninfo,name)) | (Ast0.FStorage sto)::x -> fncall_right left_mcode sto (function sto -> (Ast0.FStorage sto)::x) | (Ast0.FType ty)::x -> fncall_right left_ty ty (function ty -> (Ast0.FType ty)::x) | (Ast0.FInline inl)::x -> fncall_right left_mcode inl (function inl -> (Ast0.FInline inl)::x) | (Ast0.FAttr atr)::x -> fncall_right left_mcode atr (function atr -> (Ast0.FAttr atr)::x) let rec left_decl decl = match Ast0.unwrap decl with Ast0.MetaDecl(name,pure) -> call_right right_mcode name decl (function name -> Ast0.MetaDecl(name,pure)) | Ast0.MetaField(name,pure) -> call_right right_mcode name decl (function name -> Ast0.MetaField(name,pure)) | Ast0.MetaFieldList(name,lenname,pure) -> call_right right_mcode name decl (function name -> Ast0.MetaFieldList(name,lenname,pure)) | Ast0.AsDecl(decl,asdecl) -> failwith "not possible" | Ast0.Init(Some stg,ty,id,eq,ini,sem) -> call_right left_mcode stg decl (function stg -> Ast0.Init(Some stg,ty,id,eq,ini,sem)) | Ast0.Init(None,ty,id,eq,ini,sem) -> call_right left_ty ty decl (function ty -> Ast0.Init(None,ty,id,eq,ini,sem)) | Ast0.UnInit(Some stg,ty,id,sem) -> call_right left_mcode stg decl (function stg -> Ast0.UnInit(Some stg,ty,id,sem)) | Ast0.UnInit(None,ty,id,sem) -> call_right left_ty ty decl (function ty -> Ast0.UnInit(None,ty,id,sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> call_right left_ident name decl (function name -> Ast0.MacroDecl(name,lp,args,rp,sem)) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> call_right left_ident name decl (function name -> Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem)) | Ast0.TyDecl(ty,sem) -> call_right left_ty ty decl (function ty -> Ast0.TyDecl(ty,sem)) | Ast0.Typedef(stg,ty,id,sem) -> call_right left_mcode stg decl (function stg -> Ast0.Typedef(stg,ty,id,sem)) | Ast0.DisjDecl(starter,decls,mids,ender) -> None | Ast0.Ddots(dots,whencode) -> None | Ast0.OptDecl(d) -> call_right left_decl d decl (function decl -> Ast0.OptDecl(decl)) | Ast0.UniqueDecl(d) -> call_right left_decl d decl (function decl -> Ast0.UniqueDecl(decl)) let process = let statement r k s = let s = k s in Ast0.rewrap s (match Ast0.unwrap s with Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> (match left_fundecl name fi with None -> Ast0.unwrap s | Some (pragmas,fi,name) -> Ast0.FunDecl (update_after pragmas bef, fi,name,lp,params,rp,lbrace,body,rbrace)) | Ast0.Decl(bef,decl) -> (match left_decl decl with None -> Ast0.unwrap s | Some (pragmas,decl) -> Ast0.Decl(update_after pragmas bef,decl)) | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> (match right_statement branch1 with None -> Ast0.unwrap s | Some (pragmas,branch1) -> Ast0.IfThen (iff,lp,exp,rp,branch1,update_before pragmas aft)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> (match right_statement branch2 with None -> Ast0.unwrap s | Some (pragmas,branch2) -> Ast0.IfThenElse (iff,lp,exp,rp,branch1,els,branch2, update_before pragmas aft)) | Ast0.While(whl,lp,exp,rp,body,aft) -> (match right_statement body with None -> Ast0.unwrap s | Some (pragmas,body) -> Ast0.While(whl,lp,exp,rp,body,update_before pragmas aft)) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> (match right_statement body with None -> Ast0.unwrap s | Some (pragmas,body) -> Ast0.For (fr,lp,first,e2,sem2,e3,rp,body, update_before pragmas aft)) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> (match right_statement body with None -> Ast0.unwrap s | Some (pragmas,body) -> Ast0.Iterator(nm,lp,args,rp,body,update_before pragmas aft)) | _ -> Ast0.unwrap s) in let res = V0.rebuilder {V0.rebuilder_functions with VT0.rebuilder_stmtfn = statement} in List.map res.VT0.rebuilder_rec_top_level coccinelle-1.0.0-rc19/parsing_cocci/main.ml0000644000175000017500000000334712247442615017453 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./main.ml" (* ----------------------------------------------------------------------- *) (* Entry point *) let file = ref "" let isofile = ref None let verbose = ref true let anonymous s = if !file = "" then file := s else isofile := Some s let speclist = [("-v", Arg.Set verbose, "print parse result")] let usage = Printf.sprintf "Usage: %s [options] \nOptions are:" (Filename.basename Sys.argv.(0)) let main _ = begin Arg.parse speclist anonymous usage; (* Parse_cocci.parse_and_merge !file; *) if !file = "" then failwith "filename required"; Parse_cocci.process !file !isofile !verbose end let _ = main () coccinelle-1.0.0-rc19/parsing_cocci/visitor_ast.ml0000644000175000017500000014272512247442616021102 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./visitor_ast.ml" module Ast0 = Ast0_cocci module Ast = Ast_cocci (* --------------------------------------------------------------------- *) (* Generic traversal: combiner *) (* parameters: combining function treatment of: mcode, identifiers, expressions, fullTypes, types, declarations, statements, toplevels default value for options *) type 'a combiner = {combiner_ident : Ast.ident -> 'a; combiner_expression : Ast.expression -> 'a; combiner_fragment : Ast.string_fragment -> 'a; combiner_format : Ast.string_format -> 'a; combiner_fullType : Ast.fullType -> 'a; combiner_typeC : Ast.typeC -> 'a; combiner_declaration : Ast.declaration -> 'a; combiner_initialiser : Ast.initialiser -> 'a; combiner_parameter : Ast.parameterTypeDef -> 'a; combiner_parameter_list : Ast.parameter_list -> 'a; combiner_rule_elem : Ast.rule_elem -> 'a; combiner_statement : Ast.statement -> 'a; combiner_case_line : Ast.case_line -> 'a; combiner_top_level : Ast.top_level -> 'a; combiner_anything : Ast.anything -> 'a; combiner_expression_dots : Ast.expression Ast.dots -> 'a; combiner_statement_dots : Ast.statement Ast.dots -> 'a; combiner_declaration_dots : Ast.declaration Ast.dots -> 'a; combiner_initialiser_dots : Ast.initialiser Ast.dots -> 'a} type ('mc,'a) cmcode = 'a combiner -> 'mc Ast_cocci.mcode -> 'a type ('cd,'a) ccode = 'a combiner -> ('cd -> 'a) -> 'cd -> 'a let combiner bind option_default meta_mcodefn string_mcodefn const_mcodefn assign_mcodefn fix_mcodefn unary_mcodefn binary_mcodefn cv_mcodefn sign_mcodefn struct_mcodefn storage_mcodefn inc_file_mcodefn expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn identfn exprfn fragfn fmtfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn topfn anyfn = let multibind l = let rec loop = function [] -> option_default | [x] -> x | x::xs -> bind x (loop xs) in loop l in let get_option f = function Some x -> f x | None -> option_default in let dotsfn param default all_functions arg = let k d = match Ast.unwrap d with Ast.DOTS(l) | Ast.CIRCLES(l) | Ast.STARS(l) -> multibind (List.map default l) in param all_functions k arg in let rec meta_mcode x = meta_mcodefn all_functions x and string_mcode x = string_mcodefn all_functions x and const_mcode x = const_mcodefn all_functions x and assign_mcode x = assign_mcodefn all_functions x and fix_mcode x = fix_mcodefn all_functions x and unary_mcode x = unary_mcodefn all_functions x and binary_mcode x = binary_mcodefn all_functions x and cv_mcode x = cv_mcodefn all_functions x and sign_mcode x = sign_mcodefn all_functions x and struct_mcode x = struct_mcodefn all_functions x and storage_mcode x = storage_mcodefn all_functions x and inc_file_mcode x = inc_file_mcodefn all_functions x and iddotsfn all_functions k arg = k arg and strdotsfn all_functions k arg = k arg and expression_dots d = dotsfn expdotsfn expression all_functions d and identifier_dots d = dotsfn iddotsfn ident all_functions d and parameter_dots d = dotsfn paramdotsfn parameterTypeDef all_functions d and statement_dots d = dotsfn stmtdotsfn statement all_functions d and declaration_dots d = dotsfn decldotsfn declaration all_functions d and initialiser_dots d = dotsfn initdotsfn initialiser all_functions d and string_fragment_dots d = dotsfn strdotsfn string_fragment all_functions d and ident i = let k i = match Ast.unwrap i with Ast.Id(name) -> string_mcode name | Ast.MetaId(name,_,_,_) -> meta_mcode name | Ast.MetaFunc(name,_,_,_) -> meta_mcode name | Ast.MetaLocalFunc(name,_,_,_) -> meta_mcode name | Ast.AsIdent(id,asid) -> bind (ident id) (ident asid) | Ast.DisjId(id_list) -> multibind (List.map ident id_list) | Ast.OptIdent(id) -> ident id | Ast.UniqueIdent(id) -> ident id in identfn all_functions k i and expression e = let k e = match Ast.unwrap e with Ast.Ident(id) -> ident id | Ast.Constant(const) -> const_mcode const | Ast.StringConstant(lq,str,rq) -> multibind [string_mcode lq; string_fragment_dots str; string_mcode rq] | Ast.FunCall(fn,lp,args,rp) -> multibind [expression fn; string_mcode lp; expression_dots args; string_mcode rp] | Ast.Assignment(left,op,right,simple) -> multibind [expression left; assign_mcode op; expression right] | Ast.Sequence(left,op,right) -> multibind [expression left; string_mcode op; expression right] | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> multibind [expression exp1; string_mcode why; get_option expression exp2; string_mcode colon; expression exp3] | Ast.Postfix(exp,op) -> bind (expression exp) (fix_mcode op) | Ast.Infix(exp,op) -> bind (fix_mcode op) (expression exp) | Ast.Unary(exp,op) -> bind (unary_mcode op) (expression exp) | Ast.Binary(left,op,right) -> multibind [expression left; binary_mcode op; expression right] | Ast.Nested(left,op,right) -> multibind [expression left; binary_mcode op; expression right] | Ast.Paren(lp,exp,rp) -> multibind [string_mcode lp; expression exp; string_mcode rp] | Ast.ArrayAccess(exp1,lb,exp2,rb) -> multibind [expression exp1; string_mcode lb; expression exp2; string_mcode rb] | Ast.RecordAccess(exp,pt,field) -> multibind [expression exp; string_mcode pt; ident field] | Ast.RecordPtAccess(exp,ar,field) -> multibind [expression exp; string_mcode ar; ident field] | Ast.Cast(lp,ty,rp,exp) -> multibind [string_mcode lp; fullType ty; string_mcode rp; expression exp] | Ast.SizeOfExpr(szf,exp) -> multibind [string_mcode szf; expression exp] | Ast.SizeOfType(szf,lp,ty,rp) -> multibind [string_mcode szf; string_mcode lp; fullType ty; string_mcode rp] | Ast.TypeExp(ty) -> fullType ty | Ast.Constructor(lp,ty,rp,init) -> multibind [string_mcode lp; fullType ty; string_mcode rp; initialiser init] | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) | Ast.MetaExprList(name,_,_,_) -> meta_mcode name | Ast.AsExpr(exp,asexp) -> bind (expression exp) (expression asexp) | Ast.EComma(cm) -> string_mcode cm | Ast.DisjExpr(exp_list) -> multibind (List.map expression exp_list) | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) -> bind (string_mcode starter) (bind (expression_dots expr_dots) (bind (string_mcode ender) (get_option expression whencode))) | Ast.Edots(dots,whencode) | Ast.Ecircles(dots,whencode) | Ast.Estars(dots,whencode) -> bind (string_mcode dots) (get_option expression whencode) | Ast.OptExp(exp) | Ast.UniqueExp(exp) -> expression exp in exprfn all_functions k e and string_fragment e = let k e = match Ast.unwrap e with Ast.ConstantFragment(str) -> string_mcode str | Ast.FormatFragment(pct,fmt) -> let pct = string_mcode pct in let fmt = string_format fmt in bind pct fmt | Ast.Strdots dots -> string_mcode dots | Ast.MetaFormatList(pct,name,lenname,_,_) -> let pct = string_mcode pct in let name = meta_mcode name in multibind [pct;name] in fragfn all_functions k e and string_format e = let k e = match Ast.unwrap e with Ast.ConstantFormat(str) -> string_mcode str | Ast.MetaFormat(name,_,_,_) -> meta_mcode name in fmtfn all_functions k e and fullType ft = let k ft = match Ast.unwrap ft with Ast.Type(_,cv,ty) -> bind (get_option cv_mcode cv) (typeC ty) | Ast.AsType(ty,asty) -> bind (fullType ty) (fullType asty) | Ast.DisjType(types) -> multibind (List.map fullType types) | Ast.OptType(ty) -> fullType ty | Ast.UniqueType(ty) -> fullType ty in ftfn all_functions k ft and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra = (* have to put the treatment of the identifier into the right position *) multibind ([fullType ty; string_mcode lp1; string_mcode star] @ extra @ [string_mcode rp1; string_mcode lp2; parameter_dots params; string_mcode rp2]) and function_type (ty,lp1,params,rp1) extra = (* have to put the treatment of the identifier into the right position *) multibind ([get_option fullType ty] @ extra @ [string_mcode lp1; parameter_dots params; string_mcode rp1]) and array_type (ty,lb,size,rb) extra = multibind ([fullType ty] @ extra @ [string_mcode lb; get_option expression size; string_mcode rb]) and typeC ty = let k ty = match Ast.unwrap ty with Ast.BaseType(ty,strings) -> multibind (List.map string_mcode strings) | Ast.SignedT(sgn,ty) -> bind (sign_mcode sgn) (get_option typeC ty) | Ast.Pointer(ty,star) -> bind (fullType ty) (string_mcode star) | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [] | Ast.FunctionType (_,ty,lp1,params,rp1) -> function_type (ty,lp1,params,rp1) [] | Ast.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [] | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> multibind [string_mcode dec; string_mcode lp; expression length; get_option string_mcode comma; get_option expression precision_opt; string_mcode rp] | Ast.EnumName(kind,name) -> bind (string_mcode kind) (get_option ident name) | Ast.EnumDef(ty,lb,ids,rb) -> multibind [fullType ty; string_mcode lb; expression_dots ids; string_mcode rb] | Ast.StructUnionName(kind,name) -> bind (struct_mcode kind) (get_option ident name) | Ast.StructUnionDef(ty,lb,decls,rb) -> multibind [fullType ty; string_mcode lb; declaration_dots decls; string_mcode rb] | Ast.TypeName(name) -> string_mcode name | Ast.MetaType(name,_,_) -> meta_mcode name in tyfn all_functions k ty and named_type ty id = match Ast.unwrap ty with Ast.Type(_,None,ty1) -> (match Ast.unwrap ty1 with Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [ident id] | Ast.FunctionType(_,ty,lp1,params,rp1) -> function_type (ty,lp1,params,rp1) [ident id] | Ast.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [ident id] | _ -> bind (fullType ty) (ident id)) | _ -> bind (fullType ty) (ident id) and declaration d = let k d = match Ast.unwrap d with Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) | Ast.MetaFieldList(name,_,_,_) -> meta_mcode name | Ast.AsDecl(decl,asdecl) -> bind (declaration decl) (declaration asdecl) | Ast.Init(stg,ty,id,eq,ini,sem) -> bind (get_option storage_mcode stg) (bind (named_type ty id) (multibind [string_mcode eq; initialiser ini; string_mcode sem])) | Ast.UnInit(stg,ty,id,sem) -> bind (get_option storage_mcode stg) (bind (named_type ty id) (string_mcode sem)) | Ast.MacroDecl(name,lp,args,rp,sem) -> multibind [ident name; string_mcode lp; expression_dots args; string_mcode rp; string_mcode sem] | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> multibind [ident name; string_mcode lp; expression_dots args; string_mcode rp; string_mcode eq; initialiser ini; string_mcode sem] | Ast.TyDecl(ty,sem) -> bind (fullType ty) (string_mcode sem) | Ast.Typedef(stg,ty,id,sem) -> bind (string_mcode stg) (bind (fullType ty) (bind (typeC id) (string_mcode sem))) | Ast.DisjDecl(decls) -> multibind (List.map declaration decls) | Ast.Ddots(dots,whencode) -> bind (string_mcode dots) (get_option declaration whencode) | Ast.OptDecl(decl) -> declaration decl | Ast.UniqueDecl(decl) -> declaration decl in declfn all_functions k d and initialiser i = let k i = match Ast.unwrap i with Ast.MetaInit(name,_,_) -> meta_mcode name | Ast.MetaInitList(name,_,_,_) -> meta_mcode name | Ast.AsInit(init,asinit) -> bind (initialiser init) (initialiser asinit) | Ast.InitExpr(exp) -> expression exp | Ast.ArInitList(lb,initlist,rb) -> multibind [string_mcode lb; initialiser_dots initlist; string_mcode rb] | Ast.StrInitList(allminus,lb,initlist,rb,whencode) -> multibind [string_mcode lb; multibind (List.map initialiser initlist); string_mcode rb; multibind (List.map initialiser whencode)] | Ast.InitGccName(name,eq,ini) -> multibind [ident name; string_mcode eq; initialiser ini] | Ast.InitGccExt(designators,eq,ini) -> multibind ((List.map designator designators) @ [string_mcode eq; initialiser ini]) | Ast.IComma(cm) -> string_mcode cm | Ast.Idots(dots,whencode) -> bind (string_mcode dots) (get_option initialiser whencode) | Ast.OptIni(i) -> initialiser i | Ast.UniqueIni(i) -> initialiser i in initfn all_functions k i and designator = function Ast.DesignatorField(dot,id) -> bind (string_mcode dot) (ident id) | Ast.DesignatorIndex(lb,exp,rb) -> bind (string_mcode lb) (bind (expression exp) (string_mcode rb)) | Ast.DesignatorRange(lb,min,dots,max,rb) -> multibind [string_mcode lb; expression min; string_mcode dots; expression max; string_mcode rb] and parameterTypeDef p = let k p = match Ast.unwrap p with Ast.VoidParam(ty) -> fullType ty | Ast.Param(ty,Some id) -> named_type ty id | Ast.Param(ty,None) -> fullType ty | Ast.MetaParam(name,_,_) -> meta_mcode name | Ast.MetaParamList(name,_,_,_) -> meta_mcode name | Ast.AsParam(p,asexp) -> bind (parameterTypeDef p) (expression asexp) | Ast.PComma(cm) -> string_mcode cm | Ast.Pdots(dots) -> string_mcode dots | Ast.Pcircles(dots) -> string_mcode dots | Ast.OptParam(param) -> parameterTypeDef param | Ast.UniqueParam(param) -> parameterTypeDef param in paramfn all_functions k p and rule_elem re = let k re = match Ast.unwrap re with Ast.FunHeader(_,_,fi,name,lp,params,rp) -> multibind ((List.map fninfo fi) @ [ident name;string_mcode lp;parameter_dots params; string_mcode rp]) | Ast.Decl(_,_,decl) -> declaration decl | Ast.SeqStart(brace) -> string_mcode brace | Ast.SeqEnd(brace) -> string_mcode brace | Ast.ExprStatement(exp,sem) -> bind (get_option expression exp) (string_mcode sem) | Ast.IfHeader(iff,lp,exp,rp) -> multibind [string_mcode iff; string_mcode lp; expression exp; string_mcode rp] | Ast.Else(els) -> string_mcode els | Ast.WhileHeader(whl,lp,exp,rp) -> multibind [string_mcode whl; string_mcode lp; expression exp; string_mcode rp] | Ast.DoHeader(d) -> string_mcode d | Ast.WhileTail(whl,lp,exp,rp,sem) -> multibind [string_mcode whl; string_mcode lp; expression exp; string_mcode rp; string_mcode sem] | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> let first = forinfo first in multibind [string_mcode fr; string_mcode lp; first; get_option expression e2; string_mcode sem2; get_option expression e3; string_mcode rp] | Ast.IteratorHeader(nm,lp,args,rp) -> multibind [ident nm; string_mcode lp; expression_dots args; string_mcode rp] | Ast.SwitchHeader(switch,lp,exp,rp) -> multibind [string_mcode switch; string_mcode lp; expression exp; string_mcode rp] | Ast.Break(br,sem) -> bind (string_mcode br) (string_mcode sem) | Ast.Continue(cont,sem) -> bind (string_mcode cont) (string_mcode sem) | Ast.Label(l,dd) -> bind (ident l) (string_mcode dd) | Ast.Goto(goto,l,sem) -> bind (string_mcode goto) (bind (ident l) (string_mcode sem)) | Ast.Return(ret,sem) -> bind (string_mcode ret) (string_mcode sem) | Ast.ReturnExpr(ret,exp,sem) -> multibind [string_mcode ret; expression exp; string_mcode sem] | Ast.MetaStmt(name,_,_,_) -> meta_mcode name | Ast.MetaStmtList(name,_,_) -> meta_mcode name | Ast.MetaRuleElem(name,_,_) -> meta_mcode name | Ast.Exp(exp) -> expression exp | Ast.TopExp(exp) -> expression exp | Ast.Ty(ty) -> fullType ty | Ast.TopInit(init) -> initialiser init | Ast.Include(inc,name) -> bind (string_mcode inc) (inc_file_mcode name) | Ast.Undef(def,id) -> multibind [string_mcode def; ident id] | Ast.DefineHeader(def,id,params) -> multibind [string_mcode def; ident id; define_parameters params] | Ast.Pragma(prg,id,body) -> multibind [string_mcode prg; ident id; pragmainfo body] | Ast.Default(def,colon) -> bind (string_mcode def) (string_mcode colon) | Ast.Case(case,exp,colon) -> multibind [string_mcode case; expression exp; string_mcode colon] | Ast.DisjRuleElem(res) -> multibind (List.map rule_elem res) in rulefn all_functions k re (* not parameterisable, for now *) and forinfo fi = let k = function Ast.ForExp(e1,sem1) -> bind (get_option expression e1) (string_mcode sem1) | Ast.ForDecl (_,_,decl) -> declaration decl in k fi (* not parameterisable, for now *) and pragmainfo pi = let k pi = match Ast.unwrap pi with Ast.PragmaTuple(lp,args,rp) -> multibind [string_mcode lp;expression_dots args;string_mcode rp] | Ast.PragmaIdList(ids) -> identifier_dots ids | Ast.PragmaDots (dots) -> string_mcode dots in k pi (* not parameterizable for now... *) and define_parameters p = let k p = match Ast.unwrap p with Ast.NoParams -> option_default | Ast.DParams(lp,params,rp) -> multibind [string_mcode lp; define_param_dots params; string_mcode rp] in k p and define_param_dots d = let k d = match Ast.unwrap d with Ast.DOTS(l) | Ast.CIRCLES(l) | Ast.STARS(l) -> multibind (List.map define_param l) in k d and define_param p = let k p = match Ast.unwrap p with Ast.DParam(id) -> ident id | Ast.DPComma(comma) -> string_mcode comma | Ast.DPdots(d) -> string_mcode d | Ast.DPcircles(c) -> string_mcode c | Ast.OptDParam(dp) -> define_param dp | Ast.UniqueDParam(dp) -> define_param dp in k p (* discard the result, because the statement is assumed to be already represented elsewhere in the code *) and process_bef_aft s = match Ast.get_dots_bef_aft s with Ast.NoDots -> () | Ast.DroppingBetweenDots(stm,ind) -> let _ = statement stm in () | Ast.AddingBetweenDots(stm,ind) -> let _ = statement stm in () and statement s = process_bef_aft s; let k s = match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> multibind [rule_elem lbrace; statement_dots body; rule_elem rbrace] | Ast.IfThen(header,branch,_) -> multibind [rule_elem header; statement branch] | Ast.IfThenElse(header,branch1,els,branch2,_) -> multibind [rule_elem header; statement branch1; rule_elem els; statement branch2] | Ast.While(header,body,_) -> multibind [rule_elem header; statement body] | Ast.Do(header,body,tail) -> multibind [rule_elem header; statement body; rule_elem tail] | Ast.For(header,body,_) -> multibind [rule_elem header; statement body] | Ast.Iterator(header,body,_) -> multibind [rule_elem header; statement body] | Ast.Switch(header,lb,decls,cases,rb) -> multibind [rule_elem header;rule_elem lb; statement_dots decls; multibind (List.map case_line cases); rule_elem rb] | Ast.Atomic(re) -> rule_elem re | Ast.Disj(stmt_dots_list) -> multibind (List.map statement_dots stmt_dots_list) | Ast.Nest(starter,stmt_dots,ender,whn,_,_,_) -> bind (string_mcode starter) (bind (statement_dots stmt_dots) (bind (string_mcode ender) (multibind (List.map (whencode statement_dots statement) whn)))) | Ast.FunDecl(header,lbrace,body,rbrace) -> multibind [rule_elem header; rule_elem lbrace; statement_dots body; rule_elem rbrace] | Ast.Define(header,body) -> bind (rule_elem header) (statement_dots body) | Ast.AsStmt(stm,asstm) -> bind (statement stm) (statement asstm) | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> bind (string_mcode d) (multibind (List.map (whencode statement_dots statement) whn)) | Ast.OptStm(stmt) | Ast.UniqueStm(stmt) -> statement stmt in stmtfn all_functions k s and fninfo = function Ast.FStorage(stg) -> storage_mcode stg | Ast.FType(ty) -> fullType ty | Ast.FInline(inline) -> string_mcode inline | Ast.FAttr(attr) -> string_mcode attr and whencode notfn alwaysfn = function Ast.WhenNot a -> notfn a | Ast.WhenAlways a -> alwaysfn a | Ast.WhenModifier(_) -> option_default | Ast.WhenNotTrue(e) -> rule_elem e | Ast.WhenNotFalse(e) -> rule_elem e and case_line c = let k c = match Ast.unwrap c with Ast.CaseLine(header,code) -> bind (rule_elem header) (statement_dots code) | Ast.OptCase(case) -> case_line case in casefn all_functions k c and top_level t = let k t = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> bind (string_mcode old_file) (string_mcode new_file) | Ast.NONDECL(stmt) -> statement stmt | Ast.CODE(stmt_dots) -> statement_dots stmt_dots | Ast.ERRORWORDS(exps) -> multibind (List.map expression exps) in topfn all_functions k t and anything a = let k = function (*in many cases below, the thing is not even mcode, so we do nothing*) Ast.FullTypeTag(ft) -> fullType ft | Ast.BaseTypeTag(bt) -> option_default | Ast.StructUnionTag(su) -> option_default | Ast.SignTag(sgn) -> option_default | Ast.IdentTag(id) -> ident id | Ast.ExpressionTag(exp) -> expression exp | Ast.ConstantTag(cst) -> option_default | Ast.UnaryOpTag(unop) -> option_default | Ast.AssignOpTag(asgnop) -> option_default | Ast.FixOpTag(fixop) -> option_default | Ast.BinaryOpTag(binop) -> option_default | Ast.ArithOpTag(arithop) -> option_default | Ast.LogicalOpTag(logop) -> option_default | Ast.DeclarationTag(decl) -> declaration decl | Ast.InitTag(ini) -> initialiser ini | Ast.StorageTag(stg) -> option_default | Ast.IncFileTag(stg) -> option_default | Ast.Rule_elemTag(rule) -> rule_elem rule | Ast.StatementTag(rule) -> statement rule | Ast.ForInfoTag(rule) -> forinfo rule | Ast.CaseLineTag(case) -> case_line case | Ast.ConstVolTag(cv) -> option_default | Ast.Token(tok,info) -> option_default | Ast.Directive(str) -> option_default | Ast.Code(cd) -> top_level cd | Ast.ExprDotsTag(ed) -> expression_dots ed | Ast.ParamDotsTag(pd) -> parameter_dots pd | Ast.StmtDotsTag(sd) -> statement_dots sd | Ast.DeclDotsTag(sd) -> declaration_dots sd | Ast.TypeCTag(ty) -> typeC ty | Ast.ParamTag(param) -> parameterTypeDef param | Ast.SgrepStartTag(tok) -> option_default | Ast.SgrepEndTag(tok) -> option_default in anyfn all_functions k a and all_functions = {combiner_ident = ident; combiner_expression = expression; combiner_fragment = string_fragment; combiner_format = string_format; combiner_fullType = fullType; combiner_typeC = typeC; combiner_declaration = declaration; combiner_initialiser = initialiser; combiner_parameter = parameterTypeDef; combiner_parameter_list = parameter_dots; combiner_rule_elem = rule_elem; combiner_statement = statement; combiner_case_line = case_line; combiner_top_level = top_level; combiner_anything = anything; combiner_expression_dots = expression_dots; combiner_statement_dots = statement_dots; combiner_declaration_dots = declaration_dots; combiner_initialiser_dots = initialiser_dots} in all_functions (* ---------------------------------------------------------------------- *) type 'a inout = 'a -> 'a (* for specifying the type of rebuilder *) type rebuilder = {rebuilder_ident : Ast.ident inout; rebuilder_expression : Ast.expression inout; rebuilder_fragment : Ast.string_fragment inout; rebuilder_format : Ast.string_format inout; rebuilder_fullType : Ast.fullType inout; rebuilder_typeC : Ast.typeC inout; rebuilder_declaration : Ast.declaration inout; rebuilder_initialiser : Ast.initialiser inout; rebuilder_parameter : Ast.parameterTypeDef inout; rebuilder_parameter_list : Ast.parameter_list inout; rebuilder_statement : Ast.statement inout; rebuilder_case_line : Ast.case_line inout; rebuilder_rule_elem : Ast.rule_elem inout; rebuilder_top_level : Ast.top_level inout; rebuilder_expression_dots : Ast.expression Ast.dots inout; rebuilder_statement_dots : Ast.statement Ast.dots inout; rebuilder_declaration_dots : Ast.declaration Ast.dots inout; rebuilder_initialiser_dots : Ast.initialiser Ast.dots inout; rebuilder_define_param_dots : Ast.define_param Ast.dots inout; rebuilder_define_param : Ast.define_param inout; rebuilder_define_parameters : Ast.define_parameters inout; rebuilder_anything : Ast.anything inout} type 'mc rmcode = 'mc Ast.mcode inout type 'cd rcode = rebuilder -> ('cd inout) -> 'cd inout let rebuilder meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_file_mcode expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn identfn exprfn fragfn fmtfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn topfn anyfn = let get_option f = function Some x -> Some (f x) | None -> None in let dotsfn param default all_functions arg = let k d = Ast.rewrap d (match Ast.unwrap d with Ast.DOTS(l) -> Ast.DOTS(List.map default l) | Ast.CIRCLES(l) -> Ast.CIRCLES(List.map default l) | Ast.STARS(l) -> Ast.STARS(List.map default l)) in param all_functions k arg in let iddotsfn all_functions k arg = k arg in let strdotsfn all_functions k arg = k arg in let rec expression_dots d = dotsfn expdotsfn expression all_functions d and identifier_dots d = dotsfn iddotsfn ident all_functions d and parameter_dots d = dotsfn paramdotsfn parameterTypeDef all_functions d and statement_dots d = dotsfn stmtdotsfn statement all_functions d and declaration_dots d = dotsfn decldotsfn declaration all_functions d and initialiser_dots d = dotsfn initdotsfn initialiser all_functions d and string_fragment_dots d = dotsfn strdotsfn string_fragment all_functions d and ident i = let k i = Ast.rewrap i (match Ast.unwrap i with Ast.Id(name) -> Ast.Id(string_mcode name) | Ast.MetaId(name,constraints,keep,inherited) -> Ast.MetaId(meta_mcode name,constraints,keep,inherited) | Ast.MetaFunc(name,constraints,keep,inherited) -> Ast.MetaFunc(meta_mcode name,constraints,keep,inherited) | Ast.MetaLocalFunc(name,constraints,keep,inherited) -> Ast.MetaLocalFunc(meta_mcode name,constraints,keep,inherited) | Ast.AsIdent(id,asid) -> Ast.AsIdent(ident id,ident asid) | Ast.DisjId(id_list) -> Ast.DisjId(List.map ident id_list) | Ast.OptIdent(id) -> Ast.OptIdent(ident id) | Ast.UniqueIdent(id) -> Ast.UniqueIdent(ident id)) in identfn all_functions k i and expression e = let k e = Ast.rewrap e (match Ast.unwrap e with Ast.Ident(id) -> Ast.Ident(ident id) | Ast.Constant(const) -> Ast.Constant(const_mcode const) | Ast.StringConstant(lq,str,rq) -> Ast.StringConstant(string_mcode lq, string_fragment_dots str, string_mcode rq) | Ast.FunCall(fn,lp,args,rp) -> Ast.FunCall(expression fn, string_mcode lp, expression_dots args, string_mcode rp) | Ast.Assignment(left,op,right,simple) -> Ast.Assignment(expression left, assign_mcode op, expression right, simple) | Ast.Sequence(left,op,right) -> Ast.Sequence(expression left, string_mcode op, expression right) | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> Ast.CondExpr(expression exp1, string_mcode why, get_option expression exp2, string_mcode colon, expression exp3) | Ast.Postfix(exp,op) -> Ast.Postfix(expression exp,fix_mcode op) | Ast.Infix(exp,op) -> Ast.Infix(expression exp,fix_mcode op) | Ast.Unary(exp,op) -> Ast.Unary(expression exp,unary_mcode op) | Ast.Binary(left,op,right) -> Ast.Binary(expression left, binary_mcode op, expression right) | Ast.Nested(left,op,right) -> Ast.Nested(expression left, binary_mcode op, expression right) | Ast.Paren(lp,exp,rp) -> Ast.Paren(string_mcode lp, expression exp, string_mcode rp) | Ast.ArrayAccess(exp1,lb,exp2,rb) -> Ast.ArrayAccess(expression exp1, string_mcode lb, expression exp2, string_mcode rb) | Ast.RecordAccess(exp,pt,field) -> Ast.RecordAccess(expression exp, string_mcode pt, ident field) | Ast.RecordPtAccess(exp,ar,field) -> Ast.RecordPtAccess(expression exp, string_mcode ar, ident field) | Ast.Cast(lp,ty,rp,exp) -> Ast.Cast(string_mcode lp, fullType ty, string_mcode rp, expression exp) | Ast.SizeOfExpr(szf,exp) -> Ast.SizeOfExpr(string_mcode szf, expression exp) | Ast.SizeOfType(szf,lp,ty,rp) -> Ast.SizeOfType(string_mcode szf,string_mcode lp, fullType ty, string_mcode rp) | Ast.TypeExp(ty) -> Ast.TypeExp(fullType ty) | Ast.Constructor(lp,ty,rp,init) -> Ast.Constructor(string_mcode lp, fullType ty, string_mcode rp, initialiser init) | Ast.MetaErr(name,constraints,keep,inherited) -> Ast.MetaErr(meta_mcode name,constraints,keep,inherited) | Ast.MetaExpr(name,constraints,keep,ty,form,inherited) -> Ast.MetaExpr(meta_mcode name,constraints,keep,ty,form,inherited) | Ast.MetaExprList(name,lenname_inh,keep,inherited) -> Ast.MetaExprList(meta_mcode name,lenname_inh,keep,inherited) | Ast.AsExpr(exp,asexp) -> Ast.AsExpr(expression exp,expression asexp) | Ast.EComma(cm) -> Ast.EComma(string_mcode cm) | Ast.DisjExpr(exp_list) -> Ast.DisjExpr(List.map expression exp_list) | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) -> Ast.NestExpr(string_mcode starter,expression_dots expr_dots, string_mcode ender, get_option expression whencode,multi) | Ast.Edots(dots,whencode) -> Ast.Edots(string_mcode dots,get_option expression whencode) | Ast.Ecircles(dots,whencode) -> Ast.Ecircles(string_mcode dots,get_option expression whencode) | Ast.Estars(dots,whencode) -> Ast.Estars(string_mcode dots,get_option expression whencode) | Ast.OptExp(exp) -> Ast.OptExp(expression exp) | Ast.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in exprfn all_functions k e and string_fragment e = let k e = Ast.rewrap e (match Ast.unwrap e with Ast.ConstantFragment(str) -> Ast.ConstantFragment(string_mcode str) | Ast.FormatFragment(pct,fmt) -> Ast.FormatFragment(string_mcode pct, string_format fmt) | Ast.Strdots dots -> Ast.Strdots (string_mcode dots) | Ast.MetaFormatList(pct,name,lenname,keep,inherited) -> Ast.MetaFormatList(string_mcode pct,meta_mcode name,lenname, keep,inherited)) in fragfn all_functions k e and string_format e = let k e = Ast.rewrap e (match Ast.unwrap e with Ast.ConstantFormat(str) -> Ast.ConstantFormat(string_mcode str) | Ast.MetaFormat(name,constraints,keep,inherited) -> Ast.MetaFormat(meta_mcode name,constraints,keep,inherited)) in fmtfn all_functions k e and fullType ft = let k ft = Ast.rewrap ft (match Ast.unwrap ft with Ast.Type(allminus,cv,ty) -> Ast.Type (allminus,get_option cv_mcode cv, typeC ty) | Ast.AsType(ty,asty) -> Ast.AsType(fullType ty,fullType asty) | Ast.DisjType(types) -> Ast.DisjType(List.map fullType types) | Ast.OptType(ty) -> Ast.OptType(fullType ty) | Ast.UniqueType(ty) -> Ast.UniqueType(fullType ty)) in ftfn all_functions k ft and typeC ty = let k ty = Ast.rewrap ty (match Ast.unwrap ty with Ast.BaseType(ty,strings) -> Ast.BaseType (ty, List.map string_mcode strings) | Ast.SignedT(sgn,ty) -> Ast.SignedT(sign_mcode sgn,get_option typeC ty) | Ast.Pointer(ty,star) -> Ast.Pointer (fullType ty, string_mcode star) | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> Ast.FunctionPointer(fullType ty,string_mcode lp1,string_mcode star, string_mcode rp1,string_mcode lp2, parameter_dots params, string_mcode rp2) | Ast.FunctionType(allminus,ty,lp,params,rp) -> Ast.FunctionType(allminus,get_option fullType ty,string_mcode lp, parameter_dots params,string_mcode rp) | Ast.Array(ty,lb,size,rb) -> Ast.Array(fullType ty, string_mcode lb, get_option expression size, string_mcode rb) | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> Ast.Decimal(string_mcode dec, string_mcode lp, expression length, get_option string_mcode comma, get_option expression precision_opt, string_mcode rp) | Ast.EnumName(kind,name) -> Ast.EnumName(string_mcode kind, get_option ident name) | Ast.EnumDef(ty,lb,ids,rb) -> Ast.EnumDef (fullType ty, string_mcode lb, expression_dots ids, string_mcode rb) | Ast.StructUnionName(kind,name) -> Ast.StructUnionName (struct_mcode kind, get_option ident name) | Ast.StructUnionDef(ty,lb,decls,rb) -> Ast.StructUnionDef (fullType ty, string_mcode lb, declaration_dots decls, string_mcode rb) | Ast.TypeName(name) -> Ast.TypeName(string_mcode name) | Ast.MetaType(name,keep,inherited) -> Ast.MetaType(meta_mcode name,keep,inherited)) in tyfn all_functions k ty and declaration d = let k d = Ast.rewrap d (match Ast.unwrap d with Ast.MetaDecl(name,keep,inherited) -> Ast.MetaDecl(meta_mcode name,keep,inherited) | Ast.MetaField(name,keep,inherited) -> Ast.MetaField(meta_mcode name,keep,inherited) | Ast.MetaFieldList(name,lenname_inh,keep,inherited) -> Ast.MetaFieldList(meta_mcode name,lenname_inh,keep,inherited) | Ast.AsDecl(decl,asdecl) -> Ast.AsDecl(declaration decl,declaration asdecl) | Ast.Init(stg,ty,id,eq,ini,sem) -> Ast.Init(get_option storage_mcode stg, fullType ty, ident id, string_mcode eq, initialiser ini, string_mcode sem) | Ast.UnInit(stg,ty,id,sem) -> Ast.UnInit(get_option storage_mcode stg, fullType ty, ident id, string_mcode sem) | Ast.MacroDecl(name,lp,args,rp,sem) -> Ast.MacroDecl(ident name, string_mcode lp, expression_dots args, string_mcode rp,string_mcode sem) | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> Ast.MacroDeclInit (ident name, string_mcode lp, expression_dots args, string_mcode rp,string_mcode eq,initialiser ini, string_mcode sem) | Ast.TyDecl(ty,sem) -> Ast.TyDecl(fullType ty, string_mcode sem) | Ast.Typedef(stg,ty,id,sem) -> Ast.Typedef(string_mcode stg, fullType ty, typeC id, string_mcode sem) | Ast.DisjDecl(decls) -> Ast.DisjDecl(List.map declaration decls) | Ast.Ddots(dots,whencode) -> Ast.Ddots(string_mcode dots, get_option declaration whencode) | Ast.OptDecl(decl) -> Ast.OptDecl(declaration decl) | Ast.UniqueDecl(decl) -> Ast.UniqueDecl(declaration decl)) in declfn all_functions k d and initialiser i = let k i = Ast.rewrap i (match Ast.unwrap i with Ast.MetaInit(name,keep,inherited) -> Ast.MetaInit(meta_mcode name,keep,inherited) | Ast.MetaInitList(name,lenname_inh,keep,inherited) -> Ast.MetaInitList(meta_mcode name,lenname_inh,keep,inherited) | Ast.AsInit(ini,asini) -> Ast.AsInit(initialiser ini,initialiser asini) | Ast.InitExpr(exp) -> Ast.InitExpr(expression exp) | Ast.ArInitList(lb,initlist,rb) -> Ast.ArInitList(string_mcode lb, initialiser_dots initlist, string_mcode rb) | Ast.StrInitList(allminus,lb,initlist,rb,whencode) -> Ast.StrInitList(allminus, string_mcode lb, List.map initialiser initlist, string_mcode rb, List.map initialiser whencode) | Ast.InitGccName(name,eq,ini) -> Ast.InitGccName(ident name, string_mcode eq, initialiser ini) | Ast.InitGccExt(designators,eq,ini) -> Ast.InitGccExt (List.map designator designators, string_mcode eq, initialiser ini) | Ast.IComma(cm) -> Ast.IComma(string_mcode cm) | Ast.Idots(dots,whencode) -> Ast.Idots(string_mcode dots,get_option initialiser whencode) | Ast.OptIni(i) -> Ast.OptIni(initialiser i) | Ast.UniqueIni(i) -> Ast.UniqueIni(initialiser i)) in initfn all_functions k i and designator = function Ast.DesignatorField(dot,id) -> Ast.DesignatorField(string_mcode dot,ident id) | Ast.DesignatorIndex(lb,exp,rb) -> Ast.DesignatorIndex(string_mcode lb,expression exp,string_mcode rb) | Ast.DesignatorRange(lb,min,dots,max,rb) -> Ast.DesignatorRange(string_mcode lb,expression min,string_mcode dots, expression max,string_mcode rb) and parameterTypeDef p = let k p = Ast.rewrap p (match Ast.unwrap p with Ast.VoidParam(ty) -> Ast.VoidParam(fullType ty) | Ast.Param(ty,id) -> Ast.Param(fullType ty, get_option ident id) | Ast.MetaParam(name,keep,inherited) -> Ast.MetaParam(meta_mcode name,keep,inherited) | Ast.MetaParamList(name,lenname_inh,keep,inherited) -> Ast.MetaParamList(meta_mcode name,lenname_inh,keep,inherited) | Ast.AsParam(p,asexp) -> Ast.AsParam(parameterTypeDef p, expression asexp) | Ast.PComma(cm) -> Ast.PComma(string_mcode cm) | Ast.Pdots(dots) -> Ast.Pdots(string_mcode dots) | Ast.Pcircles(dots) -> Ast.Pcircles(string_mcode dots) | Ast.OptParam(param) -> Ast.OptParam(parameterTypeDef param) | Ast.UniqueParam(param) -> Ast.UniqueParam(parameterTypeDef param)) in paramfn all_functions k p and rule_elem re = let k re = Ast.rewrap re (match Ast.unwrap re with Ast.FunHeader(bef,allminus,fi,name,lp,params,rp) -> Ast.FunHeader(bef,allminus,List.map fninfo fi,ident name, string_mcode lp, parameter_dots params, string_mcode rp) | Ast.Decl(bef,allminus,decl) -> Ast.Decl(bef,allminus,declaration decl) | Ast.SeqStart(brace) -> Ast.SeqStart(string_mcode brace) | Ast.SeqEnd(brace) -> Ast.SeqEnd(string_mcode brace) | Ast.ExprStatement(exp,sem) -> Ast.ExprStatement (get_option expression exp, string_mcode sem) | Ast.IfHeader(iff,lp,exp,rp) -> Ast.IfHeader(string_mcode iff, string_mcode lp, expression exp, string_mcode rp) | Ast.Else(els) -> Ast.Else(string_mcode els) | Ast.WhileHeader(whl,lp,exp,rp) -> Ast.WhileHeader(string_mcode whl, string_mcode lp, expression exp, string_mcode rp) | Ast.DoHeader(d) -> Ast.DoHeader(string_mcode d) | Ast.WhileTail(whl,lp,exp,rp,sem) -> Ast.WhileTail(string_mcode whl, string_mcode lp, expression exp, string_mcode rp, string_mcode sem) | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> let first = forinfo first in Ast.ForHeader(string_mcode fr, string_mcode lp, first, get_option expression e2, string_mcode sem2, get_option expression e3, string_mcode rp) | Ast.IteratorHeader(whl,lp,args,rp) -> Ast.IteratorHeader(ident whl, string_mcode lp, expression_dots args, string_mcode rp) | Ast.SwitchHeader(switch,lp,exp,rp) -> Ast.SwitchHeader(string_mcode switch, string_mcode lp, expression exp, string_mcode rp) | Ast.Break(br,sem) -> Ast.Break(string_mcode br, string_mcode sem) | Ast.Continue(cont,sem) -> Ast.Continue(string_mcode cont, string_mcode sem) | Ast.Label(l,dd) -> Ast.Label(ident l, string_mcode dd) | Ast.Goto(goto,l,sem) -> Ast.Goto(string_mcode goto,ident l,string_mcode sem) | Ast.Return(ret,sem) -> Ast.Return(string_mcode ret, string_mcode sem) | Ast.ReturnExpr(ret,exp,sem) -> Ast.ReturnExpr(string_mcode ret, expression exp, string_mcode sem) | Ast.MetaStmt(name,keep,seqible,inherited) -> Ast.MetaStmt(meta_mcode name,keep,seqible,inherited) | Ast.MetaStmtList(name,keep,inherited) -> Ast.MetaStmtList(meta_mcode name,keep,inherited) | Ast.MetaRuleElem(name,keep,inherited) -> Ast.MetaRuleElem(meta_mcode name,keep,inherited) | Ast.Exp(exp) -> Ast.Exp(expression exp) | Ast.TopExp(exp) -> Ast.TopExp(expression exp) | Ast.Ty(ty) -> Ast.Ty(fullType ty) | Ast.TopInit(init) -> Ast.TopInit(initialiser init) | Ast.Include(inc,name) -> Ast.Include(string_mcode inc,inc_file_mcode name) | Ast.Undef(def,id) -> Ast.Undef(string_mcode def,ident id) | Ast.DefineHeader(def,id,params) -> Ast.DefineHeader(string_mcode def,ident id, define_parameters params) | Ast.Pragma(prg,id,body) -> Ast.Pragma(string_mcode prg,ident id,pragmainfo body) | Ast.Default(def,colon) -> Ast.Default(string_mcode def,string_mcode colon) | Ast.Case(case,exp,colon) -> Ast.Case(string_mcode case,expression exp,string_mcode colon) | Ast.DisjRuleElem(res) -> Ast.DisjRuleElem(List.map rule_elem res)) in rulefn all_functions k re (* not parameterizable for now... *) and forinfo fi = let k = function Ast.ForExp(e1,sem1) -> Ast.ForExp(get_option expression e1,string_mcode sem1) | Ast.ForDecl (bef,allminus,decl) -> Ast.ForDecl(bef,allminus,declaration decl) in k fi (* not parameterizable for now... *) and pragmainfo pi = let k pi = Ast.rewrap pi (match Ast.unwrap pi with Ast.PragmaTuple(lp,args,rp) -> Ast.PragmaTuple(string_mcode lp,expression_dots args, string_mcode rp) | Ast.PragmaIdList(ids) -> Ast.PragmaIdList(identifier_dots ids) | Ast.PragmaDots (dots) -> Ast.PragmaDots(string_mcode dots)) in k pi (* not parameterizable for now... *) and define_parameters p = let k p = Ast.rewrap p (match Ast.unwrap p with Ast.NoParams -> Ast.NoParams | Ast.DParams(lp,params,rp) -> Ast.DParams(string_mcode lp,define_param_dots params, string_mcode rp)) in k p and define_param_dots d = let k d = Ast.rewrap d (match Ast.unwrap d with Ast.DOTS(l) -> Ast.DOTS(List.map define_param l) | Ast.CIRCLES(l) -> Ast.CIRCLES(List.map define_param l) | Ast.STARS(l) -> Ast.STARS(List.map define_param l)) in k d and define_param p = let k p = Ast.rewrap p (match Ast.unwrap p with Ast.DParam(id) -> Ast.DParam(ident id) | Ast.DPComma(comma) -> Ast.DPComma(string_mcode comma) | Ast.DPdots(d) -> Ast.DPdots(string_mcode d) | Ast.DPcircles(c) -> Ast.DPcircles(string_mcode c) | Ast.OptDParam(dp) -> Ast.OptDParam(define_param dp) | Ast.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp)) in k p and process_bef_aft s = Ast.set_dots_bef_aft (match Ast.get_dots_bef_aft s with Ast.NoDots -> Ast.NoDots | Ast.DroppingBetweenDots(stm,ind) -> Ast.DroppingBetweenDots(statement stm,ind) | Ast.AddingBetweenDots(stm,ind) -> Ast.AddingBetweenDots(statement stm,ind)) s and statement s = let k s = Ast.rewrap s (match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> Ast.Seq(rule_elem lbrace, statement_dots body, rule_elem rbrace) | Ast.IfThen(header,branch,aft) -> Ast.IfThen(rule_elem header, statement branch,aft) | Ast.IfThenElse(header,branch1,els,branch2,aft) -> Ast.IfThenElse(rule_elem header, statement branch1, rule_elem els, statement branch2, aft) | Ast.While(header,body,aft) -> Ast.While(rule_elem header, statement body, aft) | Ast.Do(header,body,tail) -> Ast.Do(rule_elem header, statement body, rule_elem tail) | Ast.For(header,body,aft) -> Ast.For(rule_elem header, statement body, aft) | Ast.Iterator(header,body,aft) -> Ast.Iterator(rule_elem header, statement body, aft) | Ast.Switch(header,lb,decls,cases,rb) -> Ast.Switch(rule_elem header,rule_elem lb, statement_dots decls, List.map case_line cases,rule_elem rb) | Ast.Atomic(re) -> Ast.Atomic(rule_elem re) | Ast.Disj(stmt_dots_list) -> Ast.Disj (List.map statement_dots stmt_dots_list) | Ast.Nest(starter,stmt_dots,ender,whn,multi,bef,aft) -> Ast.Nest(string_mcode starter,statement_dots stmt_dots, string_mcode ender, List.map (whencode statement_dots statement) whn, multi,bef,aft) | Ast.FunDecl(header,lbrace,body,rbrace) -> Ast.FunDecl(rule_elem header,rule_elem lbrace, statement_dots body, rule_elem rbrace) | Ast.Define(header,body) -> Ast.Define(rule_elem header,statement_dots body) | Ast.AsStmt(stm,asstm) -> Ast.AsStmt(statement stm,statement asstm) | Ast.Dots(d,whn,bef,aft) -> Ast.Dots(string_mcode d, List.map (whencode statement_dots statement) whn,bef,aft) | Ast.Circles(d,whn,bef,aft) -> Ast.Circles(string_mcode d, List.map (whencode statement_dots statement) whn, bef,aft) | Ast.Stars(d,whn,bef,aft) -> Ast.Stars(string_mcode d, List.map (whencode statement_dots statement) whn,bef,aft) | Ast.OptStm(stmt) -> Ast.OptStm(statement stmt) | Ast.UniqueStm(stmt) -> Ast.UniqueStm(statement stmt)) in let s = stmtfn all_functions k s in (* better to do this after, in case there is an equality test on the whole statement, eg in free_vars. equality test would require that this subterm not already be changed *) process_bef_aft s and fninfo = function Ast.FStorage(stg) -> Ast.FStorage(storage_mcode stg) | Ast.FType(ty) -> Ast.FType(fullType ty) | Ast.FInline(inline) -> Ast.FInline(string_mcode inline) | Ast.FAttr(attr) -> Ast.FAttr(string_mcode attr) and whencode notfn alwaysfn = function Ast.WhenNot a -> Ast.WhenNot (notfn a) | Ast.WhenAlways a -> Ast.WhenAlways (alwaysfn a) | Ast.WhenModifier(x) -> Ast.WhenModifier(x) | Ast.WhenNotTrue(e) -> Ast.WhenNotTrue(rule_elem e) | Ast.WhenNotFalse(e) -> Ast.WhenNotFalse(rule_elem e) and case_line c = let k c = Ast.rewrap c (match Ast.unwrap c with Ast.CaseLine(header,code) -> Ast.CaseLine(rule_elem header,statement_dots code) | Ast.OptCase(case) -> Ast.OptCase(case_line case)) in casefn all_functions k c and top_level t = let k t = Ast.rewrap t (match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> Ast.FILEINFO (string_mcode old_file, string_mcode new_file) | Ast.NONDECL(stmt) -> Ast.NONDECL(statement stmt) | Ast.CODE(stmt_dots) -> Ast.CODE(statement_dots stmt_dots) | Ast.ERRORWORDS(exps) -> Ast.ERRORWORDS (List.map expression exps)) in topfn all_functions k t and anything a = let k = function (*in many cases below, the thing is not even mcode, so we do nothing*) Ast.FullTypeTag(ft) -> Ast.FullTypeTag(fullType ft) | Ast.BaseTypeTag(bt) as x -> x | Ast.StructUnionTag(su) as x -> x | Ast.SignTag(sgn) as x -> x | Ast.IdentTag(id) -> Ast.IdentTag(ident id) | Ast.ExpressionTag(exp) -> Ast.ExpressionTag(expression exp) | Ast.ConstantTag(cst) as x -> x | Ast.UnaryOpTag(unop) as x -> x | Ast.AssignOpTag(asgnop) as x -> x | Ast.FixOpTag(fixop) as x -> x | Ast.BinaryOpTag(binop) as x -> x | Ast.ArithOpTag(arithop) as x -> x | Ast.LogicalOpTag(logop) as x -> x | Ast.InitTag(decl) -> Ast.InitTag(initialiser decl) | Ast.DeclarationTag(decl) -> Ast.DeclarationTag(declaration decl) | Ast.StorageTag(stg) as x -> x | Ast.IncFileTag(stg) as x -> x | Ast.Rule_elemTag(rule) -> Ast.Rule_elemTag(rule_elem rule) | Ast.StatementTag(rule) -> Ast.StatementTag(statement rule) | Ast.ForInfoTag(rule) -> Ast.ForInfoTag(forinfo rule) | Ast.CaseLineTag(case) -> Ast.CaseLineTag(case_line case) | Ast.ConstVolTag(cv) as x -> x | Ast.Token(tok,info) as x -> x | Ast.Directive(str) as x -> x | Ast.Code(cd) -> Ast.Code(top_level cd) | Ast.ExprDotsTag(ed) -> Ast.ExprDotsTag(expression_dots ed) | Ast.ParamDotsTag(pd) -> Ast.ParamDotsTag(parameter_dots pd) | Ast.StmtDotsTag(sd) -> Ast.StmtDotsTag(statement_dots sd) | Ast.DeclDotsTag(sd) -> Ast.DeclDotsTag(declaration_dots sd) | Ast.TypeCTag(ty) -> Ast.TypeCTag(typeC ty) | Ast.ParamTag(param) -> Ast.ParamTag(parameterTypeDef param) | Ast.SgrepStartTag(tok) as x -> x | Ast.SgrepEndTag(tok) as x -> x in anyfn all_functions k a and all_functions = {rebuilder_ident = ident; rebuilder_expression = expression; rebuilder_fragment = string_fragment; rebuilder_format = string_format; rebuilder_fullType = fullType; rebuilder_typeC = typeC; rebuilder_declaration = declaration; rebuilder_initialiser = initialiser; rebuilder_parameter = parameterTypeDef; rebuilder_parameter_list = parameter_dots; rebuilder_rule_elem = rule_elem; rebuilder_statement = statement; rebuilder_case_line = case_line; rebuilder_top_level = top_level; rebuilder_expression_dots = expression_dots; rebuilder_statement_dots = statement_dots; rebuilder_declaration_dots = declaration_dots; rebuilder_initialiser_dots = initialiser_dots; rebuilder_define_param_dots = define_param_dots; rebuilder_define_param = define_param; rebuilder_define_parameters = define_parameters; rebuilder_anything = anything} in all_functions coccinelle-1.0.0-rc19/parsing_cocci/commas_on_lists.mli0000644000175000017500000000225212247442615022063 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./commas_on_lists.mli" val process : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/get_constants2.ml0000644000175000017500000006323712247442615021470 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./get_constants2.ml" module Ast = Ast_cocci module V = Visitor_ast module TC = Type_cocci (* Issues: 1. If a rule X depends on a rule Y (in a positive way), then we can ignore the constants in X. 2. If a rule X contains a metavariable that is not under a disjunction and that is inherited from rule Y, then we can ignore the constants in X. 3. If a rule contains a constant x in + code then subsequent rules that have it in - or context should not include it in their list of required constants. *) (* This doesn't do the . -> trick of get_constants for record fields, as that does not fit well with the recursive structure. It was not clear that that was completely safe either, although eg putting a newline after the . or -> is probably unusual. *) (* ----------------------------------------------------------------------- *) (* This phase collects everything. One can then filter out what it not wanted *) (* True means nothing was found False should never drift to the top, it is the neutral element of or and an or is never empty *) type combine = And of combine list | Or of combine list | Elem of string | False | True let false_on_top_err = "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code, or you have a failed dependency." let rec dep2c = function And l -> Printf.sprintf "(%s)" (String.concat "&" (List.map dep2c l)) | Or l -> Printf.sprintf "(%s)" (String.concat "|" (List.map dep2c l)) | Elem x -> x | False -> "false" | True -> "true" (* glimpse often fails on large queries. We can safely remove arguments of && as long as we don't remove all of them (note that there is no negation). This tries just removing one of them and then orders the results by increasing number of ors (ors are long, increasing the chance of failure, and are less restrictive, possibly increasing the chance of irrelevant code. *) let reduce_glimpse x = let rec loop x k q = match x with Elem _ -> q() | And [x] -> loop x (function changed_l -> k (And [changed_l])) q | And l -> kloop l (function changed_l -> k (And changed_l)) (function _ -> let rec rloop l k = match l with [] -> q() | x::xs -> (k xs) :: rloop xs (function changed_xs -> k (x :: changed_xs)) in rloop l (function changed_l -> k (And changed_l))) | Or l -> kloop l (function changed_l -> k (Or changed_l)) q | _ -> failwith "not possible" and kloop l k q = match l with [] -> q() | x::xs -> loop x (function changed_x -> k (changed_x::xs)) (function _ -> kloop xs (function changed_xs -> k (x :: changed_xs)) q) in let rec count_ors = function Elem _ -> 0 | And l -> List.fold_left (+) 0 (List.map count_ors l) | Or l -> ((List.length l) - 1) + (List.fold_left (+) 0 (List.map count_ors l)) | _ -> failwith "not possible" in let res = loop x (function x -> x) (function _ -> []) in let res = List.map (function x -> (count_ors x,x)) res in let res = List.sort compare res in List.map (function (_,x) -> x) res let interpret_glimpse strict x = let rec loop = function Elem x -> x | And [x] -> loop x | Or [x] -> loop x | And l -> Printf.sprintf "{%s}" (String.concat ";" (List.map loop l)) | Or l -> Printf.sprintf "{%s}" (String.concat "," (List.map loop l)) | True -> if strict then failwith "True should not be in the final result" else "True" | False -> if strict then failwith false_on_top_err else "False" in match x with True -> None | False when strict -> failwith false_on_top_err | _ -> Some (if strict then List.map loop (x::reduce_glimpse x) else [loop x]) (* grep only does or *) let interpret_grep strict x = let add x l = if List.mem x l then l else x :: l in let rec loop collected = function Elem x -> add x collected | And l | Or l -> let rec iloop collected = function [] -> collected | x::xs -> iloop (loop collected x) xs in iloop collected l | True -> if strict then failwith "True should not be in the final result" else add "True" collected | False -> if strict then failwith false_on_top_err else add "False" collected in match x with True -> None | False when strict -> failwith false_on_top_err | _ -> Some (loop [] x) let interpret_cocci_grep strict x = (* convert to cnf *) let rec cnf = function Elem x -> [[x]] | And l -> List.fold_left Common.union_set [] (List.map cnf l) | Or l -> let l = List.map cnf l in (match l with fst::rest -> List.fold_left (function prev -> function cur -> List.fold_left Common.union_set [] (List.map (fun x -> List.map (Common.union_set x) prev) cur)) fst rest | [] -> [[]]) (* false *) | True -> [] | False -> if strict then failwith false_on_top_err else [[]] in let optimize (l : string list list) = let l = List.map (function clause -> (List.length clause, clause)) l in let l = List.sort compare l in let l = List.rev (List.map (function (len,clause) -> clause) l) in let subset l1 l2 = List.for_all (fun e1 -> List.mem e1 l2) l1 in List.fold_left (fun prev cur -> if List.exists (subset cur) prev then prev else cur :: prev) [] l in let rec atoms acc = function Elem x -> if List.mem x acc then acc else x :: acc | And l | Or l -> List.fold_left atoms acc l | True | False -> acc in let wordify x = "\\b" ^ x ^"\\b" in match x with True -> None | False when strict -> failwith false_on_top_err | _ -> let orify l = Str.regexp (String.concat "\\|" (List.map wordify l)) in let res1 = orify (atoms [] x) in (* all atoms *) let res = cnf x in let res = optimize res in let res = Cocci_grep.split res in let res2 = List.map orify res in (* atoms in conjunction *) (* List.iter (function clause -> Printf.printf "%s\n" (String.concat " " clause)) res; *) Some (res1,res2) let combine2c x = match interpret_glimpse false x with None -> "None" | Some x -> String.concat " || " x let norm = function And l -> And (List.sort compare l) | Or l -> Or (List.sort compare l) | x -> x let rec merge l1 l2 = match (l1,l2) with ([],l2) -> l2 | (l1,[]) -> l1 | (x::xs,y::ys) -> (match compare x y with -1 -> x::(merge xs l2) | 0 -> x::(merge xs ys) | 1 -> y::(merge l1 ys) | _ -> failwith "not possible") let intersect l1 l2 = List.filter (function l1e -> List.mem l1e l2) l1 let minus_set l1 l2 = List.filter (function l1e -> not (List.mem l1e l2)) l1 let rec insert x l = merge [x] l let rec build_and x y = if x = y then x else match (x,y) with (True,x) | (x,True) -> x | (False,x) | (x,False) -> False | (And l1,And l2) -> And (merge l1 l2) | (x,Or l) when List.mem x l -> x | (Or l,x) when List.mem x l -> x | (Or l1,Or l2) when not ((intersect l1 l2) = []) -> let inner = build_and (List.fold_left build_or False (minus_set l1 l2)) (List.fold_left build_or False (minus_set l2 l1)) in List.fold_left build_or inner (intersect l1 l2) | (x,And l) | (And l,x) -> if List.mem x l then And l else let others = List.filter (function Or l -> not(List.mem x l) | _ -> true) l in And (insert x others) | (x,y) -> norm(And [x;y]) and build_or x y = if x = y then x else match (x,y) with (True,x) | (x,True) -> True | (False,x) | (x,False) -> x | (Or l1,Or l2) -> Or (merge l1 l2) | (x,And l) when List.mem x l -> x | (And l,x) when List.mem x l -> x | (And l1,And l2) when not ((intersect l1 l2) = []) -> let inner = build_or (List.fold_left build_and True (minus_set l1 l2)) (List.fold_left build_and True (minus_set l2 l1)) in List.fold_left build_and inner (intersect l1 l2) | (x,Or l) | (Or l,x) -> if List.mem x l then Or l else let others = List.filter (function And l -> not(List.mem x l) | _ -> true) l in Or (insert x others) | (x,y) -> norm(Or [x;y]) let keep x = Elem x let drop x = True let do_get_constants constants keywords env neg_pos = let donothing r k e = k e in let option_default = True in let bad_default = False in let bind = build_and in let inherited ((nm1,_) as x) = (* ignore virtuals, can never match *) if nm1 = "virtual" then bad_default (* perhaps inherited, but value not required, so no constraints *) else if List.mem x neg_pos then option_default else (try List.assoc nm1 env with Not_found -> False) in let minherited name = inherited (Ast.unwrap_mcode name) in let mcode _ x = List.fold_left bind option_default (List.map (function Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name) (Ast.get_pos_var x)) in (* if one branch gives no information, then we have to take anything *) let disj_union_all = List.fold_left build_or False in let ident r k i = match Ast.unwrap i with Ast.Id(name) -> bind (k i) (match Ast.unwrap_mcode name with "NULL" -> keywords "NULL" | nm -> constants nm) | Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_) | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name) | Ast.DisjId(ids) -> disj_union_all (List.map r.V.combiner_ident ids) | _ -> k i in let rec type_collect res = function TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | TC.Array(ty) -> type_collect res ty | TC.Decimal _ -> build_or res (keywords "decimal") | TC.MetaType(tyname,_,_) -> build_or res (inherited tyname) | TC.TypeName(s) -> build_or res (constants s) | TC.EnumName(TC.Name s) -> build_or res (constants s) | TC.StructUnionName(_,TC.Name s) -> build_or res (constants s) | ty -> res in (* no point to do anything special for records because glimpse is word-oriented *) let expression r k e = match Ast.unwrap e with Ast.Constant(const) -> bind (k e) (match Ast.unwrap_mcode const with Ast.String s -> constants s | Ast.Char "\\0" -> option_default (* glimpse doesn't like it *) | Ast.Char s -> option_default (* probably not chars either *) (* the following were eg keywords "1", but not good for glimpse *) | Ast.Int s -> option_default (* glimpse doesn't index integers *) | Ast.Float s -> option_default (* probably not floats either *) | Ast.DecimalConst _ -> option_default (* or decimals *)) | Ast.StringConstant(lq,str,rq) -> let str = Ast.undots str in (* pick up completely constant strings *) let strs = List.fold_left (function strs -> function frag -> match (strs, Ast.unwrap frag) with (None,_) -> None | (Some strs, Ast.ConstantFragment(str)) -> Some ((Ast.unwrap_mcode str)::strs) | (Some strs, Ast.FormatFragment(pct,fmt)) -> let cstfmt = match Ast.unwrap fmt with Ast.ConstantFormat s -> Some (Ast.unwrap_mcode s) | _ -> None in (match cstfmt with Some f -> Some (f :: "%" :: strs) | _ -> None) | (Some strs, Ast.Strdots _) | (Some strs, Ast.MetaFormatList _) -> None) (Some []) str in bind (k e) (match strs with Some strs -> constants (String.concat "" (List.rev strs)) | None -> option_default) | Ast.MetaExpr(name,_,_,Some type_list,_,_) -> let types = List.fold_left type_collect option_default type_list in bind (k e) (bind (minherited name) types) | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> bind (k e) (minherited name) | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) -> bind (k e) (bind (minherited name) (minherited lenname)) | Ast.MetaExprList(name,_,_,_) -> minherited name | Ast.SizeOfExpr(sizeof,exp) -> bind (keywords "sizeof") (k e) | Ast.SizeOfType(sizeof,lp,ty,rp) -> bind (keywords "sizeof") (k e) | Ast.NestExpr(starter,expr_dots,ender,wc,false) -> option_default | Ast.NestExpr(starter,expr_dots,ender,wc,true) -> r.V.combiner_expression_dots expr_dots | Ast.DisjExpr(exps) -> disj_union_all (List.map r.V.combiner_expression exps) | Ast.OptExp(exp) -> option_default | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> option_default | _ -> k e in (* cases for metavariabes *) let string_fragment r k ft = match Ast.unwrap ft with Ast.MetaFormatList(pct,name,Ast.MetaListLen (lenname,_,_),_,_) -> bind (k ft) (bind (minherited name) (minherited lenname)) | Ast.MetaFormatList(pct,name,_,_,_) -> bind (k ft) (minherited name) | _ -> k ft in let string_format r k ft = match Ast.unwrap ft with Ast.MetaFormat(name,_,_,_) -> bind (k ft) (minherited name) | _ -> k ft in let fullType r k ft = match Ast.unwrap ft with Ast.DisjType(decls) -> disj_union_all (List.map r.V.combiner_fullType decls) | Ast.OptType(ty) -> option_default | _ -> k ft in let baseType = function Ast.VoidType -> keywords "void" | Ast.CharType -> keywords "char" | Ast.ShortType -> keywords "short" | Ast.ShortIntType -> keywords "short" | Ast.IntType -> keywords "int" | Ast.DoubleType -> keywords "double" | Ast.LongDoubleType -> keywords "double" | Ast.FloatType -> keywords "float" | Ast.LongType | Ast.LongLongType | Ast.LongIntType | Ast.LongLongIntType -> keywords "long" | Ast.SizeType -> keywords "size_t" | Ast.SSizeType -> keywords "ssize_t" | Ast.PtrDiffType -> keywords "ptrdiff_t" in let typeC r k ty = match Ast.unwrap ty with Ast.BaseType(ty1,strings) -> bind (k ty) (baseType ty1) | Ast.TypeName(name) -> bind (k ty) (constants (Ast.unwrap_mcode name)) | Ast.MetaType(name,_,_) -> bind (minherited name) (k ty) | _ -> k ty in let declaration r k d = match Ast.unwrap d with Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> bind (k d) (minherited name) | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) -> bind (minherited name) (bind (minherited lenname) (k d)) | Ast.DisjDecl(decls) -> disj_union_all (List.map r.V.combiner_declaration decls) | Ast.OptDecl(decl) -> option_default | Ast.Ddots(dots,whencode) -> option_default | _ -> k d in let initialiser r k i = match Ast.unwrap i with Ast.OptIni(ini) -> option_default | _ -> k i in let parameter r k p = match Ast.unwrap p with Ast.OptParam(param) -> option_default | Ast.MetaParam(name,_,_) -> bind (k p) (minherited name) | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) -> bind (minherited name) (bind (minherited lenname) (k p)) | Ast.MetaParamList(name,_,_,_) -> bind (k p) (minherited name) | _ -> k p in let rule_elem r k re = match Ast.unwrap re with Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_) | Ast.MetaStmtList(name,_,_) -> bind (minherited name) (k re) | Ast.WhileHeader(whl,lp,exp,rp) -> bind (keywords "while") (k re) | Ast.WhileTail(whl,lp,exp,rp,sem) -> bind (keywords "do") (k re) | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> bind (keywords "for") (k re) | Ast.SwitchHeader(switch,lp,exp,rp) -> bind (keywords "switch") (k re) | Ast.Break(br,sem) -> bind (keywords "break") (k re) | Ast.Continue(cont,sem) -> bind (keywords "continue") (k re) | Ast.Goto(_,i,_) -> bind (keywords "goto") (k re) | Ast.Default(def,colon) -> bind (keywords "default") (k re) | Ast.Include(inc,s) -> bind (k re) (match Ast.unwrap_mcode s with Ast.Local l | Ast.NonLocal l -> let strings = List.fold_left (function prev -> function (* just take the last thing, probably the most specific. everything is necessary anyway. *) Ast.IncPath s -> [Elem s] | Ast.IncDots -> prev) [] l in (match strings with [] -> True | x::xs -> List.fold_left bind x xs)) | Ast.Pragma(prg,id,body) -> bind (keywords "pragma") (k re) | Ast.DisjRuleElem(res) -> disj_union_all (List.map r.V.combiner_rule_elem res) | _ -> k re in let statement r k s = match Ast.unwrap s with Ast.Disj(stmt_dots) -> disj_union_all (List.map r.V.combiner_statement_dots stmt_dots) | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> option_default | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) -> r.V.combiner_statement_dots stmt_dots | Ast.OptStm(s) -> option_default | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) -> option_default | _ -> k s in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression string_fragment string_format fullType typeC initialiser parameter declaration rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) let filter_combine combine to_drop = let rec and_loop = function Elem x when List.mem x to_drop -> True | Or l -> List.fold_left build_or False (List.map or_loop l) | x -> x and or_loop = function Elem x when List.mem x to_drop -> False | And l -> List.fold_left build_and True (List.map and_loop l) | x -> x in or_loop combine (* ------------------------------------------------------------------------ *) let get_all_constants minus_only = let donothing r k e = k e in let bind = Common.union_set in let option_default = [] in let mcode r (x,_,mcodekind,_) = match mcodekind with Ast.MINUS(_,_,_,_) -> [x] | _ when minus_only -> [] | _ -> [x] in let other r _ = [] in V.combiner bind option_default other mcode other other other other other other other other other other donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing (* ------------------------------------------------------------------------ *) let get_plus_constants = let donothing r k e = k e in let bind = Common.union_set in let option_default = [] in let recurse l = List.fold_left (List.fold_left (function prev -> function cur -> bind ((get_all_constants false).V.combiner_anything cur) prev)) [] l in let process_mcodekind = function Ast.MINUS(_,_,_,Ast.REPLACEMENT(anythings,_)) -> recurse anythings | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) -> Common.union_set (recurse a1) (recurse a2) | _ -> [] in let mcode r mc = process_mcodekind (Ast.get_mcodekind mc) in let end_info (_,_,_,mc) = process_mcodekind mc in let rule_elem r k e = match Ast.unwrap e with Ast.FunHeader(bef,_,_,_,_,_,_) | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e) | _ -> k e in let statement r k e = match Ast.unwrap e with Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei) | Ast.While(_,_,ei) | Ast.For(_,_,ei) | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei) | _ -> k e in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) (* true means the rule should be analyzed, false means it should be ignored *) let rec dependencies env = function Ast.Dep s -> (try List.assoc s env with Not_found -> False) | Ast.AntiDep s -> True | Ast.EverDep s -> (try List.assoc s env with Not_found -> False) | Ast.NeverDep s -> True | Ast.AndDep (d1,d2) -> build_and (dependencies env d1) (dependencies env d2) | Ast.OrDep (d1,d2) -> build_or (dependencies env d1) (dependencies env d2) | Ast.NoDep -> True | Ast.FailDep -> False (* ------------------------------------------------------------------------ *) let all_context = let bind x y = x && y in let option_default = true in let donothing recursor k e = k e in let process_mcodekind = function Ast.CONTEXT(_,Ast.NOTHING) -> true | _ -> false in let mcode r e = process_mcodekind (Ast.get_mcodekind e) in let end_info (_,_,_,mc) = process_mcodekind mc in let initialiser r k e = match Ast.unwrap e with Ast.StrInitList(all_minus,_,_,_,_) -> not all_minus && k e | _ -> k e in let rule_elem r k e = match Ast.unwrap e with Ast.FunHeader(bef,_,_,_,_,_,_) | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e) | _ -> k e in let statement r k e = match Ast.unwrap e with Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei) | Ast.While(_,_,ei) | Ast.For(_,_,ei) | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei) | _ -> k e in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing initialiser donothing donothing rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) let rule_fn tls in_plus env neg_pos = List.fold_left (function (rest_info,in_plus) -> function (cur,neg_pos) -> let minuses = let getter = do_get_constants keep drop env neg_pos in getter.V.combiner_top_level cur in let all_minuses = if !Flag.sgrep_mode2 then [] (* nothing removed for sgrep *) else (get_all_constants true).V.combiner_top_level cur in let plusses = get_plus_constants.V.combiner_top_level cur in (* the following is for eg -foo(2) +foo(x) then in another rule -foo(10); don't want to consider that foo is guaranteed to be created by the rule. not sure this works completely: what if foo is in both - and +, but in an or, so the cases aren't related? not sure this whole thing is a good idea. how do we know that something that is only in plus is really freshly created? *) let plusses = Common.minus_set plusses all_minuses in let was_bot = minuses = True in let new_minuses = filter_combine minuses in_plus in let new_plusses = Common.union_set plusses in_plus in (* perhaps it should be build_and here? we don't really have multiple minirules anymore anyway. *) match new_minuses with True -> let getter = do_get_constants drop keep env neg_pos in let retry = getter.V.combiner_top_level cur in (match retry with True when not was_bot -> (rest_info, new_plusses) | x -> (build_or x rest_info, new_plusses)) | x -> (build_or x rest_info, new_plusses)) (False,in_plus) (List.combine tls neg_pos) let run rules neg_pos_vars = let (info,_,_,_) = List.fold_left (function (rest_info,in_plus,env,locals(*dom of env*)) -> function (Ast.ScriptRule (nm,_,deps,mv,_,_),_) -> let extra_deps = List.fold_left (function prev -> function (_,(rule,_),_) -> if rule = "virtual" then prev else Ast.AndDep (Ast.Dep rule,prev)) deps mv in (match dependencies env extra_deps with False -> (rest_info, in_plus, (nm,True)::env, nm::locals) | dependencies -> (build_or dependencies rest_info, in_plus, env, locals)) | (Ast.InitialScriptRule (_,_,deps,_),_) | (Ast.FinalScriptRule (_,_,deps,_),_) -> (* initialize and finalize dependencies are irrelevant to get_constants *) (rest_info, in_plus, env, locals) | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) -> let (cur_info,cur_plus) = rule_fn cur in_plus ((nm,True)::env) neg_pos_vars in (match dependencies env dep with False -> (rest_info,cur_plus,env,locals) | dependencies -> if List.for_all all_context.V.combiner_top_level cur then let cur_info = build_and dependencies cur_info in (rest_info,cur_plus,(nm,cur_info)::env,nm::locals) else (* no constants if dependent on another rule; then we need to find the constants of that rule *) (build_or (build_and dependencies cur_info) rest_info, cur_plus,(nm,cur_info)::env,locals))) (False,[],[],[]) (List.combine (rules : Ast.rule list) neg_pos_vars) in info let get_constants rules neg_pos_vars = if !Flag.worth_trying_opt then let res = run rules neg_pos_vars in let grep = interpret_grep true res in (* useful because in string form *) let coccigrep = interpret_cocci_grep true res in match !Flag.scanner with Flag.NoScanner -> (grep,None,coccigrep,None) | Flag.Glimpse -> (grep,interpret_glimpse true res,coccigrep,None) | Flag.IdUtils -> (grep,None,coccigrep,Some res) | Flag.CocciGrep -> (grep,None,coccigrep,None) else (None,None,None,None) coccinelle-1.0.0-rc19/parsing_cocci/plus.ml0000644000175000017500000002033512247442615017506 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./plus.ml" (* The plus fragments are converted to a list of lists of lists. Innermost list: Elements have type anything. For any pair of successive elements, n and n+1, the ending line of n is the same as the starting line of n+1. Middle lists: For any pair of successive elements, n and n+1, the ending line of n is one less than the starting line of n+1. Outer list: For any pair of successive elements, n and n+1, the ending line of n is more than one less than the starting line of n+1. *) (* For nests and disjs, we are relying on the fact that <... ...> ( | ) must appear on lines by themselves, meaning that the various + fragments can't be contiguous to each other or to unrelated things. *) module Ast = Ast_cocci module V = Visitor_ast (* --------------------------------------------------------------------- *) type res = Open of Ast.anything * int * int * int * int | Closed of (Ast.anything * int * int * int * int) list let mcode fn = function (term, Ast.PLUS(info)) -> let line = info.Ast.line in let lline = info.Ast.logical_line in [Open (fn term,line,line,lline,lline)] | _ -> [Closed []] let mk_fullType x = Ast.FullTypeTag x let mk_baseType x = Ast.BaseTypeTag x let mk_structUnion x = Ast.StructUnionTag x let mk_sign x = Ast.SignTag x let mk_ident x = Ast.IdentTag x let mk_expression x = Ast.ExpressionTag x let mk_constant x = Ast.ConstantTag x let mk_unaryOp x = Ast.UnaryOpTag x let mk_assignOp x = Ast.AssignOpTag x let mk_fixOp x = Ast.FixOpTag x let mk_binaryOp x = Ast.BinaryOpTag x let mk_arithOp x = Ast.ArithOpTag x let mk_logicalOp x = Ast.LogicalOpTag x let mk_declaration x = Ast.DeclarationTag x let mk_storage x = Ast.StorageTag x let mk_rule_elem x = Ast.Rule_elemTag x let mk_const_vol x = Ast.ConstVolTag x let mk_token x = Ast.Token x let get_real_start = function Open (_,line,_,_,_) -> line | _ -> failwith "not possible" let get_real_finish = function Open (_,_,line,_,_) -> line | _ -> failwith "not possible" let get_start = function Open (_,_,_,line,_) -> line | _ -> failwith "not possible" let get_finish = function Open (_,_,_,_,line) -> line | _ -> failwith "not possible" let get_option fn = function None -> [] | Some x -> [fn x] (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Step 1: coalesce + terms, record starting and ending line numbers *) let rec close l = let rec loop = function [] -> [] | Open(x,start,finish,lstart,lfinish)::rest -> (x,start,finish,lstart,lfinish)::(loop rest) | (Closed l)::rest -> l @ (loop rest) in Closed (loop l) let test term subterms = if List.for_all (function Open(_,_,_,_,_) -> true | _ -> false) subterms then [Open(term, get_real_start (List.hd subterms), get_real_finish (List.hd (List.rev subterms)), get_start (List.hd subterms), get_finish (List.hd (List.rev subterms)))] else [close subterms] (* --------------------------------------------------------------------- *) (* Dots *) let dots recursor k dotlist = [close (k dotlist)] (* --------------------------------------------------------------------- *) (* Identifier *) let ident recursor k i = test (Ast.IdentTag i) (k i) (* --------------------------------------------------------------------- *) (* Expression *) let expression recursor k = function Ast.DisjExpr(exps) -> [close (List.concat(List.map recursor.V.combiner_expression exps))] | Ast.Edots(_,_) -> [Closed []] (* must be context *) | Ast.Ecircles(_,_) -> [Closed []] (* must be context *) | Ast.Estars(_,_) -> [Closed []] (* must be context *) | Ast.OptExp(_) | Ast.UniqueExp(_) | Ast.MultiExp(_) -> failwith "impossible" | e -> test (Ast.ExpressionTag e) (k e) (* --------------------------------------------------------------------- *) (* Types *) and fullType recursor k ft = test (Ast.FullTypeTag ft) (k ft) and typeC recursor k t = k t (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) let declaration recursor k d = test (Ast.DeclarationTag d) (k d) (* --------------------------------------------------------------------- *) (* Parameter *) let parameterTypeDef recursor k = function Ast.Pdots(_) -> [Closed []] | Ast.Pcircles(_) -> [Closed []] | p -> test (Ast.ParameterTypeDefTag p) (k p) (* --------------------------------------------------------------------- *) (* Top-level code *) let rec rule_elem recursor k re = test (Ast.Rule_elemTag re) (k re) let rec statement recursor k = function Ast.Disj(stmt_dots_list) -> [close (List.concat (List.map recursor.V.combiner_statement_dots stmt_dots_list))] | Ast.Dots(_,_,_) -> [Closed []] | Ast.Circles(_,_,_) -> [Closed []] | Ast.Stars(_,_,_) -> [Closed []] | s -> test (Ast.StatementTag s) (k s) let rec meta recursor k m = test (Ast.MetaTag m) (k m) let top_level recursor k = function Ast.FILEINFO(_,_) -> [Closed []] | Ast.ERRORWORDS(exps) -> [Closed []] | t -> test (Ast.Code t) (k t) let anything recursor k a = failwith "not called" let collect_tokens = let recursor = V.combiner (@) [] (mcode mk_token) (mcode mk_constant) (mcode mk_assignOp) (mcode mk_fixOp) (mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol) (mcode mk_baseType) (mcode mk_sign) (mcode mk_structUnion) (mcode mk_storage) dots dots dots ident expression fullType typeC parameterTypeDef declaration rule_elem statement meta top_level anything in recursor.V.combiner_top_level let rule code = List.concat(List.map collect_tokens code) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Step 2: find neighbors *) let rec find_neighbors = function [] -> [] | (x1,real_start1,real_finish1,start1,finish1)::rest -> (match find_neighbors rest with ((((x2,real_start2,real_finish2,start2,finish2):: rest_inner)::rest_middle)::rest_outer) as rest -> if finish1 = start2 then ((((x1,real_start1,real_finish1,start1,finish1):: (x2,real_start2,real_finish2,start2,finish2)::rest_inner):: rest_middle):: rest_outer) else if finish1 + 1 = start2 then (([(x1,real_start1,real_finish1,start1,finish1)]:: ((x2,real_start2,real_finish2,start2,finish2)::rest_inner):: rest_middle):: rest_outer) else [[(x1,real_start1,real_finish1,start1,finish1)]]::rest | _ -> [[[(x1,real_start1,real_finish1,start1,finish1)]]]) (* rest must be [] *) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Entry point *) let plus ast = match close (rule ast) with Closed l -> find_neighbors l | _ -> failwith "impossible" coccinelle-1.0.0-rc19/parsing_cocci/id_utils.mli0000644000175000017500000000226212247442615020507 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./id_utils.mli" val interpret : string -> Get_constants2.combine -> string list coccinelle-1.0.0-rc19/parsing_cocci/parser_cocci_menhir.mly0000644000175000017500000026340412247442616022721 0ustar eugeneugen/* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. */ %{ (* Not clear how to allow function declarations to specify a return type and how to allow both to be specified as static, because they are in different rules. The rules seem to have to be combined, which would allow functions to be declared as local variables *) (* Not clear how to let a function have a parameter of type void. At the moment, void is allowed to be the type of a variable, which is wrong, and a parameter needs both a type and an identifier *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module P = Parse_aux (* ---------------------------------------------------------------------- *) (* support for TMeta *) let print_meta (r,n) = r^"."^n let meta_metatable = Hashtbl.create(101) let coerce_tmeta newty name builder matcher = try let x = Hashtbl.find meta_metatable name in if not (matcher x) then failwith (Printf.sprintf "Metavariable %s is used as %s" (print_meta name) newty) with Not_found -> (if !Flag_parsing_cocci.show_SP then Common.pr2 (Printf.sprintf "Metavariable %s is assumed to be %s metavariable" (print_meta name) newty)); Hashtbl.add meta_metatable name builder let tmeta_to_type (name,pure,clt) = (coerce_tmeta "a type" name (TMetaType(name,pure,clt)) (function TMetaType(_,_,_) -> true | _ -> false)); Ast0.wrap(Ast0.MetaType(P.clt2mcode name clt,pure)) let tmeta_to_field (name,pure,clt) = (coerce_tmeta "a field" name (TMetaField(name,pure,clt)) (function TMetaField(_,_,_) -> true | _ -> false)); P.meta_field (name,pure,clt) let tmeta_to_exp (name,pure,clt) = (coerce_tmeta "an expression" name (TMetaExp(name,Ast0.NoConstraint,pure,None,clt)) (function TMetaExp(_,_,_,_,_) -> true | _ -> false)); Ast0.wrap (Ast0.MetaExpr(P.clt2mcode name clt,Ast0.NoConstraint,None,Ast.ANY,pure)) let tmeta_to_param (name,pure,clt) = (coerce_tmeta "a parameter" name (TMetaParam(name,pure,clt)) (function TMetaParam(_,_,_) -> true | _ -> false)); Ast0.wrap(Ast0.MetaParam(P.clt2mcode name clt,pure)) let tmeta_to_statement (name,pure,clt) = (coerce_tmeta "a statement" name (TMetaType(name,pure,clt)) (function TMetaType(_,_,_) -> true | _ -> false)); P.meta_stm (name,pure,clt) let tmeta_to_seed_id (name,pure,clt) = (coerce_tmeta "an identifier" name (TMetaId(name,Ast.IdNoConstraint,Ast.NoVal,pure,clt)) (function TMetaId(_,_,_,_,_) -> true | _ -> false)); Ast.SeedId name let tmeta_to_ident (name,pure,clt) = (coerce_tmeta "an identifier" name (TMetaId(name,Ast.IdNoConstraint,Ast.NoVal,pure,clt)) (function TMetaId(_,_,_,_,_) -> true | _ -> false)); Ast0.wrap(Ast0.MetaId(P.clt2mcode name clt,Ast.IdNoConstraint,Ast.NoVal,pure)) %} %token EOF %token TIdentifier TExpression TStatement TFunction TLocal TType TParameter %token TIdExpression TInitialiser TDeclaration TField TMetavariable TSymbol %token Tlist TFresh TConstant TError TWords TWhy0 TPlus0 TBang0 %token TPure TContext TGenerated TFormat %token TTypedef TDeclarer TIterator TName TPosition TAnalysis TPosAny %token TUsing TDisable TExtends TDepends TOn TEver TNever TExists TForall %token TScript TInitialize TFinalize TNothing TVirtual %token TRuleName %token Tchar Tshort Tint Tdouble Tfloat Tlong %token Tsize_t Tssize_t Tptrdiff_t %token Tvoid Tstruct Tunion Tenum %token Tunsigned Tsigned %token Tstatic Tauto Tregister Textern Tinline Ttypedef %token Tconst Tvolatile %token Tattr %token TIf TElse TWhile TFor TDo TSwitch TCase TDefault TReturn %token TBreak TContinue TGoto TSizeof TFunDecl Tdecimal %token TIdent TTypeId TDeclarerId TIteratorId TSymId %token TDirective %token TMetaId %token TMetaFunc TMetaLocalFunc %token TMetaIterator TMetaDeclarer %token TMetaErr %token TMetaParam TMetaStm TMetaStmList TMetaType %token TMetaInit TMetaDecl TMetaField TMeta %token TMetaParamList TMetaExpList TMetaInitList %token TMetaFieldList %token TMetaExp TMetaIdExp TMetaLocalIdExp TMetaConst %token TMetaPos %token TArob TArobArob %token TPArob %token TScriptData %token TEllipsis TOEllipsis TCEllipsis TPOEllipsis TPCEllipsis %token TWhen TWhenTrue TWhenFalse TAny TStrict TLineEnd %token TWhy TDotDot TBang TOPar TOPar0 %token TMid0 TCPar TCPar0 %token TPathIsoFile %token TIncludeL TIncludeNL %token TDefine TUndef %token TPragma %token TDefineParam %token TMinusFile TPlusFile %token TInc TDec %token TString TChar TFloat TInt %token TDecimalCst %token TOrLog %token TAndLog %token TOr %token TXor %token TAnd %token TEqEq TNotEq TTildeEq TTildeExclEq TSub %token TLogOp /* TInf TSup TInfEq TSupEq */ %token TShLOp TShROp /* TShl TShr */ %token TDmOp /* TDiv TMod TMin TMax */ %token TPlus TMinus %token TMul TTilde %token TOBrace TCBrace TOInit %token TOCro TCCro %token TPtrOp %token TMPtVirg TCppConcatOp %token TEq TDot TComma TPtVirg %token TAssign %token TIso TRightIso TIsoExpression TIsoStatement TIsoDeclaration TIsoType %token TIsoTopLevel TIsoArgExpression TIsoTestExpression TIsoToTestExpression %token TUnderscore %token TInvalid /* operator precedence */ %nonassoc TIf %nonassoc TElse %left TOrLog %left TAndLog %left TOr %left TXor %left TAnd %left TEqEq TNotEq %left TLogOp /* TInf TSup TInfEq TSupEq */ %left TShLOp TShROp /* TShl TShr */ %left TPlus TMinus %left TMul TDmOp /* TDiv TMod TMin TMax */ %start reinit %type reinit %start minus_main %type minus_main %start minus_exp_main %type minus_exp_main %start minus_ty_main %type minus_ty_main %start plus_main %type plus_main %start plus_exp_main %type plus_exp_main %start plus_ty_main %type plus_ty_main %start include_main %type include_main %start iso_rule_name %type iso_rule_name %start rule_name %type rule_name %start meta_main %type <(Ast_cocci.metavar,Ast_cocci.metavar) Common.either list> meta_main %start <(string option (*string*) * string option (*ast*)) * (Ast_cocci.meta_name * Ast_cocci.metavar) option> script_meta_main %start iso_main %type iso_main %start iso_meta_main %type <(Ast_cocci.metavar,Ast_cocci.metavar) Common.either list> iso_meta_main %start never_used %type never_used %% reinit: { } minus_main: minus_body EOF { $1 } | m=minus_body TArobArob { m } | m=minus_body TArob { m } plus_main: plus_body EOF { $1 } | p=plus_body TArobArob { p } | p=plus_body TArob { p } minus_exp_main: minus_exp_body EOF { $1 } | m=minus_exp_body TArobArob { m } | m=minus_exp_body TArob { m } minus_ty_main: minus_exp_body EOF { $1 } | m=minus_ty_body TArobArob { m } | m=minus_ty_body TArob { m } plus_exp_main: plus_exp_body EOF { $1 } | p=plus_exp_body TArobArob { p } | p=plus_exp_body TArob { p } plus_ty_main: plus_exp_body EOF { $1 } | p=plus_ty_body TArobArob { p } | p=plus_ty_body TArob { p } meta_main: m=metadec { m (!Ast0.rule_name) } iso_meta_main: m=metadec { m "" } /***************************************************************************** * * *****************************************************************************/ pure: TPure { Ast0.Pure } | TContext { Ast0.Context } | TPure TContext { Ast0.PureContext } | TContext TPure { Ast0.PureContext } | /* empty */ { Ast0.Impure } iso_rule_name: nm=pure_ident TArob { P.make_iso_rule_name_result (P.id2name nm) } rule_name: nm=ioption(pure_ident) extends d=depends i=loption(choose_iso) a=loption(disable) e=exists ee=is_expression TArob { P.make_cocci_rule_name_result nm d i a e ee } | TGenerated extends d=depends i=loption(choose_iso) a=loption(disable) e=exists ee=is_expression TArob /* these rules have no name as a cheap way to ensure that no normal rule inherits their metavariables or depends on them */ { P.make_generated_rule_name_result None d i a e ee } | TScript TDotDot lang=pure_ident nm=ioption(pure_ident) d=depends TArob { P.make_script_rule_name_result lang nm d } | TInitialize TDotDot lang=pure_ident d=depends TArob { P.make_initial_script_rule_name_result lang d } | TFinalize TDotDot lang=pure_ident d=depends TArob { P.make_final_script_rule_name_result lang d } extends: /* empty */ { () } | TExtends parent=TRuleName { !Data.install_bindings (parent) } depends: /* empty */ { Ast0.NoDep } | TDepends TOn parents=dep { parents } dep: TRuleName { Ast0.Dep $1 } | TBang TRuleName { Ast0.AntiDep (Ast0.Dep $2) } | TBang TOPar dep TCPar { Ast0.AntiDep $3 } | TEver TRuleName { Ast0.EverDep $2 } | TNever TRuleName { Ast0.NeverDep $2 } | dep TAndLog dep { Ast0.AndDep($1, $3) } | dep TOrLog dep { Ast0.OrDep ($1, $3) } | TOPar dep TCPar { $2 } choose_iso: TUsing separated_nonempty_list(TComma,TString) { List.map P.id2name $2 } disable: TDisable separated_nonempty_list(TComma,pure_ident) { List.map P.id2name $2 } exists: TExists { Ast.Exists } | TForall { Ast.Forall } | { Ast.Undetermined } is_expression: // for more flexible parsing of top level expressions { Ast.AnyP } | TExpression { Ast.ExpP } | TType { Ast.TyP } include_main: list(incl) TArob { $1 } | list(incl) TArobArob { $1 } incl: TIncludeL { let (x,_) = $1 in Data.Include(x) } | TUsing TString { Data.Iso(Common.Left(P.id2name $2)) } | TUsing TPathIsoFile { Data.Iso(Common.Right $2) } | TVirtual comma_list(pure_ident) { let names = List.map P.id2name $2 in Iteration.parsed_virtual_rules := Common.union_set names !Iteration.parsed_virtual_rules; (* ensure that the names of virtual and real rules don't overlap *) List.iter (function name -> Hashtbl.add Data.all_metadecls name []) names; Data.Virt(names) } metadec: ar=arity ispure=pure kindfn=metakind ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_metadec ar ispure kindfn ids } | kindfn=metakind_fresh ids=comma_list(pure_ident_or_meta_ident_with_seed) TMPtVirg { P.create_fresh_metadec kindfn ids } | ar=arity ispure=pure kindfn=metakind_atomic_maybe_virt ids= comma_list(pure_ident_or_meta_ident_with_idconstraint_virt(re_or_not_eqid)) TMPtVirg { let (normal,virt) = Common.partition_either (fun x -> x) ids in let (idfn,virtfn) = kindfn in function cr -> (P.create_metadec_with_constraints ar ispure idfn normal cr) @ (P.create_metadec_virt ar ispure virtfn virt cr) } | ar=arity ispure=pure kindfn=metakind_atomic ids=comma_list(pure_ident_or_meta_ident_with_idconstraint(re_or_not_eqid)) TMPtVirg { P.create_metadec_with_constraints ar ispure kindfn ids } | ar=arity ispure=pure kindfn=metakind_atomic_expi ids=comma_list(pure_ident_or_meta_ident_with_econstraint(re_or_not_eqe_or_sub)) TMPtVirg { P.create_metadec_with_constraints ar ispure kindfn ids } | ar=arity ispure=pure kindfn=metakind_atomic_expe ids=comma_list(pure_ident_or_meta_ident_with_econstraint(not_ceq_or_sub)) TMPtVirg { P.create_metadec_with_constraints ar ispure kindfn ids } | ar=arity TPosition a=option(TPosAny) ids=comma_list(pure_ident_or_meta_ident_with_x_eq(not_pos)) TMPtVirg (* pb: position variables can't be inherited from normal rules, and then there is no way to inherit from a generated rule, so there is no point to have a position variable *) { (if !Data.in_generating then failwith "position variables not allowed in a generated rule file"); let kindfn arity name pure check_meta constraints = let tok = check_meta(Ast.MetaPosDecl(arity,name)) in let any = match a with None -> Ast.PER | Some _ -> Ast.ALL in !Data.add_pos_meta name constraints any; tok in P.create_metadec_with_constraints ar false kindfn ids } | ar=arity ispure=pure TParameter Tlist TOCro len=list_len TCCro ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_len_metadec ar ispure (fun lenname arity name pure check_meta -> let tok = check_meta(Ast.MetaParamListDecl(arity,name,lenname)) in !Data.add_paramlist_meta name lenname pure; tok) len ids } | ar=arity ispure=pure TExpression Tlist TOCro len=list_len TCCro ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_len_metadec ar ispure (fun lenname arity name pure check_meta -> let tok = check_meta(Ast.MetaExpListDecl(arity,name,lenname)) in !Data.add_explist_meta name lenname pure; tok) len ids } | ar=arity ispure=pure TField Tlist TOCro len=list_len TCCro ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_len_metadec ar ispure (fun lenname arity name pure check_meta -> let tok = check_meta(Ast.MetaFieldListDecl(arity,name,lenname)) in !Data.add_field_list_meta name lenname pure; tok) len ids } | ar=arity ispure=pure TInitialiser Tlist TOCro len=list_len TCCro ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_len_metadec ar ispure (fun lenname arity name pure check_meta -> let tok = check_meta(Ast.MetaInitListDecl(arity,name,lenname)) in !Data.add_initlist_meta name lenname pure; tok) len ids } | TSymbol ids=comma_list(pure_ident) TMPtVirg { (fun _ -> let add_sym = fun (nm,_) -> !Data.add_symbol_meta nm in List.iter add_sym ids; []) } | ar=arity TFormat ids=comma_list(pure_ident_or_meta_ident_with_idconstraint(re_only)) TMPtVirg { P.create_metadec_with_constraints ar Ast0.Impure (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaFmtDecl(arity,name)) in !Data.add_fmt_meta name constraints; tok) ids } | ar=arity TFormat Tlist ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_metadec ar Ast0.Impure (fun arity name pure check_meta -> let len = Ast.AnyLen in let tok = check_meta(Ast.MetaFragListDecl(arity,name,len)) in !Data.add_fmtlist_meta name len; tok) ids } | ar=arity TFormat Tlist TOCro len=list_len TCCro ids=comma_list(pure_ident_or_meta_ident) TMPtVirg { P.create_len_metadec ar Ast0.Impure (fun lenname arity name pure check_meta -> let tok = check_meta(Ast.MetaFragListDecl(arity,name,lenname)) in !Data.add_fmtlist_meta name lenname; tok) len ids } list_len: pure_ident_or_meta_ident { Common.Left $1 } | TInt { let (x,clt) = $1 in Common.Right (int_of_string x) } | TVirtual TDot pure_ident { let nm = ("virtual",P.id2name $3) in Iteration.parsed_virtual_identifiers := Common.union_set [snd nm] !Iteration.parsed_virtual_identifiers; try Common.Right (int_of_string (List.assoc (snd nm) !Flag.defined_virtual_env)) with Not_found | Failure "int_of_string" -> begin Common.Left (Some "virtual",P.id2name $3) end } %inline metakind_fresh: TFresh TIdentifier { (fun name check_meta seed -> let tok = check_meta(Ast.MetaFreshIdDecl(name,seed)) in !Data.add_fresh_id_meta name seed; tok) } /* metavariable kinds with no constraints, etc */ %inline metakind: TMetavariable { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaMetaDecl(arity,name)) in !Data.add_meta_meta name pure; tok) } | TParameter { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaParamDecl(arity,name)) in !Data.add_param_meta name pure; tok) } | TParameter Tlist { (fun arity name pure check_meta -> let len = Ast.AnyLen in let tok = check_meta(Ast.MetaParamListDecl(arity,name,len)) in !Data.add_paramlist_meta name len pure; tok) } | TExpression Tlist { (fun arity name pure check_meta -> let len = Ast.AnyLen in let tok = check_meta(Ast.MetaExpListDecl(arity,name,len)) in !Data.add_explist_meta name len pure; tok) } | TType { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaTypeDecl(arity,name)) in !Data.add_type_meta name pure; tok) } | TInitialiser { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaInitDecl(arity,name)) in !Data.add_init_meta name pure; tok) } | TInitialiser Tlist { (fun arity name pure check_meta -> let len = Ast.AnyLen in let tok = check_meta(Ast.MetaInitListDecl(arity,name,len)) in !Data.add_initlist_meta name len pure; tok) } | TStatement { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaStmDecl(arity,name)) in !Data.add_stm_meta name pure; tok) } | TDeclaration { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaDeclDecl(arity,name)) in !Data.add_decl_meta name pure; tok) } | TField { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaFieldDecl(arity,name)) in !Data.add_field_meta name pure; tok) } | TField Tlist { (fun arity name pure check_meta -> let len = Ast.AnyLen in let tok = check_meta(Ast.MetaFieldListDecl(arity,name,len)) in !Data.add_field_list_meta name len pure; tok) } | TStatement Tlist { (fun arity name pure check_meta -> let tok = check_meta(Ast.MetaStmListDecl(arity,name)) in !Data.add_stmlist_meta name pure; tok) } | TTypedef { (fun arity (_,name) pure check_meta -> if arity = Ast.NONE && pure = Ast0.Impure then (!Data.add_type_name name; []) else raise (Semantic_cocci.Semantic "bad typedef")) } | TDeclarer TName { (fun arity (_,name) pure check_meta -> if arity = Ast.NONE && pure = Ast0.Impure then (!Data.add_declarer_name name; []) else raise (Semantic_cocci.Semantic "bad declarer")) } | TIterator TName { (fun arity (_,name) pure check_meta -> if arity = Ast.NONE && pure = Ast0.Impure then (!Data.add_iterator_name name; []) else raise (Semantic_cocci.Semantic "bad iterator")) } %inline metakind_atomic_maybe_virt: TIdentifier { let idfn arity name pure check_meta constraints = let tok = check_meta(Ast.MetaIdDecl(arity,name)) in !Data.add_id_meta name constraints pure; tok in let virtfn arity name pure check_meta virtual_env = try let vl = List.assoc name virtual_env in !Data.add_virt_id_meta_found name vl; [] with Not_found -> Iteration.parsed_virtual_identifiers := Common.union_set [name] !Iteration.parsed_virtual_identifiers; let name = ("virtual",name) in let tok = check_meta(Ast.MetaIdDecl(arity,name)) in !Data.add_virt_id_meta_not_found name pure; tok in (idfn,virtfn) } %inline metakind_atomic: TFunction { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaFuncDecl(arity,name)) in !Data.add_func_meta name constraints pure; tok) } | TLocal TFunction { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaLocalFuncDecl(arity,name)) in !Data.add_local_func_meta name constraints pure; tok) } | TDeclarer { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaDeclarerDecl(arity,name)) in !Data.add_declarer_meta name constraints pure; tok) } | TIterator { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaIteratorDecl(arity,name)) in !Data.add_iterator_meta name constraints pure; tok) } %inline metakind_atomic_expi: TError { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaErrDecl(arity,name)) in !Data.add_err_meta name constraints pure; tok) } | l=option(TLocal) TIdExpression ty=ioption(meta_exp_type) { (fun arity name pure check_meta constraints -> match l with None -> !Data.add_idexp_meta ty name constraints pure; check_meta(Ast.MetaIdExpDecl(arity,name,ty)) | Some _ -> !Data.add_local_idexp_meta ty name constraints pure; check_meta(Ast.MetaLocalIdExpDecl(arity,name,ty))) } | l=option(TLocal) TIdExpression m=nonempty_list(TMul) { (fun arity name pure check_meta constraints -> let ty = Some [P.ty_pointerify Type_cocci.Unknown m] in match l with None -> !Data.add_idexp_meta ty name constraints pure; check_meta(Ast.MetaIdExpDecl(arity,name,ty)) | Some _ -> !Data.add_local_idexp_meta ty name constraints pure; check_meta(Ast.MetaLocalIdExpDecl(arity,name,ty))) } | TExpression ty=expression_type { (fun arity name pure check_meta constraints -> let ty = Some [ty] in let tok = check_meta(Ast.MetaExpDecl(arity,name,ty)) in !Data.add_exp_meta ty name constraints pure; tok) } | TConstant ty=ioption(meta_exp_type) { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaConstDecl(arity,name,ty)) in !Data.add_const_meta ty name constraints pure; tok) } expression_type: m=nonempty_list(TMul) { P.ty_pointerify Type_cocci.Unknown m } | Tenum m=list(TMul) { P.ty_pointerify (Type_cocci.EnumName Type_cocci.NoName) m } | Tstruct m=list(TMul) { P.ty_pointerify (Type_cocci.StructUnionName (Type_cocci.Struct,Type_cocci.NoName)) m } | Tunion m=list(TMul) { P.ty_pointerify (Type_cocci.StructUnionName (Type_cocci.Union,Type_cocci.NoName)) m } %inline metakind_atomic_expe: TExpression { (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaExpDecl(arity,name,None)) in !Data.add_exp_meta None name constraints pure; tok) } | vl=meta_exp_type // no error if use $1 but doesn't type check { (fun arity name pure check_meta constraints -> let ty = Some vl in (match constraints with Ast0.NotExpCstrt constraints -> List.iter (function c -> match Ast0.unwrap c with Ast0.Constant(_) -> if not (List.exists (function Type_cocci.BaseType(Type_cocci.IntType) -> true | Type_cocci.BaseType(Type_cocci.ShortType) -> true | Type_cocci.BaseType(Type_cocci.LongType) -> true | _ -> false) vl) then failwith "metavariable with int constraint must be an int" | _ -> ()) constraints | _ -> ()); let tok = check_meta(Ast.MetaExpDecl(arity,name,ty)) in !Data.add_exp_meta ty name constraints pure; tok) } meta_exp_type: t=typedef_ctype { [Ast0_cocci.ast0_type_to_type t] } | t=typedef_ctype TOCro TCCro { [Type_cocci.Array (Ast0_cocci.ast0_type_to_type t)] } | TOBrace t=comma_list(ctype) TCBrace m=list(TMul) { List.map (function x -> P.ty_pointerify (Ast0_cocci.ast0_type_to_type x) m) t } arity: TBang0 { Ast.UNIQUE } | TWhy0 { Ast.OPT } | TPlus0 { Ast.MULTI } | /* empty */ { Ast.NONE } /* ---------------------------------------------------------------------- */ signable_types: ty=Tchar { Ast0.wrap(Ast0.BaseType(Ast.CharType,[P.clt2mcode "char" ty])) } | ty=Tshort { Ast0.wrap(Ast0.BaseType(Ast.ShortType,[P.clt2mcode "short" ty])) } | ty1=Tshort ty2=Tint { Ast0.wrap (Ast0.BaseType (Ast.ShortIntType,[P.clt2mcode "short" ty1;P.clt2mcode "int" ty2])) } | ty=Tint { Ast0.wrap(Ast0.BaseType(Ast.IntType,[P.clt2mcode "int" ty])) } | p=TMetaType { let (nm,pure,clt) = p in Ast0.wrap(Ast0.MetaType(P.clt2mcode nm clt,pure)) } | r=TRuleName TDot p=TIdent { let nm = (r,P.id2name p) in (* this is only possible when we are in a metavar decl. Otherwise, it will be represented already as a MetaType *) let _ = P.check_meta(Ast.MetaTypeDecl(Ast.NONE,nm)) in Ast0.wrap(Ast0.MetaType(P.clt2mcode nm (P.id2clt p), Ast0.Impure (*will be ignored*))) } | ty1=Tlong { Ast0.wrap(Ast0.BaseType(Ast.LongType,[P.clt2mcode "long" ty1])) } | ty1=Tlong ty2=Tint { Ast0.wrap (Ast0.BaseType (Ast.LongIntType,[P.clt2mcode "long" ty1;P.clt2mcode "int" ty2])) } | ty1=Tlong ty2=Tlong { Ast0.wrap (Ast0.BaseType (Ast.LongLongType, [P.clt2mcode "long" ty1;P.clt2mcode "long" ty2])) } | ty1=Tlong ty2=Tlong ty3=Tint { Ast0.wrap (Ast0.BaseType (Ast.LongLongIntType, [P.clt2mcode "long" ty1;P.clt2mcode "long" ty2; P.clt2mcode "int" ty3])) } non_signable_types: ty=Tvoid { Ast0.wrap(Ast0.BaseType(Ast.VoidType,[P.clt2mcode "void" ty])) } | ty1=Tlong ty2=Tdouble { Ast0.wrap (Ast0.BaseType (Ast.LongDoubleType, [P.clt2mcode "long" ty1;P.clt2mcode "double" ty2])) } | ty=Tdouble { Ast0.wrap(Ast0.BaseType(Ast.DoubleType,[P.clt2mcode "double" ty])) } | ty=Tfloat { Ast0.wrap(Ast0.BaseType(Ast.FloatType,[P.clt2mcode "float" ty])) } | ty=Tsize_t { Ast0.wrap(Ast0.BaseType(Ast.SizeType,[P.clt2mcode "size_t" ty])) } | ty=Tssize_t { Ast0.wrap(Ast0.BaseType(Ast.SSizeType,[P.clt2mcode "ssize_t" ty])) } | ty=Tptrdiff_t { Ast0.wrap(Ast0.BaseType(Ast.PtrDiffType,[P.clt2mcode "ptrdiff_t" ty])) } | s=Tenum i=ident { Ast0.wrap(Ast0.EnumName(P.clt2mcode "enum" s, Some i)) } | s=Tenum i=ioption(ident) l=TOBrace ids=enum_decl_list r=TCBrace { (if i = None && !Data.in_iso then failwith "enums must be named in the iso file"); Ast0.wrap(Ast0.EnumDef(Ast0.wrap(Ast0.EnumName(P.clt2mcode "enum" s, i)), P.clt2mcode "{" l, ids, P.clt2mcode "}" r)) } | s=struct_or_union i=type_ident // allow typedef name { Ast0.wrap(Ast0.StructUnionName(s, Some i)) } | s=struct_or_union i=ioption(type_ident) l=TOBrace d=struct_decl_list r=TCBrace { (if i = None && !Data.in_iso then failwith "structures must be named in the iso file"); Ast0.wrap(Ast0.StructUnionDef(Ast0.wrap(Ast0.StructUnionName(s, i)), P.clt2mcode "{" l, d, P.clt2mcode "}" r)) } | s=TMetaType l=TOBrace d=struct_decl_list r=TCBrace { let (nm,pure,clt) = s in let ty = Ast0.wrap(Ast0.MetaType(P.clt2mcode nm clt,pure)) in Ast0.wrap(Ast0.StructUnionDef(ty,P.clt2mcode "{" l,d,P.clt2mcode "}" r)) } | p=TTypeId { Ast0.wrap(Ast0.TypeName(P.id2mcode p)) } | Tdecimal TOPar enum_val TComma enum_val TCPar { Ast0.wrap(Ast0.Decimal(P.clt2mcode "decimal" $1, P.clt2mcode "(" $2,$3, Some (P.clt2mcode "," $4), Some $5, P.clt2mcode ")" $6)) } | Tdecimal TOPar enum_val TCPar { Ast0.wrap(Ast0.Decimal(P.clt2mcode "decimal" $1, P.clt2mcode "(" $2,$3,None,None, P.clt2mcode ")" $4)) } all_basic_types: r=Tsigned ty=signable_types { Ast0.wrap(Ast0.Signed(P.clt2mcode Ast.Signed r,Some ty)) } | r=Tunsigned ty=signable_types { Ast0.wrap(Ast0.Signed(P.clt2mcode Ast.Unsigned r,Some ty)) } | ty=signable_types { ty } | ty=non_signable_types { ty } top_ctype: ctype { Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Ty($1)))) } ctype: cv=ioption(const_vol) ty=all_basic_types m=list(mul) { List.fold_left (function prev -> function (star,cv) -> P.make_cv cv (P.pointerify prev [star])) (P.make_cv cv ty) m } | r=Tsigned { Ast0.wrap(Ast0.Signed(P.clt2mcode Ast.Signed r,None)) } | r=Tunsigned { Ast0.wrap(Ast0.Signed(P.clt2mcode Ast.Unsigned r,None)) } | lp=TOPar0 t=midzero_list(ctype,ctype) rp=TCPar0 { let (mids,code) = t in Ast0.wrap (Ast0.DisjType(P.clt2mcode "(" lp,code,mids, P.clt2mcode ")" rp)) } mul: a=TMul b=ioption(const_vol) { (a,b) } mctype: | TMeta { tmeta_to_type $1 } | ctype {$1} /* signed, unsigned alone not allowed */ typedef_ctype: cv=ioption(const_vol) ty=all_basic_types m=list(TMul) { P.pointerify (P.make_cv cv ty) m } | lp=TOPar0 t=midzero_list(mctype,mctype) rp=TCPar0 { let (mids,code) = t in Ast0.wrap (Ast0.DisjType(P.clt2mcode "(" lp,code,mids, P.clt2mcode ")" rp)) } | TMeta { tmeta_to_type $1 } /* ---------------------------------------------------------------------- */ struct_or_union: s=Tstruct { P.clt2mcode Ast.Struct s } | u=Tunion { P.clt2mcode Ast.Union u } struct_decl: TNothing { [] } | struct_decl_one { [$1] } struct_decl_one: | TMetaField { P.meta_field $1 } | TMetaFieldList { P.meta_field_list $1 } | TMeta { tmeta_to_field $1 } | lp=TOPar0 t=midzero_list(struct_decl_one,struct_decl_one) rp=TCPar0 { let (mids,code) = t in Ast0.wrap (Ast0.DisjDecl(P.clt2mcode "(" lp,code,mids, P.clt2mcode ")" rp)) } | t=ctype d=d_ident pv=TPtVirg { let (id,fn) = d in Ast0.wrap(Ast0.UnInit(None,fn t,id,P.clt2mcode ";" pv)) } | t=ctype lp1=TOPar st=TMul d=d_ident rp1=TCPar lp2=TOPar p=decl_list(name_opt_decl) rp2=TCPar pv=TPtVirg { let (id,fn) = d in let t = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp1,P.clt2mcode "*" st,P.clt2mcode ")" rp1, P.clt2mcode "(" lp2,p,P.clt2mcode ")" rp2)) in Ast0.wrap(Ast0.UnInit(None,fn t,id,P.clt2mcode ";" pv)) } | cv=ioption(const_vol) i=pure_ident_or_symbol d=d_ident pv=TPtVirg { let (id,fn) = d in let idtype = P.make_cv cv (Ast0.wrap (Ast0.TypeName(P.id2mcode i))) in Ast0.wrap(Ast0.UnInit(None,fn idtype,id,P.clt2mcode ";" pv)) } struct_decl_list: struct_decl_list_start { Ast0.wrap(Ast0.DOTS($1)) } struct_decl_list_start: struct_decl { $1 } | struct_decl struct_decl_list_start { $1@$2 } | d=edots_when(TEllipsis,struct_decl_one) r=continue_struct_decl_list { (P.mkddots_one "..." d)::r } continue_struct_decl_list: /* empty */ { [] } | struct_decl struct_decl_list_start { $1@$2 } | struct_decl { $1 } /* ---------------------------------------------------------------------- */ /* very restricted what kinds of expressions can appear in an enum decl */ enum_decl_one: | disj_ident { Ast0.wrap(Ast0.Ident($1)) } | disj_ident TEq enum_val { let id = Ast0.wrap(Ast0.Ident($1)) in Ast0.wrap (Ast0.Assignment (id,P.clt2mcode Ast.SimpleAssign $2,Ast0.set_arg_exp $3, false)) } enum_val: ident { Ast0.wrap(Ast0.Ident($1)) } | TInt { let (x,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.Int x) clt)) } | TMeta { tmeta_to_exp $1 } | TMetaConst { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.CONST,pure)) } | TMetaExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ANY,pure)) } | TMetaIdExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ID,pure)) } enum_decl_list: nonempty_list_start(enum_decl_one,edots_when(TEllipsis,enum_decl_one)) { Ast0.wrap(Ast0.DOTS($1 P.mkedots (fun c -> Ast0.EComma c))) } /*****************************************************************************/ /* have to inline everything to avoid conflicts? switch to proper declarations, statements, and expressions for the subterms */ minus_body: f=loption(filespec) b=loption(minus_start) /*ew=loption(error_words)*/ { match f@b(*@ew*) with [] -> raise (Semantic_cocci.Semantic "minus slice can't be empty") | code -> code } plus_body: f=loption(filespec) b=loption(plus_start) /*ew=loption(error_words)*/ { f@b(*@ew*) } minus_exp_body: f=loption(filespec) b=top_eexpr /*ew=loption(error_words)*/ { match f@[b](*@ew*) with [] -> raise (Semantic_cocci.Semantic "minus slice can't be empty") | code -> code } plus_exp_body: f=loption(filespec) b=top_eexpr /*ew=loption(error_words)*/ { f@[b](*@ew*) } minus_ty_body: f=loption(filespec) b=top_ctype /*ew=loption(error_words)*/ { match f@[b](*@ew*) with [] -> raise (Semantic_cocci.Semantic "minus slice can't be empty") | code -> code } plus_ty_body: f=loption(filespec) b=top_ctype /*ew=loption(error_words)*/ { f@[b](*@ew*) } filespec: TMinusFile TPlusFile { [Ast0.wrap (Ast0.FILEINFO(P.id2mcode $1, P.id2mcode $2))] } includes: TIncludeL { Ast0.wrap (Ast0.Include(P.clt2mcode "#include" (P.drop_pos (P.drop_aft (P.id2clt $1))), let (arity,ln,lln,offset,col,strbef,straft,pos) = P.id2clt $1 in let clt = (arity,ln,lln,offset,0,strbef,straft,pos) in P.clt2mcode (Ast.Local (Parse_aux.str2inc (P.id2name $1))) (P.drop_bef clt))) } | TIncludeNL { Ast0.wrap (Ast0.Include(P.clt2mcode "#include" (P.drop_pos (P.drop_aft (P.id2clt $1))), let (arity,ln,lln,offset,col,strbef,straft,pos) = P.id2clt $1 in let clt = (arity,ln,lln,offset,0,strbef,straft,pos) in P.clt2mcode (Ast.NonLocal (Parse_aux.str2inc (P.id2name $1))) (P.drop_bef clt))) } | TUndef TLineEnd { let (clt,ident) = $1 in let aft = P.get_aft clt in (* move stuff after the define to the ident *) Ast0.wrap (Ast0.Undef (P.clt2mcode "#undef" (P.drop_aft clt), (match ident with TMetaId((nm,constraints,seed,pure,clt)) -> let clt = P.set_aft aft clt in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) | TIdent((nm,clt)) -> let clt = P.set_aft aft clt in Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | TSymId(nm,clt) -> let clt = P.set_aft aft clt in Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | _ -> raise (Semantic_cocci.Semantic "unexpected name for a #define")))) } | d=defineop TLineEnd { d (Ast0.wrap(Ast0.DOTS([]))) } | d=defineop t=ctype TLineEnd { let ty = Ast0.wrap(Ast0.TopExp(Ast0.wrap(Ast0.TypeExp(t)))) in d (Ast0.wrap(Ast0.DOTS([ty]))) } | defineop b=toplevel_seq_start(toplevel_after_dots) TLineEnd { let body = match b with [e] -> (match Ast0.unwrap e with Ast0.Exp(e1) -> [Ast0.rewrap e (Ast0.TopExp(Ast0.set_arg_exp (e1)))] | _ -> b) | _ -> b in $1 (Ast0.wrap(Ast0.DOTS(body))) } | TPragma ident_or_kwd pragmabody TLineEnd { Ast0.wrap(Ast0.Pragma(P.clt2mcode "#pragma" $1, $2, $3)) } pragmabody: TOPar eexpr_list_option TCPar { Ast0.wrap(Ast0.PragmaTuple(P.clt2mcode "(" $1,$2,P.clt2mcode ")" $3)) } | l=nonempty_list(ident) { Ast0.wrap(Ast0.PragmaIdList(Ast0.wrap (Ast0.DOTS l))) } | TEllipsis { Ast0.wrap(Ast0.PragmaDots(P.clt2mcode "..." $1)) } defineop: TDefine { let (clt,ident) = $1 in let aft = P.get_aft clt in (* move stuff after the define to the ident *) function body -> Ast0.wrap (Ast0.Define (P.clt2mcode "#define" (P.drop_aft clt), (match ident with TMetaId((nm,constraints,seed,pure,clt)) -> let clt = P.set_aft aft clt in Ast0.wrap (Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) | TIdent((nm,clt)) -> let clt = P.set_aft aft clt in Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | TSymId(nm,clt) -> let clt = P.set_aft aft clt in Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | _ -> raise (Semantic_cocci.Semantic "unexpected name for a #define")), Ast0.wrap Ast0.NoParams, body)) } | TDefineParam define_param_list_option TCPar { let (clt,ident,parenoff,parencol) = $1 in let aft = P.get_aft clt in (* move stuff after the define to the ( *) (* clt is the start of the #define itself *) let (arity,line,lline,offset,col,strbef,straft,pos) = clt in let lp = P.clt2mcode "(" (arity,line,lline,parenoff,parencol,[],[],[]) in function body -> Ast0.wrap (Ast0.Define (P.clt2mcode "#define" (P.drop_aft clt), (match ident with TMetaId((nm,constraints,seed,pure,clt)) -> Ast0.wrap (Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) | TIdent((nm,clt)) -> Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | TSymId(nm,clt) -> Ast0.wrap(Ast0.Id(P.clt2mcode nm clt)) | _ -> raise (Semantic_cocci.Semantic "unexpected name for a #define")), (let clt = P.set_aft aft $3 in Ast0.wrap (Ast0.DParams (lp,$2,P.clt2mcode ")" clt))),body)) } /* ---------------------------------------------------------------------- */ dparam: mident { Ast0.wrap(Ast0.DParam $1) } define_param_list_option: empty_list_start(dparam,TEllipsis) { Ast0.wrap (Ast0.DOTS ($1 (fun _ d -> Ast0.wrap(Ast0.DPdots(P.clt2mcode "," d))) (fun c -> Ast0.DPComma c))) } /*****************************************************************************/ funproto: s=ioption(storage) t=ctype id=fn_ident lp=TOPar d=decl_list(name_opt_decl) rp=TCPar pt=TPtVirg { Ast0.wrap (Ast0.UnInit (s, Ast0.wrap (Ast0.FunctionType(Some t, P.clt2mcode "(" lp, d, P.clt2mcode ")" rp)), id, P.clt2mcode ";" pt)) } fundecl: f=fninfo TFunDecl i=fn_ident lp=TOPar d=decl_list(decl) rp=TCPar lb=TOBrace b=fun_start rb=TCBrace { Ast0.wrap(Ast0.FunDecl((Ast0.default_info(),Ast0.context_befaft()), f, i, P.clt2mcode "(" lp, d, P.clt2mcode ")" rp, P.clt2mcode "{" lb, b, P.clt2mcode "}" rb)) } fninfo: /* empty */ { [] } | storage fninfo { try let _ = List.find (function Ast0.FStorage(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "duplicate storage") with Not_found -> (Ast0.FStorage($1))::$2 } | t=ctype r=fninfo_nt { (Ast0.FType(t))::r } | Tinline fninfo { try let _ = List.find (function Ast0.FInline(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "duplicate inline") with Not_found -> (Ast0.FInline(P.clt2mcode "inline" $1))::$2 } | Tattr fninfo { try let _ = List.find (function Ast0.FAttr(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "multiple attributes") with Not_found -> (Ast0.FAttr(P.id2mcode $1))::$2 } fninfo_nt: /* empty */ { [] } | storage fninfo_nt { try let _ = List.find (function Ast0.FStorage(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "duplicate storage") with Not_found -> (Ast0.FStorage($1))::$2 } | Tinline fninfo_nt { try let _ = List.find (function Ast0.FInline(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "duplicate inline") with Not_found -> (Ast0.FInline(P.clt2mcode "inline" $1))::$2 } | Tattr fninfo_nt { try let _ = List.find (function Ast0.FAttr(_) -> true | _ -> false) $2 in raise (Semantic_cocci.Semantic "duplicate init") with Not_found -> (Ast0.FAttr(P.id2mcode $1))::$2 } storage: s=Tstatic { P.clt2mcode Ast.Static s } | s=Tauto { P.clt2mcode Ast.Auto s } | s=Tregister { P.clt2mcode Ast.Register s } | s=Textern { P.clt2mcode Ast.Extern s } decl: t=ctype i=disj_ident a=list(array_dec) { let t = P.arrayify t a in Ast0.wrap(Ast0.Param(t, Some i)) } | t=ctype { (*verify in FunDecl*) Ast0.wrap(Ast0.Param(t, None)) } | t=ctype lp=TOPar s=TMul i=disj_ident rp=TCPar lp1=TOPar d=decl_list(name_opt_decl) rp1=TCPar { let fnptr = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp,P.clt2mcode "*" s,P.clt2mcode ")" rp, P.clt2mcode "(" lp1,d,P.clt2mcode ")" rp1)) in Ast0.wrap(Ast0.Param(fnptr, Some i)) } | TMetaParam { let (nm,pure,clt) = $1 in Ast0.wrap(Ast0.MetaParam(P.clt2mcode nm clt,pure)) } | TMeta { tmeta_to_param $1 } name_opt_decl: decl { $1 } | t=ctype lp=TOPar s=TMul rp=TCPar lp1=TOPar d=decl_list(name_opt_decl) rp1=TCPar { let fnptr = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp,P.clt2mcode "*" s,P.clt2mcode ")" rp, P.clt2mcode "(" lp1,d,P.clt2mcode ")" rp1)) in Ast0.wrap(Ast0.Param(fnptr, None)) } const_vol: Tconst { P.clt2mcode Ast.Const $1 } | Tvolatile { P.clt2mcode Ast.Volatile $1 } /*****************************************************************************/ statement: includes { $1 } /* shouldn't be allowed to be a single_statement... */ | TMeta { tmeta_to_statement $1} | TMetaStm { P.meta_stm $1 } | option(expr) TPtVirg { P.exp_stm $1 $2 } | TIf TOPar eexpr TCPar single_statement %prec TIf { P.ifthen $1 $2 $3 $4 $5 } | TIf TOPar eexpr TCPar single_statement TElse single_statement { P.ifthenelse $1 $2 $3 $4 $5 $6 $7 } | TFor TOPar option(eexpr) TPtVirg option(eexpr) TPtVirg option(eexpr) TCPar single_statement { P.forloop $1 $2 $3 $4 $5 $6 $7 $8 $9 } | TFor TOPar one_decl_var option(eexpr) TPtVirg option(eexpr) TCPar single_statement { P.forloop2 $1 $2 $3 $4 $5 $6 $7 $8 } | TWhile TOPar eexpr TCPar single_statement { P.whileloop $1 $2 $3 $4 $5 } | TDo single_statement TWhile TOPar eexpr TCPar TPtVirg { P.doloop $1 $2 $3 $4 $5 $6 $7 } | iter_ident TOPar eexpr_list_option TCPar single_statement { P.iterator $1 $2 $3 $4 $5 } | TSwitch TOPar eexpr TCPar TOBrace list(decl_var) list(case_line) TCBrace { P.switch $1 $2 $3 $4 $5 (List.concat $6) $7 $8 } | TReturn eexpr TPtVirg { P.ret_exp $1 $2 $3 } | TReturn TPtVirg { P.ret $1 $2 } | TBreak TPtVirg { P.break $1 $2 } | TContinue TPtVirg { P.cont $1 $2 } | mident TDotDot { P.label $1 $2 } | TGoto disj_ident TPtVirg { P.goto $1 $2 $3 } | TOBrace fun_start TCBrace { P.seq $1 $2 $3 } stm_dots: TEllipsis w=list(whenppdecs) { Ast0.wrap(Ast0.Dots(P.clt2mcode "..." $1, List.concat w)) } | TOEllipsis w=list(whenppdecs) b=nest_start c=TCEllipsis { Ast0.wrap(Ast0.Nest(P.clt2mcode "<..." $1, b, P.clt2mcode "...>" c, List.concat w, false)) } | TPOEllipsis w=list(whenppdecs) b=nest_start c=TPCEllipsis { Ast0.wrap(Ast0.Nest(P.clt2mcode "<+..." $1, b, P.clt2mcode "...+>" c, List.concat w, true)) } %inline stm_dots_ell: a=TEllipsis w=list(whenppdecs) { Ast0.wrap(Ast0.Dots(P.clt2mcode "..." a, List.concat w)) } %inline stm_dots_nest: a=TOEllipsis w=list(whenppdecs) b=nest_start c=TCEllipsis { Ast0.wrap(Ast0.Nest(P.clt2mcode "<..." a, b, P.clt2mcode "...>" c, List.concat w, false)) } | a=TPOEllipsis w=list(whenppdecs) b=nest_start c=TPCEllipsis { Ast0.wrap(Ast0.Nest(P.clt2mcode "<+..." a, b, P.clt2mcode "...+>" c, List.concat w, true)) } whenppdecs: w=whens(when_start,rule_elem_statement,any_strict) { w } /* a statement that fits into a single rule_elem. should nests be included? what about statement metavariables? */ rule_elem_statement: one_decl_var { Ast0.wrap(Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),$1)) } | option(expr) TPtVirg { P.exp_stm $1 $2 } | TReturn eexpr TPtVirg { P.ret_exp $1 $2 $3 } | TReturn TPtVirg { P.ret $1 $2 } | TBreak TPtVirg { P.break $1 $2 } | TContinue TPtVirg { P.cont $1 $2 } | TOPar0 midzero_list(rule_elem_statement,rule_elem_statement) TCPar0 { let (mids,code) = $2 in Ast0.wrap (Ast0.Disj(P.clt2mcode "(" $1, List.map (function x -> Ast0.wrap(Ast0.DOTS([x]))) code, mids, P.clt2mcode ")" $3)) } /* a statement on its own */ single_statement: statement { $1 } | TOPar0 midzero_list(statement,statement) TCPar0 /* degenerate case, elements are single statements and thus don't contain dots */ { let (mids,code) = $2 in Ast0.wrap (Ast0.Disj(P.clt2mcode "(" $1, List.map (function x -> Ast0.wrap(Ast0.DOTS([x]))) code, mids, P.clt2mcode ")" $3)) } iso_statement: /* statement or declaration used in statement context */ statement { $1 } | decl_var { match $1 with [decl] -> Ast0.wrap (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),decl)) | _ -> failwith "exactly one decl allowed in statement iso" } case_line: TDefault TDotDot fun_start { Ast0.wrap (Ast0.Default(P.clt2mcode "default" $1,P.clt2mcode ":" $2,$3)) } | TCase eexpr TDotDot fun_start { Ast0.wrap(Ast0.Case(P.clt2mcode "case" $1,$2,P.clt2mcode ":" $3,$4)) } /* | lp=TOPar0 t=midzero_list(case_line,case_line) rp=TCPar0 { let (mids,code) = ([],[t]) in Ast0.wrap (Ast0.DisjCase(P.clt2mcode "(" lp,code,mids, P.clt2mcode ")" rp)) } */ /* In the following, an identifier as a type is not fully supported. Indeed, the language is ambiguous: what is foo * bar; */ /* The AST DisjDecl cannot be generated because it would be ambiguous with a disjunction on a statement with a declaration in each branch */ decl_var: t=ctype pv=TPtVirg { [Ast0.wrap(Ast0.TyDecl(t,P.clt2mcode ";" pv))] } | TMetaDecl { [P.meta_decl $1] } | s=ioption(storage) t=ctype d=comma_list(d_ident) pv=TPtVirg { List.map (function (id,fn) -> Ast0.wrap(Ast0.UnInit(s,fn t,id,P.clt2mcode ";" pv))) d } | f=funproto { [f] } | s=ioption(storage) t=ctype d=d_ident q=TEq e=initialize pv=TPtVirg {let (id,fn) = d in [Ast0.wrap(Ast0.Init(s,fn t,id,P.clt2mcode "=" q,e,P.clt2mcode ";" pv))]} /* type is a typedef name */ | s=ioption(storage) cv=ioption(const_vol) i=pure_ident_or_symbol d=comma_list(d_ident) pv=TPtVirg { List.map (function (id,fn) -> let idtype = P.make_cv cv (Ast0.wrap (Ast0.TypeName(P.id2mcode i))) in Ast0.wrap(Ast0.UnInit(s,fn idtype,id,P.clt2mcode ";" pv))) d } | s=ioption(storage) cv=ioption(const_vol) i=pure_ident_or_symbol d=d_ident q=TEq e=initialize pv=TPtVirg { let (id,fn) = d in !Data.add_type_name (P.id2name i); let idtype = P.make_cv cv (Ast0.wrap (Ast0.TypeName(P.id2mcode i))) in [Ast0.wrap(Ast0.Init(s,fn idtype,id,P.clt2mcode "=" q,e, P.clt2mcode ";" pv))] } /* function pointer type */ | s=ioption(storage) t=ctype lp1=TOPar st=TMul d=d_ident rp1=TCPar lp2=TOPar p=decl_list(name_opt_decl) rp2=TCPar pv=TPtVirg { let (id,fn) = d in let t = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp1,P.clt2mcode "*" st,P.clt2mcode ")" rp1, P.clt2mcode "(" lp2,p,P.clt2mcode ")" rp2)) in [Ast0.wrap(Ast0.UnInit(s,fn t,id,P.clt2mcode ";" pv))] } | decl_ident TOPar eexpr_list_option TCPar TPtVirg { [Ast0.wrap(Ast0.MacroDecl($1,P.clt2mcode "(" $2,$3, P.clt2mcode ")" $4,P.clt2mcode ";" $5))] } | decl_ident TOPar eexpr_list_option TCPar q=TEq e=initialize TPtVirg { [Ast0.wrap (Ast0.MacroDeclInit ($1,P.clt2mcode "(" $2,$3, P.clt2mcode ")" $4,P.clt2mcode "=" q,e, P.clt2mcode ";" $7))] } | s=ioption(storage) t=ctype lp1=TOPar st=TMul d=d_ident rp1=TCPar lp2=TOPar p=decl_list(name_opt_decl) rp2=TCPar q=TEq e=initialize pv=TPtVirg { let (id,fn) = d in let t = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp1,P.clt2mcode "*" st,P.clt2mcode ")" rp1, P.clt2mcode "(" lp2,p,P.clt2mcode ")" rp2)) in [Ast0.wrap(Ast0.Init(s,fn t,id,P.clt2mcode "=" q,e,P.clt2mcode ";" pv))]} | s=Ttypedef t=typedef_ctype id=comma_list(typedef_ident) pv=TPtVirg { let s = P.clt2mcode "typedef" s in List.map (function id -> Ast0.wrap(Ast0.Typedef(s,t,id,P.clt2mcode ";" pv))) id } one_decl_var: t=ctype pv=TPtVirg { Ast0.wrap(Ast0.TyDecl(t,P.clt2mcode ";" pv)) } | TMetaDecl { P.meta_decl $1 } | s=ioption(storage) t=ctype d=d_ident pv=TPtVirg { let (id,fn) = d in Ast0.wrap(Ast0.UnInit(s,fn t,id,P.clt2mcode ";" pv)) } | f=funproto { f } | s=ioption(storage) t=ctype d=d_ident q=TEq e=initialize pv=TPtVirg { let (id,fn) = d in Ast0.wrap(Ast0.Init(s,fn t,id,P.clt2mcode "=" q,e,P.clt2mcode ";" pv)) } /* type is a typedef name */ | s=ioption(storage) cv=ioption(const_vol) i=pure_ident_or_symbol d=d_ident pv=TPtVirg { let (id,fn) = d in let idtype = P.make_cv cv (Ast0.wrap (Ast0.TypeName(P.id2mcode i))) in Ast0.wrap(Ast0.UnInit(s,fn idtype,id,P.clt2mcode ";" pv)) } | s=ioption(storage) cv=ioption(const_vol) i=pure_ident_or_symbol d=d_ident q=TEq e=initialize pv=TPtVirg { let (id,fn) = d in !Data.add_type_name (P.id2name i); let idtype = P.make_cv cv (Ast0.wrap (Ast0.TypeName(P.id2mcode i))) in Ast0.wrap(Ast0.Init(s,fn idtype,id,P.clt2mcode "=" q,e, P.clt2mcode ";" pv)) } /* function pointer type */ | s=ioption(storage) t=ctype lp1=TOPar st=TMul d=d_ident rp1=TCPar lp2=TOPar p=decl_list(name_opt_decl) rp2=TCPar pv=TPtVirg { let (id,fn) = d in let t = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp1,P.clt2mcode "*" st,P.clt2mcode ")" rp1, P.clt2mcode "(" lp2,p,P.clt2mcode ")" rp2)) in Ast0.wrap(Ast0.UnInit(s,fn t,id,P.clt2mcode ";" pv)) } | decl_ident TOPar eexpr_list_option TCPar TPtVirg { Ast0.wrap(Ast0.MacroDecl($1,P.clt2mcode "(" $2,$3, P.clt2mcode ")" $4,P.clt2mcode ";" $5)) } | decl_ident TOPar eexpr_list_option TCPar q=TEq e=initialize TPtVirg { Ast0.wrap (Ast0.MacroDeclInit ($1,P.clt2mcode "(" $2,$3, P.clt2mcode ")" $4,P.clt2mcode "=" q,e, P.clt2mcode ";" $7)) } | s=ioption(storage) t=ctype lp1=TOPar st=TMul d=d_ident rp1=TCPar lp2=TOPar p=decl_list(name_opt_decl) rp2=TCPar q=TEq e=initialize pv=TPtVirg { let (id,fn) = d in let t = Ast0.wrap (Ast0.FunctionPointer (t,P.clt2mcode "(" lp1,P.clt2mcode "*" st,P.clt2mcode ")" rp1, P.clt2mcode "(" lp2,p,P.clt2mcode ")" rp2)) in Ast0.wrap(Ast0.Init(s,fn t,id,P.clt2mcode "=" q,e,P.clt2mcode ";" pv))} d_ident: disj_ident list(array_dec) { ($1, function t -> P.arrayify t $2) } array_dec: l=TOCro i=option(eexpr) r=TCCro { (l,i,r) } initialize: eexpr { Ast0.wrap(Ast0.InitExpr($1)) } | TOBrace initialize_list TCBrace { if P.struct_initializer $2 then let il = P.drop_dot_commas $2 in Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,il,P.clt2mcode "}" $3,false)) else Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,$2,P.clt2mcode "}" $3,true)) } | TMetaInit {let (nm,pure,clt) = $1 in Ast0.wrap(Ast0.MetaInit(P.clt2mcode nm clt,pure)) } initialize2: /*arithexpr and not eexpr because can have ambiguity with comma*/ /*dots and nests probably not allowed at top level, haven't looked into why*/ arith_expr(eexpr,invalid) { Ast0.wrap(Ast0.InitExpr($1)) } | nest_expressions_only { Ast0.wrap(Ast0.InitExpr($1)) } | TOBrace initialize_list TCBrace { if P.struct_initializer $2 then let il = P.drop_dot_commas $2 in Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,il,P.clt2mcode "}" $3,false)) else Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,$2,P.clt2mcode "}" $3,true)) } /* gccext:, labeled elements */ | list(designator) TEq initialize2 /*can we have another of these on the rhs?*/ { Ast0.wrap(Ast0.InitGccExt($1,P.clt2mcode "=" $2,$3)) } | mident TDotDot initialize2 { Ast0.wrap(Ast0.InitGccName($1,P.clt2mcode ":" $2,$3)) } /* in old kernel */ | TMetaInit {let (nm,pure,clt) = $1 in Ast0.wrap(Ast0.MetaInit(P.clt2mcode nm clt,pure)) } | TMetaInitList {let (nm,lenname,pure,clt) = $1 in let nm = P.clt2mcode nm clt in let lenname = match lenname with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(P.clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in Ast0.wrap(Ast0.MetaInitList(nm,lenname,pure)) } designator: | TDot disj_ident { Ast0.DesignatorField (P.clt2mcode "." $1,$2) } | TOCro eexpr TCCro { Ast0.DesignatorIndex (P.clt2mcode "[" $1,$2,P.clt2mcode "]" $3) } | TOCro eexpr TEllipsis eexpr TCCro { Ast0.DesignatorRange (P.clt2mcode "[" $1,$2,P.clt2mcode "..." $3, $4,P.clt2mcode "]" $5) } initialize_list: empty_list_start(initialize2,edots_when(TEllipsis,initialize)) { Ast0.wrap(Ast0.DOTS($1 P.mkidots (fun c -> Ast0.IComma c))) } /* a statement that is part of a list */ decl_statement: TMetaStmList { let (nm,pure,clt) = $1 in [Ast0.wrap(Ast0.MetaStmt(P.clt2mcode nm clt,pure))] } | decl_var { List.map (function x -> Ast0.wrap (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),x))) $1 } | statement { [$1] } /* this doesn't allow expressions at top level, because the parser doesn't know whether there is one. If there is one, this is not sequencible. If there is not one, then it is. It seems complicated to get around this at the parser level. We would have to have a check afterwards to allow this. One case where this would be useful is for a when. Now we allow a sequence of whens, so one can be on only statements and one can be on only expressions. */ | TOPar0 t=midzero_list(fun_start,fun_start) TCPar0 { let (mids,code) = t in if List.for_all (function x -> match Ast0.unwrap x with Ast0.DOTS([]) -> true | _ -> false) code then [] else [Ast0.wrap(Ast0.Disj(P.clt2mcode "(" $1, code, mids, P.clt2mcode ")" $3))] } /* a statement that is part of a list */ decl_statement_expr: TMetaStmList { let (nm,pure,clt) = $1 in [Ast0.wrap(Ast0.MetaStmt(P.clt2mcode nm clt,pure))] } | decl_var { List.map (function x -> Ast0.wrap (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),x))) $1 } | statement { [$1] } /* this doesn't allow expressions at top level, because the parser doesn't know whether there is one. If there is one, this is not sequencible. If there is not one, then it is. It seems complicated to get around this at the parser level. We would have to have a check afterwards to allow this. One case where this would be useful is for a when. Now we allow a sequence of whens, so one can be on only statements and one can be on only expressions. */ | TOPar0 t=midzero_list(fun_after_stm,fun_after_dots_or) TCPar0 { let (mids,code) = t in if List.for_all (function [] -> true | _ -> false) code then [] else let dot_code = List.map (function x -> Ast0.wrap(Ast0.DOTS x)) code in [Ast0.wrap(Ast0.Disj(P.clt2mcode "(" $1, dot_code, mids, P.clt2mcode ")" $3))] } /*****************************************************************************/ /* expr cannot contain <... ...> at the top level. This can only be allowed as an expression when the expression is delimited on the left by an expression-specific marker. In that case, the rule eexpr is used, which allows <... ...> anywhere. Hopefully, this will not be too much of a problem in practice. dot_expressions is the most permissive. all three kinds of expressions use this once an expression_specific token has been seen The arg versions don't allow sequences, to avoid conflicting with commas in argument lists. */ expr: pre_basic_expr(expr,invalid) { $1 } /* allows ... and nests */ eexpr: pre_basic_expr(eexpr,dot_expressions) { $1 } eargexpr: basic_expr(eexpr,dot_expressions) { $1 } /* no sequences */ /* allows nests but not .... */ dexpr: pre_basic_expr(eexpr,nest_expressions) { $1 } dargexpr: basic_expr(eexpr,nest_expressions) { $1 } /* no sequences */ top_eexpr: eexpr { Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Exp($1)))) } invalid: TInvalid { raise (Semantic_cocci.Semantic "not matchable") } dot_expressions: TEllipsis { Ast0.wrap(Ast0.Edots(P.clt2mcode "..." $1,None)) } | nest_expressions { $1 } /* not clear what whencode would mean, so just drop it */ nest_expressions: TOEllipsis e=expr_dots(TEllipsis) c=TCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<..." $1, Ast0.wrap(Ast0.DOTS(e (P.mkedots "..."))), P.clt2mcode "...>" c, None, false)) } | TPOEllipsis e=expr_dots(TEllipsis) c=TPCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<+..." $1, Ast0.wrap(Ast0.DOTS(e (P.mkedots "..."))), P.clt2mcode "...+>" c, None, true)) } | TMeta { tmeta_to_exp $1 } nest_expressions_only: TOEllipsis e=expr_dots(TEllipsis) c=TCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<..." $1, Ast0.wrap(Ast0.DOTS(e (P.mkedots "..."))), P.clt2mcode "...>" c, None, false)) } | TPOEllipsis e=expr_dots(TEllipsis) c=TPCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<+..." $1, Ast0.wrap(Ast0.DOTS(e (P.mkedots "..."))), P.clt2mcode "...+>" c, None, true)) } //whenexp: TWhen TNotEq w=eexpr TLineEnd { w } pre_basic_expr(recurser,primary_extra): basic_expr(recurser,primary_extra) { $1 } | pre_basic_expr(recurser,primary_extra) TComma basic_expr(recurser,primary_extra) { Ast0.wrap(Ast0.Sequence($1,P.clt2mcode "," $2,$3)) } basic_expr(recurser,primary_extra): assign_expr(recurser,primary_extra) { $1 } assign_expr(r,pe): cond_expr(r,pe) { $1 } | unary_expr(r,pe) TAssign assign_expr_bis { let (op,clt) = $2 in Ast0.wrap(Ast0.Assignment($1,P.clt2mcode op clt, Ast0.set_arg_exp $3,false)) } | unary_expr(r,pe) TEq assign_expr_bis { Ast0.wrap (Ast0.Assignment ($1,P.clt2mcode Ast.SimpleAssign $2,Ast0.set_arg_exp $3,false)) } assign_expr_bis: cond_expr(eexpr,dot_expressions) { $1 } | unary_expr(eexpr,dot_expressions) TAssign assign_expr_bis { let (op,clt) = $2 in Ast0.wrap(Ast0.Assignment($1,P.clt2mcode op clt, Ast0.set_arg_exp $3,false)) } | unary_expr(eexpr,dot_expressions) TEq assign_expr_bis { Ast0.wrap (Ast0.Assignment ($1,P.clt2mcode Ast.SimpleAssign $2,Ast0.set_arg_exp $3,false)) } cond_expr(r,pe): arith_expr(r,pe) { $1 } | l=arith_expr(r,pe) w=TWhy t=option(eexpr) dd=TDotDot r=eargexpr/*see parser_c*/ { Ast0.wrap(Ast0.CondExpr (l, P.clt2mcode "?" w, t, P.clt2mcode ":" dd, r)) } arith_expr(r,pe): cast_expr(r,pe) { $1 } | arith_expr(r,pe) TMul arith_expr_bis { P.arith_op Ast.Mul $1 $2 $3 } | arith_expr(r,pe) TDmOp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr(r,pe) TPlus arith_expr_bis { P.arith_op Ast.Plus $1 $2 $3 } | arith_expr(r,pe) TMinus arith_expr_bis { P.arith_op Ast.Minus $1 $2 $3 } | arith_expr(r,pe) TShLOp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr(r,pe) TShROp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr(r,pe) TLogOp arith_expr_bis { let (op,clt) = $2 in P.logic_op op $1 clt $3 } | arith_expr(r,pe) TEqEq arith_expr_bis { P.logic_op Ast.Eq $1 $2 $3 } | arith_expr(r,pe) TNotEq arith_expr_bis { P.logic_op Ast.NotEq $1 $2 $3 } | arith_expr(r,pe) TAnd arith_expr_bis { P.arith_op Ast.And $1 $2 $3 } | arith_expr(r,pe) TOr arith_expr_bis { P.arith_op Ast.Or $1 $2 $3 } | arith_expr(r,pe) TXor arith_expr_bis { P.arith_op Ast.Xor $1 $2 $3 } | arith_expr(r,pe) TAndLog arith_expr_bis { P.logic_op Ast.AndLog $1 $2 $3 } | arith_expr(r,pe) TOrLog arith_expr_bis { P.logic_op Ast.OrLog $1 $2 $3 } // allows dots now that an expression-specific token has been seen // need an extra rule because of recursion restrictions arith_expr_bis: cast_expr(eexpr,dot_expressions) { $1 } | arith_expr_bis TMul arith_expr_bis { P.arith_op Ast.Mul $1 $2 $3 } | arith_expr_bis TDmOp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr_bis TPlus arith_expr_bis { P.arith_op Ast.Plus $1 $2 $3 } | arith_expr_bis TMinus arith_expr_bis { P.arith_op Ast.Minus $1 $2 $3 } | arith_expr_bis TShLOp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr_bis TShROp arith_expr_bis { let (op,clt) = $2 in P.arith_op op $1 clt $3 } | arith_expr_bis TLogOp arith_expr_bis { let (op,clt) = $2 in P.logic_op op $1 clt $3 } | arith_expr_bis TEqEq arith_expr_bis { P.logic_op Ast.Eq $1 $2 $3 } | arith_expr_bis TNotEq arith_expr_bis { P.logic_op Ast.NotEq $1 $2 $3 } | arith_expr_bis TAnd arith_expr_bis { P.arith_op Ast.And $1 $2 $3 } | arith_expr_bis TOr arith_expr_bis { P.arith_op Ast.Or $1 $2 $3 } | arith_expr_bis TXor arith_expr_bis { P.arith_op Ast.Xor $1 $2 $3 } | arith_expr_bis TAndLog arith_expr_bis { P.logic_op Ast.AndLog $1 $2 $3 } // no OrLog because it is left associative and this is for // a right argument, not sure why not the same problem for AndLog cast_expr(r,pe): unary_expr(r,pe) { $1 } | lp=TOPar t=ctype rp=TCPar e=cast_expr(r,pe) { Ast0.wrap(Ast0.Cast (P.clt2mcode "(" lp, t, P.clt2mcode ")" rp, e)) } unary_expr(r,pe): postfix_expr(r,pe) { $1 } | TInc unary_expr_bis { Ast0.wrap(Ast0.Infix ($2, P.clt2mcode Ast.Inc $1)) } | TDec unary_expr_bis { Ast0.wrap(Ast0.Infix ($2, P.clt2mcode Ast.Dec $1)) } | unary_op cast_expr(r,pe) { let mcode = $1 in Ast0.wrap(Ast0.Unary($2, mcode)) } | TBang unary_expr_bis { let mcode = P.clt2mcode Ast.Not $1 in Ast0.wrap(Ast0.Unary($2, mcode)) } | TSizeof unary_expr_bis { Ast0.wrap(Ast0.SizeOfExpr (P.clt2mcode "sizeof" $1, $2)) } | s=TSizeof lp=TOPar t=ctype rp=TCPar { Ast0.wrap(Ast0.SizeOfType (P.clt2mcode "sizeof" s, P.clt2mcode "(" lp,t, P.clt2mcode ")" rp)) } // version that allows dots unary_expr_bis: postfix_expr(eexpr,dot_expressions) { $1 } | TInc unary_expr_bis { Ast0.wrap(Ast0.Infix ($2, P.clt2mcode Ast.Inc $1)) } | TDec unary_expr_bis { Ast0.wrap(Ast0.Infix ($2, P.clt2mcode Ast.Dec $1)) } | unary_op cast_expr(eexpr,dot_expressions) { let mcode = $1 in Ast0.wrap(Ast0.Unary($2, mcode)) } | TBang unary_expr_bis { let mcode = P.clt2mcode Ast.Not $1 in Ast0.wrap(Ast0.Unary($2, mcode)) } | TSizeof unary_expr_bis { Ast0.wrap(Ast0.SizeOfExpr (P.clt2mcode "sizeof" $1, $2)) } | s=TSizeof lp=TOPar t=ctype rp=TCPar { Ast0.wrap(Ast0.SizeOfType (P.clt2mcode "sizeof" s, P.clt2mcode "(" lp,t, P.clt2mcode ")" rp)) } unary_op: TAnd { P.clt2mcode Ast.GetRef $1 } | TMul { P.clt2mcode Ast.DeRef $1 } | TPlus { P.clt2mcode Ast.UnPlus $1 } | TMinus { P.clt2mcode Ast.UnMinus $1 } | TTilde { P.clt2mcode Ast.Tilde $1 } postfix_expr(r,pe): primary_expr(r,pe) { $1 } | postfix_expr(r,pe) TOCro eexpr TCCro { Ast0.wrap(Ast0.ArrayAccess ($1,P.clt2mcode "[" $2,$3, P.clt2mcode "]" $4)) } | postfix_expr(r,pe) TDot disj_ident { Ast0.wrap(Ast0.RecordAccess($1, P.clt2mcode "." $2, $3)) } | postfix_expr(r,pe) TPtrOp disj_ident { Ast0.wrap(Ast0.RecordPtAccess($1, P.clt2mcode "->" $2, $3)) } | postfix_expr(r,pe) TInc { Ast0.wrap(Ast0.Postfix ($1, P.clt2mcode Ast.Inc $2)) } | postfix_expr(r,pe) TDec { Ast0.wrap(Ast0.Postfix ($1, P.clt2mcode Ast.Dec $2)) } | postfix_expr(r,pe) TOPar eexpr_list_option TCPar { Ast0.wrap(Ast0.FunCall($1,P.clt2mcode "(" $2, $3, P.clt2mcode ")" $4)) } /*(* gccext: also called compound literals *) empty case causes conflicts */ | TOPar ctype TCPar TOBrace initialize_list TCBrace { let init = if P.struct_initializer $5 then let il = P.drop_dot_commas $5 in Ast0.wrap (Ast0.InitList(P.clt2mcode "{" $4,il,P.clt2mcode "}" $6,false)) else Ast0.wrap (Ast0.InitList(P.clt2mcode "{" $4,$5,P.clt2mcode "}" $6,true)) in Ast0.wrap (Ast0.Constructor(P.clt2mcode "(" $1, $2, P.clt2mcode ")" $3, init)) } primary_expr(recurser,primary_extra): func_ident { Ast0.wrap(Ast0.Ident($1)) } | TAndLog ident { let op = P.clt2mcode Ast.GetRefLabel $1 in Ast0.wrap(Ast0.Unary(Ast0.wrap(Ast0.Ident($2)), op)) } | TInt { let (x,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.Int x) clt)) } | TFloat { let (x,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.Float x) clt)) } | TString { let (x,clt) = $1 in P.parse_string x clt } | TChar { let (x,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.Char x) clt)) } | TDecimalCst { let (x,l,p,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.DecimalConst(x,l,p)) clt)) } | TMetaConst { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.CONST,pure)) } | TMetaErr { let (nm,constraints,pure,clt) = $1 in Ast0.wrap(Ast0.MetaErr(P.clt2mcode nm clt,constraints,pure)) } | TMetaExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ANY,pure)) } | TMetaIdExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ID,pure)) } | TMetaLocalIdExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.LocalID,pure)) } | TOPar eexpr TCPar { Ast0.wrap(Ast0.Paren(P.clt2mcode "(" $1,$2, P.clt2mcode ")" $3)) } | TOPar0 midzero_list(recurser,eexpr) TCPar0 { let (mids,code) = $2 in Ast0.wrap(Ast0.DisjExpr(P.clt2mcode "(" $1, code, mids, P.clt2mcode ")" $3)) } | primary_extra { $1 } expr_dots(dotter): r=no_dot_start_end(dexpr,edots_when(dotter,eexpr)) { r } // used in NEST no_dot_start_end(grammar,dotter): g=grammar dg=list(pair(dotter,grammar)) { function dot_builder -> g :: (List.concat(List.map (function (d,g) -> [dot_builder d;g]) dg)) } /*****************************************************************************/ pure_ident: TIdent { $1 } pure_ident_or_symbol: pure_ident { $1 } | TSymId { $1 } pure_ident_kwd: | TIdentifier { "identifier" } | TExpression { "expression" } | TStatement { "statement" } | TFunction { "function" } | TLocal { "local" } | TType { "type" } | TParameter { "parameter" } | TIdExpression { "idexpression" } | TInitialiser { "initialiser" } | Tlist { "list" } | TFresh { "fresh" } | TConstant { "constant" } | TError { "error" } | TWords { "words" } | TPure { "pure" } | TContext { "context" } | TGenerated { "generated" } | TTypedef { "typedef" } | TDeclarer { "declarer" } | TIterator { "iterator" } | TName { "name" } | TPosition { "position" } | TSymbol { "symbol" } meta_ident: TRuleName TDot pure_ident { (Some $1,P.id2name $3) } | TRuleName TDot pure_ident_kwd { (Some $1,$3) } pure_ident_or_meta_ident: pure_ident { (None,P.id2name $1) } | pure_ident_kwd { (None,$1) } | meta_ident { $1 } wrapped_sym_ident: TSymId { Ast0.wrap(Ast0.Id(P.sym2mcode $1)) } pure_ident_or_meta_ident_with_seed: pure_ident_or_meta_ident { ($1,Ast.NoVal) } | pure_ident_or_meta_ident TEq separated_nonempty_list(TCppConcatOp,seed_elem) { match $3 with [Ast.SeedString s] -> ($1,Ast.StringSeed s) | _ -> ($1,Ast.ListSeed $3) } seed_elem: TString { let (x,_) = $1 in Ast.SeedString x } | TMetaId { let (x,_,_,_,_) = $1 in Ast.SeedId x } | TMeta {failwith "tmeta"} | TVirtual TDot pure_ident { let nm = ("virtual",P.id2name $3) in Iteration.parsed_virtual_identifiers := Common.union_set [snd nm] !Iteration.parsed_virtual_identifiers; try Ast.SeedString (List.assoc (snd nm) !Flag.defined_virtual_env) with Not_found -> Ast.SeedId nm } | TRuleName TDot pure_ident { let nm = ($1,P.id2name $3) in P.check_meta(Ast.MetaIdDecl(Ast.NONE,nm)); Ast.SeedId nm } pure_ident_or_meta_ident_with_x_eq(x_eq): i=pure_ident_or_meta_ident l=loption(x_eq) { (i, l) } pure_ident_or_meta_ident_with_econstraint(x_eq): i=pure_ident_or_meta_ident optc=option(x_eq) { match optc with None -> (i, Ast0.NoConstraint) | Some c -> (i, c) } pure_ident_or_meta_ident_with_idconstraint_virt(constraint_type): i=pure_ident_or_meta_ident c=option(constraint_type) { Common.Left (match c with None -> (i, Ast.IdNoConstraint) | Some constraint_ -> (i,constraint_)) } | TVirtual TDot pure_ident { let nm = P.id2name $3 in Iteration.parsed_virtual_identifiers := Common.union_set [nm] !Iteration.parsed_virtual_identifiers; Common.Right nm } pure_ident_or_meta_ident_with_idconstraint(constraint_type): i=pure_ident_or_meta_ident c=option(constraint_type) { match c with None -> (i, Ast.IdNoConstraint) | Some constraint_ -> (i,constraint_) } re_or_not_eqid: re=regexp_eqid {Ast.IdRegExpConstraint re} | ne=not_eqid {ne} re_only: re=regexp_eqid {Ast.IdRegExpConstraint re} regexp_eqid: TTildeEq re=TString { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); let (s,_) = re in Ast.IdRegExp (s,Regexp.regexp s) } | TTildeExclEq re=TString { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); let (s,_) = re in Ast.IdNotRegExp (s,Regexp.regexp s) } not_eqid: TNotEq i=pure_ident_or_meta_ident { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating (* pb: constraints not stored with metavars; too lazy to search for them in the pattern *) then failwith "constraints not allowed in a generated rule file"); (match i with (Some rn,id) -> let i = P.check_inherited_constraint i (function mv -> Ast.MetaIdDecl(Ast.NONE,mv)) in Ast.IdNegIdSet([],[i]) | (None,i) -> Ast.IdNegIdSet([i],[])) } | TNotEq TOBrace l=comma_list(pure_ident_or_meta_ident) TCBrace { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); let (str,meta) = List.fold_left (function (str,meta) -> function (Some rn,id) as i -> let i = P.check_inherited_constraint i (function mv -> Ast.MetaIdDecl(Ast.NONE,mv)) in (str,i::meta) | (None,i) -> (i::str,meta)) ([],[]) l in Ast.IdNegIdSet(str,meta) } re_or_not_eqe_or_sub: re=regexp_eqid {Ast0.NotIdCstrt re} | ne=not_eqe {Ast0.NotExpCstrt ne} | s=sub {Ast0.SubExpCstrt s} not_ceq_or_sub: ceq=not_ceq {Ast0.NotExpCstrt ceq} | s=sub {Ast0.SubExpCstrt s} not_eqe: TNotEq i=pure_ident { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); [Ast0.wrap(Ast0.Ident(Ast0.wrap(Ast0.Id(P.id2mcode i))))] } | TNotEq TOBrace l=comma_list(pure_ident) TCBrace { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); List.map (function i -> Ast0.wrap(Ast0.Ident(Ast0.wrap(Ast0.Id(P.id2mcode i))))) l } not_ceq: TNotEq i=ident_or_const { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); [i] } | TNotEq TOBrace l=comma_list(ident_or_const) TCBrace { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); l } sub: (* has to be inherited because not clear how to check subterm constraints in the functorized CTL engine, so need the variable to be bound already when bind the subterm constrained metavariable *) TSub i=meta_ident { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); let i = P.check_inherited_constraint i (function mv -> Ast.MetaExpDecl(Ast.NONE,mv,None)) in [i] } | TSub TOBrace l=comma_list(meta_ident) TCBrace { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); List.map (function i -> P.check_inherited_constraint i (function mv -> Ast.MetaExpDecl(Ast.NONE,mv,None))) l} ident_or_const: i=pure_ident { Ast0.wrap(Ast0.Ident(Ast0.wrap(Ast0.Id(P.id2mcode i)))) } | wrapped_sym_ident { Ast0.wrap(Ast0.Ident($1)) } | TInt { let (x,clt) = $1 in Ast0.wrap(Ast0.Constant (P.clt2mcode (Ast.Int x) clt)) } not_pos: TNotEq i=meta_ident { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); let i = P.check_inherited_constraint i (function mv -> Ast.MetaPosDecl(Ast.NONE,mv)) in [i] } | TNotEq TOBrace l=comma_list(meta_ident) TCBrace { (if !Data.in_iso then failwith "constraints not allowed in iso file"); (if !Data.in_generating then failwith "constraints not allowed in a generated rule file"); List.map (function i -> P.check_inherited_constraint i (function mv -> Ast.MetaPosDecl(Ast.NONE,mv))) l } func_ident: ident { $1 } | TMetaFunc { let (nm,constraints,pure,clt) = $1 in Ast0.wrap(Ast0.MetaFunc(P.clt2mcode nm clt,constraints,pure)) } | TMetaLocalFunc { let (nm,constraints,pure,clt) = $1 in Ast0.wrap (Ast0.MetaLocalFunc(P.clt2mcode nm clt,constraints,pure)) } fn_ident: disj_ident { $1 } | TMetaFunc { let (nm,constraints,pure,clt) = $1 in Ast0.wrap(Ast0.MetaFunc(P.clt2mcode nm clt,constraints,pure)) } | TMetaLocalFunc { let (nm,constraints,pure,clt) = $1 in Ast0.wrap (Ast0.MetaLocalFunc(P.clt2mcode nm clt,constraints,pure)) } ident: pure_ident { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } | wrapped_sym_ident { $1 } | TMetaId { let (nm,constraints,seed,pure,clt) = $1 in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) } ident_or_kwd: pure_ident { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } | wrapped_sym_ident { $1 } | TMeta { tmeta_to_ident $1 } | TMetaId { let (nm,constraints,seed,pure,clt) = $1 in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) } | Tinline { Ast0.wrap(Ast0.Id(P.clt2mcode "inline" $1)) } mident: pure_ident { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } | wrapped_sym_ident { $1 } | TMeta { tmeta_to_ident $1 } | TMetaId { let (nm,constraints,seed,pure,clt) = $1 in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,seed,pure)) } disj_ident: mident { $1 } | lp=TOPar0 t=midzero_list(disj_ident,disj_ident) rp=TCPar0 { let (mids,code) = t in Ast0.wrap (Ast0.DisjId(P.clt2mcode "(" lp,code,mids, P.clt2mcode ")" rp)) } type_ident: disj_ident { $1 } | TTypeId { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } decl_ident: TDeclarerId { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } | TMetaDeclarer { let (nm,constraints,pure,clt) = $1 in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,Ast.NoVal,pure)) } iter_ident: TIteratorId { Ast0.wrap(Ast0.Id(P.id2mcode $1)) } | TMetaIterator { let (nm,constraints,pure,clt) = $1 in Ast0.wrap(Ast0.MetaId(P.clt2mcode nm clt,constraints,Ast.NoVal,pure)) } typedef_ident: pure_ident_or_symbol { Ast0.wrap(Ast0.TypeName(P.id2mcode $1)) } | TMeta { tmeta_to_type $1 } | TMetaType { let (nm,pure,clt) = $1 in Ast0.wrap(Ast0.MetaType(P.clt2mcode nm clt,pure)) } /*****************************************************************************/ decl_list(decl): empty_list_start(one_dec(decl),TEllipsis) { Ast0.wrap (Ast0.DOTS ($1 (fun _ d -> Ast0.wrap(Ast0.Pdots(P.clt2mcode "..." d))) (fun c -> Ast0.PComma c))) } one_dec(decl): decl { $1 } | TMetaParamList { let (nm,lenname,pure,clt) = $1 in let nm = P.clt2mcode nm clt in let lenname = match lenname with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(P.clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in Ast0.wrap(Ast0.MetaParamList(nm,lenname,pure)) } /* ---------------------------------------------------------------------- */ /* comma list parser, used for fn params, fn args, enums, initlists, #define params */ /* enums: enum_decl, edots_when(TEllipsis,enum_decl_one) fun s d -> P.mkedots "..." d fun c -> Ast0.EComma c */ empty_list_start(elem,dotter): /* empty */ { fun build_dots build_comma -> [] } | nonempty_list_start(elem,dotter) { $1 } nonempty_list_start(elem,dotter): /* dots allowed */ elem { fun build_dots build_comma -> [$1] } | elem TComma { fun build_dots build_comma -> $1::[Ast0.wrap(build_comma(P.clt2mcode "," $2))] } | elem TComma nonempty_list_start(elem,dotter) { fun build_dots build_comma -> $1::(Ast0.wrap(build_comma(P.clt2mcode "," $2))):: ($3 build_dots build_comma) } | TNothing nonempty_list_start(elem,dotter) { $2 } | d=dotter { fun build_dots build_comma -> [(build_dots "..." d)] } | d=dotter TComma { fun build_dots build_comma -> [(build_dots "..." d);Ast0.wrap(build_comma(P.clt2mcode "," $2))] } | d=dotter TComma r=continue_list(elem,dotter) { fun build_dots build_comma -> (build_dots "..." d):: (Ast0.wrap(build_comma(P.clt2mcode "," $2))):: (r build_dots build_comma) } continue_list(elem,dotter): /* dots not allowed */ elem { fun build_dots build_comma -> [$1] } | elem TComma { fun build_dots build_comma -> $1::[Ast0.wrap(build_comma(P.clt2mcode "," $2))] } | elem TComma nonempty_list_start(elem,dotter) { fun build_dots build_comma -> $1::(Ast0.wrap(build_comma(P.clt2mcode "," $2))):: ($3 build_dots build_comma) } | TNothing nonempty_list_start(elem,dotter) { $2 } /* ---------------------------------------------------------------------- */ /* error words make it complicated to be able to use error as a metavariable name or a type in a metavariable list; for that we would like to allow TError as an ident, but that makes conflicts with this rule. To add back error words, need to find some appropriate delimiter for it, but it has not been used much so just drop it */ /*error_words: TError TWords TEq TOCro cl=comma_list(dexpr) TCCro { [Ast0.wrap(Ast0.ERRORWORDS(cl))] } */ /* ---------------------------------------------------------------------- */ /* sequences of statements and expressions */ /* There are number of cases that must be considered: 1. Top level: Dots and nests allowed at the beginning or end Expressions allowed at the beginning or end One function allowed, by itself 2. A function body: Dots and nests allowed at the beginning or end Expressions not allowed at the beginning or end Functions not allowed 3. The body of a nest: Dots and nests not allowed at the beginning or end Expressions allowed at the beginning or end Functions not allowed 4. Whencode: Dots and nests not allowed at the beginning but allowed at the end Expressions allowed at the beginning or end Functions not allowed These are implemented by the rules minus_toplevel_sequence, plus_toplevel_sequence, function_body_sequence, nest_body_sequence, and when_body_sequence. */ /* ------------------------------------------------------------------------ */ /* Minus top level */ /* doesn't allow only ... */ minus_start: fundecl { [Ast0.wrap(Ast0.OTHER($1))] } | ctype { [Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Ty($1))))] } | top_init { [Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.TopInit($1))))] } | toplevel_seq_startne(toplevel_after_dots_init) { List.map (function x -> Ast0.wrap(Ast0.OTHER(x))) $1 } toplevel_seq_startne(after_dots_init): a=stm_dots_ell b=after_dots_init { a::b } | a=stm_dots_nest b=after_dots_init { a::b } | a=stm_dots_nest { [a] } | expr toplevel_after_exp { (Ast0.wrap(Ast0.Exp($1)))::$2 } | decl_statement_expr toplevel_after_stm { $1@$2 } toplevel_seq_start(after_dots_init): stm_dots after_dots_init { $1::$2 } | expr toplevel_after_exp { (Ast0.wrap(Ast0.Exp($1)))::$2 } | decl_statement_expr toplevel_after_stm { $1@$2 } toplevel_after_dots_init: TNothing toplevel_after_exp {$2} | expr toplevel_after_exp {(Ast0.wrap(Ast0.Exp($1)))::$2} | decl_statement_expr toplevel_after_stm {$1@$2} toplevel_after_exp: /* empty */ {[]} | stm_dots toplevel_after_dots {$1::$2} toplevel_after_dots: /* empty */ {[]} | TNothing toplevel_after_exp {$2} | expr toplevel_after_exp {(Ast0.wrap(Ast0.Exp($1)))::$2} | decl_statement_expr toplevel_after_stm {$1@$2} toplevel_after_stm: /* empty */ {[]} | stm_dots toplevel_after_dots {$1::$2} | decl_statement toplevel_after_stm {$1@$2} top_init: TOInit initialize_list TCBrace { if P.struct_initializer $2 then let il = P.drop_dot_commas $2 in Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,il,P.clt2mcode "}" $3,false)) else Ast0.wrap(Ast0.InitList(P.clt2mcode "{" $1,$2,P.clt2mcode "}" $3,true)) } /* ------------------------------------------------------------------------ */ /* Plus top level */ /* does allow only ... also allows multiple top-level functions */ plus_start: ctype { [Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Ty($1))))] } | top_init { [Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.TopInit($1))))] } | stm_dots plus_after_dots { (Ast0.wrap(Ast0.OTHER($1)))::$2 } | expr plus_after_exp { (Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Exp($1)))))::$2 } | fundecl plus_after_stm { Ast0.wrap(Ast0.OTHER($1))::$2 } | decl_statement_expr plus_after_stm { (List.map (function x -> Ast0.wrap(Ast0.OTHER(x))) $1)@$2 } plus_after_exp: /* empty */ {[]} | stm_dots plus_after_dots { (Ast0.wrap(Ast0.OTHER($1)))::$2 } plus_after_dots: /* empty */ {[]} | TNothing plus_after_exp {$2} | expr plus_after_exp { (Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.Exp($1)))))::$2 } | fundecl plus_after_stm { Ast0.wrap(Ast0.OTHER($1))::$2 } | decl_statement_expr plus_after_stm { (List.map (function x -> Ast0.wrap(Ast0.OTHER(x))) $1)@$2 } plus_after_stm: /* empty */ {[]} | stm_dots plus_after_dots { (Ast0.wrap(Ast0.OTHER($1)))::$2 } | fundecl plus_after_stm { Ast0.wrap(Ast0.OTHER($1))::$2 } | decl_statement plus_after_stm { (List.map (function x -> Ast0.wrap(Ast0.OTHER(x))) $1)@$2 } /* ------------------------------------------------------------------------ */ /* Function body */ fun_start: fun_after_stm { Ast0.wrap(Ast0.DOTS($1)) } fun_after_stm: /* empty */ {[]} | stm_dots fun_after_dots {$1::$2} | decl_statement fun_after_stm {$1@$2} fun_after_dots: /* empty */ {[]} | TNothing fun_after_exp {$2} | expr fun_after_exp {Ast0.wrap(Ast0.Exp($1))::$2} | decl_statement_expr fun_after_stm {$1@$2} fun_after_exp: stm_dots fun_after_dots {$1::$2} /* hack to allow mixing statements and expressions in an or */ fun_after_dots_or: /* empty */ {[]} | TNothing fun_after_exp_or {$2} | expr fun_after_exp_or {Ast0.wrap(Ast0.Exp($1))::$2} | decl_statement_expr fun_after_stm {$1@$2} fun_after_exp_or: /* empty */ {[]} | stm_dots fun_after_dots {$1::$2} /* ------------------------------------------------------------------------ */ /* Nest body */ nest_start: nest_after_dots { Ast0.wrap(Ast0.DOTS($1)) } nest_after_dots: decl_statement_expr nest_after_stm {$1@$2} | TNothing nest_after_exp {$2} | expr nest_after_exp {(Ast0.wrap(Ast0.Exp($1)))::$2} nest_after_stm: /* empty */ {[]} | stm_dots nest_after_dots {$1::$2} | decl_statement nest_after_stm {$1@$2} nest_after_exp: /* empty */ {[]} | stm_dots nest_after_dots {$1::$2} /* ------------------------------------------------------------------------ */ /*Whencode*/ when_start: expr toplevel_after_exp { Ast0.wrap(Ast0.DOTS((Ast0.wrap(Ast0.Exp($1)))::$2)) } | decl_statement toplevel_after_stm { Ast0.wrap(Ast0.DOTS($1@$2)) } /* ---------------------------------------------------------------------- */ /* arg expr. may contain a type or a explist metavariable */ aexpr: dargexpr { Ast0.set_arg_exp $1 } | TMetaExpList { let (nm,lenname,pure,clt) = $1 in let nm = P.clt2mcode nm clt in let lenname = match lenname with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(P.clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in Ast0.wrap(Ast0.MetaExprList(nm,lenname,pure)) } | ctype { Ast0.set_arg_exp(Ast0.wrap(Ast0.TypeExp($1))) } eexpr_list_option: empty_list_start(aexpr,TEllipsis) { Ast0.wrap (Ast0.DOTS ($1 (fun _ d -> Ast0.wrap(Ast0.Edots(P.clt2mcode "..." d,None))) (fun c -> Ast0.EComma c))) } /****************************************************************************/ // non-empty lists - drop separator comma_list(elem): separated_nonempty_list(TComma,elem) { $1 } midzero_list(elem,aft): a=elem b=list(mzl(aft)) { let (mids,code) = List.split b in (mids,(a::code)) } mzl(elem): a=TMid0 b=elem { (P.clt2mcode "|" a, b) } edots_when(dotter,when_grammar): d=dotter { (d,None) } | d=dotter TWhen TNotEq w=when_grammar TLineEnd { (d,Some w) } whens(when_grammar,simple_when_grammar,any_strict): TWhen TNotEq w=when_grammar TLineEnd { [Ast0.WhenNot w] } | TWhen TEq w=simple_when_grammar TLineEnd { [Ast0.WhenAlways w] } | TWhen comma_list(any_strict) TLineEnd { List.map (function x -> Ast0.WhenModifier(x)) $2 } | TWhenTrue TNotEq e = eexpr TLineEnd { [Ast0.WhenNotTrue e] } | TWhenFalse TNotEq e = eexpr TLineEnd { [Ast0.WhenNotFalse e] } any_strict: TAny { Ast.WhenAny } | TStrict { Ast.WhenStrict } | TForall { Ast.WhenForall } | TExists { Ast.WhenExists } /***************************************************************************** * * *****************************************************************************/ iso_main: TIsoExpression e1=eexpr el=list(iso(eexpr)) EOF { let fn x = Ast0.ExprTag x in P.iso_adjust fn fn e1 el } | TIsoArgExpression e1=eexpr el=list(iso(eexpr)) EOF { let fn x = Ast0.ArgExprTag x in P.iso_adjust fn fn e1 el } | TIsoTestExpression e1=eexpr el=list(iso(eexpr)) EOF { let fn x = Ast0.TestExprTag x in P.iso_adjust fn fn e1 el } | TIsoToTestExpression e1=eexpr el=list(iso(eexpr)) EOF { let ffn x = Ast0.ExprTag x in let fn x = Ast0.TestExprTag x in P.iso_adjust ffn fn e1 el } | TIsoStatement s1=iso_statement sl=list(iso(iso_statement)) EOF { let fn x = Ast0.StmtTag x in P.iso_adjust fn fn s1 sl } | TIsoType t1=ctype tl=list(iso(ctype)) EOF { let fn x = Ast0.TypeCTag x in P.iso_adjust fn fn t1 tl } | TIsoTopLevel e1=nest_start el=list(iso(nest_start)) EOF { let fn x = Ast0.DotsStmtTag x in P.iso_adjust fn fn e1 el } | TIsoDeclaration d1=decl_var dl=list(iso(decl_var)) EOF { let check_one = function [x] -> x | _ -> raise (Semantic_cocci.Semantic "only one variable per declaration in an isomorphism rule") in let d1 = check_one d1 in let dl = List.map (function Common.Left x -> Common.Left(check_one x) | Common.Right x -> Common.Right(check_one x)) dl in let fn x = Ast0.DeclTag x in P.iso_adjust fn fn d1 dl } iso(term): TIso t=term { Common.Left t } | TRightIso t=term { Common.Right t } /***************************************************************************** * * *****************************************************************************/ never_used: TDirective { () } | TPArob TMetaPos { () } | TScriptData { () } | TAnalysis { () } script_meta_main: py=pure_ident TMPtVirg { ((Some (P.id2name py), None), None) } | py=pure_ident script_name_decl TMPtVirg { ((Some (P.id2name py), None), Some $2) } | TOPar TUnderscore TComma ast=pure_ident TCPar script_name_decl TMPtVirg { ((None, Some (P.id2name ast)), Some $6) } | TOPar str=pure_ident TComma TUnderscore TCPar script_name_decl TMPtVirg { ((Some (P.id2name str), None), Some $6) } | TOPar str=pure_ident TComma ast=pure_ident TCPar script_name_decl TMPtVirg { ((Some (P.id2name str), Some (P.id2name ast)), Some $6) } script_name_decl: TShLOp TRuleName TDot cocci=pure_ident { let nm = P.id2name cocci in let mv = Parse_aux.lookup $2 nm in (($2, nm), mv) } | TShLOp TVirtual TDot cocci=pure_ident { let nm = P.id2name cocci in Iteration.parsed_virtual_identifiers := Common.union_set [nm] !Iteration.parsed_virtual_identifiers; let name = ("virtual", nm) in let mv = Ast.MetaIdDecl(Ast.NONE,name) in (name,mv) } coccinelle-1.0.0-rc19/parsing_cocci/tests/0000755000175000017500000000000012247437436017335 5ustar eugeneugencoccinelle-1.0.0-rc19/parsing_cocci/tests/30.cocci0000644000175000017500000000056012247437436020562 0ustar eugeneugen@@ expression E; @@ ( - if ((E->flags & (1 << TTY_DO_WRITE_WAKEUP)) && E->ldisc.write_wakeup) | - if (test_bit(TTY_DO_WRITE_WAKEUP, &E->flags) && E->ldisc.write_wakeup) ) - (E->ldisc.write_wakeup)(E); + tty_wakeup(E); ooo - wake_up_interruptible(&E->write_wait); @@ expression E; @@ - if (E->ldisc.flush_buffer) E->ldisc.flush_buffer(E); + tty_ldisc_flush(E); coccinelle-1.0.0-rc19/parsing_cocci/tests/8.cocci0000644000175000017500000000122012247437436020501 0ustar eugeneugen@@ filename A; @@ --- a/.../A##.c +++ b/.../A##.c ... + static struct request_queue A##_queue; @@ local function fn; identifier X; @@ fn (..., request_queue_t *X, ...) { <... - QUEUE + X ...> } @@ @@ + #define QUEUE(&X) <... ? QUEUE ...> @@ @@ - BLK_DEFAULT_QUEUE(MAJOR_NR) + &A##_queue @@ identifier i; expression E, Y, Z; @@ ( for (i = 0; i < E; i++) { ... + Y->queue = &A##_queue; set_capacity(Y, Z); ... } ... for (i = 0; i < E; i++) { ... add_disk(Y); ... } | + Y->queue = &A##_queue; set_capacity(Y, Z); ... add_disk(Y); | + Y->queue = &A##_queue; add_disk(Y); ) coccinelle-1.0.0-rc19/parsing_cocci/tests/26.cocci0000644000175000017500000000025212247437436020565 0ustar eugeneugen@@ expression A, B; statement S; @@ - if (!pci_dma_supported(A,B)) S - pci_set_dma_mask(A,B); + if (pci_set_dma_mask(A,B) < 0 || pci_set_consistent_dma_mask(A,B) < 0) S coccinelle-1.0.0-rc19/parsing_cocci/tests/22.cocci0000644000175000017500000000103212247437436020556 0ustar eugeneugen@@ @@ --- a/drivers/usb/storage/... +++ b/drivers/usb/storage/... @@ struct us_data X; expression Y; @@ - usb_sndbulkpipe (X->pusb_dev, Y) + X->send_bulk_pipe @@ struct us_data X; expression Y; @@ - usb_rcvbulkpipe (X->pusb_dev, Y) + X->recv_bulk_pipe @@ struct us_data X; expression Y; @@ - usb_sndctrlpipe (X->pusb_dev, Y) + X->send_ctrl_pipe @@ struct us_data X; expression Y; @@ - usb_rcvctrlpipe (X->pusb_dev, Y) + X->recv_ctrl_pipe @@ @@ error words = [usb_sndbulkpipe, usb_rcvbulkpipe, usb_sndctrlpipe, usb_rcvctrlpipe] coccinelle-1.0.0-rc19/parsing_cocci/tests/3.cocci0000644000175000017500000000122412247437436020500 0ustar eugeneugen@@ struct Scsi_Host_Template sht; !local function proc_info_func; @@ sht.proc_info = proc_info_func; @@ identifier buffer, start, offset, length, inout, hostptr, hostno; @@ proc_info_func( + struct Scsi_Host *hostptr, char *buffer, char **start, off_t offset, int length, - int hostno, int inout) { ... - struct Scsi_Host *hostptr; ... - hostptr = scsi_host_hn_get(hostno); ... ?- if (hostptr == NULL) { ... } ... ?- scsi_host_put(hostptr); ... } @@ expression E; @@ proc_info_func(...) { <... ( - E->host_no == hostno + E == hostptr | - hostno + hostptr->host_no ) ...> } coccinelle-1.0.0-rc19/parsing_cocci/tests/21.cocci0000644000175000017500000000074712247437436020571 0ustar eugeneugen@@ expression A, B, C; @@ - snd_magic_cast(A, B, C) + B @@ expression X; @@ - snd_magic_kfree(X) + kfree(X) @@ expression X, A, C; @@ - X = snd_magic_kcalloc(A, 0, C) + X = kcalloc(1, sizeof(*X), C) @@ expression X, A, B, C; @@ - X = snd_magic_kcalloc(A, B, C) + X = kcalloc(1, sizeof(*X)+B, C) @@ expression X, A, C; @@ - X = snd_magic_kmalloc(A, 0, C) + X = kmalloc(sizeof(*X), C) @@ expression X, A, B, C; @@ - X = snd_magic_kmalloc(A, B, C) + X = kmalloc(sizeof(*X)+B, C) coccinelle-1.0.0-rc19/parsing_cocci/tests/13.cocci0000644000175000017500000000022712247437436020563 0ustar eugeneugen@@ expression E; @@ - printk("... %s ...", + printk("... %u.%u.%u.%u ...", ..., - in_ntoa(E), + NIPQUAD(E), ...); coccinelle-1.0.0-rc19/parsing_cocci/tests/4.cocci0000644000175000017500000000071312247437436020503 0ustar eugeneugen@@ struct video_device v; local function fn; @@ v.mmap = fn; @@ local function fn1; identifier dev, adr, size; fresh identifier vma; @@ fn( + struct vm_area_struct *vma, struct video_device *dev, const char *adr, unsigned long size) { <*** fn1( + vma, ...) ***> } fn1( + struct vm_area_struct *vma, ...) { <*** remap_page_range( + vma, ...) ***> } coccinelle-1.0.0-rc19/parsing_cocci/tests/7.cocci0000644000175000017500000000010312247437436020477 0ustar eugeneugen@@ @@ if (blk_queue_empty(QUEUE)) { - CLEAR_INTR; ... } coccinelle-1.0.0-rc19/parsing_cocci/tests/29.cocci0000644000175000017500000000035712247437436020576 0ustar eugeneugen@@ struct tty_operations t; local function fn; @@ t.write = fn; @@ parameter p; identifier x; @@ fn(p, - int x, ...) { <*** - x + 0 ***> } @@ expression E1, E2; @@ - fn(E1, E2, + fn(E1, ...) coccinelle-1.0.0-rc19/parsing_cocci/tests/9.cocci0000644000175000017500000000111112247437436020501 0ustar eugeneugen@@ expression E1, E2; expression X, Y; @@ ( - E1.l1.l1l2 = E2 + E1.l2.l1l2 = E2 | - E1.l2.l2l1 = E2 + E1.l1.l2l1 = E2 | - E1.l2.l2l3 = E2 + E1.l3.l2l3 = E2 | - E1.l3.l3l4 = E2 + E1.lli.l3l4 = E2 | - E1.l3.l3l2 = E2 + E1.l2.l3l2 = E2 | - E1.lli.l4l3 = E2 + E1.l3.l4l3 = E2 | - E1.lli.l4l3_proto = E2 + E1.l3.l4l3_proto = E2 | - E1->l1.l1l2(E1, X, Y) + L1L2(E1, X, Y) | - E1->l1.l2l1(E1, X, Y) + L2L1(E1, X, Y) | - E1->l1.l2l3(E1, X, Y) + L2L3(E1, X, Y) | - E1->l1.l3l2(E1, X, Y) + L3L2(E1, X, Y) | - E1->l1.l3l4(E1, X, Y) + L3L4(E1, X, Y) | - E1->lli.l4l3(E1, X, Y) + L4L3(E1, X, Y) ) coccinelle-1.0.0-rc19/parsing_cocci/tests/18.cocci0000644000175000017500000000057212247437436020573 0ustar eugeneugen@@ constant char *string; @@ - devfs_mk_dir(NULL,string,NULL) + devfs_mk_dir(string) @@ constant char *string; identifier txt; int E; expression list A; @@ - char txt[E]; ... WHEN != txt - sprintf(txt,string,A); ... WHEN != txt - devfs_mk_dir(NULL,txt,NULL) + devfs_mk_dir(string,A) @@ @@ error words = [devfs_mk_dir] coccinelle-1.0.0-rc19/parsing_cocci/tests/2.cocci0000644000175000017500000000050312247437436020476 0ustar eugeneugen@@ struct i2c_client x; @@ - x.name + x.dev.name @@ struct i2c_client *p; expression E; @@ ( - p->data = E + i2c_set_clientdata(p,E) | - p->data + i2c_get_clientdata(p) ) @@ struct i2c_client *p; expression E1, E2; @@ p = kmalloc(E1, E2); ? if (!p) { ... } + memcpy(p,0,E1); ... WHEN != memcpy(p,...) coccinelle-1.0.0-rc19/parsing_cocci/tests/25.cocci0000644000175000017500000000052112247437436020563 0ustar eugeneugen@@ expression A, C, E; mdk_rdev_t *rdev; identifier B, D, X, Y; @@ ( X = mddev_to_conf(A); ... - atomic_dec(&X->B[C].rdev->nr_pending) + rdev_dec_pending(X->B[C].rdev,A) ... | ... - atomic_dec(&rdev->nr_pending) + rdev_dec_pending(rdev,Y->mddev) ... ) @@ expression F; @@ error words = [atomic_dec(&F->nr_pending)] coccinelle-1.0.0-rc19/parsing_cocci/tests/problems0000644000175000017500000000141112247437436021100 0ustar eugeneugen1.cocci: ok 2.cocci: ok 3.cocci: ok 4.cocci: ok 5.cocci: ok 6.cocci: how to specify that there is no while loop around some code? 7.cocci: ok 8.cocci: don't allow a metavariable to be declared as filename, don't support filename - and + syntax 9.cocci: ok 10.cocci: ok 11.cocci: don't allow structure declarations; don't allow mixing top-level declarations and statement nests 12.cocci: ok 13.cocci: ok 14.cocci: don't allow ( | ) on a function header (up to { ) 15.cocci: ok 16.cocci: ok 17.cocci: don't allow ( | ) with only + fragments 18.cocci: ok 19.cocci: ok 20.cocci: ok 21.cocci: ok 22.cocci: ok 23.cocci: rule not yet written 24.cocci: rule not yet written 25.cocci: ok 26.cocci: ok 27.cocci: ok 28.cocci: ok 29.cocci: ok 30.cocci: okcoccinelle-1.0.0-rc19/parsing_cocci/tests/10.cocci0000644000175000017500000000016012247437436020554 0ustar eugeneugen@@ expression E; @@ - pnp_activate_dev(E, NULL) + pnp_activate_dev(E) @@ @@ error words = [pnp_activate_dev] coccinelle-1.0.0-rc19/parsing_cocci/tests/24.cocci0000644000175000017500000000000012247437436020552 0ustar eugeneugencoccinelle-1.0.0-rc19/parsing_cocci/tests/19.cocci0000644000175000017500000000073112247437436020571 0ustar eugeneugen@@ struct gendisk g; expression E; @@ ?- g.nr_real = E; @@ struct gendisk g; @@ error words = [g.nr_real] @@ struct gendisk *A; expression B, E; struct gendisk *C; int E1;@@ ( add_gendisk(C+E1); ooo - A[minor(B)].nr_sects = E; + set_capacity(C[&DEVICE_NR(B)],E); | - A->part[B].nr_sects = E; + set_capacity(A+B,E); | add_gendisk(C+E1); ooo - A[minor(B)].nr_sects + get_capacity(C[&DEVICE_NR(B)]) ooo | ... - A->part[B].nr_sects + get_capacity(A+B) ... ) coccinelle-1.0.0-rc19/parsing_cocci/tests/23.cocci0000644000175000017500000000054712247437436020571 0ustar eugeneugen@@ expression X, Y, E; identifier field; error err; @@ - Y = init_etherdev(NULL,X); + Y = alloc_etherdev(X); ... Y.field = E; + if (!register_netdev(Y)) { + kfree(Y); + return err; + } @@ error err; @@ Y = alloc_etherdev(X); <... if (...) { ... - unregister_netdev(Y) ... return err; } ...> ... register_netdev(Y) ... coccinelle-1.0.0-rc19/parsing_cocci/tests/12.cocci0000644000175000017500000000102212247437436020554 0ustar eugeneugen@@ expression E1, E2, E3; @@ - usb_deregister_dev(E1, E2, E3); + usb_deregister_dev(E2, E3); @@ struct usb_driver d; !expression fops_val; @@ - d.fops = fops_val; @@ struct usb_driver d; !int minor_val; @@ - d.minor = minor_val; @@ struct usb_driver d; int num_minor_val; @@ - d.num_minor = num_minor_val; @@ expression E1, E2, E3; identifier ret; statement S; @@ - ret = usb_register_dev(E1, E2, E3); + ret = usb_register_dev(fops_val, minor_val, E2, E3); - if (ret) { - if (ret != -ENODEV) S - ... - } + if (ret) S coccinelle-1.0.0-rc19/parsing_cocci/tests/17.cocci0000644000175000017500000000032412247437436020565 0ustar eugeneugen@@ expression X, Y; @@ - bio_endio(X,Y) ( + bio_endio(X, bio_sectors(X) << 9, Y ? 0 : -EIO) | + bio_endio(X, X->bi_size << 9, Y ? 0 : -EIO) ) @@ expression X; @@ - bio_io_error(X) + bio_io_error(X,X->bi_size) coccinelle-1.0.0-rc19/parsing_cocci/tests/14.cocci0000644000175000017500000000052112247437436020561 0ustar eugeneugen@@ !type A; type A1; identifier X, X1; expression Y, Z; @@ ( A X; ooo A1 X1; ) <... request_irq(X->irq, Y, Z) ... <... X1->irq = X->irq; ...> ...> @@ identifier X2; local function fn; @@ ( fn(..., A1 X2, ...) { | fn(...) { A1 X2; ) <... - synchronize_irq() + synchronize_irq(X2) ...> } coccinelle-1.0.0-rc19/parsing_cocci/tests/11.cocci0000644000175000017500000000310712247437436020561 0ustar eugeneugen@@ identifier usb; @@ @@ local function probe_fn; local function disconnect_fn; int minor; @@ struct usb_driver usb = { ooo probe: probe_fn, ooo disconnect: disconnect_fn, ooo minor: minor, ooo }; @@ int minor_offset; expression E1, E2, E3, E4, E5, E6; type T; T moe; identifier field; identifier v; expression L1, L2, L3, L; statement loop_body; @@ ( probe_fn(...) { ... int v; ... WHEN != v = L + if (usb_register_dev(&usb, 1, &v)) { while(L1) { <... v = L2; ...> } + } ... WHEN != v = L ! moe.field = v; ... WHEN != v = L devfs_register(E1, E2, E3, USB_MAJOR, minor + moe.field, E4, E5, E6) ... WHEN != v = L } | probe_fn(...) { ... int v; ... WHEN != v = L + if (usb_register_dev(&usb, 1, &v)) { while(L1) { <... v = L2; ...> } + } ... WHEN != v = L ( ! moe.field = v; ooo WHEN != v = L devfs_register(E1, E2, E3, USB_MAJOR, minor + v, E4, E5, E6) ) ... WHEN != v = L } | probe_fn(...) { ... WHEN != moe.field = L + if (usb_register_dev(&usb, 1, &moe.field)) { while(L1) { <... moe.field = L2; ...> } + } ... WHEN != moe.field = L devfs_register(E1, E2, E3, USB_MAJOR, minor + moe.field, E4, E5, E6) ... WHEN != moe.field = L } ) @@ T E; identifier f; @@ disconnect_fn(...) { *** ! devfs_unregister(E.f) + usb_deregister_dev(&usb, 1, E.field) *** } coccinelle-1.0.0-rc19/parsing_cocci/tests/16.cocci0000644000175000017500000000012512247437436020563 0ustar eugeneugen@@ @@ --- a/drivers/scsi/... +++ b/drivers/scsi/... - ATA_MAX_PRD + LIBATA_MAX_PRD coccinelle-1.0.0-rc19/parsing_cocci/tests/20.cocci0000644000175000017500000000101612247437436020556 0ustar eugeneugen@@ expression A, B, C, D; @@ - snd_pcm_lib_preallocate_pci_pages_for_all(A, B, C, D) + snd_pcm_lib_preallocate_pages_for_all(B, SNDRV_DMA_TYPE_DEV, snd_dma_pci_data(A), C, D) @@ expression A, B, C; @@ - snd_pcm_lib_preallocate_isa_pages_for_all(A, B, C) + snd_pcm_lib_preallocate_pages_for_all(A, SNDRV_DMA_TYPE_DEV, snd_dma_isa_data(), B, C) @@ expression A, B, C, D; @@ - snd_pcm_lib_preallocate_sbus_pages_for_all(A, B, C, D) + snd_pcm_lib_preallocate_pages_for_all(B, SNDRV_DMA_TYPE_SBUS, snd_dma_sbus_data(A), C, D) coccinelle-1.0.0-rc19/parsing_cocci/tests/27.cocci0000644000175000017500000000023212247437436020564 0ustar eugeneugen@@ local function f; struct IsdnCard card; @@ card.irq_func = f @@ fresh identifier mode_switch; @@ f(... + , int mode_switch ) { ... } coccinelle-1.0.0-rc19/parsing_cocci/tests/1.cocci0000644000175000017500000000040412247437436020475 0ustar eugeneugen@@ expression E; @@ - #include <... ( - mem_map_reserve(E) + SetPageReserved(E) | - cs4x_mem_map_reserve(E) + SetPageReserved(E) | - mem_map_unreserve(E) + ClearPageReserved(E) | - cs4x_mem_map_unreserve(E) + ClearPageReserved(E) ) ...> coccinelle-1.0.0-rc19/parsing_cocci/tests/Makefile0000644000175000017500000000473612247437436021007 0ustar eugeneugenall: 1.output 2.output 3.output 4.output 5.output 6.output 7.output \ 8.output 9.output 10.output 11.output 12.output 13.output 14.output \ 15.output 16.output 17.output 18.output 19.output 20.output 21.output \ 22.output 23.output 24.output 25.output 26.output 27.output 28.output \ 29.output 30.output 1.output: 1.cocci ../cocci_parser ../cocci_parser 1.cocci > 1.output 2.output: 2.cocci ../cocci_parser ../cocci_parser 2.cocci > 2.output 3.output: 3.cocci ../cocci_parser ../cocci_parser 3.cocci > 3.output 4.output: 4.cocci ../cocci_parser ../cocci_parser 4.cocci > 4.output 5.output: 5.cocci ../cocci_parser ../cocci_parser 5.cocci > 5.output 6.output: 6.cocci ../cocci_parser ../cocci_parser 6.cocci > 6.output 7.output: 7.cocci ../cocci_parser ../cocci_parser 7.cocci > 7.output 8.output: 8.cocci ../cocci_parser ../cocci_parser 8.cocci > 8.output 9.output: 9.cocci ../cocci_parser ../cocci_parser 9.cocci > 9.output 10.output: 10.cocci ../cocci_parser ../cocci_parser 10.cocci > 10.output 11.output: 11.cocci ../cocci_parser ../cocci_parser 11.cocci > 11.output 12.output: 12.cocci ../cocci_parser ../cocci_parser 12.cocci > 12.output 13.output: 13.cocci ../cocci_parser ../cocci_parser 13.cocci > 13.output 14.output: 14.cocci ../cocci_parser ../cocci_parser 14.cocci > 14.output 15.output: 15.cocci ../cocci_parser ../cocci_parser 15.cocci > 15.output 16.output: 16.cocci ../cocci_parser ../cocci_parser 16.cocci > 16.output 17.output: 17.cocci ../cocci_parser ../cocci_parser 17.cocci > 17.output 18.output: 18.cocci ../cocci_parser ../cocci_parser 18.cocci > 18.output 19.output: 19.cocci ../cocci_parser ../cocci_parser 19.cocci > 19.output 20.output: 20.cocci ../cocci_parser ../cocci_parser 20.cocci > 20.output 21.output: 21.cocci ../cocci_parser ../cocci_parser 21.cocci > 21.output 22.output: 22.cocci ../cocci_parser ../cocci_parser 22.cocci > 22.output 23.output: 23.cocci ../cocci_parser ../cocci_parser 23.cocci > 23.output 24.output: 24.cocci ../cocci_parser ../cocci_parser 24.cocci > 24.output 25.output: 25.cocci ../cocci_parser ../cocci_parser 25.cocci > 25.output 26.output: 26.cocci ../cocci_parser ../cocci_parser 26.cocci > 26.output 27.output: 27.cocci ../cocci_parser ../cocci_parser 27.cocci > 27.output 28.output: 28.cocci ../cocci_parser ../cocci_parser 28.cocci > 28.output 29.output: 29.cocci ../cocci_parser ../cocci_parser 29.cocci > 29.output 30.output: 30.cocci ../cocci_parser ../cocci_parser 30.cocci > 30.output clean: /bin/rm ?.output ??.output coccinelle-1.0.0-rc19/parsing_cocci/tests/5.cocci0000644000175000017500000000073212247437436020505 0ustar eugeneugen@@ struct IsdnCard v; local function fn; @@ v.irq_func = &fn; @@ identifier intno, dev_id, regs; @@ fn(int intno, void *dev_id, struct pt_regs *regs) { <... ( - spin_lock(...); | - spin_unlock(...); ) ...> } @@ identifier cs; @@ fn(int intno, void *dev_id, struct pt_regs *regs) { ... struct IsdnCardState *cs = dev_id; + spin_lock(&cs->lock); ... ?- if (!cs) { ... } ... + spin_unlock(&cs->lock); return; } coccinelle-1.0.0-rc19/parsing_cocci/tests/28.cocci0000644000175000017500000000032612247437436020571 0ustar eugeneugen@@ +struct urb u1; struct urb u2; expression E, E2; @@ <*** u1.transfer_flags = URB_ASYNC_UNLINK|E; *** WHEN != u1.transfer_flags = E2; <... - usb_unlink_urb(u2) + usb_kill_urb(u2) ...> ***> coccinelle-1.0.0-rc19/parsing_cocci/tests/15.cocci0000644000175000017500000000027012247437436020563 0ustar eugeneugen@@ {struct input_dev, struct gameport} dev; @@ ( - dev.idbus + dev.id.bustype | - dev.idvendor + dev.id.vendor | - dev.idproduct + dev.id.product | - dev.idversion + dev.id.version ) coccinelle-1.0.0-rc19/parsing_cocci/tests/6.cocci0000644000175000017500000001431612247437436020511 0ustar eugeneugen@@ ?local function read_fn; ?local function write_fn; ?local function write_block_fn; !type T; identifier dev; identifier subaddr; @@ - read_fn(T *dev, unsigned char subaddr) { - ... - not while (...) { - ooo - - ooo - - ooo - not } - ... - } @@ identifier dev; identifier subaddr; identifier data; @@ - write_fn(T *dev, unsigned char subaddr, unsigned char data) { - ... - not while (...) { - - not } - ... - } @@ identifier dev; identifier data; identifier len; @@ - write_block_fn(T *dev, unsigned char *data, unsigned int len) { - - } - ooo> - } @@ !local function attach_fn, detach_fn, command_fn; expression E, E1, E2, E3, E4; struct i2c_driver I; @@ ooo WHEN !<= I.{attach,detach,command} = E; struct i2c_driver i2c_driver_struct = { E1, E2, E3, E4, attach_fn, detach_fn, command_fn }; ooo @@ !local function init_fn, exit_fn; @@ module_init(init_fn); ooo module_exit(exit_fn); @@ !identifier i2c_driver_struct; @@ init_fn(...) { ... i2c_register_driver(&i2c_driver_struct); ... } @@ filename A; fresh identifier A##_probe; fresh identifier normal_i2c, normal_i2c_range, probe, probe_range, ignore, ignore_range, force, addr_data, client_template; @@ --- a/.../A##.c +++ b/.../A##.c -! #include + #include + ... + static unsigned short normal_i2c[] = {34>>1, I2C_CLIENT_END }; + static unsigned short normal_i2c_range[] = { I2C_CLIENT_END }; + static unsigned short probe[2] = { I2C_CLIENT_END, I2C_CLIENT_END }; + static unsigned short probe_range[2] = { I2C_CLIENT_END, I2C_CLIENT_END }; + static unsigned short ignore[2] = { I2C_CLIENT_END, I2C_CLIENT_END }; + static unsigned short ignore_range[2] = { I2C_CLIENT_END, I2C_CLIENT_END }; + static unsigned short force[2] = { I2C_CLIENT_END, I2C_CLIENT_END }; + + static struct i2c_client_address_data addr_data = { + normal_i2c, normal_i2c_range, + probe, probe_range, + ignore, ignore_range, + force + }; + static struct i2c_client client_template; @@ identifier bus; @@ struct T { ... !- struct i2c_bus *bus; + struct i2c_client *client; ... + struct semaphore lock; } @@ expression E; @@ ! static struct i2c_driver i2c_driver_struct = { E, - I2C_DRIVERID_VIDEODECODER, - I2C_##A/u, I2C_##A/u + 1, + I2C_DRIVERID_##A/u, + I2C_DF_NOTIFY, - attach_fn, + probe_fn, detach_fn, command_fn }; + static struct i2c_client client_template = { + "##A##_client", -1, 0, 0, NULL, &i2c_driver_struct + }; @@ @@ init_fn(...) { ... - C[i2c_register_driver(&i2c_driver_struct)] + C[i2c_add_driver(&i2c_driver_struct)] ... } @@ @@ exit_fn(...) { ... - C[i2c_unregister_driver(&i2c_driver_struct)] + C[i2c_del_driver(&i2c_driver_struct)] ... } error words = [i2c_register_driver, i2c_unregister_driver] @@ identifier device; identifier coder; fresh identifier adap, addr, flags, kind; fresh identifier client; expression E; error expression error_code; @@ - attach_fn(struct i2c_device *device) + attach_fn(struct i2c_adapter *adap, int addr, unsigned long flags, int kind) { + struct i2c_client *client; + client = kmalloc(sizeof(*client), GFP_KERNEL); + if(client == NULL) return -ENOMEM; + client_template.adapter = adap; + client_template.addr = addr; + memcpy(client, &client_template, sizeof(*client)); ... <... + kfree(client); return error_code; ...> ... + init_MUTEX(&coder->lock); + i2c_attach_client(client); + MOD_INC_USE_COUNT; return E; } { ooo <... - MOD_INC_USE_COUNT ...> ooo <... - MOD_DEC_USE_COUNT ...> ooo } { ... ! T *coder; ... - device->data = coder; ... <... - device->data + coder ...> } { ... + client->data = coder; coder->bus = device->bus; ... } { ooo <... - device->bus + client ...> ooo <... - coder->bus + coder->client ...> ooo <... - device->addr + addr ...> ooo } { <... - device + client ...> } error words = [attach_fn: device->data] @@ identifier device; fresh identifier client; @@ ( attach_fn(struct i2c_device *device) { | command_fn(struct i2c_device *device, ...) { ) <... device_fn(device,...) ...> } @@ @@ - device_fn(struct i2c_device *device, ...) { + device_fn(struct i2c_client *client, ...) { <... - device + client ...> } @@ fresh identifier adap; @@ + static int A##_probe(struct i2c_adapter *adap) { + return i2c_probe(adap, &addr_data, A##_attach); + } ... @@ fresh identifier client; @@ - detach_fn(struct i2c_device *device) + detach_fn(struct i2c_client *client) { <... - device + client ...> } { + i2c_detach_client(client); ... + kfree(client); MOD_DEC_USE_COUNT; ... } @@ identifier device; fresh identifier client; @@ - command_fn(struct i2c_device *device, ...) { + command_fn(struct i2c_client *client, ...) { <... - device + client ...> } @@ local function fn; identifier client; expression X1, Y1, X2, Y2, Z2, X3, Y3, Z3, X4, Y4, X5, Y5, Z5, X6, Y6, Z6; @@ ( fn(...) { struct i2c_client *client; | fn(..., struct i2c_client *client, ...) { ) ooo <... - read_fn(X1,Y1) + i2c_smbus_read_byte(client) ...> ooo <... - write_fn(X2,Y2,Z2) + i2c_smbus_write_byte(client,Y2,Z2) ...> ooo <... - write_block_fn(X3,Y3,Z3) + i2c_master_send(client,Y3,Z3) ...> ooo } fn(...) { ooo <... - read_fn(X4,Y4) + i2c_smbus_read_byte(X4->client) ...> ooo <... - write_fn(X5,Y5,Z5) + i2c_smbus_write_byte(X5->client,Y5,Z5) ...> ooo <... - write_block_fn(X6,Y6,Z6) + i2c_master_send(X6->client,Y6,Z6) ...> ooo } coccinelle-1.0.0-rc19/parsing_cocci/Makefile0000644000175000017500000001210212247442615017622 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif TARGET=cocci_parser OCAMLCFLAGS ?= -g OPTFLAGS ?= -g LEXER_SOURCES = lexer_cocci.mll CLI_LEXER_SOURCES = lexer_cli.mll SCRIPT_LEXER_SOURCES = lexer_script.mll PARSER_SOURCES = parser_cocci_menhir.mly SOURCES = flag_parsing_cocci.ml type_cocci.ml ast_cocci.ml ast0_cocci.ml \ pretty_print_cocci.ml unparse_ast0.ml visitor_ast0_types.ml \ visitor_ast.ml visitor_ast0.ml compute_lines.ml comm_assoc.ml \ iso_pattern.ml iso_compile.ml single_statement.ml simple_assignments.ml \ get_metas.ml ast0toast.ml check_meta.ml top_level.ml type_infer.ml \ test_exps.ml unitary_ast0.ml arity.ml index.ml context_neg.ml \ adjust_pragmas.ml insert_plus.ml function_prototypes.ml \ unify_ast.ml semantic_cocci.ml data.ml free_vars.ml safe_for_multi_decls.ml \ parse_printf.ml parse_aux.ml disjdistr.ml \ $(LEXER_SOURCES:.mll=.ml) $(PARSER_SOURCES:.mly=.ml) \ $(CLI_LEXER_SOURCES:.mll=.ml) $(SCRIPT_LEXER_SOURCES:.mll=.ml) \ cocci_grep.ml get_constants2.ml id_utils.ml adjacency.ml commas_on_lists.ml \ parse_cocci.ml command_line.ml LIBS=../commons/commons.cma ../globals/globals.cma SYSLIBS = str.cma unix.cma INCLUDES = -I ../commons \ -I ../commons/ocamlextra \ -I ../globals \ -I $(MENHIRDIR) MENHIRMOD=menhirLib.cmo MENHIROMOD=menhirLib.cmx # The Caml compilers. OCAMLCFLAGS ?= -g -dtypes EXEC=$(TARGET).byte EXEC=$(TARGET) LIB=$(TARGET).cma OPTLIB=$(LIB:.cma=.cmxa) GENERATED= $(LEXER_SOURCES:.mll=.ml) \ $(CLI_LEXER_SOURCES:.mll=.ml) $(SCRIPT_LEXER_SOURCES:.mll=.ml) \ $(PARSER_SOURCES:.mly=.ml) $(PARSER_SOURCES:.mly=.mli) OBJS = $(SOURCES:.ml=.cmo) OPTOBJS = $(OBJS:.cmo=.cmx) ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(LIB) local: $(EXEC) all.opt: @$(MAKE) $(OPTLIB) BUILD_OPT=yes $(LIB): $(GENERATED) $(OBJS) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -I $(MENHIRDIR) -a -o $(LIB) $(MENHIRMOD) $(OBJS) $(OPTLIB): $(GENERATED) $(OPTOBJS) $(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) -I $(MENHIRDIR) -a -o $(OPTLIB) $(MENHIROMOD) $(OPTOBJS) $(EXEC): $(OBJS) main.cmo $(LIBS) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -o $(EXEC) $(SYSLIBS) $(LIBS) $(OBJS) main.cmo else all: cd .. && $(OCAMLBUILD) parsing_cocci/parsing_cocci.cma all.opt: cd .. && $(OCAMLBUILD) parsing_cocci/parsing_cocci.cmxa $(EXEC): cd .. && $(OCAMLBUILD) parsing_cocci/main.byte cp ../_build/parsing_cocci/main.byte $(EXEC) clean:: cd .. && $(OCAMLBUILD) -clean rm -f $(TARGET) $(TARGET).byte $(TARGET).native endif clean:: rm -f $(LIB) rm -f $(OPTLIB) $(LIB:.cma=.a) rm -f $(TARGET) .SUFFIXES: .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< .mli.cmi: $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< .ml.cmx: $(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) -c $< $(LEXER_SOURCES:.mll=.ml) : $(LEXER_SOURCES) $(OCAMLLEX) $(LEXER_SOURCES) ifneq ($(FEATURE_OCAMLBUILD),yes) $(PARSER_SOURCES:.mly=.ml) $(PARSER_SOURCES:.mly=.mli) : $(PARSER_SOURCES) $(MENHIR) --ocamlc "${OCAMLC}" --ocamldep "${OCAMLDEP}" --table --base parser_cocci_menhir $(PARSER_SOURCES) else $(PARSER_SOURCES:.mly=.ml) $(PARSER_SOURCES:.mly=.mli) : $(PARSER_SOURCES) cd .. && $(OCAMLBUILD) parsing_cocci/$@ cp ../_build/parsing_cocci/$@ $@ endif $(CLI_LEXER_SOURCES:.mll=.ml): $(CLI_LEXER_SOURCES) $(OCAMLLEX) $(CLI_LEXER_SOURCES) $(SCRIPT_LEXER_SOURCES:.mll=.ml): $(SCRIPT_LEXER_SOURCES) $(OCAMLLEX) $(SCRIPT_LEXER_SOURCES) distclean:: clean if test -z "${KEEP_GENERATED}"; then \ @echo cleaning generated parsers and lexers; \ rm -f $(GENERATED); fi # clean rule for others files clean:: rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ #*# rm -f .depend .PHONEY: depend .depend depend: $(GENERATED) $(OCAMLDEP) *.mli *.ml > .depend lexer_cocci.ml: lexer_cocci.mll lexer_script.ml: lexer_script.mll lexer_cli.ml: lexer_cli.mll parser_cocci_menhir.ml: parser_cocci_menhir.mly lexer_cocci.mll parser_cocci_menhir.mli: parser_cocci_menhir.mly lexer_cocci.mll ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.0-rc19/parsing_cocci/merge.ml0000644000175000017500000001670512247442615017630 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./merge.ml" (* given parsed minus code and a stream of + code, figure out where to put the + code in the mcode of the minus code *) (* Need to be able to find the nearest inhabited line rather than just adding 1 or subtracting 1 to the actual line number. This is an issue for plus.ml as well. This problem is dealt with by the logical line field, which is not incremented for blank lines. *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Step 1: convert minus/context code to an ordered stream of tokens *) type position = Minus of Ast.info * Ast.anything list list ref | Context of Ast.info * Ast.anything Ast.befaft ref | Bad of Ast.info let mcode = function (_,_,Ast.MINUS(info,plus_stream)) -> [Minus (info,plus_stream)] | (_,_,Ast.CONTEXT(info,plus_stream)) -> [Context (info,plus_stream)] | _ -> failwith "not possible 1" let bad_mcode = function (_,_,Ast.MINUS(info,plus_stream)) -> Bad(info) | (_,_,Ast.CONTEXT(info,plus_stream)) -> Bad(info) | _ -> failwith "not possible 2" let make_bad l = List.map (function Minus(info,plus_stream) -> Bad(info) | Context(info,plus_stream) -> Bad(info) | x -> x) l (* --------------------------------------------------------------------- *) (* combiner info *) let bind x y = x @ y let option_default = [] (* --------------------------------------------------------------------- *) let get_option f = function Some x -> f x | None -> option_default let ident recursor k i = k i (* nothing special to do *) let expression recursor k e = match Ast0.unwrap e with Ast0.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode) | Ast0.Estars(dots,whencode) -> (bad_mcode dots) :: (get_option (function x -> make_bad(recursor.V0.combiner_expression x)) whencode) | _ -> k e let donothing recursor k ft = k ft (* needs a case for things to which new code cannot be attached *) let parameterTypeDef recursor k p = match Ast0.unwrap p with Ast0.Pdots(dots) -> [bad_mcode dots] | Ast0.Pcircles(dots) -> [bad_mcode dots] | _ -> k p let statement recursor k s = match Ast0.unwrap s with Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode) | Ast0.Stars(d,whencode) -> (bad_mcode d) :: (get_option (function x -> make_bad(recursor.V0.combiner_statement_dots x)) whencode) | _ -> k s let top_level recursor k t = match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> [bad_mcode old_file;bad_mcode new_file] | Ast0.ERRORWORDS(exps) -> make_bad (List.concat (List.map recursor.V0.combiner_expression exps)) | _ -> k t let recursor = V0.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing ident expression donothing donothing parameterTypeDef donothing statement top_level let rule code = List.concat (List.map recursor.V0.combiner_top_level code) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Step 2: merge the plus stream with the minus/context tokens *) (* Mcode *) let get_start l = let (_,_,_,start,_) = List.hd (List.hd l) in start let get_finish l = let (_,_,_,_,finish) = List.hd (List.rev (List.hd (List.rev l))) in finish let get_real_start l = let (_,start,_,_,_) = List.hd (List.hd l) in start let get_real_finish l = let (_,_,finish,_,_) = List.hd (List.rev (List.hd (List.rev l))) in finish let get_minus_next_line mline = function [] -> mline + 1 | Bad(info)::xs -> info.Ast.logical_line | Minus(info,_)::xs -> info.Ast.logical_line | Context(info,_)::xs -> info.Ast.logical_line let drop_lines l = List.map (List.map (function (x,_,_,_,_) -> x)) l let rec merge minus_stream plus_stream = match (minus_stream,plus_stream) with (_,[]) -> () | ([],plus::plus_stream) -> failwith (Printf.sprintf "minus stream ran out before plus stream\n(plus code begins on line %d)\n" (get_real_start plus)) | (Bad(info)::minus_stream,plus::plus_stream) -> let pfinish = get_finish plus in if info.Ast.logical_line > pfinish then failwith (Printf.sprintf "plus code starting on line %d has no minus or context code to attach to\n" (get_real_start plus)) else merge minus_stream (plus::plus_stream) | (((Minus(info,cell)::minus_stream) as all_minus),plus::plus_stream) -> let mline = info.Ast.logical_line in let mnext_line = get_minus_next_line mline minus_stream in let pstart = get_start plus in let pfinish = get_finish plus in if pstart < mline && pfinish > mline then (cell := (drop_lines plus) @ !cell; merge minus_stream plus_stream) else if pfinish + 1 = mline then (cell := (drop_lines plus) @ !cell; merge all_minus plus_stream) else if not(mline = mnext_line) && (pstart - 1 = mline) then (cell := !cell @ (drop_lines plus); merge minus_stream plus_stream) else if pfinish < mline then Printf.printf "failed to merge + code between lines %d and %d" (get_real_start plus) (get_real_finish plus) else merge minus_stream (plus::plus_stream) | (((Context(info,cell)::minus_stream) as all_minus),plus::plus_stream) -> let mline = info.Ast.logical_line in let mnext_line = get_minus_next_line mline minus_stream in let pstart = get_start plus in let pfinish = get_finish plus in if pfinish + 1 = mline then (cell := Ast.BEFORE (drop_lines plus); merge all_minus plus_stream) else if not(mline = mnext_line) && (pstart - 1 = mline) then begin (match !cell with Ast.BEFORE x -> cell := Ast.BEFOREAFTER (x,drop_lines plus) | _ -> cell := Ast.AFTER (drop_lines plus)); merge minus_stream plus_stream end else if pfinish < mline then Printf.printf "failed to merge + code between lines %d and %d" (get_real_start plus) (get_real_finish plus) else merge minus_stream (plus::plus_stream) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Entry point *) let do_merge minus plus_stream = let minus_tokens = rule minus in merge minus_tokens plus_stream coccinelle-1.0.0-rc19/parsing_cocci/parse_printf.mli0000644000175000017500000000230412247442615021364 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./parse_printf.mli" exception Not_format_string val get_format_string : string -> string * string coccinelle-1.0.0-rc19/parsing_cocci/comm_assoc.mli0000644000175000017500000000235612247442615021022 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./comm_assoc.mli" val comm_assoc : Ast0_cocci.rule -> string (* rule name *) -> string list (* dropped isos *) -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/function_prototypes.ml0000644000175000017500000004021012247442615022652 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./function_prototypes.ml" module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types type id = Id of string | Meta of Ast.meta_name let rec get_name name = match Ast0.unwrap name with Ast0.Id(nm) -> [Id(Ast0.unwrap_mcode nm)] | Ast0.MetaId(nm,_,_,_) | Ast0.MetaFunc(nm,_,_) | Ast0.MetaLocalFunc(nm,_,_) -> [Meta(Ast0.unwrap_mcode nm)] | Ast0.AsIdent(id1,id2) -> failwith "not supported" | Ast0.DisjId(_,id_list,_,_) -> List.concat (List.map get_name id_list) | Ast0.OptIdent(id) | Ast0.UniqueIdent(id) -> get_name id (* --------------------------------------------------------------------- *) (* collect all of the functions *) let brace_to_semi (_,arity,info,mcodekind,pos,adj) = let info = (* drop column information, so that with -smpl_spacing the semicolon will come out right after the close parenthesis *) {info with Ast0.pos_info = {info.Ast0.pos_info with Ast0.column = -1}} in (";",Ast0.NONE,info,mcodekind,pos,adj) let collect_function (stm : Ast0.statement) = match Ast0.unwrap stm with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> let stg = match List.filter (function Ast0.FStorage(_) -> true | _ -> false) fninfo with [Ast0.FStorage(s)] -> Some s | _ -> None in let ty = match List.filter (function Ast0.FType(_) -> true | _ -> false) fninfo with [Ast0.FType(t)] -> Some t | _ -> None in List.map (function nm -> (nm,stm, Ast0.copywrap stm (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()), Ast0.copywrap stm (Ast0.UnInit (stg, Ast0.copywrap stm (Ast0.FunctionType(ty,lp,params,rp)), name,brace_to_semi lbrace)))))) (get_name name) | _ -> [] let collect_functions stmt_dots = List.concat (List.map collect_function (Ast0.undots stmt_dots)) let drop_positions = let mcode (term,arity,info,mc,_,adj) = (term,arity,info,mc,ref [],adj) in let donothing r k e = k e in let res = V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in res.VT0.rebuilder_rec_statement let get_all_functions rule = let res = match Ast0.unwrap rule with Ast0.NONDECL(stmt) -> collect_function stmt | Ast0.CODE(rule_elem_dots) -> collect_functions rule_elem_dots | _ -> [] in List.map (function (nm,def,vl) -> (nm, (def, drop_positions ((Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement vl)))) res (* --------------------------------------------------------------------- *) (* try to match up the functions *) (* pass through the - and + functions in lockstep, until one runs out. Then process the remaining minuses, if any. If we can find another function of the same name for either the current - or + function, take that one. Otherwise, align the two current ones. *) let rec align all_minus all_plus = let rec loop = function ([],_) -> [] | ((mname,(mdef,mproto))::minus,[]) -> (try let (_,pproto) = List.assoc mname all_plus in (mname,mdef,mproto,Some pproto)::(loop (minus,[])) with Not_found -> (mname,mdef,mproto,None)::(loop (minus, []))) | ((mname,(mdef,mproto))::minus,(pname,(pdef,pproto))::plus) -> if mname = pname then (mname,mdef,mproto,Some pproto)::(loop (minus, [])) else (try let (_,pproto_for_minus) = List.assoc mname all_plus in (try let _ = List.assoc mname all_plus in (* protos that match both *) (mname,mdef,mproto,Some pproto_for_minus)::(loop (minus, plus)) with Not_found -> (* proto that matches only minus *) (mname,mdef,mproto,Some pproto_for_minus):: (loop (minus, ((pname,(pdef,pproto))::plus)))) with Not_found -> (try let _ = List.assoc mname all_plus in (* proto only for plus *) (mname,mdef,mproto,None)::(loop (minus, plus)) with Not_found -> (* protos for no one *) (mname,mdef,mproto,Some pproto)::(loop (minus, plus)))) in List.filter changed_proto (loop (all_minus, all_plus)) (* --------------------------------------------------------------------- *) and strip = let donothing r k e = {(Ast0.wrap (Ast0.unwrap (k e))) with Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE)} in let mcode (mc,_,_,_,_,_) = (mc,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE, ref [],-1) in (* need a case for everything that has an unvisited component and can be in a function prototype. Also get rid of constraints because pcre constraints cannot be compared. *) let ident r k e = donothing r k (Ast0.rewrap e (match Ast0.unwrap e with Ast0.MetaId(nm,constraints,seed,pure) -> Ast0.MetaId(nm,Ast.IdNoConstraint,seed,Ast0.Pure) | Ast0.MetaFunc(nm,constraints,pure) -> Ast0.MetaFunc(nm,Ast.IdNoConstraint,Ast0.Pure) | Ast0.MetaLocalFunc(nm,constraints,pure) -> Ast0.MetaLocalFunc(nm,Ast.IdNoConstraint,Ast0.Pure) | e -> e)) in let typeC r k e = donothing r k (Ast0.rewrap e (match Ast0.unwrap e with Ast0.MetaType(nm,pure) -> Ast0.MetaType(nm,Ast0.Pure) | e -> e)) in let param r k e = donothing r k (Ast0.rewrap e (match Ast0.unwrap e with Ast0.MetaParam(nm,pure) -> Ast0.MetaParam(nm,Ast0.Pure) | Ast0.MetaParamList(nm,lenname,pure) -> Ast0.MetaParamList(nm,lenname,Ast0.Pure) | e -> e)) in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing ident donothing typeC donothing param donothing donothing donothing donothing donothing and changed_proto = function (mname,mdef,mproto,None) -> true | (mname,mdef,mproto,Some pproto) -> not ((strip.VT0.rebuilder_rec_statement mproto) = (strip.VT0.rebuilder_rec_statement pproto)) (* --------------------------------------------------------------------- *) (* make rules *) let rec drop_param_name p = Ast0.rewrap p (match Ast0.unwrap p with Ast0.Param(p,_) -> Ast0.Param(p,None) | Ast0.OptParam(p) -> Ast0.OptParam(drop_param_name p) | Ast0.UniqueParam(p) -> Ast0.UniqueParam(p) | p -> p) let drop_names dec = let dec = (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement dec in match Ast0.unwrap dec with Ast0.Decl(info,uninit) -> (match Ast0.unwrap uninit with Ast0.UnInit(stg,typ,name,sem) -> (match Ast0.unwrap typ with Ast0.FunctionType(ty,lp,params,rp) -> let params = match Ast0.unwrap params with Ast0.DOTS(l) -> Ast0.rewrap params (Ast0.DOTS(List.map drop_param_name l)) | Ast0.CIRCLES(l) -> Ast0.rewrap params (Ast0.CIRCLES(List.map drop_param_name l)) | Ast0.STARS(l) -> failwith "unexpected stars" in Ast0.rewrap dec (Ast0.Decl (info, Ast0.rewrap uninit (Ast0.UnInit (stg, Ast0.rewrap typ (Ast0.FunctionType(ty,lp,params,rp)), name,sem)))) | _ -> failwith "function prototypes: unexpected type") | _ -> failwith "unexpected declaration") | _ -> failwith "unexpected term" let ct = ref 0 let new_name name = let n = !ct in ct := !ct + 1; name^"__"^(string_of_int n) let new_iname name index = name^"__"^(string_of_int index) let rec rename_param old_name all param index = match Ast0.unwrap param with Ast0.Param(ty,Some id) when all -> (match Ast0.unwrap id with Ast0.MetaId (((_,name),arity,info,mcodekind,pos,adj),constraints,seed,pure) -> let nm = ("__no_name__",new_name name) in let new_id = Ast0.rewrap id (Ast0.MetaId ((nm,arity,info,mcodekind,pos,adj),constraints,seed, Ast0.Pure)) in ([Ast.MetaIdDecl(Ast.NONE,nm)], Ast0.rewrap param (Ast0.Param(ty,Some new_id))) | _ -> ([],param)) | Ast0.Pdots(d) -> let nm = (old_name,new_iname "__P" index) in let nml = (old_name,new_iname "__n" index) in let new_id = Ast0.rewrap param (Ast0.MetaParamList(Ast0.rewrap_mcode d nm, Ast0.MetaListLen (Ast0.rewrap_mcode d nml), Ast0.Pure)) in (* only add both new metavariable declarations for the function definition case. For the prototype case the length should be inherited *) ((if not all then [Ast.MetaParamListDecl(Ast.NONE,nm,Ast.MetaLen nml); Ast.MetaListlenDecl(nml)] else [Ast.MetaParamListDecl(Ast.NONE,nm,Ast.MetaLen nml)]), new_id) | Ast0.OptParam(p) -> let (metavars,p) = rename_param old_name all p index in (metavars,Ast0.rewrap param (Ast0.OptParam(p))) | Ast0.UniqueParam(p) -> let (metavars,p) = rename_param old_name all p index in (metavars,Ast0.rewrap param (Ast0.UniqueParam(p))) | _ -> ([],param) let iota l = let rec loop n = function [] -> [] | x::xs -> n :: (loop (n+1) xs) in loop 1 l (* try to convert names in the - parameter list to new metavariables, to account for spelling mistakes on the part of the programmer *) let fresh_names old_name mdef dec = let res = ([],[],dec,mdef) in match Ast0.unwrap dec with Ast0.Decl(info,uninit) -> (match Ast0.unwrap uninit with Ast0.UnInit(stg,typ,name,sem) -> (match Ast0.unwrap typ with Ast0.FunctionType(ty,lp,params,rp) -> let (metavars,newdec) = let (metavars,l) = let params = Ast0.undots params in List.split (List.map2 (rename_param old_name true) params (iota params)) in (List.concat metavars, Ast0.rewrap dec (Ast0.Decl (info, Ast0.rewrap uninit (Ast0.UnInit (stg, Ast0.rewrap typ (Ast0.FunctionType (ty,lp,Ast0.rewrap params (Ast0.DOTS(l)), rp)), name,sem))))) in let (def_metavars,newdef) = match Ast0.unwrap mdef with Ast0.FunDecl(x,fninfo,name,lp,params,rp,lb,body,rb) -> let (def_metavars,def_l) = let params = Ast0.undots params in List.split (List.map2 (rename_param old_name false) params (iota params)) in (List.concat def_metavars, Ast0.rewrap mdef (Ast0.FunDecl(x,fninfo,name,lp, Ast0.rewrap params (Ast0.DOTS(def_l)), rp,lb,body,rb))) | _ -> failwith "unexpected function definition" in (metavars,def_metavars,newdec,newdef) | _ -> res) | _ -> res) | _ -> res (* since there is no + counterpart, the function must be completely deleted *) let no_names dec = match Ast0.unwrap dec with Ast0.Decl(info,uninit) -> (match Ast0.unwrap uninit with Ast0.UnInit(stg,typ,name,sem) -> (match Ast0.unwrap typ with Ast0.FunctionType(ty,lp,params,rp) -> Ast0.rewrap dec (Ast0.Decl (info, Ast0.rewrap uninit (Ast0.UnInit (stg, Ast0.rewrap typ (Ast0.FunctionType (ty,lp, Ast0.rewrap params (let info = Ast0.get_info params in let mcodekind = (* use the mcodekind of an atomic minused thing *) Ast0.get_mcode_mcodekind lp in let pdots = ("...",Ast0.NONE,info,mcodekind, ref [],-1) in Ast0.DOTS ([Ast0.rewrap params (Ast0.Pdots(pdots))])), rp)), name,sem)))) | _ -> dec) | _ -> dec) | _ -> dec let mkcode proto = Ast0.copywrap proto (Ast0.CODE(Ast0.copywrap proto (Ast0.DOTS [proto]))) let merge mproto pproto = let mproto = Compute_lines.compute_lines true [mkcode mproto] in let pproto = Compute_lines.compute_lines true [mkcode pproto] in let (m,p) = List.split(Context_neg.context_neg mproto pproto) in Insert_plus.insert_plus m p true (* no isos for protos *); (* convert to ast so that the + code will fall down to the tokens and off the artificially added Ast0.CODE *) let mproto = Ast0toast.ast0toast_toplevel (List.hd mproto) in (* clean up the wrapping added above *) match Ast.unwrap mproto with Ast.CODE mproto -> List.hd (Ast.undots mproto) | _ -> failwith "not possible" let make_rule rule_name = function (mname,mdef,mproto,Some pproto) -> let (metavars,mdef_metavars,mproto,mdef) = fresh_names rule_name mdef mproto in let no_name_mproto = drop_names mproto in let no_name_pproto = drop_names pproto in (metavars,mdef_metavars, [merge mproto pproto; merge no_name_mproto no_name_pproto],mdef) | (mname,mdef,mproto,None) -> ([],[],[Ast0toast.statement(no_names mproto)],mdef) (* --------------------------------------------------------------------- *) let reinsert mdefs minus = let table = List.map (function x -> match Ast0.unwrap x with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (name,x) | _ -> failwith "bad mdef") mdefs in List.map (function x -> match Ast0.unwrap x with Ast0.NONDECL(stmt) -> (match Ast0.unwrap stmt with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (try Ast0.rewrap x (Ast0.NONDECL(List.assoc name table)) with Not_found -> x) | _ -> x) | Ast0.CODE(rule_elem_dots) -> (match Ast0.undots rule_elem_dots with [f] -> (match Ast0.unwrap f with Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> (try Ast0.rewrap x (Ast0.CODE (Ast0.rewrap x (Ast0.DOTS [List.assoc name table]))) with Not_found -> x) | _ -> (* let's hope there are no functions in here... *) x) | _ -> (* let's hope there are no functions in here... *) x) | _ -> x) minus (* --------------------------------------------------------------------- *) (* entry point *) let rec split4 = function [] -> ([],[],[],[]) | (a,b,c,d)::rest -> let (ax,bx,cx,dx) = split4 rest in (a::ax,b::bx,c::cx,d::dx) let mk_ast_code proto = Ast.rewrap proto (Ast.CODE(Ast.rewrap proto (Ast.DOTS [proto]))) let process rule_name rule_metavars dropped_isos minus plus ruletype = let minus_functions = List.concat (List.map get_all_functions minus) in match minus_functions with [] -> ((rule_metavars,minus),None) | _ -> let plus_functions = List.concat (List.map get_all_functions plus) in let protos = align minus_functions plus_functions in let (metavars,mdef_metavars,rules,mdefs) = split4(List.map (make_rule rule_name) protos) in let metavars = List.concat metavars in let mdef_metavars = (List.concat mdef_metavars) @ rule_metavars in let rules = List.concat rules in let minus = reinsert mdefs minus in match rules with [] -> ((rule_metavars,minus),None) | [x] -> (* probably not possible, since there is always the version with variables and the version without *) ((mdef_metavars,minus), Some (metavars, Ast.CocciRule ("proto for "^rule_name, (Ast.Dep rule_name,dropped_isos,Ast.Forall), [mk_ast_code x], [false],ruletype))) | x::_ -> let drules = List.map (function x -> Ast.rewrap x (Ast.DOTS [x])) rules in let res = Ast.CocciRule ("proto for "^rule_name, (Ast.Dep rule_name,dropped_isos,Ast.Forall), [mk_ast_code (Ast.rewrap x (Ast.Disj drules))], [false],ruletype) in ((mdef_metavars,minus),Some(metavars,res)) coccinelle-1.0.0-rc19/parsing_cocci/cocci_grep.mli0000644000175000017500000000240412247442615020766 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci_grep.mli" val interpret : (Str.regexp * Str.regexp list) (*pattern*) -> string (*filename*) -> bool val split : string list list -> string list list coccinelle-1.0.0-rc19/parsing_cocci/flag_parsing_cocci.ml0000644000175000017500000000324112247442615022314 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./flag_parsing_cocci.ml" (* uses E rather than A and adds comments indicating the start and end of each matched term *) let sgrep_mode = ref false (* no longer supported, subsumed by sgrep2 *) let show_SP = ref false let show_iso_failures = ref true (* interpret the patch in an inverted way *) let interpret_inverted = ref false let iso_limit = ref (None : int option) (*(Some 3)*) let disabled_isos = ref ([] : string list) (* Used to debug embedded ML scripts *) let keep_ml_script = ref false let id_utils_index = ref ".id-utils.index" (* default id-utils value *) coccinelle-1.0.0-rc19/parsing_cocci/cocci_grep.ml0000644000175000017500000001133012247442615020613 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci_grep.ml" (* input should be in CNF, ie an outer list, representing a conjunction, with inner lists of words, representing disjunctions. There is no negation. *) let interpret_clause re l = try let _ = Str.search_forward re l 0 in true with Not_found -> false let interpret (big_regexp,regexps) file = let i = open_in file in let simple = match regexps with [_] -> true | _ -> false in let rec loop big_regexp simple regexps = let l = input_line i in if interpret_clause big_regexp l then if simple then true else let res = List.partition (function regexp -> interpret_clause regexp l) regexps in match res with (_,[]) -> true | (_,([regexp] as regexps)) -> loop regexp true regexps | (_,regexps) -> loop big_regexp simple regexps else loop big_regexp simple regexps in let res = try loop big_regexp simple regexps with End_of_file -> false in close_in i; res (* --------------------------------------------------------------------- *) (* Helpers for get_constants2 *) let count_atoms l = let tbl = Hashtbl.create 101 in let add x = let cell = try Hashtbl.find tbl x with Not_found -> let cell = ref 0 in Hashtbl.add tbl x cell; cell in cell := !cell + 1 in List.iter (List.iter add) l; let lst = Hashtbl.fold (fun element ct rest -> (!ct,element)::rest) tbl [] in let lst = List.sort compare lst in (* Printf.printf "table\n"; List.iter (function (ct,ele) -> Printf.printf "%d: %s\n" ct ele) lst; *) List.map (fun (ct,element) -> (element,ct)) lst let subset l1 l2 = List.for_all (fun e1 -> List.mem e1 l2) l1 let flatten ls = List.fold_left (fun res elem -> Common.union_set elem res) [] ls let extend element res available = let (added,available) = List.partition (List.mem element) available in let added = flatten added in if added = [] then (res,available) else begin let added = Common.union_set added res in (added, List.fold_left (function available -> function clause -> if subset clause added then available else clause :: available) [] available) end let indexify l = let rec loop n = function [] -> [] | x :: xs -> (x,n) :: loop (n+1) xs in loop 0 l let split l = (* Printf.printf "formula\n"; List.iter (fun clause -> Printf.printf "%s\n" (String.concat " " clause)) l; Printf.printf "\n"; *) let tbl = count_atoms l in let (pretbl,tbl) = List.partition (function (_,1) -> true | _ -> false) tbl in let (preres,available) = List.fold_left (function (preres,available) -> function (f,ct) -> let (res,available) = extend f [] available in match res with [] -> (preres,available) | _ -> (res::preres,available)) ([],l) pretbl in let tbl = indexify tbl in let rec loop front back leftres rightres = function [] -> (leftres,rightres) | available -> match (front,back) with ((((f,_),nf)::front),(((b,_),nb)::back)) -> if nf < nb then let (leftres,available) = extend f leftres available in let (rightres,available) = extend b rightres available in loop front back leftres rightres available else if nf = nb then (Common.union_set (flatten available) leftres,rightres) else (leftres,rightres) | ([],[]) -> (leftres,rightres) | _ -> failwith "not possible" in let (a,b) = loop tbl (List.rev tbl) [] [] available in (* discard empties *) let a = match a with [] -> [] | _ -> [a] in let b = match b with [] -> [] | _ -> [b] in let res = a@b@preres in (*List.iter (function a -> Printf.printf "*** %s\n" (String.concat " " a)) res; *) res coccinelle-1.0.0-rc19/parsing_cocci/index.ml0000644000175000017500000002245612247442615017640 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./index.ml" (* create an index for each constructor *) (* current max is 165 *) (* doesn't really work - requires that identical terms with no token subterms (eg dots) not appear on the same line *) module Ast = Ast_cocci module Ast0 = Ast0_cocci (* if a dot list is empty, add the starting line of the dot list to the address. Otherwise add 0. An empty dot list should only match with another empty one. *) let expression_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 1::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 2::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 3::(if l = [] then [ln] else [0]) let initialiser_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 113::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 114::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 115::(if l = [] then [ln] else [0]) let parameter_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 4::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 5::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 6::(if l = [] then [ln] else [0]) let statement_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 7::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 8::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 9::(if l = [] then [ln] else [0]) let declaration_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 134::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 135::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 136::(if l = [] then [ln] else [0]) let case_line_dots d = let ln = (Ast0.get_info d).Ast0.pos_info.Ast0.line_start in match Ast0.unwrap d with Ast0.DOTS(l) -> 138::(if l = [] then [ln] else [0]) | Ast0.CIRCLES(l) -> 139::(if l = [] then [ln] else [0]) | Ast0.STARS(l) -> 140::(if l = [] then [ln] else [0]) let ident i = match Ast0.unwrap i with Ast0.Id(name) -> [10] | Ast0.MetaId(name,_,_,_) -> [11] | Ast0.MetaFunc(name,_,_) -> [12] | Ast0.MetaLocalFunc(name,_,_) -> [13] | Ast0.DisjId(_,id_list,_,_) -> [152] | Ast0.OptIdent(id) -> [14] | Ast0.UniqueIdent(id) -> [15] | Ast0.AsIdent _ -> failwith "not possible" let expression e = match Ast0.unwrap e with Ast0.Ident(id) -> [17] | Ast0.Constant(const) -> [18] | Ast0.StringConstant(lq,str,rq) -> [165] | Ast0.FunCall(fn,lp,args,rp) -> [19] | Ast0.Assignment(left,op,right,simple) -> [20] | Ast0.Sequence(left,op,right) -> [156] | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> [21] | Ast0.Postfix(exp,op) -> [22] | Ast0.Infix(exp,op) -> [23] | Ast0.Unary(exp,op) -> [24] | Ast0.Binary(left,op,right) -> [25] | Ast0.Nested(left,op,right) -> failwith "nested in index not possible" | Ast0.Paren(lp,exp,rp) -> [26] | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> [27] | Ast0.RecordAccess(exp,pt,field) -> [28] | Ast0.RecordPtAccess(exp,ar,field) -> [29] | Ast0.Cast(lp,ty,rp,exp) -> [30] | Ast0.SizeOfExpr(szf,exp) -> [98] (* added after *) | Ast0.SizeOfType(szf,lp,ty,rp) -> [99] (* added after *) | Ast0.TypeExp(ty) -> [123] (* added after *) | Ast0.Constructor(lp,ty,rp,init) -> [155] | Ast0.MetaErr(name,_,_) -> [32] | Ast0.MetaExpr(name,_,ty,_,_) -> [33] | Ast0.MetaExprList(name,_,_) -> [34] | Ast0.EComma(cm) -> [35] | Ast0.DisjExpr(_,expr_list,_,_) -> [36] | Ast0.NestExpr(_,expr_dots,_,_,_) -> [37] | Ast0.Edots(dots,whencode) -> [38] | Ast0.Ecircles(dots,whencode) -> [39] | Ast0.Estars(dots,whencode) -> [40] | Ast0.OptExp(exp) -> [41] | Ast0.UniqueExp(exp) -> [42] | Ast0.AsExpr _ -> failwith "not possible" let typeC t = match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> [44] | Ast0.BaseType(ty,strings) -> [48] | Ast0.Signed(sign,ty) -> [129] | Ast0.Pointer(ty,star) -> [49] | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> [131] | Ast0.FunctionType(ty,lp1,params,rp1) -> [132] | Ast0.Array(ty,lb,size,rb) -> [50] | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> [160] | Ast0.EnumName(kind,name) -> [146] | Ast0.EnumDef(ty,lb,decls,rb) -> [150] | Ast0.StructUnionName(kind,name) -> [51] | Ast0.StructUnionDef(ty,lb,decls,rb) -> [117] | Ast0.TypeName(name) -> [52] | Ast0.MetaType(name,_) -> [53] | Ast0.DisjType(_,type_list,_,_) -> [130] | Ast0.OptType(ty) -> [45] | Ast0.UniqueType(ty) -> [46] | Ast0.AsType _ -> failwith "not possible" let declaration d = match Ast0.unwrap d with Ast0.MetaDecl(name,_) -> [148] | Ast0.MetaField(name,_) -> [149] | Ast0.MetaFieldList(name,_,_) -> [152] | Ast0.Init(stg,ty,id,eq,exp,sem) -> [54] | Ast0.UnInit(stg,ty,id,sem) -> [55] | Ast0.MacroDecl(name,lp,args,rp,sem) -> [137] | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> [157] | Ast0.TyDecl(ty,sem) -> [116] | Ast0.Typedef(stg,ty,id,sem) -> [143] | Ast0.DisjDecl(_,decls,_,_) -> [97] (* added after *) | Ast0.Ddots(dots,whencode) -> [133] | Ast0.OptDecl(decl) -> [56] | Ast0.UniqueDecl(decl) -> [57] | Ast0.AsDecl _ -> failwith "not possible" let initialiser i = match Ast0.unwrap i with Ast0.MetaInit(nm,_) -> [106] (* added after *) | Ast0.MetaInitList(nm,_,_) -> [153] (* added after *) | Ast0.InitExpr(exp) -> [102] | Ast0.InitList(lb,initlist,rb,ordered) -> [103] | Ast0.InitGccExt(designators,eq,ini) -> [104] | Ast0.InitGccName(name,eq,ini) -> [105] | Ast0.IComma(cm) -> [108] | Ast0.Idots(d,whencode) -> [109] | Ast0.OptIni(id) -> [110] | Ast0.UniqueIni(id) -> [111] | Ast0.AsInit _ -> failwith "not possible" let parameterTypeDef p = match Ast0.unwrap p with Ast0.VoidParam(ty) -> [59] | Ast0.Param(ty,id) -> [60] | Ast0.MetaParam(name,_) -> [61] | Ast0.MetaParamList(name,_,_) -> [62] | Ast0.PComma(cm) -> [63] | Ast0.Pdots(dots) -> [64] | Ast0.Pcircles(dots) -> [65] | Ast0.OptParam(param) -> [66] | Ast0.UniqueParam(param) -> [67] | Ast0.AsParam _ -> failwith "not possible" let statement s = match Ast0.unwrap s with Ast0.FunDecl(bef,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> [68] | Ast0.Decl(bef,decl) -> [69] | Ast0.Seq(lbrace,body,rbrace) -> [70] | Ast0.ExprStatement(exp,sem) -> [71] | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> [72] | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> [73] | Ast0.While(whl,lp,exp,rp,body,_) -> [74] | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> [75] | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,_) -> [76] | Ast0.Iterator(nm,lp,args,rp,body,_) -> [142] | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> [125] | Ast0.Break(br,sem) -> [100] | Ast0.Continue(cont,sem) -> [101] | Ast0.Label(l,dd) -> [144] | Ast0.Goto(goto,l,sem) -> [145] | Ast0.Return(ret,sem) -> [77] | Ast0.ReturnExpr(ret,exp,sem) -> [78] | Ast0.MetaStmt(name,_) -> [79] | Ast0.MetaStmtList(name,_) -> [80] | Ast0.Disj(_,statement_dots_list,_,_) -> [81] | Ast0.Nest(_,stmt_dots,_,_,_) -> [82] | Ast0.Exp(exp) -> [83] | Ast0.TopExp(exp) -> [141] | Ast0.Ty(ty) -> [124] | Ast0.TopInit(init) -> [146] | Ast0.Dots(d,whencode) -> [84] | Ast0.Circles(d,whencode) -> [85] | Ast0.Stars(d,whencode) -> [86] | Ast0.Include(inc,name) -> [118] | Ast0.Undef(def,id) -> [151] | Ast0.Define(def,id,params,body) -> [119] | Ast0.Pragma(prg,id,body) -> [161] | Ast0.OptStm(re) -> [87] | Ast0.UniqueStm(re) -> [88] | Ast0.AsStmt _ -> failwith "not possible" let forinfo fi = match Ast0.unwrap fi with Ast0.ForExp(exp,sem) -> [158] | Ast0.ForDecl (bef,decl) -> [159] and pragmainfo pi = match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> [162] | Ast0.PragmaIdList(ids) -> [163] | Ast0.PragmaDots (dots) -> [164] let case_line c = match Ast0.unwrap c with Ast0.Default(def,colon,code) -> [126] | Ast0.Case(case,exp,colon,code) -> [127] | Ast0.DisjCase(_,case_lines,_,_) -> [107] | Ast0.OptCase(case) -> [128] let top_level t = match Ast0.unwrap t with Ast0.NONDECL(stmt) -> [90] | Ast0.FILEINFO(old_file,new_file) -> [92] | Ast0.CODE(stmt_dots) -> [94] | Ast0.ERRORWORDS(exps) -> [95] | Ast0.OTHER(_) -> [96] | Ast0.TOPCODE(_) -> [154] (* 99-101 already used *) coccinelle-1.0.0-rc19/parsing_cocci/unify_ast.ml0000644000175000017500000006520112247442615020525 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unify_ast.ml" (* --------------------------------------------------------------------- *) (* Given two patterns, A and B, determine whether B can match any matched subterms of A. For simplicity, this doesn't maintain an environment; it just assume metavariables match. Thus the result is either NO or MAYBE. *) module Ast = Ast_cocci module V = Visitor_ast (* --------------------------------------------------------------------- *) type res = NO | MAYBE let return b = if b then MAYBE else NO let unify_mcode (x,_,_,_) (y,_,_,_) = x = y let ret_unify_mcode a b = return (unify_mcode a b) let unify_option f t1 t2 = match (t1,t2) with (Some t1, Some t2) -> f t1 t2 | (None, None) -> return true | _ -> return false let unify_true_option f t1 t2 = match (t1,t2) with (Some t1, Some t2) -> f t1 t2 | (None, None) -> return true | _ -> return true let bool_unify_option f t1 t2 = match (t1,t2) with (Some t1, Some t2) -> f t1 t2 | (None, None) -> true | _ -> false let conjunct_bindings b1 b2 = match b1 with NO -> b1 | MAYBE -> b2 let disjunct_bindings b1 b2 = match b1 with MAYBE -> b1 | NO -> b2 let disjunct_all_bindings = List.fold_left disjunct_bindings NO (* --------------------------------------------------------------------- *) (* compute the common prefix. if in at least one case, this ends with the end of the pattern or a ..., then return true. *) let unify_lists fn dfn la lb = let rec loop = function ([],_) | (_,[]) -> return true | (cura::resta,curb::restb) -> (match fn cura curb with MAYBE -> loop (resta,restb) | NO -> if dfn cura or dfn curb then MAYBE else NO) in loop (la,lb) let unify_dots fn dfn d1 d2 = match (Ast.unwrap d1,Ast.unwrap d2) with (Ast.DOTS(l1),Ast.DOTS(l2)) | (Ast.CIRCLES(l1),Ast.CIRCLES(l2)) | (Ast.STARS(l1),Ast.STARS(l2)) -> unify_lists fn dfn l1 l2 | _ -> return false let edots e = match Ast.unwrap e with Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> true | _ -> false let ddots e = match Ast.unwrap e with Ast.Ddots(_,_) -> true | _ -> false let pdots p = match Ast.unwrap p with Ast.Pdots(_) | Ast.Pcircles(_) -> true | _ -> false let dpdots e = match Ast.unwrap e with Ast.DPdots(_) | Ast.DPcircles(_) -> true | _ -> false let sdots s = match Ast.unwrap s with Ast.Dots(_,_,_,_) | Ast.Circles(_,_,_,_) | Ast.Stars(_,_,_,_) -> true | _ -> false let idots e = match Ast.unwrap e with Ast.Idots(_,_) -> true | _ -> false let strdots e = match Ast.unwrap e with Ast.Strdots(_) -> true | _ -> false (* --------------------------------------------------------------------- *) (* Identifier *) let rec unify_ident i1 i2 = match (Ast.unwrap i1,Ast.unwrap i2) with (Ast.Id(i1),Ast.Id(i2)) -> return (unify_mcode i1 i2) | (Ast.MetaId(_,_,_,_),_) | (Ast.MetaFunc(_,_,_,_),_) | (Ast.MetaLocalFunc(_,_,_,_),_) | (_,Ast.MetaId(_,_,_,_)) | (_,Ast.MetaFunc(_,_,_,_)) | (_,Ast.MetaLocalFunc(_,_,_,_)) -> return true | (Ast.AsIdent(id1,asid1),_) -> disjunct_all_bindings (List.map (function x -> unify_ident x i2) [id1;asid1]) | (_,Ast.AsIdent(id2,asid2)) -> disjunct_all_bindings (List.map (function x -> unify_ident x i1) [id2;asid2]) | (Ast.DisjId(i1),_) -> disjunct_all_bindings (List.map (function x -> unify_ident x i2) i1) | (_,Ast.DisjId(i2)) -> disjunct_all_bindings (List.map (function x -> unify_ident i1 x) i2) | (Ast.OptIdent(_),_) | (Ast.UniqueIdent(_),_) | (_,Ast.OptIdent(_)) | (_,Ast.UniqueIdent(_)) -> failwith "unsupported ident" (* --------------------------------------------------------------------- *) (* Expression *) and unify_expression e1 e2 = match (Ast.unwrap e1,Ast.unwrap e2) with (Ast.Ident(i1),Ast.Ident(i2)) -> unify_ident i1 i2 | (Ast.Constant(c1),Ast.Constant(c2))-> return (unify_mcode c1 c2) | (Ast.StringConstant(lq1,str1,rq1),Ast.StringConstant(lq2,str2,rq2)) -> unify_dots unify_string_fragment strdots str1 str2 | (Ast.FunCall(f1,lp1,args1,rp1),Ast.FunCall(f2,lp2,args2,rp2)) -> conjunct_bindings (unify_expression f1 f2) (unify_dots unify_expression edots args1 args2) | (Ast.Assignment(l1,op1,r1,_),Ast.Assignment(l2,op2,r2,_)) -> if unify_mcode op1 op2 then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) else return false | (Ast.Sequence(l1,_,r1),Ast.Sequence(l2,_,r2)) -> conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) | (Ast.CondExpr(tst1,q1,thn1,c1,els1),Ast.CondExpr(tst2,q2,thn2,c2,els2)) -> conjunct_bindings (unify_expression tst1 tst2) (conjunct_bindings (unify_option unify_expression thn1 thn2) (unify_expression els1 els2)) | (Ast.Postfix(e1,op1),Ast.Postfix(e2,op2)) -> if unify_mcode op1 op2 then unify_expression e1 e2 else return false | (Ast.Infix(e1,op1),Ast.Infix(e2,op2)) -> if unify_mcode op1 op2 then unify_expression e1 e2 else return false | (Ast.Unary(e1,op1),Ast.Unary(e2,op2)) -> if unify_mcode op1 op2 then unify_expression e1 e2 else return false | (Ast.Binary(l1,op1,r1),Ast.Binary(l2,op2,r2)) -> if unify_mcode op1 op2 then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) else return false | (Ast.ArrayAccess(ar1,lb1,e1,rb1),Ast.ArrayAccess(ar2,lb2,e2,rb2)) -> conjunct_bindings (unify_expression ar1 ar2) (unify_expression e1 e2) | (Ast.RecordAccess(e1,d1,fld1),Ast.RecordAccess(e2,d2,fld2)) -> conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2) | (Ast.RecordPtAccess(e1,pt1,fld1),Ast.RecordPtAccess(e2,pt2,fld2)) -> conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2) | (Ast.Cast(lp1,ty1,rp1,e1),Ast.Cast(lp2,ty2,rp2,e2)) -> conjunct_bindings (unify_fullType ty1 ty2) (unify_expression e1 e2) | (Ast.SizeOfExpr(szf1,e1),Ast.SizeOfExpr(szf2,e2)) -> unify_expression e1 e2 | (Ast.SizeOfType(szf1,lp1,ty1,rp1),Ast.SizeOfType(szf2,lp2,ty2,rp2)) -> unify_fullType ty1 ty2 | (Ast.TypeExp(ty1),Ast.TypeExp(ty2)) -> unify_fullType ty1 ty2 | (Ast.Constructor(lp1,ty1,rp1,i1),Ast.Constructor(lp2,ty2,rp2,i2)) -> conjunct_bindings (unify_fullType ty1 ty2) (unify_initialiser i1 i2) | (Ast.Paren(lp1,e1,rp1),Ast.Paren(lp2,e2,rp2)) -> unify_expression e1 e2 | (Ast.MetaErr(_,_,_,_),_) | (Ast.MetaExpr(_,_,_,_,_,_),_) | (Ast.MetaExprList(_,_,_,_),_) | (_,Ast.MetaErr(_,_,_,_)) | (_,Ast.MetaExpr(_,_,_,_,_,_)) | (_,Ast.MetaExprList(_,_,_,_)) -> return true | (Ast.AsExpr(exp1,asexp1),_) -> disjunct_all_bindings (List.map (function x -> unify_expression x e2) [exp1;asexp1]) | (_,Ast.AsExpr(exp2,asexp2)) -> disjunct_all_bindings (List.map (function x -> unify_expression x e1) [exp2;asexp2]) | (Ast.EComma(cm1),Ast.EComma(cm2)) -> return true | (Ast.DisjExpr(e1),_) -> disjunct_all_bindings (List.map (function x -> unify_expression x e2) e1) | (_,Ast.DisjExpr(e2)) -> disjunct_all_bindings (List.map (function x -> unify_expression e1 x) e2) | (Ast.NestExpr(_,e1,_,_,_),Ast.NestExpr(_,e2,_,_,_)) -> unify_dots unify_expression edots e1 e2 (* dots can match against anything. return true to be safe. *) | (Ast.Edots(_,_),_) | (_,Ast.Edots(_,_)) | (Ast.Ecircles(_,_),_) | (_,Ast.Ecircles(_,_)) | (Ast.Estars(_,_),_) | (_,Ast.Estars(_,_)) -> return true | (Ast.OptExp(_),_) | (Ast.UniqueExp(_),_) | (_,Ast.OptExp(_)) | (_,Ast.UniqueExp(_)) -> failwith "unsupported expression" | _ -> return false (* --------------------------------------------------------------------- *) (* Strings *) and unify_string_fragment e1 e2 = match (Ast.unwrap e1,Ast.unwrap e2) with (Ast.ConstantFragment(str1),Ast.ConstantFragment(str2)) -> return (unify_mcode str1 str2) | (Ast.FormatFragment(pct1,fmt1),Ast.FormatFragment(pct2,fmt2)) -> unify_string_format fmt1 fmt2 | (Ast.Strdots(dots1),Ast.Strdots(dots2)) -> return true | (Ast.MetaFormatList(pct,name,len,_,_),_) | (_,Ast.MetaFormatList(pct,name,len,_,_)) -> return true | _ -> return false and unify_string_format e1 e2 = match (Ast.unwrap e1,Ast.unwrap e2) with (Ast.ConstantFormat(str1), Ast.ConstantFormat(str2)) -> return (unify_mcode str1 str2) | (Ast.MetaFormat(name,_,_,_),_) | (_,Ast.MetaFormat(name,_,_,_)) -> return true (* --------------------------------------------------------------------- *) (* Types *) and unify_fullType ft1 ft2 = match (Ast.unwrap ft1,Ast.unwrap ft2) with (Ast.Type(_,cv1,ty1),Ast.Type(_,cv2,ty2)) -> if bool_unify_option unify_mcode cv1 cv2 then unify_typeC ty1 ty2 else return false | (Ast.AsType(ty1,asty1),_) -> disjunct_all_bindings (List.map (function x -> unify_fullType x ft2) [ty1;asty1]) | (_,Ast.AsType(ty2,asty2)) -> disjunct_all_bindings (List.map (function x -> unify_fullType x ft1) [ty2;asty2]) | (Ast.DisjType(ft1),_) -> disjunct_all_bindings (List.map (function x -> unify_fullType x ft2) ft1) | (_,Ast.DisjType(ft2)) -> disjunct_all_bindings (List.map (function x -> unify_fullType ft1 x) ft2) | (Ast.OptType(_),_) | (Ast.UniqueType(_),_) | (_,Ast.OptType(_)) | (_,Ast.UniqueType(_)) -> failwith "unsupported type" and unify_typeC t1 t2 = match (Ast.unwrap t1,Ast.unwrap t2) with (Ast.BaseType(ty1,stringsa),Ast.BaseType(ty2,stringsb)) -> if ty1 = ty2 then unify_lists ret_unify_mcode (function _ -> false (* not dots*)) stringsa stringsb else return false | (Ast.SignedT(sgn1,ty1),Ast.SignedT(sgn2,ty2)) -> if unify_mcode sgn1 sgn2 then unify_option unify_typeC ty1 ty2 else return false | (Ast.Pointer(ty1,s1),Ast.Pointer(ty2,s2)) -> unify_fullType ty1 ty2 | (Ast.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), Ast.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) -> if List.for_all2 unify_mcode [lp1a;stara;rp1a;lp2a;rp2a] [lp1b;starb;rp1b;lp2b;rp2b] then conjunct_bindings (unify_fullType tya tyb) (unify_dots unify_parameterTypeDef pdots paramsa paramsb) else return false | (Ast.FunctionType(_,tya,lp1a,paramsa,rp1a), Ast.FunctionType(_,tyb,lp1b,paramsb,rp1b)) -> if List.for_all2 unify_mcode [lp1a;rp1a] [lp1b;rp1b] then conjunct_bindings (unify_option unify_fullType tya tyb) (unify_dots unify_parameterTypeDef pdots paramsa paramsb) else return false | (Ast.FunctionType _ , _) -> failwith "not supported" | (Ast.Array(ty1,lb1,e1,rb1),Ast.Array(ty2,lb2,e2,rb2)) -> conjunct_bindings (unify_fullType ty1 ty2) (unify_option unify_expression e1 e2) | (Ast.Decimal(dec1,lp1,len1,comma1,prec_opt1,rp1), Ast.Decimal(dec2,lp2,len2,comma2,prec_opt2,rp2)) -> conjunct_bindings (unify_expression len1 len2) (unify_option unify_expression prec_opt1 prec_opt2) | (Ast.EnumName(s1,Some ts1),Ast.EnumName(s2,Some ts2)) -> if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false | (Ast.EnumName(s1,None),Ast.EnumName(s2,None)) -> return true | (Ast.EnumDef(ty1,lb1,ids1,rb1),Ast.EnumDef(ty2,lb2,ids2,rb2)) -> conjunct_bindings (unify_fullType ty1 ty2) (unify_dots unify_expression edots ids1 ids2) | (Ast.StructUnionName(s1,Some ts1),Ast.StructUnionName(s2,Some ts2)) -> if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false | (Ast.StructUnionName(s1,None),Ast.StructUnionName(s2,None)) -> return (unify_mcode s1 s2) | (Ast.StructUnionDef(ty1,lb1,decls1,rb1), Ast.StructUnionDef(ty2,lb2,decls2,rb2)) -> conjunct_bindings (unify_fullType ty1 ty2) (unify_dots unify_declaration ddots decls1 decls2) | (Ast.TypeName(t1),Ast.TypeName(t2)) -> return (unify_mcode t1 t2) | (Ast.MetaType(_,_,_),_) | (_,Ast.MetaType(_,_,_)) -> return true | _ -> return false (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and unify_declaration d1 d2 = match (Ast.unwrap d1,Ast.unwrap d2) with (Ast.MetaDecl(_,_,_),_) | (_,Ast.MetaDecl(_,_,_)) -> return true | (Ast.MetaField(_,_,_),_) | (_,Ast.MetaField(_,_,_)) -> return true | (Ast.MetaFieldList(_,_,_,_),_) | (_,Ast.MetaFieldList(_,_,_,_)) -> return true | (Ast.Init(stg1,ft1,id1,eq1,i1,s1),Ast.Init(stg2,ft2,id2,eq2,i2,s2)) -> if bool_unify_option unify_mcode stg1 stg2 then conjunct_bindings (unify_fullType ft1 ft2) (conjunct_bindings (unify_ident id1 id2) (unify_initialiser i1 i2)) else return false | (Ast.UnInit(stg1,ft1,id1,s1),Ast.UnInit(stg2,ft2,id2,s2)) -> if bool_unify_option unify_mcode stg1 stg2 then conjunct_bindings (unify_fullType ft1 ft2) (unify_ident id1 id2) else return false | (Ast.MacroDecl(n1,lp1,args1,rp1,sem1), Ast.MacroDecl(n2,lp2,args2,rp2,sem2)) -> conjunct_bindings (unify_ident n1 n2) (unify_dots unify_expression edots args1 args2) | (Ast.MacroDeclInit(n1,lp1,args1,rp1,eq1,ini1,sem1), Ast.MacroDeclInit(n2,lp2,args2,rp2,eq2,ini2,sem2)) -> conjunct_bindings (unify_ident n1 n2) (conjunct_bindings (unify_dots unify_expression edots args1 args2) (unify_initialiser ini1 ini2)) | (Ast.TyDecl(ft1,s1),Ast.TyDecl(ft2,s2)) -> unify_fullType ft1 ft2 | (Ast.Typedef(stg1,ft1,id1,s1),Ast.Typedef(stg2,ft2,id2,s2)) -> conjunct_bindings (unify_fullType ft1 ft2) (unify_typeC id1 id2) | (Ast.DisjDecl(d1),_) -> disjunct_all_bindings (List.map (function x -> unify_declaration x d2) d1) | (_,Ast.DisjDecl(d2)) -> disjunct_all_bindings (List.map (function x -> unify_declaration d1 x) d2) (* dots can match against anything. return true to be safe. *) | (Ast.Ddots(_,_),_) | (_,Ast.Ddots(_,_)) -> return true | (Ast.OptDecl(_),_) | (Ast.UniqueDecl(_),_) | (_,Ast.OptDecl(_)) | (_,Ast.UniqueDecl(_)) -> failwith "unsupported decl" | _ -> return false (* --------------------------------------------------------------------- *) (* Initializer *) and unify_initialiser i1 i2 = match (Ast.unwrap i1,Ast.unwrap i2) with (Ast.MetaInit(_,_,_),_) | (_,Ast.MetaInit(_,_,_)) -> return true | (Ast.MetaInitList(_,_,_,_),_) | (_,Ast.MetaInitList(_,_,_,_)) -> return true | (Ast.InitExpr(expa),Ast.InitExpr(expb)) -> unify_expression expa expb | (Ast.ArInitList(_,initlista,_), Ast.ArInitList(_,initlistb,_)) -> (* ignore whencode - returns true safely *) unify_dots unify_initialiser idots initlista initlistb | (Ast.StrInitList(_,_,initlista,_,whena), Ast.StrInitList(_,_,initlistb,_,whenb)) -> (* ignore whencode - returns true safely *) unify_lists unify_initialiser (function _ -> false) initlista initlistb | (Ast.InitGccExt(designatorsa,_,inia), Ast.InitGccExt(designatorsb,_,inib)) -> conjunct_bindings (unify_lists unify_designator (function _ -> false) designatorsa designatorsb) (unify_initialiser inia inib) | (Ast.InitGccName(namea,_,inia),Ast.InitGccName(nameb,_,inib)) -> conjunct_bindings (unify_ident namea nameb) (unify_initialiser inia inib) | (Ast.OptIni(_),_) | (Ast.UniqueIni(_),_) | (_,Ast.OptIni(_)) | (_,Ast.UniqueIni(_)) -> failwith "unsupported decl" | _ -> return false and unify_designator d1 d2 = match (d1,d2) with (Ast.DesignatorField(_,idb),Ast.DesignatorField(_,ida)) -> unify_ident ida idb | (Ast.DesignatorIndex(_,expa,_),Ast.DesignatorIndex(_,expb,_)) -> unify_expression expa expb | (Ast.DesignatorRange(_,mina,_,maxa,_), Ast.DesignatorRange(_,minb,_,maxb,_)) -> conjunct_bindings (unify_expression mina minb) (unify_expression maxa maxb) | _ -> return false (* --------------------------------------------------------------------- *) (* Parameter *) and unify_parameterTypeDef p1 p2 = match (Ast.unwrap p1,Ast.unwrap p2) with (Ast.VoidParam(ft1),Ast.VoidParam(ft2)) -> unify_fullType ft1 ft2 | (Ast.Param(ft1,i1),Ast.Param(ft2,i2)) -> conjunct_bindings (unify_fullType ft1 ft2) (unify_option unify_ident i1 i2) | (Ast.MetaParam(_,_,_),_) | (Ast.MetaParamList(_,_,_,_),_) | (_,Ast.MetaParam(_,_,_)) | (_,Ast.MetaParamList(_,_,_,_)) -> return true | (Ast.PComma(_),Ast.PComma(_)) -> return true (* dots can match against anything. return true to be safe. *) | (Ast.Pdots(_),_) | (_,Ast.Pdots(_)) | (Ast.Pcircles(_),_) | (_,Ast.Pcircles(_)) -> return true (* not sure what to do with the asexp.... *) | (Ast.AsParam(param1,asexp1),_) -> unify_parameterTypeDef param1 p2 | (_,Ast.AsParam(param2,asexp2)) -> unify_parameterTypeDef p1 param2 | (Ast.OptParam(_),_) | (Ast.UniqueParam(_),_) | (_,Ast.OptParam(_)) | (_,Ast.UniqueParam(_)) -> failwith "unsupported parameter" | _ -> return false (* --------------------------------------------------------------------- *) (* Define parameter *) and unify_define_parameters p1 p2 = match (Ast.unwrap p1,Ast.unwrap p2) with (Ast.NoParams,Ast.NoParams) -> return true | (Ast.DParams(lp1,params1,rp1),Ast.DParams(lp2,params2,rp2)) -> unify_dots unify_define_param dpdots params1 params2 | _ -> return false and unify_define_param p1 p2 = match (Ast.unwrap p1,Ast.unwrap p2) with (Ast.DParam(i1),Ast.DParam(i2)) -> (unify_ident i1 i2) | (Ast.DPComma(_),Ast.DPComma(_)) -> return true (* dots can match against anything. return true to be safe. *) | (Ast.DPdots(_),_) | (_,Ast.DPdots(_)) | (Ast.DPcircles(_),_) | (_,Ast.DPcircles(_)) -> return true | (Ast.OptDParam(_),_) | (Ast.UniqueDParam(_),_) | (_,Ast.OptDParam(_)) | (_,Ast.UniqueDParam(_)) -> failwith "unsupported parameter" | _ -> return false (* --------------------------------------------------------------------- *) (* Top-level code *) and unify_rule_elem re1 re2 = match (Ast.unwrap re1,Ast.unwrap re2) with (Ast.FunHeader(_,_,fi1,nm1,lp1,params1,rp1), Ast.FunHeader(_,_,fi2,nm2,lp2,params2,rp2)) -> conjunct_bindings (unify_fninfo fi1 fi2) (conjunct_bindings (unify_ident nm1 nm2) (unify_dots unify_parameterTypeDef pdots params1 params2)) | (Ast.Decl(_,_,d1),Ast.Decl(_,_,d2)) -> unify_declaration d1 d2 | (Ast.SeqStart(lb1),Ast.SeqStart(lb2)) -> return true | (Ast.SeqEnd(rb1),Ast.SeqEnd(rb2)) -> return true | (Ast.ExprStatement(e1,s1),Ast.ExprStatement(e2,s2)) -> unify_option unify_expression e1 e2 | (Ast.IfHeader(if1,lp1,e1,rp1),Ast.IfHeader(if2,lp2,e2,rp2)) -> unify_expression e1 e2 | (Ast.Else(e1),Ast.Else(e2)) -> return true | (Ast.WhileHeader(wh1,lp1,e1,rp1),Ast.WhileHeader(wh2,lp2,e2,rp2)) -> unify_expression e1 e2 | (Ast.DoHeader(d1),Ast.DoHeader(d2)) -> return true | (Ast.WhileTail(wh1,lp1,e1,rp1,s1),Ast.WhileTail(wh2,lp2,e2,rp2,s2)) -> unify_expression e1 e2 | (Ast.ForHeader(fr1,lp1,first1,e21,s21,e31,rp1), Ast.ForHeader(fr2,lp2,first2,e22,s22,e32,rp2)) -> let first = match (first1,first2) with (Ast.ForExp(e11,s11),Ast.ForExp(e12,s1)) -> unify_option unify_expression e11 e12 | (Ast.ForDecl(_,_,d1),Ast.ForDecl(_,_,d2)) -> unify_declaration d1 d2 | _ -> return false in conjunct_bindings first (conjunct_bindings (unify_option unify_expression e21 e22) (unify_option unify_expression e31 e32)) | (Ast.IteratorHeader(nm1,lp1,args1,rp1), Ast.IteratorHeader(nm2,lp2,args2,rp2)) -> conjunct_bindings (unify_ident nm1 nm2) (unify_dots unify_expression edots args1 args2) | (Ast.Undef(_,n1),Ast.Undef(_,n2)) -> unify_ident n1 n2 | (Ast.DefineHeader(_,n1,p1),Ast.DefineHeader(_,n2,p2)) -> conjunct_bindings (unify_ident n1 n2) (unify_define_parameters p1 p2) | (Ast.Pragma(_,i1,n1),Ast.Pragma(_,i2,n2)) -> conjunct_bindings (unify_ident i1 i2) (unify_pragmainfo n1 n2) | (Ast.Break(r1,s1),Ast.Break(r2,s2)) -> return true | (Ast.Continue(r1,s1),Ast.Continue(r2,s2)) -> return true | (Ast.Label(l1,dd1),Ast.Label(l2,dd2)) -> unify_ident l1 l2 | (Ast.Goto(g1,l1,dd1),Ast.Goto(g2,l2,dd2)) -> unify_ident l1 l2 | (Ast.Return(r1,s1),Ast.Return(r2,s2)) -> return true | (Ast.ReturnExpr(r1,e1,s1),Ast.ReturnExpr(r2,e2,s2)) -> unify_expression e1 e2 | (Ast.DisjRuleElem(res1),_) -> disjunct_all_bindings (List.map (function x -> unify_rule_elem x re2) res1) | (_,Ast.DisjRuleElem(res2)) -> disjunct_all_bindings (List.map (function x -> unify_rule_elem re1 x) res2) | (Ast.MetaRuleElem(_,_,_),_) | (Ast.MetaStmt(_,_,_,_),_) | (Ast.MetaStmtList(_,_,_),_) | (_,Ast.MetaRuleElem(_,_,_)) | (_,Ast.MetaStmt(_,_,_,_)) | (_,Ast.MetaStmtList(_,_,_)) -> return true (* can match a rule_elem in different parts *) | (Ast.Exp(e1),Ast.Exp(e2)) -> return true | (Ast.Exp(e1),_) -> subexp (unify_expression e1) re2 | (_,Ast.Exp(e2)) -> subexp (unify_expression e2) re1 | (Ast.TopExp(e1),Ast.TopExp(e2)) -> unify_expression e1 e2 | (Ast.TopInit(i1),Ast.TopInit(i2)) -> unify_initialiser i1 i2 (* can match a rule_elem in different parts *) | (Ast.Ty(t1),Ast.Ty(t2)) -> return true | (Ast.Ty(t1),_) -> subtype (unify_fullType t1) re2 | (_,Ast.Ty(t2)) -> subtype (unify_fullType t2) re1 | _ -> return false and unify_pragmainfo pi1 pi2 = match (Ast.unwrap pi1,Ast.unwrap pi2) with (Ast.PragmaTuple(lp1,args1,rp1),Ast.PragmaTuple(lp2,args2,rp2)) -> unify_dots unify_expression edots args1 args2 | (Ast.PragmaIdList(ids1),Ast.PragmaIdList(ids2)) -> unify_dots unify_ident (function _ -> false) ids1 ids2 | (Ast.PragmaDots(_),_) | (_,Ast.PragmaDots(_)) -> return true | _ -> return false and unify_fninfo patterninfo cinfo = let patterninfo = List.sort compare patterninfo in let cinfo = List.sort compare cinfo in let rec loop = function (Ast.FStorage(sta)::resta,Ast.FStorage(stb)::restb) -> if unify_mcode sta stb then loop (resta,restb) else return false | (Ast.FType(tya)::resta,Ast.FType(tyb)::restb) -> conjunct_bindings (unify_fullType tya tyb) (loop (resta,restb)) | (Ast.FInline(ia)::resta,Ast.FInline(ib)::restb) -> if unify_mcode ia ib then loop (resta,restb) else return false | (Ast.FAttr(ia)::resta,Ast.FAttr(ib)::restb) -> if unify_mcode ia ib then loop (resta,restb) else return false | (x::resta,((y::_) as restb)) -> (match compare x y with -1 -> return false | 1 -> loop (resta,restb) | _ -> failwith "not possible") | _ -> return false in loop (patterninfo,cinfo) and subexp f = let bind = conjunct_bindings in let option_default = return false in let mcode r e = option_default in let expr r k e = conjunct_bindings (f e) (k e) in let donothing r k e = k e in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing expr donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in recursor.V.combiner_rule_elem and subtype f = let bind = conjunct_bindings in let option_default = return false in let mcode r e = option_default in let fullType r k e = conjunct_bindings (f e) (k e) in let donothing r k e = k e in let recursor = V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing fullType donothing donothing donothing donothing donothing donothing donothing donothing donothing in recursor.V.combiner_rule_elem let rec unify_statement s1 s2 = match (Ast.unwrap s1,Ast.unwrap s2) with (Ast.Seq(lb1,s1,rb1),Ast.Seq(lb2,s2,rb2)) -> conjunct_bindings (unify_rule_elem lb1 lb2) (conjunct_bindings (unify_dots unify_statement sdots s1 s2) (unify_rule_elem rb1 rb2)) | (Ast.IfThen(h1,thn1,_),Ast.IfThen(h2,thn2,_)) -> conjunct_bindings (unify_rule_elem h1 h2) (unify_statement thn1 thn2) | (Ast.IfThenElse(h1,thn1,e1,els1,_),Ast.IfThenElse(h2,thn2,e2,els2,_)) -> conjunct_bindings (unify_rule_elem h1 h2) (conjunct_bindings (unify_statement thn1 thn2) (conjunct_bindings (unify_rule_elem e1 e2) (unify_statement els1 els2))) | (Ast.While(h1,s1,_),Ast.While(h2,s2,_)) -> conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2) | (Ast.Do(h1,s1,t1),Ast.Do(h2,s2,t2)) -> conjunct_bindings (unify_rule_elem h1 h2) (conjunct_bindings (unify_statement s1 s2) (unify_rule_elem t1 t2)) | (Ast.For(h1,s1,_),Ast.For(h2,s2,_)) -> conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2) | (Ast.Atomic(re1),Ast.Atomic(re2)) -> unify_rule_elem re1 re2 | (Ast.Disj(s1),_) -> let s2 = Ast.rewrap s2 (Ast.DOTS[s2]) in disjunct_all_bindings (List.map (function x -> unify_dots unify_statement sdots x s2) s1) | (_,Ast.Disj(s2)) -> let s1 = Ast.rewrap s1 (Ast.DOTS[s1]) in disjunct_all_bindings (List.map (function x -> unify_dots unify_statement sdots s1 x) s2) | (Ast.Nest(_,s1,_,_,_,_,_),Ast.Nest(_,s2,_,_,_,_,_)) -> unify_dots unify_statement sdots s1 s2 | (Ast.FunDecl(h1,lb1,s1,rb1),Ast.FunDecl(h2,lb2,s2,rb2)) -> conjunct_bindings (unify_rule_elem h1 h2) (conjunct_bindings (unify_rule_elem lb1 lb2) (conjunct_bindings (unify_dots unify_statement sdots s1 s2) (unify_rule_elem rb1 rb2))) | (Ast.Define(h1,s1),Ast.Define(h2,s2)) -> conjunct_bindings (unify_rule_elem h1 h2) (unify_dots unify_statement sdots s1 s2) (* dots can match against anything. return true to be safe. *) | (Ast.Dots(_,_,_,_),_) | (_,Ast.Dots(_,_,_,_)) | (Ast.Circles(_,_,_,_),_) | (_,Ast.Circles(_,_,_,_)) | (Ast.Stars(_,_,_,_),_) | (_,Ast.Stars(_,_,_,_)) -> return true | (Ast.OptStm(_),_) | (Ast.UniqueStm(_),_) | (_,Ast.OptStm(_)) | (_,Ast.UniqueStm(_)) -> failwith "unsupported statement" | _ -> return false let unify_statement_dots = unify_dots unify_statement sdots coccinelle-1.0.0-rc19/parsing_cocci/adjust_pragmas.mli0000644000175000017500000000225112247442616021676 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./adjust_pragmas.mli" val process : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.0-rc19/parsing_cocci/parse_aux.ml0000644000175000017500000006347312247442616020525 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./parse_aux.ml" (* exports everything, used only by parser_cocci_menhir.mly *) module Ast0 = Ast0_cocci module Ast = Ast_cocci let contains_string_constant = ref false (* types for metavariable tokens *) type info = Ast.meta_name * Ast0.pure * Data.clt type midinfo = Ast.meta_name * Data.iconstraints * Ast.seed * Ast0.pure * Data.clt type idinfo = Ast.meta_name * Data.iconstraints * Ast0.pure * Data.clt type expinfo = Ast.meta_name * Data.econstraints * Ast0.pure * Data.clt type tyinfo = Ast.meta_name * Ast0.typeC list * Ast0.pure * Data.clt type list_info = Ast.meta_name * Ast.list_len * Ast0.pure * Data.clt type typed_expinfo = Ast.meta_name * Data.econstraints * Ast0.pure * Type_cocci.typeC list option * Data.clt type pos_info = Ast.meta_name * Data.pconstraints * Ast.meta_collect * Data.clt let get_option fn = function None -> None | Some x -> Some (fn x) let make_info line logical_line offset col strbef straft isSymbol = let new_pos_info = {Ast0.line_start = line; Ast0.line_end = line; Ast0.logical_start = logical_line; Ast0.logical_end = logical_line; Ast0.column = col; Ast0.offset = offset; } in { Ast0.pos_info = new_pos_info; Ast0.attachable_start = true; Ast0.attachable_end = true; Ast0.mcode_start = []; Ast0.mcode_end = []; Ast0.strings_before = strbef; Ast0.strings_after = straft; Ast0.isSymbolIdent = isSymbol; } let clt2info (_,line,logical_line,offset,col,strbef,straft,pos) = make_info line logical_line offset col strbef straft false let drop_bef (arity,line,lline,offset,col,strbef,straft,pos) = (arity,line,lline,offset,col,[],straft,pos) let drop_aft (arity,line,lline,offset,col,strbef,straft,pos) = (arity,line,lline,offset,col,strbef,[],pos) (* used for #define, to put aft on ident/( *) let get_aft (arity,line,lline,offset,col,strbef,straft,pos) = straft let set_aft aft (arity,line,lline,offset,col,strbef,_,pos) = (arity,line,lline,offset,col,strbef,aft,pos) let drop_pos (arity,line,lline,offset,col,strbef,straft,pos) = (arity,line,lline,offset,col,strbef,straft,[]) let clt2mcode_ext str isSymbol = function (Data.MINUS,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol, Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1) | (Data.OPTMINUS,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.OPT,make_info line lline offset col strbef straft isSymbol, Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1) | (Data.UNIQUEMINUS,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.UNIQUE,make_info line lline offset col strbef straft isSymbol, Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1) | (Data.PLUS,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol, Ast0.PLUS(Ast.ONE),ref pos,-1) | (Data.PLUSPLUS,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol, Ast0.PLUS(Ast.MANY),ref pos,-1) | (Data.CONTEXT,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.NONE,make_info line lline offset col strbef straft isSymbol, Ast0.CONTEXT(ref(Ast.NOTHING, Ast0.default_token_info,Ast0.default_token_info)), ref pos,-1) | (Data.OPT,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.OPT,make_info line lline offset col strbef straft isSymbol, Ast0.CONTEXT(ref(Ast.NOTHING, Ast0.default_token_info,Ast0.default_token_info)), ref pos,-1) | (Data.UNIQUE,line,lline,offset,col,strbef,straft,pos) -> (str,Ast0.UNIQUE,make_info line lline offset col strbef straft isSymbol, Ast0.CONTEXT(ref(Ast.NOTHING, Ast0.default_token_info,Ast0.default_token_info)), ref pos,-1) let clt2mcode name clt = clt2mcode_ext name false clt let id2name (name, clt) = name let id2clt (name, clt) = clt let id2mcode (name, clt) = clt2mcode name clt let sym2mcode (name, clt) = clt2mcode_ext name true clt let mkdots str (dot,whencode) = match str with "..." -> Ast0.wrap(Ast0.Dots(clt2mcode str dot, whencode)) | "ooo" -> Ast0.wrap(Ast0.Circles(clt2mcode str dot, whencode)) | "***" -> Ast0.wrap(Ast0.Stars(clt2mcode str dot, whencode)) | _ -> failwith "cannot happen" let mkedots str (dot,whencode) = match str with "..." -> Ast0.wrap(Ast0.Edots(clt2mcode str dot, whencode)) | "ooo" -> Ast0.wrap(Ast0.Ecircles(clt2mcode str dot, whencode)) | "***" -> Ast0.wrap(Ast0.Estars(clt2mcode str dot, whencode)) | _ -> failwith "cannot happen" let mkdpdots str dot = match str with "..." -> Ast0.wrap(Ast0.DPdots(clt2mcode str dot)) | "ooo" -> Ast0.wrap(Ast0.DPcircles(clt2mcode str dot)) | _ -> failwith "cannot happen" let mkidots str (dot,whencode) = match str with "..." -> Ast0.wrap(Ast0.Idots(clt2mcode str dot, whencode)) | _ -> failwith "cannot happen" let mkddots str (dot,whencode) = match (str,whencode) with ("...",None) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, None)) | ("...",Some [w]) -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, Some w)) | _ -> failwith "cannot happen" let mkddots_one str (dot,whencode) = match str with "..." -> Ast0.wrap(Ast0.Ddots(clt2mcode str dot, whencode)) | _ -> failwith "cannot happen" let mkpdots str dot = match str with "..." -> Ast0.wrap(Ast0.Pdots(clt2mcode str dot)) | "ooo" -> Ast0.wrap(Ast0.Pcircles(clt2mcode str dot)) | _ -> failwith "cannot happen" let arith_op ast_op left op right = Ast0.wrap (Ast0.Binary(left, clt2mcode (Ast.Arith ast_op) op, right)) let logic_op ast_op left op right = Ast0.wrap (Ast0.Binary(left, clt2mcode (Ast.Logical ast_op) op, right)) let make_cv cv ty = match cv with None -> ty | Some x -> Ast0.wrap (Ast0.ConstVol(x,ty)) let top_dots l = let circle x = match Ast0.unwrap x with Ast0.Circles(_) -> true | _ -> false in let star x = match Ast0.unwrap x with Ast0.Stars(_) -> true | _ -> false in if List.exists circle l then Ast0.wrap(Ast0.CIRCLES(l)) else if List.exists star l then Ast0.wrap(Ast0.STARS(l)) else Ast0.wrap(Ast0.DOTS(l)) (* here the offset is that of the first in the sequence of *s, not that of each * individually *) let pointerify ty m = List.fold_left (function inner -> function cur -> Ast0.wrap(Ast0.Pointer(inner,clt2mcode "*" cur))) ty m let ty_pointerify ty m = List.fold_left (function inner -> function cur -> Type_cocci.Pointer(inner)) ty m let arrayify ty ar = List.fold_right (function (l,i,r) -> function rest -> Ast0.wrap (Ast0.Array(rest,clt2mcode "[" l,i,clt2mcode "]" r))) ar ty (* Left is <=>, Right is =>. Collect <=>s. *) (* The parser should have done this, with precedences. But whatever... *) let iso_adjust first_fn fn first rest = let rec loop = function [] -> [[]] | (Common.Left x)::rest -> (match loop rest with front::after -> (fn x::front)::after | _ -> failwith "not possible") | (Common.Right x)::rest -> (match loop rest with front::after -> []::(fn x::front)::after | _ -> failwith "not possible") in match loop rest with front::after -> (first_fn first::front)::after | _ -> failwith "not possible" let lookup rule name = try let info = Hashtbl.find Data.all_metadecls rule in List.find (function mv -> Ast.get_meta_name mv = (rule,name)) info with Not_found -> raise (Semantic_cocci.Semantic("bad rule "^rule^" or bad variable "^name)) let check_meta_tyopt type_irrelevant = function Ast.MetaMetaDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaMetaDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaIdDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaIdDecl(_,_) | Ast.MetaFreshIdDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaFreshIdDecl((rule,name),seed) -> raise (Semantic_cocci.Semantic "can't inherit the freshness of an identifier") | Ast.MetaTypeDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaTypeDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaInitDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaInitDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaInitListDecl(Ast.NONE,(rule,name),len_name) -> (match lookup rule name with Ast.MetaInitListDecl(_,_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaListlenDecl((rule,name)) -> (match lookup rule name with Ast.MetaListlenDecl(_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaParamDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaParamDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaParamListDecl(Ast.NONE,(rule,name),len_name) -> (match lookup rule name with Ast.MetaParamListDecl(_,_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaConstDecl(Ast.NONE,(rule,name),ty) -> (match lookup rule name with Ast.MetaConstDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaErrDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaErrDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaExpDecl(Ast.NONE,(rule,name),ty) -> (match lookup rule name with Ast.MetaExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaIdExpDecl(Ast.NONE,(rule,name),ty) -> (match lookup rule name with Ast.MetaIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaLocalIdExpDecl(Ast.NONE,(rule,name),ty) -> (match lookup rule name with Ast.MetaLocalIdExpDecl(_,_,ty1) when type_irrelevant or ty = ty1 -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaExpListDecl(Ast.NONE,(rule,name),len_name) -> (match lookup rule name with Ast.MetaExpListDecl(_,_,_) -> () | Ast.MetaParamListDecl(_,_,_) when not (!Flag.make_hrule = None) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaDeclDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaDeclDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaFieldDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaFieldDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaFieldListDecl(Ast.NONE,(rule,name),len_name) -> (match lookup rule name with Ast.MetaFieldListDecl(_,_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaStmDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaStmDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaStmListDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaStmListDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaFuncDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaFuncDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaLocalFuncDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaLocalFuncDecl(_,_) -> () | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | Ast.MetaPosDecl(Ast.NONE,(rule,name)) -> (match lookup rule name with Ast.MetaPosDecl(_,_) -> if not (List.mem rule !Data.inheritable_positions) && not !Data.ignore_patch_or_match then raise (Semantic_cocci.Semantic ("position cannot be inherited over modifications: "^name)) | _ -> raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name))) | _ -> raise (Semantic_cocci.Semantic ("arity not allowed on imported declaration")) let check_meta m = check_meta_tyopt false m let check_inherited_constraint meta_name fn = match meta_name with (None,_) -> failwith "constraint must be an inherited variable" | (Some rule,name) -> let i = (rule,name) in check_meta_tyopt true (fn i); i let create_metadec ar ispure kindfn ids current_rule = List.concat (List.map (function (rule,nm) -> let (rule,checker) = match rule with None -> ((current_rule,nm),function x -> [Common.Left x]) | Some rule -> ((rule,nm), function x -> check_meta x; [Common.Right x]) in kindfn ar rule ispure checker) ids) let create_metadec_virt ar ispure kindfn ids current_rule = List.concat (List.map (function nm -> let checker = function x -> [Common.Right x] in kindfn ar nm ispure checker !Flag.defined_virtual_env) ids) let create_fresh_metadec kindfn ids current_rule = List.concat (List.map (function ((rule,nm),seed) -> let (rule,checker) = match rule with None -> ((current_rule,nm),function x -> [Common.Left x]) | Some rule -> ((rule,nm), function x -> check_meta x; [Common.Right x]) in kindfn rule checker seed) ids) let create_metadec_with_constraints ar ispure kindfn ids current_rule = List.concat (List.map (function ((rule,nm),constraints) -> let (rule,checker) = match rule with None -> ((current_rule,nm),function x -> [Common.Left x]) | Some rule -> ((rule,nm), function x -> check_meta x; [Common.Right x]) in kindfn ar rule ispure checker constraints) ids) let create_metadec_ty ar ispure kindfn ids current_rule = List.concat (List.map (function ((rule,nm),constraints) -> let (rule,checker) = match rule with None -> ((current_rule,nm),function x -> [Common.Left x]) | Some rule -> ((rule,nm), function x -> check_meta x; [Common.Right x]) in kindfn ar rule ispure checker constraints) ids) let create_len_metadec ar ispure kindfn lenid ids current_rule = let (lendec,lenname) = match lenid with Common.Left lenid -> let lendec = create_metadec Ast.NONE Ast0.Impure (fun _ name _ check_meta -> check_meta(Ast.MetaListlenDecl(name))) [lenid] current_rule in let lenname = match lendec with [Common.Left (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x | [Common.Right (Ast.MetaListlenDecl(x))] -> Ast.MetaLen x | _ -> failwith "unexpected length declaration" in (lendec,lenname) | Common.Right n -> ([],Ast.CstLen n) in lendec@(create_metadec ar ispure (kindfn lenname) ids current_rule) (* ---------------------------------------------------------------------- *) let str2inc s = let elements = Str.split (Str.regexp "/") s in List.map (function "..." -> Ast.IncDots | s -> Ast.IncPath s) elements (* ---------------------------------------------------------------------- *) (* declarations and statements *) let meta_decl name = let (nm,pure,clt) = name in Ast0.wrap(Ast0.MetaDecl(clt2mcode nm clt,pure)) let meta_field name = let (nm,pure,clt) = name in Ast0.wrap(Ast0.MetaField(clt2mcode nm clt,pure)) let meta_field_list name = let (nm,lenname,pure,clt) = name in let lenname = match lenname with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in Ast0.wrap(Ast0.MetaFieldList(clt2mcode nm clt,lenname,pure)) let meta_stm name = let (nm,pure,clt) = name in Ast0.wrap(Ast0.MetaStmt(clt2mcode nm clt,pure)) let exp_stm exp pv = Ast0.wrap(Ast0.ExprStatement (exp, clt2mcode ";" pv)) let make_fake_mcode _ = (Ast0.default_info(),Ast0.context_befaft(),-1) let ifthen iff lp tst rp thn = Ast0.wrap(Ast0.IfThen(clt2mcode "if" iff, clt2mcode "(" lp,tst,clt2mcode ")" rp,thn,make_fake_mcode())) let ifthenelse iff lp tst rp thn e els = Ast0.wrap(Ast0.IfThenElse(clt2mcode "if" iff, clt2mcode "(" lp,tst,clt2mcode ")" rp,thn, clt2mcode "else" e,els,make_fake_mcode())) let forloop fr lp e1 sc1 e2 sc2 e3 rp s = Ast0.wrap(Ast0.For(clt2mcode "for" fr,clt2mcode "(" lp, Ast0.wrap(Ast0.ForExp(e1,clt2mcode ";" sc1)),e2, clt2mcode ";" sc2,e3,clt2mcode ")" rp,s, make_fake_mcode())) let forloop2 fr lp decl e2 sc2 e3 rp s = let bef = (Ast0.default_info(),Ast0.context_befaft()) in Ast0.wrap(Ast0.For(clt2mcode "for" fr,clt2mcode "(" lp, Ast0.wrap(Ast0.ForDecl (bef,decl)),e2, clt2mcode ";" sc2,e3,clt2mcode ")" rp,s, make_fake_mcode())) let whileloop w lp e rp s = Ast0.wrap(Ast0.While(clt2mcode "while" w,clt2mcode "(" lp, e,clt2mcode ")" rp,s,make_fake_mcode())) let doloop d s w lp e rp pv = Ast0.wrap(Ast0.Do(clt2mcode "do" d,s,clt2mcode "while" w, clt2mcode "(" lp,e,clt2mcode ")" rp, clt2mcode ";" pv)) let iterator i lp e rp s = Ast0.wrap(Ast0.Iterator(i,clt2mcode "(" lp,e,clt2mcode ")" rp,s, make_fake_mcode())) let switch s lp e rp lb d c rb = let d = List.map (function d -> Ast0.wrap(Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()),d))) d in Ast0.wrap(Ast0.Switch(clt2mcode "switch" s,clt2mcode "(" lp,e, clt2mcode ")" rp,clt2mcode "{" lb, Ast0.wrap(Ast0.DOTS(d)), Ast0.wrap(Ast0.DOTS(c)),clt2mcode "}" rb)) let ret_exp r e pv = Ast0.wrap(Ast0.ReturnExpr(clt2mcode "return" r,e,clt2mcode ";" pv)) let ret r pv = Ast0.wrap(Ast0.Return(clt2mcode "return" r,clt2mcode ";" pv)) let break b pv = Ast0.wrap(Ast0.Break(clt2mcode "break" b,clt2mcode ";" pv)) let cont c pv = Ast0.wrap(Ast0.Continue(clt2mcode "continue" c,clt2mcode ";" pv)) let label i dd = Ast0.wrap(Ast0.Label(i,clt2mcode ":" dd)) let goto g i pv = Ast0.wrap(Ast0.Goto(clt2mcode "goto" g,i,clt2mcode ";" pv)) let seq lb s rb = Ast0.wrap(Ast0.Seq(clt2mcode "{" lb,s,clt2mcode "}" rb)) (* ---------------------------------------------------------------------- *) let check_rule_name = function Some nm -> let n = id2name nm in (try let _ = Hashtbl.find Data.all_metadecls n in raise (Semantic_cocci.Semantic ("repeated rule name")) with Not_found -> Some n) | None -> None let make_iso_rule_name_result n = (try let _ = Hashtbl.find Data.all_metadecls n in raise (Semantic_cocci.Semantic ("repeated rule name")) with Not_found -> ()); Ast.CocciRulename (Some n,Ast.NoDep,[],[],Ast.Undetermined,Ast.AnyP (*discarded*)) let fix_dependencies d = let rec loop inverted = function Ast0.Dep s when inverted -> Ast.AntiDep s | Ast0.Dep s -> Ast.Dep s | Ast0.AntiDep d -> loop (not inverted) d | Ast0.EverDep s when inverted -> Ast.NeverDep s | Ast0.EverDep s -> Ast.EverDep s | Ast0.NeverDep s when inverted -> Ast.EverDep s | Ast0.NeverDep s -> Ast.NeverDep s | Ast0.AndDep(d1,d2) when inverted -> Ast.OrDep(loop inverted d1,loop inverted d2) | Ast0.AndDep(d1,d2) -> Ast.AndDep(loop inverted d1,loop inverted d2) | Ast0.OrDep(d1,d2) when inverted -> Ast.AndDep(loop inverted d1,loop inverted d2) | Ast0.OrDep(d1,d2) -> Ast.OrDep(loop inverted d1,loop inverted d2) | Ast0.NoDep -> Ast.NoDep | Ast0.FailDep -> Ast.FailDep in loop false d let make_cocci_rule_name_result nm d i a e ee = Ast.CocciRulename (check_rule_name nm,fix_dependencies d,i,a,e,ee) let make_generated_rule_name_result nm d i a e ee = Ast.GeneratedRulename (check_rule_name nm,fix_dependencies d,i,a,e,ee) let make_script_rule_name_result lang nm deps = let l = id2name lang in Ast.ScriptRulename (check_rule_name nm,l,fix_dependencies deps) let make_initial_script_rule_name_result lang deps = let l = id2name lang in Ast.InitialScriptRulename(None,l,fix_dependencies deps) let make_final_script_rule_name_result lang deps = let l = id2name lang in Ast.FinalScriptRulename(None,l,fix_dependencies deps) (* ---------------------------------------------------------------------- *) (* decide whether an init list is ordered or unordered *) let struct_initializer initlist = let rec loop i = match Ast0.unwrap i with Ast0.InitGccExt _ -> true | Ast0.InitGccName _ -> true | Ast0.OptIni i | Ast0.UniqueIni i -> loop i | Ast0.MetaInit _ | Ast0.MetaInitList _ -> false (* ambiguous... *) | _ -> false in let l = Ast0.undots initlist in (l = []) or (List.exists loop l) let drop_dot_commas initlist = match Ast0.unwrap initlist with Ast0.DOTS(l) -> let rec loop after_comma = function [] -> [] | x::xs -> (match Ast0.unwrap x with Ast0.Idots(dots,whencode) -> x :: (loop true xs) | Ast0.IComma(comma) when after_comma -> (*drop*) loop false xs | _ -> x :: (loop false xs)) in Ast0.rewrap initlist (Ast0.DOTS(loop false l)) | _ -> failwith "not supported" (* ----------------------------------------------------------------------- *) (* strings *) type metavars = MFrag of (string Ast0.mcode -> Ast0.string_fragment) | MFmt of Ast0.string_format let string_metavariables str clt = try let (name,constraints) = List.assoc str !Data.format_metavariables in MFmt(Ast0.wrap(Ast0.MetaFormat(clt2mcode name clt,constraints))) with Not_found -> try let (name,lenname) = List.assoc str !Data.format_list_metavariables in let lenname = match lenname with Ast.AnyLen -> Ast0.AnyListLen | Ast.MetaLen nm -> Ast0.MetaListLen(clt2mcode nm clt) | Ast.CstLen n -> Ast0.CstListLen n in MFrag (fun pct -> Ast0.wrap(Ast0.MetaFormatList(pct,clt2mcode name clt,lenname))) with Not_found -> failwith "bad metavariable in string" let pct_split str = let lst = Common.list_of_string str in let complete l = let l = List.rev l in String.concat "" (List.map (function c -> Printf.sprintf "%c" c) l) in let rec loop acc cur = function [] -> List.rev ((complete cur)::acc) | '%'::'%'::rest -> loop acc ('%'::'%'::cur) rest | ['%'] -> raise Parse_printf.Not_format_string | '%'::rest -> loop ((complete cur)::acc) [] rest | x :: rest -> loop acc (x :: cur) rest in loop [] [] lst let parse_middle middle clt = let pieces = pct_split middle in match pieces with [] -> failwith "not possible" | fst::rest -> let first = match fst with "" -> [] | "..." -> [Ast0.wrap(Ast0.Strdots(clt2mcode fst clt))] | _ -> [Ast0.wrap (Ast0.ConstantFragment(clt2mcode fst clt))] in let rest = List.map (function r -> let pct = clt2mcode "%" clt in let mkfmt d = Ast0.wrap (Ast0.ConstantFormat(clt2mcode d clt)) in match String.get r 0 with '@' -> let mkrest = function "" -> [] | "..." -> [Ast0.wrap(Ast0.Strdots(clt2mcode "..." clt))] | s -> [Ast0.wrap(Ast0.ConstantFragment(clt2mcode s clt))] in (match Str.split (Str.regexp "@") r with first::rest -> (match string_metavariables first clt with MFmt fmtvar -> (Ast0.wrap (Ast0.FormatFragment(pct,fmtvar))):: (mkrest (String.concat "@" rest)) | MFrag fragvar -> (fragvar pct)::(mkrest (String.concat "@" rest))) | _ -> failwith "bad string2") | _ -> match Parse_printf.get_format_string r with (d,"") -> [Ast0.wrap (Ast0.FormatFragment(pct,mkfmt d))] | (d,rest) -> [Ast0.wrap (Ast0.FormatFragment(pct,mkfmt d)); Ast0.wrap (Ast0.ConstantFragment(clt2mcode rest clt))]) rest in first @ (List.concat rest) let not_format_string str clt = Ast0.wrap(Ast0.Constant (clt2mcode (Ast.String str) clt)) let parse_string str clt = if List.length(Str.split_delim (Str.regexp "%") str) > 1 then try begin let first = "\"" in let last = "\"" in let middle = parse_middle str clt in let middle = Ast0.wrap (Ast0.DOTS middle) in contains_string_constant := true; Ast0.wrap (Ast0.StringConstant(clt2mcode first clt,middle,clt2mcode last clt)) end with Parse_printf.Not_format_string -> not_format_string str clt else not_format_string str clt coccinelle-1.0.0-rc19/parsing_cocci/check_meta.mli0000644000175000017500000000254412247442616020762 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./check_meta.mli" val check_meta : string -> Ast_cocci.metavar list (* old metavariables *) -> Ast_cocci.metavar list (* explicitly inherited *) -> Ast_cocci.metavar list (* declared locally *) -> Ast0_cocci.rule -> Ast0_cocci.rule -> unit coccinelle-1.0.0-rc19/parsing_cocci/context_neg.ml0000644000175000017500000013206212247442615021041 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./context_neg.ml" (* Detects subtrees that are all minus/plus and nodes that are "binding context nodes". The latter is a node whose structure and immediate tokens are the same in the minus and plus trees, and such that for every child, the set of context nodes in the child subtree is the same in the minus and plus subtrees. *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module U = Unparse_ast0 (* --------------------------------------------------------------------- *) (* Generic access to code *) let set_mcodekind x mcodekind = match x with Ast0.DotsExprTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DotsInitTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DotsParamTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DotsStmtTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DotsDeclTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DotsCaseTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.IdentTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.ExprTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> failwith "not possible - iso only" | Ast0.TypeCTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.ParamTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.DeclTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.InitTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.StmtTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.ForInfoTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.CaseLineTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.TopTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "invisible at this stage" | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase" let set_index x index = match x with Ast0.DotsExprTag(d) -> Ast0.set_index d index | Ast0.DotsInitTag(d) -> Ast0.set_index d index | Ast0.DotsParamTag(d) -> Ast0.set_index d index | Ast0.DotsStmtTag(d) -> Ast0.set_index d index | Ast0.DotsDeclTag(d) -> Ast0.set_index d index | Ast0.DotsCaseTag(d) -> Ast0.set_index d index | Ast0.IdentTag(d) -> Ast0.set_index d index | Ast0.ExprTag(d) -> Ast0.set_index d index | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> failwith "not possible - iso only" | Ast0.TypeCTag(d) -> Ast0.set_index d index | Ast0.ParamTag(d) -> Ast0.set_index d index | Ast0.InitTag(d) -> Ast0.set_index d index | Ast0.DeclTag(d) -> Ast0.set_index d index | Ast0.StmtTag(d) -> Ast0.set_index d index | Ast0.ForInfoTag(d) -> Ast0.set_index d index | Ast0.CaseLineTag(d) -> Ast0.set_index d index | Ast0.TopTag(d) -> Ast0.set_index d index | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "invisible at this stage" | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase" let get_index = function Ast0.DotsExprTag(d) -> Index.expression_dots d | Ast0.DotsInitTag(d) -> Index.initialiser_dots d | Ast0.DotsParamTag(d) -> Index.parameter_dots d | Ast0.DotsStmtTag(d) -> Index.statement_dots d | Ast0.DotsDeclTag(d) -> Index.declaration_dots d | Ast0.DotsCaseTag(d) -> Index.case_line_dots d | Ast0.IdentTag(d) -> Index.ident d | Ast0.ExprTag(d) -> Index.expression d | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> failwith "not possible - iso only" | Ast0.TypeCTag(d) -> Index.typeC d | Ast0.ParamTag(d) -> Index.parameterTypeDef d | Ast0.InitTag(d) -> Index.initialiser d | Ast0.DeclTag(d) -> Index.declaration d | Ast0.StmtTag(d) -> Index.statement d | Ast0.ForInfoTag(d) -> Index.forinfo d | Ast0.CaseLineTag(d) -> Index.case_line d | Ast0.TopTag(d) -> Index.top_level d | Ast0.IsoWhenTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase" | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase" | Ast0.MetaPosTag(p) -> failwith "invisible at this stage" | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase" (* --------------------------------------------------------------------- *) (* Collect the line numbers of the plus code. This is used for disjunctions. It is not completely clear why this is necessary, but it seems like an easy fix for whatever is the problem that is discussed in disj_cases *) let plus_lines = ref ([] : int list) let insert n = let rec loop = function [] -> [n] | x::xs -> match compare n x with 1 -> x::(loop xs) | 0 -> x::xs | -1 -> n::x::xs | _ -> failwith "not possible" in plus_lines := loop !plus_lines let find n min max = let rec loop = function [] -> (min,max) | [x] -> if n < x then (min,x) else (x,max) | x1::x2::rest -> if n < x1 then (min,x1) else if n > x1 && n < x2 then (x1,x2) else loop (x2::rest) in loop !plus_lines let collect_plus_lines top = plus_lines := []; let bind x y = () in let option_default = () in let donothing r k e = k e in let mcode (_,_,info,mcodekind,_,_) = match mcodekind with Ast0.PLUS _ -> insert info.Ast0.pos_info.Ast0.line_start | _ -> () in let fn = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in fn.VT0.combiner_rec_top_level top (* --------------------------------------------------------------------- *) type kind = Neutral | AllMarked of Ast.count | NotAllMarked (* marked means + or - *) (* --------------------------------------------------------------------- *) (* The first part analyzes each of the minus tree and the plus tree separately *) (* ints are unique token indices (offset field) *) type node = Token (* tokens *) of kind * int (* unique index *) * Ast0.mcodekind * int list (* context tokens *) | Recursor (* children *) of kind * int list (* indices of all tokens at the level below *) * Ast0.mcodekind list (* tokens at the level below *) * int list | Bind (* neighbors *) of kind * int list (* indices of all tokens at current level *) * Ast0.mcodekind list (* tokens at current level *) * int list (* indices of all tokens at the level below *) * Ast0.mcodekind list (* tokens at the level below *) * int list list let kind2c = function Neutral -> "neutral" | AllMarked _ -> "allmarked" | NotAllMarked -> "notallmarked" let node2c = function Token(k,_,_,_) -> Printf.sprintf "token %s\n" (kind2c k) | Recursor(k,_,_,_) -> Printf.sprintf "recursor %s\n" (kind2c k) | Bind(k,_,_,_,_,_) -> Printf.sprintf "bind %s\n" (kind2c k) (* goal: detect negative in both tokens and recursors, or context only in tokens *) let bind c1 c2 = let lub = function (k1,k2) when k1 = k2 -> k1 | (Neutral,AllMarked c) -> AllMarked c | (AllMarked c,Neutral) -> AllMarked c | _ -> NotAllMarked in match (c1,c2) with (* token/token *) (* there are tokens at this level, so ignore the level below *) (Token(k1,i1,t1,l1),Token(k2,i2,t2,l2)) -> Bind(lub(k1,k2),[i1;i2],[t1;t2],[],[],[l1;l2]) (* token/recursor *) (* there are tokens at this level, so ignore the level below *) | (Token(k1,i1,t1,l1),Recursor(k2,_,_,l2)) -> Bind(lub(k1,k2),[i1],[t1],[],[],[l1;l2]) | (Recursor(k1,_,_,l1),Token(k2,i2,t2,l2)) -> Bind(lub(k1,k2),[i2],[t2],[],[],[l1;l2]) (* token/bind *) (* there are tokens at this level, so ignore the level below *) | (Token(k1,i1,t1,l1),Bind(k2,i2,t2,_,_,l2)) -> Bind(lub(k1,k2),i1::i2,t1::t2,[],[],l1::l2) | (Bind(k1,i1,t1,_,_,l1),Token(k2,i2,t2,l2)) -> Bind(lub(k1,k2),i1@[i2],t1@[t2],[],[],l1@[l2]) (* recursor/bind *) | (Recursor(k1,bi1,bt1,l1),Bind(k2,i2,t2,bi2,bt2,l2)) -> Bind(lub(k1,k2),i2,t2,bi1@bi2,bt1@bt2,l1::l2) | (Bind(k1,i1,t1,bi1,bt1,l1),Recursor(k2,bi2,bt2,l2)) -> Bind(lub(k1,k2),i1,t1,bi1@bi2,bt1@bt2,l1@[l2]) (* recursor/recursor and bind/bind - not likely to ever occur *) | (Recursor(k1,bi1,bt1,l1),Recursor(k2,bi2,bt2,l2)) -> Bind(lub(k1,k2),[],[],bi1@bi2,bt1@bt2,[l1;l2]) | (Bind(k1,i1,t1,bi1,bt1,l1),Bind(k2,i2,t2,bi2,bt2,l2)) -> Bind(lub(k1,k2),i1@i2,t1@t2,bi1@bi2,bt1@bt2,l1@l2) let option_default = (*Bind(Neutral,[],[],[],[],[])*) Recursor(Neutral,[],[],[]) let mcode (_,_,info,mcodekind,pos,_) = let offset = info.Ast0.pos_info.Ast0.offset in match mcodekind with Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[]) | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[]) | Ast0.CONTEXT(_) -> Token(NotAllMarked,offset,mcodekind,[offset]) | _ -> failwith "not possible" let neutral_mcode (_,_,info,mcodekind,pos,_) = let offset = info.Ast0.pos_info.Ast0.offset in match mcodekind with Ast0.MINUS(_) -> Token(Neutral,offset,mcodekind,[]) | Ast0.PLUS _ -> Token(Neutral,offset,mcodekind,[]) | Ast0.CONTEXT(_) -> Token(Neutral,offset,mcodekind,[offset]) | _ -> failwith "not possible" (* neutral for context; used for mcode in bef aft nodes that don't represent anything if they don't contain some information *) let nc_mcode (_,_,info,mcodekind,pos,_) = (* distinguish from the offset of some real token *) let offset = (-1) * info.Ast0.pos_info.Ast0.offset in match mcodekind with Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[]) | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[]) | Ast0.CONTEXT(_) -> (* Unlike the other mcode cases, we drop the offset from the context offsets. This is because we don't know whether the term this is associated with is - or context. In any case, the context offsets are used for identification, and this invisible node should not be needed for this purpose. *) Token(Neutral,offset,mcodekind,[]) | _ -> failwith "not possible" let is_context = function Ast0.CONTEXT(_) -> true | _ -> false let union_all l = List.fold_left Common.union_set [] l (* is minus is true when we are processing minus code that might be intermingled with plus code. it is used in disj_cases *) let classify is_minus all_marked table code = let mkres builder k il tl bil btl l e = (match k with AllMarked count -> Ast0.set_mcodekind e (all_marked count) (* definitive *) | _ -> let check_index il tl = if List.for_all is_context tl then (let e1 = builder e in let index = (get_index e1)@il in try let _ = Hashtbl.find table index in failwith (Printf.sprintf "line %d: index %s already used\n" (Ast0.get_info e).Ast0.pos_info.Ast0.line_start (String.concat " " (List.map string_of_int index))) with Not_found -> Hashtbl.add table index (e1,l)) in if il = [] then check_index bil btl else check_index il tl); if il = [] then Recursor(k, bil, btl, union_all l) else Recursor(k, il, tl, union_all l) in let compute_result builder e = function Bind(k,il,tl,bil,btl,l) -> mkres builder k il tl bil btl l e | Token(k,il,tl,l) -> mkres builder k [il] [tl] [] [] [l] e | Recursor(k,bil,btl,l) -> mkres builder k [] [] bil btl [l] e in let make_not_marked = function Bind(k,il,tl,bil,btl,l) -> Bind(NotAllMarked,il,tl,bil,btl,l) | Token(k,il,tl,l) -> Token(NotAllMarked,il,tl,l) | Recursor(k,bil,btl,l) -> Recursor(NotAllMarked,bil,btl,l) in let do_nothing builder r k e = compute_result builder e (k e) in let disj_cases disj starter code fn ender = (* neutral_mcode used so starter and ender don't have an affect on whether the code is considered all plus/minus, but so that they are consider in the index list, which is needed to make a disj with something in one branch and nothing in the other different from code that just has the something (starter/ender enough, mids not needed for this). Cannot agglomerate + code over | boundaries, because two - cases might have different + code, and don't want to put the + code together into one unit. *) let make_not_marked = if is_minus then (let min = Ast0.get_line disj in let max = Ast0.get_line_end disj in let (plus_min,plus_max) = find min (min-1) (max+1) in if max > plus_max then make_not_marked else (function x -> x)) else make_not_marked in bind (neutral_mcode starter) (bind (List.fold_right bind (List.map make_not_marked (List.map fn code)) option_default) (neutral_mcode ender)) in (* no whencode in plus tree so have to drop it *) (* need special cases for dots, nests, and disjs *) let ident r k e = compute_result Ast0.ident e (match Ast0.unwrap e with Ast0.DisjId(starter,id_list,_,ender) -> disj_cases e starter id_list r.VT0.combiner_rec_ident ender | _ -> k e) in let expression r k e = compute_result Ast0.expr e (match Ast0.unwrap e with Ast0.NestExpr(starter,exp,ender,whencode,multi) -> k (Ast0.rewrap e (Ast0.NestExpr(starter,exp,ender,None,multi))) | Ast0.Edots(dots,whencode) -> k (Ast0.rewrap e (Ast0.Edots(dots,None))) | Ast0.Ecircles(dots,whencode) -> k (Ast0.rewrap e (Ast0.Ecircles(dots,None))) | Ast0.Estars(dots,whencode) -> k (Ast0.rewrap e (Ast0.Estars(dots,None))) | Ast0.DisjExpr(starter,expr_list,_,ender) -> disj_cases e starter expr_list r.VT0.combiner_rec_expression ender | _ -> k e) in (* not clear why we have the next two cases, since DisjDecl and DisjType shouldn't have been constructed yet, as they only come from isos *) (* actually, DisjDecl now allowed in source struct decls *) let declaration r k e = compute_result Ast0.decl e (match Ast0.unwrap e with Ast0.DisjDecl(starter,decls,_,ender) -> disj_cases e starter decls r.VT0.combiner_rec_declaration ender | Ast0.Ddots(dots,whencode) -> k (Ast0.rewrap e (Ast0.Ddots(dots,None))) (* Need special cases for the following so that the type will be considered as a unit, rather than distributed around the declared variable. This needs to be done because of the call to compute_result, ie the processing of each term should make a side-effect on the complete term structure as well as collecting some information about it. So we have to visit each complete term structure. In (all?) other such cases, we visit the terms using rebuilder, which just visits the subterms, rather than reordering their components. *) | Ast0.Init(stg,ty,id,eq,ini,sem) -> bind (match stg with Some stg -> mcode stg | _ -> option_default) (bind (r.VT0.combiner_rec_typeC ty) (bind (r.VT0.combiner_rec_ident id) (bind (mcode eq) (bind (r.VT0.combiner_rec_initialiser ini) (mcode sem))))) | Ast0.UnInit(stg,ty,id,sem) -> bind (match stg with Some stg -> mcode stg | _ -> option_default) (bind (r.VT0.combiner_rec_typeC ty) (bind (r.VT0.combiner_rec_ident id) (mcode sem))) | _ -> k e) in let param r k e = compute_result Ast0.param e (match Ast0.unwrap e with Ast0.Param(ty,Some id) -> (* needed for the same reason as in the Init and UnInit cases *) bind (r.VT0.combiner_rec_typeC ty) (r.VT0.combiner_rec_ident id) | _ -> k e) in let typeC r k e = compute_result Ast0.typeC e (match Ast0.unwrap e with Ast0.DisjType(starter,types,_,ender) -> disj_cases e starter types r.VT0.combiner_rec_typeC ender | _ -> k e) in let initialiser r k i = compute_result Ast0.ini i (match Ast0.unwrap i with Ast0.Idots(dots,whencode) -> k (Ast0.rewrap i (Ast0.Idots(dots,None))) | _ -> k i) in let case_line r k e = compute_result Ast0.case_line e (match Ast0.unwrap e with Ast0.DisjCase(starter,case_list,_,ender) -> disj_cases e starter case_list r.VT0.combiner_rec_case_line ender | _ -> k e) in let statement r k s = compute_result Ast0.stmt s (match Ast0.unwrap s with Ast0.Nest(started,stm_dots,ender,whencode,multi) -> k (Ast0.rewrap s (Ast0.Nest(started,stm_dots,ender,[],multi))) | Ast0.Dots(dots,whencode) -> k (Ast0.rewrap s (Ast0.Dots(dots,[]))) | Ast0.Circles(dots,whencode) -> k (Ast0.rewrap s (Ast0.Circles(dots,[]))) | Ast0.Stars(dots,whencode) -> k (Ast0.rewrap s (Ast0.Stars(dots,[]))) | Ast0.Disj(starter,statement_dots_list,_,ender) -> disj_cases s starter statement_dots_list r.VT0.combiner_rec_statement_dots ender (* cases for everything with extra mcode *) | Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_) | Ast0.Decl((info,bef),_) -> bind (nc_mcode ((),(),info,bef,(),-1)) (k s) (* For these, the info of the aft mcode is derived from the else branch. These might not correspond for a context if, eg if only the else branch is replaced. Thus we take instead the info of the starting keyword. In a context case, these will be the same on the - and + sides. All that is used as an offset, and it is only used as a key, so this is safe to do. For an iterator, we take the left parenthesis, which should have the same property. *) | Ast0.IfThen(start,_,_,_,_,(info,aft,adj)) | Ast0.IfThenElse(start,_,_,_,_,_,_,(info,aft,adj)) | Ast0.Iterator(_,start,_,_,_,(info,aft,adj)) | Ast0.While(start,_,_,_,_,(info,aft,adj)) | Ast0.For(start,_,_,_,_,_,_,_,(info,aft,adj)) -> let mcode_info (_,_,info,_,_,_) = info in bind (k s) (nc_mcode ((),(),mcode_info start,aft,(),adj)) | _ -> k s ) in let do_top builder r k e = compute_result builder e (k e) in let combiner = V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode (do_nothing Ast0.dotsExpr) (do_nothing Ast0.dotsInit) (do_nothing Ast0.dotsParam) (do_nothing Ast0.dotsStmt) (do_nothing Ast0.dotsDecl) (do_nothing Ast0.dotsCase) ident expression typeC initialiser param declaration statement (do_nothing Ast0.forinfo) case_line (do_top Ast0.top) in combiner.VT0.combiner_rec_top_level code (* --------------------------------------------------------------------- *) (* Traverse the hash tables and find corresponding context nodes that have the same context children *) (* this is just a sanity check - really only need to look at the top-level structure *) let equal_mcode (_,_,info1,_,_,_) (_,_,info2,_,_,_) = info1.Ast0.pos_info.Ast0.offset = info2.Ast0.pos_info.Ast0.offset let equal_option e1 e2 = match (e1,e2) with (Some x, Some y) -> equal_mcode x y | (None, None) -> true | _ -> false let dots fn d1 d2 = match (Ast0.unwrap d1,Ast0.unwrap d2) with (Ast0.DOTS(l1),Ast0.DOTS(l2)) -> List.length l1 = List.length l2 | (Ast0.CIRCLES(l1),Ast0.CIRCLES(l2)) -> List.length l1 = List.length l2 | (Ast0.STARS(l1),Ast0.STARS(l2)) -> List.length l1 = List.length l2 | _ -> false let rec equal_ident i1 i2 = match (Ast0.unwrap i1,Ast0.unwrap i2) with (Ast0.Id(name1),Ast0.Id(name2)) -> equal_mcode name1 name2 | (Ast0.MetaId(name1,_,_,_),Ast0.MetaId(name2,_,_,_)) -> equal_mcode name1 name2 | (Ast0.MetaFunc(name1,_,_),Ast0.MetaFunc(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.MetaLocalFunc(name1,_,_),Ast0.MetaLocalFunc(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.DisjId(starter1,_,mids1,ender1), Ast0.DisjId(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | (Ast0.OptIdent(_),Ast0.OptIdent(_)) -> true | (Ast0.UniqueIdent(_),Ast0.UniqueIdent(_)) -> true | _ -> false let rec equal_expression e1 e2 = match (Ast0.unwrap e1,Ast0.unwrap e2) with (Ast0.Ident(_),Ast0.Ident(_)) -> true | (Ast0.Constant(const1),Ast0.Constant(const2)) -> equal_mcode const1 const2 | (Ast0.StringConstant(lq1,const1,rq1),Ast0.StringConstant(lq2,const2,rq2))-> equal_mcode lq1 lq2 && equal_mcode rq1 rq2 | (Ast0.FunCall(_,lp1,_,rp1),Ast0.FunCall(_,lp2,_,rp2)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.Assignment(_,op1,_,_),Ast0.Assignment(_,op2,_,_)) -> equal_mcode op1 op2 | (Ast0.Sequence(_,op1,_),Ast0.Sequence(_,op2,_)) -> equal_mcode op1 op2 | (Ast0.CondExpr(_,why1,_,colon1,_),Ast0.CondExpr(_,why2,_,colon2,_)) -> equal_mcode why1 why2 && equal_mcode colon1 colon2 | (Ast0.Postfix(_,op1),Ast0.Postfix(_,op2)) -> equal_mcode op1 op2 | (Ast0.Infix(_,op1),Ast0.Infix(_,op2)) -> equal_mcode op1 op2 | (Ast0.Unary(_,op1),Ast0.Unary(_,op2)) -> equal_mcode op1 op2 | (Ast0.Binary(_,op1,_),Ast0.Binary(_,op2,_)) -> equal_mcode op1 op2 | (Ast0.Paren(lp1,_,rp1),Ast0.Paren(lp2,_,rp2)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.ArrayAccess(_,lb1,_,rb1),Ast0.ArrayAccess(_,lb2,_,rb2)) -> equal_mcode lb1 lb2 && equal_mcode rb1 rb2 | (Ast0.RecordAccess(_,pt1,_),Ast0.RecordAccess(_,pt2,_)) -> equal_mcode pt1 pt2 | (Ast0.RecordPtAccess(_,ar1,_),Ast0.RecordPtAccess(_,ar2,_)) -> equal_mcode ar1 ar2 | (Ast0.Cast(lp1,_,rp1,_),Ast0.Cast(lp2,_,rp2,_)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.SizeOfExpr(szf1,_),Ast0.SizeOfExpr(szf2,_)) -> equal_mcode szf1 szf2 | (Ast0.SizeOfType(szf1,lp1,_,rp1),Ast0.SizeOfType(szf2,lp2,_,rp2)) -> equal_mcode szf1 szf2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.TypeExp(_),Ast0.TypeExp(_)) -> true | (Ast0.Constructor(lp1,_,rp1,_),Ast0.Constructor(lp2,_,rp2,_)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.MetaErr(name1,_,_),Ast0.MetaErr(name2,_,_)) | (Ast0.MetaExpr(name1,_,_,_,_),Ast0.MetaExpr(name2,_,_,_,_)) | (Ast0.MetaExprList(name1,_,_),Ast0.MetaExprList(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.EComma(cm1),Ast0.EComma(cm2)) -> equal_mcode cm1 cm2 | (Ast0.DisjExpr(starter1,_,mids1,ender1), Ast0.DisjExpr(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | (Ast0.NestExpr(starter1,_,ender1,_,m1), Ast0.NestExpr(starter2,_,ender2,_,m2)) -> equal_mcode starter1 starter2 && equal_mcode ender1 ender2 && m1 = m2 | (Ast0.Edots(dots1,_),Ast0.Edots(dots2,_)) | (Ast0.Ecircles(dots1,_),Ast0.Ecircles(dots2,_)) | (Ast0.Estars(dots1,_),Ast0.Estars(dots2,_)) -> equal_mcode dots1 dots2 | (Ast0.OptExp(_),Ast0.OptExp(_)) -> true | (Ast0.UniqueExp(_),Ast0.UniqueExp(_)) -> true | _ -> false let rec equal_typeC t1 t2 = match (Ast0.unwrap t1,Ast0.unwrap t2) with (Ast0.ConstVol(cv1,_),Ast0.ConstVol(cv2,_)) -> equal_mcode cv1 cv2 | (Ast0.BaseType(ty1,stringsa),Ast0.BaseType(ty2,stringsb)) -> List.for_all2 equal_mcode stringsa stringsb | (Ast0.Signed(sign1,_),Ast0.Signed(sign2,_)) -> equal_mcode sign1 sign2 | (Ast0.Pointer(_,star1),Ast0.Pointer(_,star2)) -> equal_mcode star1 star2 | (Ast0.Array(_,lb1,_,rb1),Ast0.Array(_,lb2,_,rb2)) -> equal_mcode lb1 lb2 && equal_mcode rb1 rb2 | (Ast0.Decimal(dec1,lp1,_,comma1,_,rp1), Ast0.Decimal(dec2,lp2,_,comma2,_,rp2)) -> equal_mcode dec1 dec2 && equal_mcode lp1 lp2 && equal_option comma1 comma2 && equal_mcode rp1 rp2 | (Ast0.EnumName(kind1,_),Ast0.EnumName(kind2,_)) -> equal_mcode kind1 kind2 | (Ast0.EnumDef(_,lb1,_,rb1),Ast0.EnumDef(_,lb2,_,rb2)) -> equal_mcode lb1 lb2 && equal_mcode rb1 rb2 | (Ast0.StructUnionName(kind1,_),Ast0.StructUnionName(kind2,_)) -> equal_mcode kind1 kind2 | (Ast0.FunctionType(ty1,lp1,p1,rp1),Ast0.FunctionType(ty2,lp2,p2,rp2)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.StructUnionDef(_,lb1,_,rb1), Ast0.StructUnionDef(_,lb2,_,rb2)) -> equal_mcode lb1 lb2 && equal_mcode rb1 rb2 | (Ast0.TypeName(name1),Ast0.TypeName(name2)) -> equal_mcode name1 name2 | (Ast0.MetaType(name1,_),Ast0.MetaType(name2,_)) -> equal_mcode name1 name2 | (Ast0.DisjType(starter1,_,mids1,ender1), Ast0.DisjType(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | (Ast0.OptType(_),Ast0.OptType(_)) -> true | (Ast0.UniqueType(_),Ast0.UniqueType(_)) -> true | _ -> false let equal_declaration d1 d2 = match (Ast0.unwrap d1,Ast0.unwrap d2) with (Ast0.MetaDecl(name1,_),Ast0.MetaDecl(name2,_)) | (Ast0.MetaField(name1,_),Ast0.MetaField(name2,_)) | (Ast0.MetaFieldList(name1,_,_),Ast0.MetaFieldList(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.Init(stg1,_,_,eq1,_,sem1),Ast0.Init(stg2,_,_,eq2,_,sem2)) -> equal_option stg1 stg2 && equal_mcode eq1 eq2 && equal_mcode sem1 sem2 | (Ast0.UnInit(stg1,_,_,sem1),Ast0.UnInit(stg2,_,_,sem2)) -> equal_option stg1 stg2 && equal_mcode sem1 sem2 | (Ast0.MacroDecl(nm1,lp1,_,rp1,sem1),Ast0.MacroDecl(nm2,lp2,_,rp2,sem2))-> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2 | (Ast0.MacroDeclInit(nm1,lp1,_,rp1,eq1,_,sem1), Ast0.MacroDeclInit(nm2,lp2,_,rp2,eq2,_,sem2))-> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode eq1 eq2 && equal_mcode sem1 sem2 | (Ast0.TyDecl(_,sem1),Ast0.TyDecl(_,sem2)) -> equal_mcode sem1 sem2 | (Ast0.Ddots(dots1,_),Ast0.Ddots(dots2,_)) -> equal_mcode dots1 dots2 | (Ast0.OptDecl(_),Ast0.OptDecl(_)) -> true | (Ast0.UniqueDecl(_),Ast0.UniqueDecl(_)) -> true | (Ast0.DisjDecl(starter1,_,mids1,ender1), Ast0.DisjDecl(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | _ -> false let equal_designator d1 d2 = match (d1,d2) with (Ast0.DesignatorField(dot1,_),Ast0.DesignatorField(dot2,_)) -> equal_mcode dot1 dot2 | (Ast0.DesignatorIndex(lb1,_,rb1),Ast0.DesignatorIndex(lb2,_,rb2)) -> (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2) | (Ast0.DesignatorRange(lb1,_,dots1,_,rb1), Ast0.DesignatorRange(lb2,_,dots2,_,rb2)) -> (equal_mcode lb1 lb2) && (equal_mcode dots1 dots2) && (equal_mcode rb1 rb2) | _ -> false let equal_initialiser i1 i2 = match (Ast0.unwrap i1,Ast0.unwrap i2) with (Ast0.MetaInit(name1,_),Ast0.MetaInit(name2,_)) -> equal_mcode name1 name2 | (Ast0.MetaInitList(name1,_,_),Ast0.MetaInitList(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.InitExpr(_),Ast0.InitExpr(_)) -> true | (Ast0.InitList(lb1,_,rb1,o1),Ast0.InitList(lb2,_,rb2,o2)) -> (* can't compare orderedness, because this can differ between - and + code *) (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2) | (Ast0.InitGccExt(designators1,eq1,_), Ast0.InitGccExt(designators2,eq2,_)) -> (List.for_all2 equal_designator designators1 designators2) && (equal_mcode eq1 eq2) | (Ast0.InitGccName(_,eq1,_),Ast0.InitGccName(_,eq2,_)) -> equal_mcode eq1 eq2 | (Ast0.IComma(cm1),Ast0.IComma(cm2)) -> equal_mcode cm1 cm2 | (Ast0.Idots(d1,_),Ast0.Idots(d2,_)) -> equal_mcode d1 d2 | (Ast0.OptIni(_),Ast0.OptIni(_)) -> true | (Ast0.UniqueIni(_),Ast0.UniqueIni(_)) -> true | _ -> false let equal_parameterTypeDef p1 p2 = match (Ast0.unwrap p1,Ast0.unwrap p2) with (Ast0.VoidParam(_),Ast0.VoidParam(_)) -> true | (Ast0.Param(_,_),Ast0.Param(_,_)) -> true | (Ast0.MetaParam(name1,_),Ast0.MetaParam(name2,_)) | (Ast0.MetaParamList(name1,_,_),Ast0.MetaParamList(name2,_,_)) -> equal_mcode name1 name2 | (Ast0.PComma(cm1),Ast0.PComma(cm2)) -> equal_mcode cm1 cm2 | (Ast0.Pdots(dots1),Ast0.Pdots(dots2)) | (Ast0.Pcircles(dots1),Ast0.Pcircles(dots2)) -> equal_mcode dots1 dots2 | (Ast0.OptParam(_),Ast0.OptParam(_)) -> true | (Ast0.UniqueParam(_),Ast0.UniqueParam(_)) -> true | _ -> false let rec equal_statement s1 s2 = match (Ast0.unwrap s1,Ast0.unwrap s2) with (Ast0.FunDecl(_,fninfo1,_,lp1,_,rp1,lbrace1,_,rbrace1), Ast0.FunDecl(_,fninfo2,_,lp2,_,rp2,lbrace2,_,rbrace2)) -> (List.length fninfo1) = (List.length fninfo2) && List.for_all2 equal_fninfo fninfo1 fninfo2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode lbrace1 lbrace2 && equal_mcode rbrace1 rbrace2 | (Ast0.Decl(_,_),Ast0.Decl(_,_)) -> true | (Ast0.Seq(lbrace1,_,rbrace1),Ast0.Seq(lbrace2,_,rbrace2)) -> equal_mcode lbrace1 lbrace2 && equal_mcode rbrace1 rbrace2 | (Ast0.ExprStatement(_,sem1),Ast0.ExprStatement(_,sem2)) -> equal_mcode sem1 sem2 | (Ast0.IfThen(iff1,lp1,_,rp1,_,_),Ast0.IfThen(iff2,lp2,_,rp2,_,_)) -> equal_mcode iff1 iff2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.IfThenElse(iff1,lp1,_,rp1,_,els1,_,_), Ast0.IfThenElse(iff2,lp2,_,rp2,_,els2,_,_)) -> equal_mcode iff1 iff2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode els1 els2 | (Ast0.While(whl1,lp1,_,rp1,_,_),Ast0.While(whl2,lp2,_,rp2,_,_)) -> equal_mcode whl1 whl2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.Do(d1,_,whl1,lp1,_,rp1,sem1),Ast0.Do(d2,_,whl2,lp2,_,rp2,sem2)) -> equal_mcode whl1 whl2 && equal_mcode d1 d2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2 | (Ast0.For(fr1,lp1,first1,_,sem21,_,rp1,_,_), Ast0.For(fr2,lp2,first2,_,sem22,_,rp2,_,_)) -> let first = match (Ast0.unwrap first1,Ast0.unwrap first2) with (Ast0.ForExp(_,sem1),Ast0.ForExp(_,sem2)) -> equal_mcode sem1 sem2 | (Ast0.ForDecl _,Ast0.ForDecl _) -> true | _ -> false in equal_mcode fr1 fr2 && equal_mcode lp1 lp2 && first && equal_mcode sem21 sem22 && equal_mcode rp1 rp2 | (Ast0.Iterator(nm1,lp1,_,rp1,_,_),Ast0.Iterator(nm2,lp2,_,rp2,_,_)) -> equal_mcode lp1 lp2 && equal_mcode rp1 rp2 | (Ast0.Switch(switch1,lp1,_,rp1,lb1,_,_,rb1), Ast0.Switch(switch2,lp2,_,rp2,lb2,_,_,rb2)) -> equal_mcode switch1 switch2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode lb1 lb2 && equal_mcode rb1 rb2 | (Ast0.Break(br1,sem1),Ast0.Break(br2,sem2)) -> equal_mcode br1 br2 && equal_mcode sem1 sem2 | (Ast0.Continue(cont1,sem1),Ast0.Continue(cont2,sem2)) -> equal_mcode cont1 cont2 && equal_mcode sem1 sem2 | (Ast0.Label(_,dd1),Ast0.Label(_,dd2)) -> equal_mcode dd1 dd2 | (Ast0.Goto(g1,_,sem1),Ast0.Goto(g2,_,sem2)) -> equal_mcode g1 g2 && equal_mcode sem1 sem2 | (Ast0.Return(ret1,sem1),Ast0.Return(ret2,sem2)) -> equal_mcode ret1 ret2 && equal_mcode sem1 sem2 | (Ast0.ReturnExpr(ret1,_,sem1),Ast0.ReturnExpr(ret2,_,sem2)) -> equal_mcode ret1 ret2 && equal_mcode sem1 sem2 | (Ast0.MetaStmt(name1,_),Ast0.MetaStmt(name2,_)) | (Ast0.MetaStmtList(name1,_),Ast0.MetaStmtList(name2,_)) -> equal_mcode name1 name2 | (Ast0.Disj(starter1,_,mids1,ender1),Ast0.Disj(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | (Ast0.Nest(starter1,_,ender1,_,m1),Ast0.Nest(starter2,_,ender2,_,m2)) -> equal_mcode starter1 starter2 && equal_mcode ender1 ender2 && m1 = m2 | (Ast0.Exp(_),Ast0.Exp(_)) -> true | (Ast0.TopExp(_),Ast0.TopExp(_)) -> true | (Ast0.Ty(_),Ast0.Ty(_)) -> true | (Ast0.TopInit(_),Ast0.TopInit(_)) -> true | (Ast0.Dots(d1,_),Ast0.Dots(d2,_)) | (Ast0.Circles(d1,_),Ast0.Circles(d2,_)) | (Ast0.Stars(d1,_),Ast0.Stars(d2,_)) -> equal_mcode d1 d2 | (Ast0.Include(inc1,name1),Ast0.Include(inc2,name2)) -> equal_mcode inc1 inc2 && equal_mcode name1 name2 | (Ast0.Undef(def1,_),Ast0.Undef(def2,_)) -> equal_mcode def1 def2 | (Ast0.Define(def1,_,_,_),Ast0.Define(def2,_,_,_)) -> equal_mcode def1 def2 | (Ast0.Pragma(prg1,_,_),Ast0.Pragma(prg2,_,_)) -> equal_mcode prg1 prg2 | (Ast0.OptStm(_),Ast0.OptStm(_)) -> true | (Ast0.UniqueStm(_),Ast0.UniqueStm(_)) -> true | _ -> false and equal_fninfo x y = match (x,y) with (Ast0.FStorage(s1),Ast0.FStorage(s2)) -> equal_mcode s1 s2 | (Ast0.FType(_),Ast0.FType(_)) -> true | (Ast0.FInline(i1),Ast0.FInline(i2)) -> equal_mcode i1 i2 | (Ast0.FAttr(i1),Ast0.FAttr(i2)) -> equal_mcode i1 i2 | _ -> false let equal_case_line c1 c2 = match (Ast0.unwrap c1,Ast0.unwrap c2) with (Ast0.Default(def1,colon1,_),Ast0.Default(def2,colon2,_)) -> equal_mcode def1 def2 && equal_mcode colon1 colon2 | (Ast0.Case(case1,_,colon1,_),Ast0.Case(case2,_,colon2,_)) -> equal_mcode case1 case2 && equal_mcode colon1 colon2 | (Ast0.DisjCase(starter1,_,mids1,ender1), Ast0.DisjCase(starter2,_,mids2,ender2)) -> equal_mcode starter1 starter2 && List.for_all2 equal_mcode mids1 mids2 && equal_mcode ender1 ender2 | (Ast0.OptCase(_),Ast0.OptCase(_)) -> true | _ -> false let rec equal_top_level t1 t2 = match (Ast0.unwrap t1,Ast0.unwrap t2) with (Ast0.NONDECL(_),Ast0.NONDECL(_)) -> true | (Ast0.FILEINFO(old_file1,new_file1),Ast0.FILEINFO(old_file2,new_file2)) -> equal_mcode old_file1 old_file2 && equal_mcode new_file1 new_file2 | (Ast0.CODE(_),Ast0.CODE(_)) -> true | (Ast0.ERRORWORDS(_),Ast0.ERRORWORDS(_)) -> true | _ -> false let root_equal e1 e2 = match (e1,e2) with (Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) -> dots equal_expression d1 d2 | (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) -> dots equal_parameterTypeDef d1 d2 | (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) -> dots equal_statement d1 d2 | (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) -> dots equal_declaration d1 d2 | (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) -> dots equal_case_line d1 d2 | (Ast0.IdentTag(i1),Ast0.IdentTag(i2)) -> equal_ident i1 i2 | (Ast0.ExprTag(e1),Ast0.ExprTag(e2)) -> equal_expression e1 e2 | (Ast0.ArgExprTag(d),_) -> failwith "not possible - iso only" | (Ast0.TypeCTag(t1),Ast0.TypeCTag(t2)) -> equal_typeC t1 t2 | (Ast0.ParamTag(p1),Ast0.ParamTag(p2)) -> equal_parameterTypeDef p1 p2 | (Ast0.InitTag(d1),Ast0.InitTag(d2)) -> equal_initialiser d1 d2 | (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) -> equal_declaration d1 d2 | (Ast0.StmtTag(s1),Ast0.StmtTag(s2)) -> equal_statement s1 s2 | (Ast0.TopTag(t1),Ast0.TopTag(t2)) -> equal_top_level t1 t2 | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) | (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_)) | (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) -> failwith "only within iso phase" | _ -> false let default_context _ = Ast0.CONTEXT(ref(Ast.NOTHING, Ast0.default_token_info,Ast0.default_token_info)) let traverse minus_table plus_table = Hashtbl.iter (function key -> function (e,l) -> try let (plus_e,plus_l) = Hashtbl.find plus_table key in if root_equal e plus_e && List.for_all (function x -> x) (List.map2 Common.equal_set l plus_l) then let i = Ast0.fresh_index() in (set_index e i; set_index plus_e i; set_mcodekind e (default_context()); set_mcodekind plus_e (default_context())) with Not_found -> ()) minus_table (* --------------------------------------------------------------------- *) (* contextify the whencode *) let contextify_all = let bind x y = () in let option_default = () in let mcode x = () in let do_nothing r k e = Ast0.set_mcodekind e (default_context()); k e in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing let contextify_whencode = let bind x y = () in let option_default = () in let expression r k e = k e; match Ast0.unwrap e with Ast0.NestExpr(_,_,_,Some whencode,_) | Ast0.Edots(_,Some whencode) | Ast0.Ecircles(_,Some whencode) | Ast0.Estars(_,Some whencode) -> contextify_all.VT0.combiner_rec_expression whencode | _ -> () in let initialiser r k i = match Ast0.unwrap i with Ast0.Idots(dots,Some whencode) -> contextify_all.VT0.combiner_rec_initialiser whencode | _ -> k i in let whencode = function Ast0.WhenNot sd -> contextify_all.VT0.combiner_rec_statement_dots sd | Ast0.WhenAlways s -> contextify_all.VT0.combiner_rec_statement s | Ast0.WhenModifier(_) -> () | Ast0.WhenNotTrue(e) -> contextify_all.VT0.combiner_rec_expression e | Ast0.WhenNotFalse(e) -> contextify_all.VT0.combiner_rec_expression e in let statement r k (s : Ast0.statement) = k s; match Ast0.unwrap s with Ast0.Nest(_,_,_,whn,_) | Ast0.Dots(_,whn) | Ast0.Circles(_,whn) | Ast0.Stars(_,whn) -> List.iter whencode whn | _ -> () in let combiner = V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_exprfn = expression; VT0.combiner_initfn = initialiser; VT0.combiner_stmtfn = statement} in combiner.VT0.combiner_rec_top_level (* --------------------------------------------------------------------- *) (* the first int list is the tokens in the node, the second is the tokens in the descendants *) let minus_table = (Hashtbl.create(50) : (int list, Ast0.anything * int list list) Hashtbl.t) let plus_table = (Hashtbl.create(50) : (int list, Ast0.anything * int list list) Hashtbl.t) let iscode t = match Ast0.unwrap t with Ast0.NONDECL(_) -> true | Ast0.FILEINFO(_) -> true | Ast0.ERRORWORDS(_) -> false | Ast0.CODE(_) -> true | Ast0.TOPCODE(_) | Ast0.OTHER(_) -> failwith "unexpected top level code" (* ------------------------------------------------------------------- *) (* alignment of minus and plus *) let concat = function [] -> [] | [s] -> [s] | l -> let rec loop = function [] -> [] | x::rest -> (match Ast0.unwrap x with Ast0.NONDECL(s) -> let stms = loop rest in s::stms | Ast0.CODE(ss) -> let stms = loop rest in (match Ast0.unwrap ss with Ast0.DOTS(d) -> d@stms | _ -> failwith "no dots allowed in pure plus code") | _ -> failwith "plus code is being discarded") in let res = Compute_lines.compute_statement_dots_lines false (Ast0.rewrap (List.hd l) (Ast0.DOTS (loop l))) in [Ast0.rewrap res (Ast0.CODE res)] let collect_up_to m plus = let minfo = Ast0.get_info m in let mend = minfo.Ast0.pos_info.Ast0.logical_end in let rec loop = function [] -> ([],[]) | p::plus -> let pinfo = Ast0.get_info p in let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in if pstart > mend then ([],p::plus) else let (plus,rest) = loop plus in (p::plus,rest) in let (plus,rest) = loop plus in (concat plus,rest) let realign minus plus = let rec loop = function ([],_) -> failwith "not possible, some context required" | ([m],p) -> ([m],concat p) | (m::minus,plus) -> let (p,plus) = collect_up_to m plus in let (minus,plus) = loop (minus,plus) in (m::minus,p@plus) in loop (minus,plus) (* ------------------------------------------------------------------- *) (* check compatible: check that at the top level the minus and plus code is of the same kind. Could go further and make the correspondence between the code between ...s. *) let isonly f l = match Ast0.undots l with [s] -> f s | _ -> false let isall f l = List.for_all (isonly f) l let rec is_exp s = match Ast0.unwrap s with Ast0.Exp(e) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_exp stmts | _ -> false let rec is_ty s = match Ast0.unwrap s with Ast0.Ty(e) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_ty stmts | _ -> false let rec is_init s = match Ast0.unwrap s with Ast0.TopInit(e) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_init stmts | _ -> false let rec is_decl s = match Ast0.unwrap s with Ast0.Decl(_,e) -> true | Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_decl stmts | _ -> false let rec is_fndecl s = match Ast0.unwrap s with Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_fndecl stmts | _ -> false let rec is_toplevel s = match Ast0.unwrap s with Ast0.Decl(_,e) -> true | Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_toplevel stmts | Ast0.ExprStatement(Some fc,_) -> (match Ast0.unwrap fc with Ast0.FunCall(_,_,_,_) -> true | _ -> false) | Ast0.Include(_,_) -> true | Ast0.Undef(_,_) -> true | Ast0.Pragma(_,_,_) -> true | Ast0.Define(_,_,_,_) -> true | _ -> false (* consider code and topcode to be the same; difference handled in top_level.ml *) let check_compatible m p = let fail _ = failwith (Printf.sprintf "incompatible minus and plus code starting on lines %d and %d" (Ast0.get_line m) (Ast0.get_line p)) in match (Ast0.unwrap m, Ast0.unwrap p) with (Ast0.NONDECL(decl1),Ast0.NONDECL(decl2)) -> if not (is_decl decl1 && is_decl decl2) then fail() | (Ast0.NONDECL(decl1),Ast0.CODE(code2)) -> (* This is probably the only important case. We don't want to replace top-level declarations by arbitrary code. *) let v1 = is_decl decl1 in let v2 = List.for_all is_toplevel (Ast0.undots code2) in if !Flag.make_hrule = None && v1 && not v2 then fail() | (Ast0.CODE(code1),Ast0.NONDECL(decl2)) -> let v1 = List.for_all is_toplevel (Ast0.undots code1) in let v2 = is_decl decl2 in if v1 && not v2 then fail() | (Ast0.CODE(code1),Ast0.CODE(code2)) -> let v1 = isonly is_init code1 in let v2a = isonly is_init code2 in let v2b = isonly is_exp code2 in if v1 then (if not (v2a || v2b) then fail()) else let testers = [is_exp;is_ty] in List.iter (function tester -> let v1 = isonly tester code1 in let v2 = isonly tester code2 in if (v1 && not v2) or (!Flag.make_hrule = None && v2 && not v1) then fail()) testers; let v1 = isonly is_fndecl code1 in let v2 = List.for_all is_toplevel (Ast0.undots code2) in if !Flag.make_hrule = None && v1 && not v2 then fail() | (Ast0.FILEINFO(_,_),Ast0.FILEINFO(_,_)) -> () | (Ast0.OTHER(_),Ast0.OTHER(_)) -> () | _ -> fail() (* can't just remove expressions or types, not sure if all cases are needed. *) let check_complete m = match Ast0.unwrap m with Ast0.NONDECL(code) -> if is_exp code or is_ty code then failwith (Printf.sprintf "invalid minus starting on line %d" (Ast0.get_line m)) | Ast0.CODE(code) -> if isonly is_exp code or isonly is_ty code then failwith (Printf.sprintf "invalid minus starting on line %d" (Ast0.get_line m)) | _ -> () (* ------------------------------------------------------------------- *) (* returns a list of corresponding minus and plus trees *) let context_neg minus plus = Hashtbl.clear minus_table; Hashtbl.clear plus_table; List.iter contextify_whencode minus; let (minus,plus) = realign minus plus in let rec loop = function ([],[]) -> [] | ([],l) -> failwith (Printf.sprintf "%d plus things remaining" (List.length l)) | (minus,[]) -> List.iter check_complete minus; plus_lines := []; let _ = List.map (function m -> classify true (function _ -> Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info))) minus_table m) minus in [] | (((m::minus) as mall),((p::plus) as pall)) -> let minfo = Ast0.get_info m in let pinfo = Ast0.get_info p in let mstart = minfo.Ast0.pos_info.Ast0.logical_start in let mend = minfo.Ast0.pos_info.Ast0.logical_end in let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in let pend = pinfo.Ast0.pos_info.Ast0.logical_end in if (iscode m or iscode p) && (mend + 1 = pstart or pend + 1 = mstart or (* adjacent *) (mstart <= pstart && mend >= pstart) or (pstart <= mstart && pend >= mstart)) (* overlapping or nested *) then begin (* ensure that the root of each tree has a unique index, although it might get overwritten if the node is a context node *) let i = Ast0.fresh_index() in Ast0.set_index m i; Ast0.set_index p i; check_compatible m p; collect_plus_lines p; let _ = classify true (function _ -> Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info))) minus_table m in let _ = classify false (function c -> Ast0.PLUS c) plus_table p in traverse minus_table plus_table; (m,p)::loop(minus,plus) end else if not(iscode m or iscode p) then loop(minus,plus) else if mstart < pstart then begin plus_lines := []; let _ = classify true (function _ -> Ast0.MINUS(ref(Ast.NOREPLACEMENT, Ast0.default_token_info))) minus_table m in loop(minus,pall) end else loop(mall,plus) in loop(minus,plus) coccinelle-1.0.0-rc19/parsing_cocci/unify_ast.mli0000644000175000017500000000237712247442615020703 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./unify_ast.mli" type res = NO | MAYBE val unify_statement_dots : Ast_cocci.statement Ast_cocci.dots -> Ast_cocci.statement Ast_cocci.dots -> res coccinelle-1.0.0-rc19/parsing_cocci/lexer_script.mll0000644000175000017500000000505112247442615021400 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./lexer_script.mll" { open Parser_cocci_menhir module D = Data module Ast = Ast_cocci exception Lexical of string let tok = Lexing.lexeme let file = ref "" let language = ref "" let inc_line _ = Lexer_cocci.line := !Lexer_cocci.line + 1 } (* ---------------------------------------------------------------------- *) (* tokens *) let oct = ['0'-'7'] let hex = ['0'-'9' 'a'-'f' 'A'-'F'] let myrule = [^'\'''"''@''/''\n''\r''\011''\012''('')']+ rule token = parse | myrule { TScriptData (tok lexbuf) } | '(' { TScriptData (tok lexbuf) } | ')' { TScriptData (tok lexbuf) } | ['\n' '\r' '\011' '\012'] { inc_line(); let text = tok lexbuf in let text = if !language = "ocaml" then Printf.sprintf "%s# %d \"%s\"%s" text !Lexer_cocci.line !file text else text in TScriptData text } | "@@" { TArobArob } | "@" { TArob } | "/" { TScriptData (tok lexbuf) } | "//" [^ '\n']* { token lexbuf } (* skip SmPL comments *) | '"' { TScriptData (Printf.sprintf "\"%s\"" (string lexbuf)) } | "'" { TScriptData (Printf.sprintf "'%s'" (cstring lexbuf)) } | eof { EOF } | _ { raise (Lexical ("unrecognised symbol, in token rule:"^tok lexbuf)) } (* These are C strings. Perhaps they require some adjustment. *) and string = parse | '"' { "" } | (_ as x) { (String.make 1 x) ^ string lexbuf } and cstring = parse | "'" { "" } | (_ as x) { (String.make 1 x) ^ cstring lexbuf } coccinelle-1.0.0-rc19/parsing_cocci/ast0toast.ml0000644000175000017500000012557412247442615020460 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./ast0toast.ml" (* Arities matter for the minus slice, but not for the plus slice. *) (* + only allowed on code in a nest (in_nest = true). ? only allowed on rule_elems, and on subterms if the context is ? also. *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let unitary = Type_cocci.Unitary let ctr = ref 0 let get_ctr _ = let c = !ctr in ctr := !ctr + 1; c (* --------------------------------------------------------------------- *) (* Move plus tokens from the MINUS and CONTEXT structured nodes to the corresponding leftmost and rightmost mcodes *) let inline_mcodes = let bind x y = () in let option_default = () in let mcode _ = () in let do_nothing r k e = k e; let einfo = Ast0.get_info e in match (Ast0.get_mcodekind e) with Ast0.MINUS(replacements) -> (match !replacements with (Ast.NOREPLACEMENT,_) -> () | replacements -> let minus_try = function (true,mc) -> if List.for_all (function Ast0.MINUS(mreplacements) -> true | _ -> false) mc then (List.iter (function Ast0.MINUS(mreplacements) -> mreplacements := replacements | _ -> ()) mc; true) else false | _ -> false in if not (minus_try(einfo.Ast0.attachable_start, einfo.Ast0.mcode_start) or minus_try(einfo.Ast0.attachable_end, einfo.Ast0.mcode_end)) then failwith "minus tree should not have bad code on both sides") | Ast0.CONTEXT(befaft) | Ast0.MIXED(befaft) -> let concat starter startinfo ender endinfo = let lst = match (starter,ender) with ([],_) -> ender | (_,[]) -> starter | _ -> if startinfo.Ast0.tline_end = endinfo.Ast0.tline_start then (* put them in the same inner list *) let last = List.hd (List.rev starter) in let butlast = List.rev(List.tl(List.rev starter)) in butlast @ (last@(List.hd ender)) :: (List.tl ender) else starter @ ender in (lst, {endinfo with Ast0.tline_start = startinfo.Ast0.tline_start}) in let attach_bef bef beforeinfo befit = function (true,mcl) -> List.iter (function Ast0.MINUS(mreplacements) -> (match !mreplacements with (Ast.NOREPLACEMENT,tokeninfo) -> mreplacements := (Ast.REPLACEMENT(bef,befit),beforeinfo) | (Ast.REPLACEMENT(anythings,it),tokeninfo) -> let (newbef,newinfo) = concat bef beforeinfo anythings tokeninfo in let it = Ast.lub_count befit it in mreplacements := (Ast.REPLACEMENT(newbef,it),newinfo)) | Ast0.CONTEXT(mbefaft) -> (match !mbefaft with (Ast.BEFORE(mbef,it),mbeforeinfo,a) -> let (newbef,newinfo) = concat bef beforeinfo mbef mbeforeinfo in let it = Ast.lub_count befit it in mbefaft := (Ast.BEFORE(newbef,it),newinfo,a) | (Ast.AFTER(maft,it),_,a) -> let it = Ast.lub_count befit it in mbefaft := (Ast.BEFOREAFTER(bef,maft,it),beforeinfo,a) | (Ast.BEFOREAFTER(mbef,maft,it),mbeforeinfo,a) -> let (newbef,newinfo) = concat bef beforeinfo mbef mbeforeinfo in let it = Ast.lub_count befit it in mbefaft := (Ast.BEFOREAFTER(newbef,maft,it),newinfo,a) | (Ast.NOTHING,_,a) -> mbefaft := (Ast.BEFORE(bef,befit),beforeinfo,a)) | _ -> failwith "unexpected annotation") mcl | _ -> Printf.printf "before %s\n" (Dumper.dump bef); failwith "context tree should not have bad code before" in let attach_aft aft afterinfo aftit = function (true,mcl) -> List.iter (function Ast0.MINUS(mreplacements) -> (match !mreplacements with (Ast.NOREPLACEMENT,tokeninfo) -> mreplacements := (Ast.REPLACEMENT(aft,aftit),afterinfo) | (Ast.REPLACEMENT(anythings,it),tokeninfo) -> let (newaft,newinfo) = concat anythings tokeninfo aft afterinfo in let it = Ast.lub_count aftit it in mreplacements := (Ast.REPLACEMENT(newaft,it),newinfo)) | Ast0.CONTEXT(mbefaft) -> (match !mbefaft with (Ast.BEFORE(mbef,it),b,_) -> let it = Ast.lub_count aftit it in mbefaft := (Ast.BEFOREAFTER(mbef,aft,it),b,afterinfo) | (Ast.AFTER(maft,it),b,mafterinfo) -> let (newaft,newinfo) = concat maft mafterinfo aft afterinfo in let it = Ast.lub_count aftit it in mbefaft := (Ast.AFTER(newaft,it),b,newinfo) | (Ast.BEFOREAFTER(mbef,maft,it),b,mafterinfo) -> let (newaft,newinfo) = concat maft mafterinfo aft afterinfo in let it = Ast.lub_count aftit it in mbefaft := (Ast.BEFOREAFTER(mbef,newaft,it),b,newinfo) | (Ast.NOTHING,b,_) -> mbefaft := (Ast.AFTER(aft,aftit),b,afterinfo)) | _ -> failwith "unexpected annotation") mcl | _ -> failwith "context tree should not have bad code after" in (match !befaft with (Ast.BEFORE(bef,it),beforeinfo,_) -> attach_bef bef beforeinfo it (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start) | (Ast.AFTER(aft,it),_,afterinfo) -> attach_aft aft afterinfo it (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end) | (Ast.BEFOREAFTER(bef,aft,it),beforeinfo,afterinfo) -> attach_bef bef beforeinfo it (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start); attach_aft aft afterinfo it (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end) | (Ast.NOTHING,_,_) -> ()) | Ast0.PLUS _ -> () in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing (* --------------------------------------------------------------------- *) (* For function declarations. Can't use the mcode at the root, because that might be mixed when the function contains ()s, where agglomeration of -s is not possible. *) let check_allminus = let donothing r k e = k e in let bind x y = x && y in let option_default = true in let mcode (_,_,_,mc,_,_) = match mc with Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = Ast.NOREPLACEMENT | _ -> false in (* special case for disj and asExpr etc *) let ident r k e = match Ast0.unwrap e with Ast0.DisjId(starter,id_list,mids,ender) -> List.for_all r.VT0.combiner_rec_ident id_list | Ast0.AsIdent(id,asid) -> k id | _ -> k e in let expression r k e = match Ast0.unwrap e with Ast0.DisjExpr(starter,expr_list,mids,ender) -> List.for_all r.VT0.combiner_rec_expression expr_list | Ast0.AsExpr(exp,asexp) -> k exp | _ -> k e in let declaration r k e = match Ast0.unwrap e with Ast0.DisjDecl(starter,decls,mids,ender) -> List.for_all r.VT0.combiner_rec_declaration decls | Ast0.AsDecl(decl,asdecl) -> k decl | _ -> k e in let typeC r k e = match Ast0.unwrap e with Ast0.DisjType(starter,decls,mids,ender) -> List.for_all r.VT0.combiner_rec_typeC decls | Ast0.AsType(ty,asty) -> k ty | _ -> k e in let initialiser r k e = match Ast0.unwrap e with Ast0.AsInit(init,asinit) -> k init | _ -> k e in let statement r k e = match Ast0.unwrap e with Ast0.Disj(starter,statement_dots_list,mids,ender) -> List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list | Ast0.AsStmt(stmt,asstmt) -> k stmt | _ -> k e in let case_line r k e = match Ast0.unwrap e with Ast0.DisjCase(starter,case_lines,mids,ender) -> List.for_all r.VT0.combiner_rec_case_line case_lines | _ -> k e in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing ident expression typeC initialiser donothing declaration statement donothing case_line donothing (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) let get_option fn = function None -> None | Some x -> Some (fn x) (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Mcode *) let convert_info info = let strings_to_s l = List.map (function (s,info) -> (s,info.Ast0.line_start,info.Ast0.column)) l in { Ast.line = info.Ast0.pos_info.Ast0.line_start; Ast.column = info.Ast0.pos_info.Ast0.column; Ast.strbef = strings_to_s info.Ast0.strings_before; Ast.straft = strings_to_s info.Ast0.strings_after; } let convert_mcodekind adj = function Ast0.MINUS(replacements) -> let (replacements,_) = !replacements in Ast.MINUS(Ast.NoPos,[],Ast.ADJ adj,replacements) | Ast0.PLUS count -> Ast.PLUS count | Ast0.CONTEXT(befaft) -> let (befaft,_,_) = !befaft in Ast.CONTEXT(Ast.NoPos,befaft) | Ast0.MIXED(_) -> failwith "not possible for mcode" let convert_fake_mcode (_,mc,adj) = convert_mcodekind adj mc let convert_allminus_mcodekind allminus = function Ast0.CONTEXT(befaft) -> let (befaft,_,_) = !befaft in if allminus then (match befaft with Ast.NOTHING -> Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.NOREPLACEMENT) | Ast.BEFORE(a,ct) | Ast.AFTER(a,ct) -> Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.REPLACEMENT(a,ct)) | Ast.BEFOREAFTER(b,a,ct) -> Ast.MINUS(Ast.NoPos,[],Ast.ALLMINUS,Ast.REPLACEMENT(b@a,ct))) else Ast.CONTEXT(Ast.NoPos,befaft) | _ -> failwith "convert_allminus_mcodekind: unexpected mcodekind" let pos_mcode(term,_,info,mcodekind,pos,adj) = (* avoids a recursion problem *) (term,convert_info info,convert_mcodekind adj mcodekind,[]) let mcode (term,_,info,mcodekind,pos,adj) = let pos = List.fold_left (function prev -> function Ast0.MetaPosTag(Ast0.MetaPos(pos,constraints,per)) -> (Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false))::prev | _ -> prev) [] !pos in (term,convert_info info,convert_mcodekind adj mcodekind,List.rev pos) (* --------------------------------------------------------------------- *) (* Dots *) let wrap ast line isos = {(Ast.make_term ast) with Ast.node_line = line; Ast.iso_info = isos} let rewrap ast0 isos ast = wrap ast ((Ast0.get_info ast0).Ast0.pos_info.Ast0.line_start) isos let no_isos = [] (* no isos on tokens *) let tokenwrap (_,info,_,_) s ast = wrap ast info.Ast.line no_isos let iso_tokenwrap (_,info,_,_) s ast iso = wrap ast info.Ast.line iso let dots fn d = rewrap d no_isos (match Ast0.unwrap d with Ast0.DOTS(x) -> Ast.DOTS(List.map fn x) | Ast0.CIRCLES(x) -> Ast.CIRCLES(List.map fn x) | Ast0.STARS(x) -> Ast.STARS(List.map fn x)) (* --------------------------------------------------------------------- *) (* Identifier *) let rec do_isos l = List.map (function (nm,x) -> (nm,anything x)) l and ident i = rewrap i (do_isos (Ast0.get_iso i)) (match Ast0.unwrap i with Ast0.Id(name) -> Ast.Id(mcode name) | Ast0.DisjId(_,id_list,_,_) -> Ast.DisjId(List.map ident id_list) | Ast0.MetaId(name,constraints,_,_) -> Ast.MetaId(mcode name,constraints,unitary,false) | Ast0.MetaFunc(name,constraints,_) -> Ast.MetaFunc(mcode name,constraints,unitary,false) | Ast0.MetaLocalFunc(name,constraints,_) -> Ast.MetaLocalFunc(mcode name,constraints,unitary,false) | Ast0.AsIdent(id,asid) -> Ast.AsIdent(ident id,ident asid) | Ast0.OptIdent(id) -> Ast.OptIdent(ident id) | Ast0.UniqueIdent(id) -> Ast.UniqueIdent(ident id)) (* --------------------------------------------------------------------- *) (* Expression *) and expression e = let e1 = rewrap e (do_isos (Ast0.get_iso e)) (match Ast0.unwrap e with Ast0.Ident(id) -> Ast.Ident(ident id) | Ast0.Constant(const) -> Ast.Constant(mcode const) | Ast0.StringConstant(lq,str,rq) -> Ast.StringConstant(mcode lq, dots string_fragment str, mcode rq) | Ast0.FunCall(fn,lp,args,rp) -> let fn = expression fn in let lp = mcode lp in let args = dots expression args in let rp = mcode rp in Ast.FunCall(fn,lp,args,rp) | Ast0.Assignment(left,op,right,simple) -> Ast.Assignment(expression left,mcode op,expression right,simple) | Ast0.Sequence(left,op,right) -> Ast.Sequence(expression left,mcode op,expression right) | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> let exp1 = expression exp1 in let why = mcode why in let exp2 = get_option expression exp2 in let colon = mcode colon in let exp3 = expression exp3 in Ast.CondExpr(exp1,why,exp2,colon,exp3) | Ast0.Postfix(exp,op) -> Ast.Postfix(expression exp,mcode op) | Ast0.Infix(exp,op) -> Ast.Infix(expression exp,mcode op) | Ast0.Unary(exp,op) -> Ast.Unary(expression exp,mcode op) | Ast0.Binary(left,op,right) -> Ast.Binary(expression left,mcode op,expression right) | Ast0.Nested(left,op,right) -> Ast.Nested(expression left,mcode op,expression right) | Ast0.Paren(lp,exp,rp) -> Ast.Paren(mcode lp,expression exp,mcode rp) | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> Ast.ArrayAccess(expression exp1,mcode lb,expression exp2,mcode rb) | Ast0.RecordAccess(exp,pt,field) -> Ast.RecordAccess(expression exp,mcode pt,ident field) | Ast0.RecordPtAccess(exp,ar,field) -> Ast.RecordPtAccess(expression exp,mcode ar,ident field) | Ast0.Cast(lp,ty,rp,exp) -> let allminus = check_allminus.VT0.combiner_rec_expression e in Ast.Cast(mcode lp,typeC allminus ty,mcode rp,expression exp) | Ast0.SizeOfExpr(szf,exp) -> Ast.SizeOfExpr(mcode szf,expression exp) | Ast0.SizeOfType(szf,lp,ty,rp) -> let allminus = check_allminus.VT0.combiner_rec_expression e in Ast.SizeOfType(mcode szf, mcode lp,typeC allminus ty,mcode rp) | Ast0.TypeExp(ty) -> let allminus = check_allminus.VT0.combiner_rec_expression e in Ast.TypeExp(typeC allminus ty) | Ast0.Constructor(lp,ty,rp,init) -> let allminus = check_allminus.VT0.combiner_rec_expression e in Ast.Constructor(mcode lp,typeC allminus ty,mcode rp,initialiser init) | Ast0.MetaErr(name,cstrts,_) -> Ast.MetaErr(mcode name,constraints cstrts,unitary,false) | Ast0.MetaExpr(name,cstrts,ty,form,_) -> Ast.MetaExpr(mcode name,constraints cstrts,unitary,ty,form,false) | Ast0.MetaExprList(name,lenname,_) -> Ast.MetaExprList(mcode name,do_lenname lenname,unitary,false) | Ast0.AsExpr(expr,asexpr) -> Ast.AsExpr(expression expr,expression asexpr) | Ast0.EComma(cm) -> Ast.EComma(mcode cm) | Ast0.DisjExpr(_,exps,_,_) -> Ast.DisjExpr(List.map expression exps) | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) -> let starter = mcode starter in let whencode = get_option expression whencode in let ender = mcode ender in Ast.NestExpr(starter,dots expression exp_dots,ender,whencode,multi) | Ast0.Edots(dots,whencode) -> let dots = mcode dots in let whencode = get_option expression whencode in Ast.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode) -> let dots = mcode dots in let whencode = get_option expression whencode in Ast.Ecircles(dots,whencode) | Ast0.Estars(dots,whencode) -> let dots = mcode dots in let whencode = get_option expression whencode in Ast.Estars(dots,whencode) | Ast0.OptExp(exp) -> Ast.OptExp(expression exp) | Ast0.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in if Ast0.get_test_exp e then Ast.set_test_exp e1 else e1 and expression_dots ed = dots expression ed and string_fragment e = rewrap e no_isos (match Ast0.unwrap e with Ast0.ConstantFragment(str) -> Ast.ConstantFragment(mcode str) | Ast0.FormatFragment(pct,fmt) -> Ast.FormatFragment(mcode pct, string_format fmt) | Ast0.Strdots dots -> Ast.Strdots (mcode dots) | Ast0.MetaFormatList(pct,name,lenname) -> Ast.MetaFormatList(mcode pct, mcode name, do_lenname lenname, unitary,false)) and string_format e = rewrap e no_isos (match Ast0.unwrap e with Ast0.ConstantFormat(str) -> Ast.ConstantFormat(mcode str) | Ast0.MetaFormat(name,constraints) -> Ast.MetaFormat(mcode name,constraints,unitary,false)) and constraints c = match c with Ast0.NoConstraint -> Ast.NoConstraint | Ast0.NotIdCstrt idctrt -> Ast.NotIdCstrt idctrt | Ast0.NotExpCstrt exps -> Ast.NotExpCstrt (List.map expression exps) | Ast0.SubExpCstrt ids -> Ast.SubExpCstrt ids and do_lenname = function Ast0.MetaListLen(nm) -> Ast.MetaListLen(mcode nm,unitary,false) | Ast0.CstListLen n -> Ast.CstListLen n | Ast0.AnyListLen -> Ast.AnyListLen (* --------------------------------------------------------------------- *) (* Types *) and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1 and typeC allminus t = rewrap t (do_isos (Ast0.get_iso t)) (match Ast0.unwrap t with Ast0.ConstVol(cv,ty) -> let rec collect_disjs t = match Ast0.unwrap t with Ast0.DisjType(_,types,_,_) -> if Ast0.get_iso t = [] then List.concat (List.map collect_disjs types) else failwith "unexpected iso on a disjtype" | _ -> [t] in let res = List.map (function ty -> Ast.Type (allminus, Some (mcode cv), rewrap_iso ty (base_typeC allminus ty))) (collect_disjs ty) in (* one could worry that isos are lost because we flatten the disjunctions. but there should not be isos on the disjunctions themselves. *) (match res with [ty] -> ty | types -> Ast.DisjType(List.map (rewrap t no_isos) types)) | Ast0.BaseType(_) | Ast0.Signed(_,_) | Ast0.Pointer(_,_) | Ast0.FunctionPointer(_,_,_,_,_,_,_) | Ast0.FunctionType(_,_,_,_) | Ast0.Array(_,_,_,_) | Ast0.Decimal(_,_,_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_) | Ast0.StructUnionDef(_,_,_,_) | Ast0.EnumDef(_,_,_,_) | Ast0.TypeName(_) | Ast0.MetaType(_,_) -> Ast.Type(allminus,None,rewrap t no_isos (base_typeC allminus t)) | Ast0.DisjType(_,types,_,_) -> Ast.DisjType(List.map (typeC allminus) types) | Ast0.AsType(ty,asty) -> Ast.AsType(typeC allminus ty,typeC allminus asty) | Ast0.OptType(ty) -> Ast.OptType(typeC allminus ty) | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC allminus ty)) and base_typeC allminus t = match Ast0.unwrap t with Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings) | Ast0.Signed(sgn,ty) -> Ast.SignedT (mcode sgn, get_option (function x -> rewrap_iso x (base_typeC allminus x)) ty) | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC allminus ty,mcode star) | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> Ast.FunctionPointer (typeC allminus ty,mcode lp1,mcode star,mcode rp1, mcode lp2,parameter_list params,mcode rp2) | Ast0.FunctionType(ret,lp,params,rp) -> let allminus = check_allminus.VT0.combiner_rec_typeC t in Ast.FunctionType (allminus,get_option (typeC allminus) ret,mcode lp, parameter_list params,mcode rp) | Ast0.Array(ty,lb,size,rb) -> Ast.Array(typeC allminus ty,mcode lb,get_option expression size, mcode rb) | Ast0.Decimal(dec,lp,length,comma,precision_opt,rp) -> Ast.Decimal(mcode dec,mcode lp,expression length, get_option mcode comma,get_option expression precision_opt, mcode rp) | Ast0.EnumName(kind,name) -> Ast.EnumName(mcode kind,get_option ident name) | Ast0.EnumDef(ty,lb,ids,rb) -> Ast.EnumDef(typeC allminus ty,mcode lb,dots expression ids,mcode rb) | Ast0.StructUnionName(kind,name) -> Ast.StructUnionName(mcode kind,get_option ident name) | Ast0.StructUnionDef(ty,lb,decls,rb) -> Ast.StructUnionDef(typeC allminus ty,mcode lb, dots declaration decls, mcode rb) | Ast0.TypeName(name) -> Ast.TypeName(mcode name) | Ast0.MetaType(name,_) -> Ast.MetaType(mcode name,unitary,false) | _ -> failwith "ast0toast: unexpected type" (* --------------------------------------------------------------------- *) (* Variable declaration *) (* Even if the Cocci program specifies a list of declarations, they are split out into multiple declarations of a single variable each. *) and declaration d = rewrap d (do_isos (Ast0.get_iso d)) (match Ast0.unwrap d with Ast0.MetaDecl(name,_) -> Ast.MetaDecl(mcode name,unitary,false) | Ast0.MetaField(name,_) -> Ast.MetaField(mcode name,unitary,false) | Ast0.MetaFieldList(name,lenname,_) -> Ast.MetaFieldList(mcode name,do_lenname lenname,unitary,false) | Ast0.AsDecl(decl,asdecl) -> Ast.AsDecl(declaration decl,declaration asdecl) | Ast0.Init(stg,ty,id,eq,ini,sem) -> let allminus = check_allminus.VT0.combiner_rec_declaration d in let stg = get_option mcode stg in let ty = typeC allminus ty in let id = ident id in let eq = mcode eq in let ini = initialiser ini in let sem = mcode sem in Ast.Init(stg,ty,id,eq,ini,sem) | Ast0.UnInit(stg,ty,id,sem) -> (match Ast0.unwrap ty with Ast0.FunctionType(tyx,lp1,params,rp1) -> let allminus = check_allminus.VT0.combiner_rec_declaration d in Ast.UnInit(get_option mcode stg, rewrap ty (do_isos (Ast0.get_iso ty)) (Ast.Type (allminus,None, rewrap ty no_isos (Ast.FunctionType (allminus,get_option (typeC allminus) tyx, mcode lp1, parameter_list params,mcode rp1)))), ident id,mcode sem) | _ -> let allminus = check_allminus.VT0.combiner_rec_declaration d in Ast.UnInit(get_option mcode stg,typeC allminus ty,ident id, mcode sem)) | Ast0.MacroDecl(name,lp,args,rp,sem) -> let name = ident name in let lp = mcode lp in let args = dots expression args in let rp = mcode rp in let sem = mcode sem in Ast.MacroDecl(name,lp,args,rp,sem) | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> let name = ident name in let lp = mcode lp in let args = dots expression args in let rp = mcode rp in let eq = mcode eq in let ini = initialiser ini in let sem = mcode sem in Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) | Ast0.TyDecl(ty,sem) -> let allminus = check_allminus.VT0.combiner_rec_declaration d in Ast.TyDecl(typeC allminus ty,mcode sem) | Ast0.Typedef(stg,ty,id,sem) -> let allminus = check_allminus.VT0.combiner_rec_declaration d in let id = typeC allminus id in (match Ast.unwrap id with Ast.Type(_,None,id) -> (* only MetaType or Id *) Ast.Typedef(mcode stg,typeC allminus ty,id,mcode sem) | _ -> failwith "bad typedef") | Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls) | Ast0.Ddots(dots,whencode) -> let dots = mcode dots in let whencode = get_option declaration whencode in Ast.Ddots(dots,whencode) | Ast0.OptDecl(decl) -> Ast.OptDecl(declaration decl) | Ast0.UniqueDecl(decl) -> Ast.UniqueDecl(declaration decl)) and declaration_dots l = dots declaration l (* --------------------------------------------------------------------- *) (* Initialiser *) and strip_idots initlist = let isminus mc = match Ast0.get_mcode_mcodekind mc with Ast0.MINUS _ -> true | _ -> false in match Ast0.unwrap initlist with Ast0.DOTS(l) -> let l = match List.rev l with [] | [_] -> l | x::y::xs -> (match (Ast0.unwrap x,Ast0.unwrap y) with (Ast0.IComma _,Ast0.Idots _) -> (* drop comma that was added by add_comma *) List.rev (y::xs) | _ -> l) in let (whencode,init,dotinfo) = let rec loop = function [] -> ([],[],[]) | x::rest -> (match Ast0.unwrap x with Ast0.Idots(dots,Some whencode) -> let (restwhen,restinit,dotinfo) = loop rest in (whencode :: restwhen, restinit, (isminus dots)::dotinfo) | Ast0.Idots(dots,None) -> let (restwhen,restinit,dotinfo) = loop rest in (restwhen, restinit, (isminus dots)::dotinfo) | _ -> let (restwhen,restinit,dotinfo) = loop rest in (restwhen,x::restinit,dotinfo)) in loop l in let allminus = if List.for_all (function x -> not x) dotinfo then false (* false if no dots *) else if List.for_all (function x -> x) dotinfo then true else failwith "inconsistent annotations on initialiser list dots" in (whencode, init, allminus) | Ast0.CIRCLES(x) | Ast0.STARS(x) -> failwith "not possible for an initlist" and initialiser i = rewrap i no_isos (match Ast0.unwrap i with Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false) | Ast0.MetaInitList(name,lenname,_) -> Ast.MetaInitList(mcode name,do_lenname lenname,unitary,false) | Ast0.AsInit(init,asinit) -> Ast.AsInit(initialiser init,initialiser asinit) | Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp) | Ast0.InitList(lb,initlist,rb,true) -> Ast.ArInitList(mcode lb,dots initialiser initlist,mcode rb) | Ast0.InitList(lb,initlist,rb,false) -> let (whencode,initlist,allminus) = strip_idots initlist in Ast.StrInitList (allminus,mcode lb,List.map initialiser initlist,mcode rb, List.map initialiser whencode) | Ast0.InitGccExt(designators,eq,ini) -> Ast.InitGccExt(List.map designator designators,mcode eq, initialiser ini) | Ast0.InitGccName(name,eq,ini) -> Ast.InitGccName(ident name,mcode eq,initialiser ini) | Ast0.IComma(comma) -> Ast.IComma(mcode comma) | Ast0.Idots(dots,whencode) -> let dots = mcode dots in let whencode = get_option initialiser whencode in Ast.Idots(dots,whencode) | Ast0.OptIni(ini) -> Ast.OptIni(initialiser ini) | Ast0.UniqueIni(ini) -> Ast.UniqueIni(initialiser ini)) and designator = function Ast0.DesignatorField(dot,id) -> Ast.DesignatorField(mcode dot,ident id) | Ast0.DesignatorIndex(lb,exp,rb) -> Ast.DesignatorIndex(mcode lb, expression exp, mcode rb) | Ast0.DesignatorRange(lb,min,dots,max,rb) -> Ast.DesignatorRange(mcode lb,expression min,mcode dots,expression max, mcode rb) (* --------------------------------------------------------------------- *) (* Parameter *) and parameterTypeDef p = rewrap p no_isos (match Ast0.unwrap p with Ast0.VoidParam(ty) -> Ast.VoidParam(typeC false ty) | Ast0.Param(ty,id) -> let allminus = check_allminus.VT0.combiner_rec_parameter p in Ast.Param(typeC allminus ty,get_option ident id) | Ast0.MetaParam(name,_) -> Ast.MetaParam(mcode name,unitary,false) | Ast0.MetaParamList(name,lenname,_) -> Ast.MetaParamList(mcode name,do_lenname lenname,unitary,false) | Ast0.AsParam(p,asexpr) -> Ast.AsParam(parameterTypeDef p,expression asexpr) | Ast0.PComma(cm) -> Ast.PComma(mcode cm) | Ast0.Pdots(dots) -> Ast.Pdots(mcode dots) | Ast0.Pcircles(dots) -> Ast.Pcircles(mcode dots) | Ast0.OptParam(param) -> Ast.OptParam(parameterTypeDef param) | Ast0.UniqueParam(param) -> Ast.UniqueParam(parameterTypeDef param)) and parameter_list l = dots parameterTypeDef l (* --------------------------------------------------------------------- *) (* Top-level code *) and statement s = let rec statement seqible s = let rewrap_stmt ast0 ast = let befaft = match Ast0.get_dots_bef_aft s with Ast0.NoDots -> Ast.NoDots | Ast0.DroppingBetweenDots s -> Ast.DroppingBetweenDots (statement seqible s,get_ctr()) | Ast0.AddingBetweenDots s -> Ast.AddingBetweenDots (statement seqible s,get_ctr()) in Ast.set_dots_bef_aft befaft (rewrap ast0 no_isos ast) in let rewrap_rule_elem ast0 ast = rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in rewrap_stmt s (match Ast0.unwrap s with Ast0.Decl((_,bef),decl) -> let allminus = check_allminus.VT0.combiner_rec_statement s in Ast.Atomic(rewrap_rule_elem s (Ast.Decl(convert_allminus_mcodekind allminus bef, allminus,declaration decl))) | Ast0.Seq(lbrace,body,rbrace) -> let lbrace = mcode lbrace in let body = dots (statement seqible) body in let rbrace = mcode rbrace in Ast.Seq(iso_tokenwrap lbrace s (Ast.SeqStart(lbrace)) (do_isos (Ast0.get_iso s)), body, tokenwrap rbrace s (Ast.SeqEnd(rbrace))) | Ast0.ExprStatement(exp,sem) -> Ast.Atomic(rewrap_rule_elem s (Ast.ExprStatement (get_option expression exp,mcode sem))) | Ast0.IfThen(iff,lp,exp,rp,branch,aft) -> Ast.IfThen (rewrap_rule_elem s (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)), statement Ast.NotSequencible branch, ([],[],[],convert_fake_mcode aft)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> let els = mcode els in Ast.IfThenElse (rewrap_rule_elem s (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)), statement Ast.NotSequencible branch1, tokenwrap els s (Ast.Else(els)), statement Ast.NotSequencible branch2, ([],[],[],convert_fake_mcode aft)) | Ast0.While(wh,lp,exp,rp,body,aft) -> Ast.While(rewrap_rule_elem s (Ast.WhileHeader (mcode wh,mcode lp,expression exp,mcode rp)), statement Ast.NotSequencible body, ([],[],[],convert_fake_mcode aft)) | Ast0.Do(d,body,wh,lp,exp,rp,sem) -> let wh = mcode wh in Ast.Do(rewrap_rule_elem s (Ast.DoHeader(mcode d)), statement Ast.NotSequencible body, tokenwrap wh s (Ast.WhileTail(wh,mcode lp,expression exp,mcode rp, mcode sem))) | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,aft) -> let fr = mcode fr in let lp = mcode lp in let first = forinfo first in let exp2 = get_option expression exp2 in let sem2= mcode sem2 in let exp3 = get_option expression exp3 in let rp = mcode rp in let body = statement Ast.NotSequencible body in Ast.For(rewrap_rule_elem s (Ast.ForHeader(fr,lp,first,exp2,sem2,exp3,rp)), body,([],[],[],convert_fake_mcode aft)) | Ast0.Iterator(nm,lp,args,rp,body,aft) -> Ast.Iterator(rewrap_rule_elem s (Ast.IteratorHeader (ident nm,mcode lp, dots expression args, mcode rp)), statement Ast.NotSequencible body, ([],[],[],convert_fake_mcode aft)) | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> let switch = mcode switch in let lp = mcode lp in let exp = expression exp in let rp = mcode rp in let lb = mcode lb in let decls = dots (statement seqible) decls in let cases = List.map case_line (Ast0.undots cases) in let rb = mcode rb in Ast.Switch(rewrap_rule_elem s (Ast.SwitchHeader(switch,lp,exp,rp)), tokenwrap lb s (Ast.SeqStart(lb)), decls,cases, tokenwrap rb s (Ast.SeqEnd(rb))) | Ast0.Break(br,sem) -> Ast.Atomic(rewrap_rule_elem s (Ast.Break(mcode br,mcode sem))) | Ast0.Continue(cont,sem) -> Ast.Atomic(rewrap_rule_elem s (Ast.Continue(mcode cont,mcode sem))) | Ast0.Label(l,dd) -> Ast.Atomic(rewrap_rule_elem s (Ast.Label(ident l,mcode dd))) | Ast0.Goto(goto,l,sem) -> Ast.Atomic (rewrap_rule_elem s (Ast.Goto(mcode goto,ident l,mcode sem))) | Ast0.Return(ret,sem) -> Ast.Atomic(rewrap_rule_elem s (Ast.Return(mcode ret,mcode sem))) | Ast0.ReturnExpr(ret,exp,sem) -> Ast.Atomic (rewrap_rule_elem s (Ast.ReturnExpr(mcode ret,expression exp,mcode sem))) | Ast0.MetaStmt(name,_) -> Ast.Atomic(rewrap_rule_elem s (Ast.MetaStmt(mcode name,unitary,seqible,false))) | Ast0.MetaStmtList(name,_) -> Ast.Atomic(rewrap_rule_elem s (Ast.MetaStmtList(mcode name,unitary,false))) | Ast0.AsStmt(stmt,asstmt) -> Ast.AsStmt(statement seqible stmt,statement seqible asstmt) | Ast0.TopExp(exp) -> Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp))) | Ast0.Exp(exp) -> Ast.Atomic(rewrap_rule_elem s (Ast.Exp(expression exp))) | Ast0.TopInit(init) -> Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init))) | Ast0.Ty(ty) -> let allminus = check_allminus.VT0.combiner_rec_statement s in Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC allminus ty))) | Ast0.Disj(_,rule_elem_dots_list,_,_) -> Ast.Disj(List.map (function x -> statement_dots seqible x) rule_elem_dots_list) | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) -> Ast.Nest (mcode starter,statement_dots Ast.Sequencible rule_elem_dots, mcode ender, List.map (whencode (statement_dots Ast.Sequencible) (statement Ast.NotSequencible)) whn, multi,[],[]) | Ast0.Dots(d,whn) -> let d = mcode d in let whn = List.map (whencode (statement_dots Ast.Sequencible) (statement Ast.NotSequencible)) whn in Ast.Dots(d,whn,[],[]) | Ast0.Circles(d,whn) -> let d = mcode d in let whn = List.map (whencode (statement_dots Ast.Sequencible) (statement Ast.NotSequencible)) whn in Ast.Circles(d,whn,[],[]) | Ast0.Stars(d,whn) -> let d = mcode d in let whn = List.map (whencode (statement_dots Ast.Sequencible) (statement Ast.NotSequencible)) whn in Ast.Stars(d,whn,[],[]) | Ast0.FunDecl((_,bef),fi,name,lp,params,rp,lbrace,body,rbrace) -> let fi = List.map fninfo fi in let name = ident name in let lp = mcode lp in let params = parameter_list params in let rp = mcode rp in let lbrace = mcode lbrace in let body = dots (statement seqible) body in let rbrace = mcode rbrace in let allminus = check_allminus.VT0.combiner_rec_statement s in Ast.FunDecl(rewrap_rule_elem s (Ast.FunHeader (convert_allminus_mcodekind allminus bef, allminus,fi,name,lp,params,rp)), tokenwrap lbrace s (Ast.SeqStart(lbrace)), body, tokenwrap rbrace s (Ast.SeqEnd(rbrace))) | Ast0.Include(inc,str) -> Ast.Atomic(rewrap_rule_elem s (Ast.Include(mcode inc,mcode str))) | Ast0.Undef(def,id) -> Ast.Atomic(rewrap_rule_elem s (Ast.Undef(mcode def,ident id))) | Ast0.Define(def,id,params,body) -> Ast.Define (rewrap_rule_elem s (Ast.DefineHeader (mcode def,ident id, define_parameters params)), statement_dots Ast.NotSequencible (*not sure*) body) | Ast0.Pragma(prg,id,body) -> Ast.Atomic(rewrap_rule_elem s (Ast.Pragma(mcode prg,ident id,pragmainfo body))) | Ast0.OptStm(stm) -> Ast.OptStm(statement seqible stm) | Ast0.UniqueStm(stm) -> Ast.UniqueStm(statement seqible stm)) and pragmainfo pi = rewrap pi no_isos (match Ast0.unwrap pi with Ast0.PragmaTuple(lp,args,rp) -> let lp = mcode lp in let args = dots expression args in let rp = mcode rp in Ast.PragmaTuple(lp,args,rp) | Ast0.PragmaIdList(ids) -> Ast.PragmaIdList(dots ident ids) | Ast0.PragmaDots (dots) -> Ast.PragmaDots (mcode dots)) and define_parameters p = rewrap p no_isos (match Ast0.unwrap p with Ast0.NoParams -> Ast.NoParams | Ast0.DParams(lp,params,rp) -> Ast.DParams(mcode lp, dots define_param params, mcode rp)) and define_param p = rewrap p no_isos (match Ast0.unwrap p with Ast0.DParam(id) -> Ast.DParam(ident id) | Ast0.DPComma(comma) -> Ast.DPComma(mcode comma) | Ast0.DPdots(d) -> Ast.DPdots(mcode d) | Ast0.DPcircles(c) -> Ast.DPcircles(mcode c) | Ast0.OptDParam(dp) -> Ast.OptDParam(define_param dp) | Ast0.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp)) and whencode notfn alwaysfn = function Ast0.WhenNot a -> Ast.WhenNot (notfn a) | Ast0.WhenAlways a -> Ast.WhenAlways (alwaysfn a) | Ast0.WhenModifier(x) -> Ast.WhenModifier(x) | x -> let rewrap_rule_elem ast0 ast = rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in match x with Ast0.WhenNotTrue(e) -> Ast.WhenNotTrue(rewrap_rule_elem e (Ast.Exp(expression e))) | Ast0.WhenNotFalse(e) -> Ast.WhenNotFalse(rewrap_rule_elem e (Ast.Exp(expression e))) | _ -> failwith "not possible" and process_list seqible isos = function [] -> [] | x::rest -> let first = statement seqible x in let first = if !Flag.track_iso_usage then Ast.set_isos first (isos@(Ast.get_isos first)) else first in (match Ast0.unwrap x with Ast0.Dots(_,_) | Ast0.Nest(_) -> first::(process_list (Ast.SequencibleAfterDots []) no_isos rest) | _ -> first::(process_list Ast.Sequencible no_isos rest)) and statement_dots seqible d = let isos = do_isos (Ast0.get_iso d) in rewrap d no_isos (match Ast0.unwrap d with Ast0.DOTS(x) -> Ast.DOTS(process_list seqible isos x) | Ast0.CIRCLES(x) -> Ast.CIRCLES(process_list seqible isos x) | Ast0.STARS(x) -> Ast.STARS(process_list seqible isos x)) (* the following is no longer used. the goal was to let one put a statement at the very beginning of a function pattern and have it skip over the declarations in the C code. that feature was removed a long time ago, however, in favor of ... when != S, which also causes whatever comes after it to match the first real statement. the separation of declarations from the rest of the body means that the quantifier of any variable shared between them comes out too high, posing problems when there is ... decl ... stmt, as the quantifier of any shared variable will be around the whole thing, making variables not free enough in the first ..., and thus not implementing the expected shortest path condition. example: f() { ... int A; ... foo(A); }. the quantifier for A should start just before int A, not at the top of the function. and separate_decls seqible d = let rec collect_decls = function [] -> ([],[]) | (x::xs) as l -> (match Ast0.unwrap x with Ast0.Decl(_) -> let (decls,other) = collect_decls xs in (x :: decls,other) | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) -> let (decls,other) = collect_decls xs in (match decls with [] -> ([],x::other) | _ -> (x :: decls,other)) | Ast0.Disj(starter,stmt_dots_list,mids,ender) -> let disjs = List.map collect_dot_decls stmt_dots_list in let all_decls = List.for_all (function (_,s) -> s=[]) disjs in if all_decls then let (decls,other) = collect_decls xs in (x :: decls,other) else ([],l) | _ -> ([],l)) and collect_dot_decls d = match Ast0.unwrap d with Ast0.DOTS(x) -> collect_decls x | Ast0.CIRCLES(x) -> collect_decls x | Ast0.STARS(x) -> collect_decls x in let process l d fn = let (decls,other) = collect_decls l in (rewrap d no_isos (fn (List.map (statement seqible) decls)), rewrap d no_isos (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in match Ast0.unwrap d with Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x) | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x) | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in statement Ast.Sequencible s and forinfo fi = match Ast0.unwrap fi with Ast0.ForExp(exp1,sem1) -> let exp1 = get_option expression exp1 in let sem1 = mcode sem1 in Ast.ForExp(exp1,sem1) | Ast0.ForDecl ((_,bef),decl) -> let allminus = check_allminus.VT0.combiner_rec_declaration decl in Ast.ForDecl (convert_allminus_mcodekind allminus bef, allminus, declaration decl) and fninfo = function Ast0.FStorage(stg) -> Ast.FStorage(mcode stg) | Ast0.FType(ty) -> Ast.FType(typeC false ty) | Ast0.FInline(inline) -> Ast.FInline(mcode inline) | Ast0.FAttr(attr) -> Ast.FAttr(mcode attr) and option_to_list = function Some x -> [x] | None -> [] and case_line c = rewrap c no_isos (match Ast0.unwrap c with Ast0.Default(def,colon,code) -> let def = mcode def in let colon = mcode colon in let code = dots statement code in Ast.CaseLine(rewrap c no_isos (Ast.Default(def,colon)),code) | Ast0.Case(case,exp,colon,code) -> let case = mcode case in let exp = expression exp in let colon = mcode colon in let code = dots statement code in Ast.CaseLine(rewrap c no_isos (Ast.Case(case,exp,colon)),code) | Ast0.DisjCase(_,case_lines,_,_) -> failwith "not supported" (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*) | Ast0.OptCase(case) -> Ast.OptCase(case_line case)) and statement_dots l = dots statement l (* --------------------------------------------------------------------- *) (* what is possible is only what is at the top level in an iso *) and anything = function Ast0.DotsExprTag(d) -> Ast.ExprDotsTag(expression_dots d) | Ast0.DotsParamTag(d) -> Ast.ParamDotsTag(parameter_list d) | Ast0.DotsInitTag(d) -> failwith "not possible" | Ast0.DotsStmtTag(d) -> Ast.StmtDotsTag(statement_dots d) | Ast0.DotsDeclTag(d) -> Ast.DeclDotsTag(declaration_dots d) | Ast0.DotsCaseTag(d) -> failwith "not possible" | Ast0.IdentTag(d) -> Ast.IdentTag(ident d) | Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d) | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) -> failwith "only in isos, not converted to ast" | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC false d) | Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d) | Ast0.InitTag(d) -> Ast.InitTag(initialiser d) | Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d) | Ast0.StmtTag(d) -> Ast.StatementTag(statement d) | Ast0.ForInfoTag(d) -> Ast.ForInfoTag(forinfo d) | Ast0.CaseLineTag(d) -> Ast.CaseLineTag(case_line d) | Ast0.TopTag(d) -> Ast.Code(top_level d) | Ast0.IsoWhenTag(_) -> failwith "not possible" | Ast0.IsoWhenTTag(_) -> failwith "not possible" | Ast0.IsoWhenFTag(_) -> failwith "not possible" | Ast0.MetaPosTag _ -> failwith "not possible" | Ast0.HiddenVarTag _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Function declaration *) (* top level isos are probably lost to tracking *) and top_level t = rewrap t no_isos (match Ast0.unwrap t with Ast0.FILEINFO(old_file,new_file) -> Ast.FILEINFO(mcode old_file,mcode new_file) | Ast0.NONDECL(stmt) -> Ast.NONDECL(statement stmt) | Ast0.CODE(rule_elem_dots) -> Ast.CODE(statement_dots rule_elem_dots) | Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps) | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level") (* --------------------------------------------------------------------- *) (* Entry point for minus code *) (* Inline_mcodes is very important - sends + code attached to the - code down to the mcodes. The functions above can only be used when there is no attached + code, eg in + code itself. *) let ast0toast_toplevel x = inline_mcodes.VT0.combiner_rec_top_level x; top_level x let ast0toast name deps dropped exists x is_exp ruletype = List.iter inline_mcodes.VT0.combiner_rec_top_level x; Ast.CocciRule (name,(deps,dropped,exists),List.map top_level x,is_exp,ruletype) coccinelle-1.0.0-rc19/parsing_cocci/iso_pattern.ml0000644000175000017500000030552712247442616021064 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./iso_pattern.ml" (* Potential problem: offset of mcode is not updated when an iso is instantiated, implying that a term may end up with many mcodes with the same offset. On the other hand, at the moment offset only seems to be used before this phase. Furthermore add_dot_binding relies on the offset to remain the same between matching an iso and instantiating it with bindings. *) (* Consider whether ... in iso should match <... ...> in smpl? *) (* --------------------------------------------------------------------- *) (* match a SmPL expression against a SmPL abstract syntax tree, either - or + *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types let current_rule = ref "" (* --------------------------------------------------------------------- *) type isomorphism = Ast_cocci.metavar list * Ast0_cocci.anything list list * string (* name *) let strip_info = let mcode (term,_,_,_,_,_) = (term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE, ref [],-1) in let donothing r k e = let x = k e in {(Ast0.wrap (Ast0.unwrap x)) with Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE); Ast0.true_if_test = x.Ast0.true_if_test} in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing let anything_equal = function (Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) -> failwith "not a possible variable binding" (*not sure why these are pbs*) | (Ast0.DotsInitTag(d1),Ast0.DotsInitTag(d2)) -> failwith "not a possible variable binding" | (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) -> failwith "not a possible variable binding" | (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) -> (strip_info.VT0.rebuilder_rec_statement_dots d1) = (strip_info.VT0.rebuilder_rec_statement_dots d2) | (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) -> failwith "not a possible variable binding" | (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) -> failwith "not a possible variable binding" | (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) -> (strip_info.VT0.rebuilder_rec_ident d1) = (strip_info.VT0.rebuilder_rec_ident d2) | (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) -> (strip_info.VT0.rebuilder_rec_expression d1) = (strip_info.VT0.rebuilder_rec_expression d2) | (Ast0.ArgExprTag(_),_) | (_,Ast0.ArgExprTag(_)) -> failwith "not possible - only in isos1" | (Ast0.TestExprTag(_),_) | (_,Ast0.TestExprTag(_)) -> failwith "not possible - only in isos1" | (Ast0.TypeCTag(d1),Ast0.TypeCTag(d2)) -> (strip_info.VT0.rebuilder_rec_typeC d1) = (strip_info.VT0.rebuilder_rec_typeC d2) | (Ast0.InitTag(d1),Ast0.InitTag(d2)) -> (strip_info.VT0.rebuilder_rec_initialiser d1) = (strip_info.VT0.rebuilder_rec_initialiser d2) | (Ast0.ParamTag(d1),Ast0.ParamTag(d2)) -> (strip_info.VT0.rebuilder_rec_parameter d1) = (strip_info.VT0.rebuilder_rec_parameter d2) | (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) -> (strip_info.VT0.rebuilder_rec_declaration d1) = (strip_info.VT0.rebuilder_rec_declaration d2) | (Ast0.StmtTag(d1),Ast0.StmtTag(d2)) -> (strip_info.VT0.rebuilder_rec_statement d1) = (strip_info.VT0.rebuilder_rec_statement d2) | (Ast0.CaseLineTag(d1),Ast0.CaseLineTag(d2)) -> (strip_info.VT0.rebuilder_rec_case_line d1) = (strip_info.VT0.rebuilder_rec_case_line d2) | (Ast0.TopTag(d1),Ast0.TopTag(d2)) -> (strip_info.VT0.rebuilder_rec_top_level d1) = (strip_info.VT0.rebuilder_rec_top_level d2) | (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_)) -> failwith "only for isos within iso phase" | (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) -> failwith "only for isos within iso phase" | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) -> failwith "only for isos within iso phase" | _ -> false let term (var1,_,_,_,_,_) = var1 let dot_term (var1,_,info,_,_,_) = ("", var1 ^ (string_of_int info.Ast0.pos_info.Ast0.offset)) type reason = NotPure of Ast0.pure * Ast.meta_name * Ast0.anything | NotPureLength of Ast.meta_name | ContextRequired of Ast0.anything | NonMatch | Braces of Ast0.statement | Nest of Ast0.statement | Position of Ast.meta_name | TypeMatch of reason list let rec interpret_reason name line reason printer = Printf.printf "warning: iso %s does not match the code below on line %d\n" name line; printer(); Format.print_newline(); match reason with NotPure(Ast0.Pure,(_,var),nonpure) -> Printf.printf "pure metavariable %s is matched against the following nonpure code:\n" var; Unparse_ast0.unparse_anything nonpure | NotPure(Ast0.Context,(_,var),nonpure) -> Printf.printf "context metavariable %s is matched against the following\nnoncontext code:\n" var; Unparse_ast0.unparse_anything nonpure | NotPure(Ast0.PureContext,(_,var),nonpure) -> Printf.printf "pure context metavariable %s is matched against the following\nnonpure or noncontext code:\n" var; Unparse_ast0.unparse_anything nonpure | NotPureLength((_,var)) -> Printf.printf "pure metavariable %s is matched against too much or too little code\n" var; | ContextRequired(term) -> Printf.printf "the following code matched is not uniformly minus or context,\nor contains a disjunction:\n"; Unparse_ast0.unparse_anything term | Braces(s) -> Printf.printf "braces must be all minus (plus code allowed) or all\ncontext (plus code not allowed in the body) to match:\n"; Unparse_ast0.statement "" s; Format.print_newline() | Nest(s) -> Printf.printf "iso with nest doesn't match whencode (TODO):\n"; Unparse_ast0.statement "" s; Format.print_newline() | Position(rule,name) -> Printf.printf "position variable %s.%s conflicts with an isomorphism\n" rule name | TypeMatch reason_list -> List.iter (function r -> interpret_reason name line r printer) reason_list | _ -> failwith "not possible" type 'a either = OK of 'a | Fail of reason let add_binding var exp bindings = let var = term var in let attempt bindings = try let cur = List.assoc var bindings in if anything_equal(exp,cur) then [bindings] else [] with Not_found -> [((var,exp)::bindings)] in match List.concat(List.map attempt bindings) with [] -> Fail NonMatch | x -> OK x let add_dot_binding var exp bindings = let var = dot_term var in let attempt bindings = try let cur = List.assoc var bindings in if anything_equal(exp,cur) then [bindings] else [] with Not_found -> [((var,exp)::bindings)] in match List.concat(List.map attempt bindings) with [] -> Fail NonMatch | x -> OK x (* multi-valued *) let add_multi_dot_binding var exp bindings = let var = dot_term var in let attempt bindings = [((var,exp)::bindings)] in match List.concat(List.map attempt bindings) with [] -> Fail NonMatch | x -> OK x let rec nub ls = match ls with [] -> [] | (x::xs) when (List.mem x xs) -> nub xs | (x::xs) -> x::(nub xs) (* --------------------------------------------------------------------- *) let init_env = [[]] let debug str m binding = let res = m binding in (match res with None -> Printf.printf "%s: failed\n" str | Some binding -> List.iter (function binding -> Printf.printf "%s: %s\n" str (String.concat " " (List.map (function (x,_) -> x) binding))) binding); res let conjunct_bindings (m1 : 'binding -> 'binding either) (m2 : 'binding -> 'binding either) (binding : 'binding) : 'binding either = match m1 binding with Fail(reason) -> Fail(reason) | OK binding -> m2 binding let rec conjunct_many_bindings = function [] -> failwith "not possible" | [x] -> x | x::xs -> conjunct_bindings x (conjunct_many_bindings xs) let mcode_equal (x,_,_,_,_,_) (y,_,_,_,_,_) = x = y let return b binding = if b then OK binding else Fail NonMatch let return_false reason binding = Fail reason let match_option f t1 t2 = match (t1,t2) with (Some t1, Some t2) -> f t1 t2 | (None, None) -> return true | _ -> return false let bool_match_option f t1 t2 = match (t1,t2) with (Some t1, Some t2) -> f t1 t2 | (None, None) -> true | _ -> false (* context_required is for the example if ( + (int * ) x == NULL) where we can't change x == NULL to eg NULL == x. So there can either be nothing attached to the root or the term has to be all removed. if would be nice if we knew more about the relationship between the - and + code, because in the case where the + code is a separate statement in a sequence, this is not a problem. Perhaps something could be done in insert_plus The example seems strange. Why isn't the cast attached to x? *) let is_context e = !Flag.sgrep_mode2 or (* everything is context for sgrep *) (match Ast0.get_mcodekind e with Ast0.CONTEXT(cell) -> true | _ -> false) (* needs a special case when there is a Disj or an empty DOTS the following stops at the statement level, and gives true if one statement is replaced by another *) let rec is_pure_context s = !Flag.sgrep_mode2 or (* everything is context for sgrep *) (match Ast0.unwrap s with Ast0.Disj(starter,statement_dots_list,mids,ender) -> List.for_all (function x -> match Ast0.undots x with [s] -> is_pure_context s | _ -> false (* could we do better? *)) statement_dots_list | _ -> (match Ast0.get_mcodekind s with Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> true | _ -> false) | Ast0.MINUS(mc) -> (match !mc with (* do better for the common case of replacing a stmt by another one *) (Ast.REPLACEMENT([[Ast.StatementTag(s)]],_),_) -> (match Ast.unwrap s with Ast.IfThen(_,_,_) -> false (* potentially dangerous *) | _ -> true) | (_,_) -> false) | _ -> false)) let is_minus e = match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false let match_list matcher is_list_matcher do_list_match la lb = let rec loop = function ([],[]) -> return true | ([x],lb) when is_list_matcher x -> do_list_match x lb | (x::xs,y::ys) -> conjunct_bindings (matcher x y) (loop (xs,ys)) | _ -> return false in loop (la,lb) let all_caps = Str.regexp "^[A-Z_][A-Z_0-9]*$" let match_maker checks_needed context_required whencode_allowed = let check_mcode pmc (*pattern*) cmc (*code*) binding = if checks_needed then match Ast0.get_pos cmc with [] -> OK binding (* no hidden vars in smpl code, so nothing to do *) | ((a::_) as hidden_code) -> let hidden_pattern = List.filter (function Ast0.HiddenVarTag _ -> true | _ -> false) (Ast0.get_pos pmc) in (match hidden_pattern with [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name1,_,_))])] -> add_binding name1 (Ast0.HiddenVarTag(hidden_code)) binding | [] -> Fail(Position(Ast0.unwrap_mcode(Ast0.meta_pos_name a))) | _ -> failwith "badly compiled iso - multiple hidden variable") else OK binding in let match_dots matcher is_list_matcher do_list_match d1 d2 = match (Ast0.unwrap d1, Ast0.unwrap d2) with (Ast0.DOTS(la),Ast0.DOTS(lb)) | (Ast0.CIRCLES(la),Ast0.CIRCLES(lb)) | (Ast0.STARS(la),Ast0.STARS(lb)) -> match_list matcher is_list_matcher (do_list_match d2) la lb | _ -> return false in let is_elist_matcher el = match Ast0.unwrap el with Ast0.MetaExprList(_,_,_) -> true | _ -> false in let is_plist_matcher pl = match Ast0.unwrap pl with Ast0.MetaParamList(_,_,_) -> true | _ -> false in let is_slist_matcher pl = match Ast0.unwrap pl with Ast0.MetaStmtList(_,_) -> true | _ -> false in let is_strlist_matcher sl = false in let no_list _ = false in let build_dots pattern data = match Ast0.unwrap pattern with Ast0.DOTS(_) -> Ast0.rewrap pattern (Ast0.DOTS(data)) | Ast0.CIRCLES(_) -> Ast0.rewrap pattern (Ast0.CIRCLES(data)) | Ast0.STARS(_) -> Ast0.rewrap pattern (Ast0.STARS(data)) in let pure_sp_code = let bind = Ast0.lub_pure in let option_default = Ast0.Context in let pure_mcodekind mc = if !Flag.sgrep_mode2 then Ast0.PureContext else match mc with Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> Ast0.PureContext | _ -> Ast0.Context) | Ast0.MINUS(mc) -> (match !mc with (Ast.NOREPLACEMENT,_) -> Ast0.Pure | _ -> Ast0.Impure) | _ -> Ast0.Impure in let donothing r k e = bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e) in let mcode m = pure_mcodekind (Ast0.get_mcode_mcodekind m) in (* a case for everything that has a metavariable *) (* pure is supposed to match only unitary metavars, not anything that contains only unitary metavars *) let ident r k i = bind (bind (pure_mcodekind (Ast0.get_mcodekind i)) (k i)) (match Ast0.unwrap i with Ast0.MetaId(name,_,_,pure) | Ast0.MetaFunc(name,_,pure) | Ast0.MetaLocalFunc(name,_,pure) -> pure | _ -> Ast0.Impure) in let expression r k e = bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e)) (match Ast0.unwrap e with Ast0.MetaErr(name,_,pure) | Ast0.MetaExpr(name,_,_,_,pure) | Ast0.MetaExprList(name,_,pure) -> pure | _ -> Ast0.Impure) in let typeC r k t = bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t)) (match Ast0.unwrap t with Ast0.MetaType(name,pure) -> pure | _ -> Ast0.Impure) in let init r k t = bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t)) (match Ast0.unwrap t with Ast0.MetaInit(name,pure) | Ast0.MetaInitList(name,_,pure) -> pure | _ -> Ast0.Impure) in let param r k p = bind (bind (pure_mcodekind (Ast0.get_mcodekind p)) (k p)) (match Ast0.unwrap p with Ast0.MetaParam(name,pure) | Ast0.MetaParamList(name,_,pure) -> pure | _ -> Ast0.Impure) in let decl r k d = bind (bind (pure_mcodekind (Ast0.get_mcodekind d)) (k d)) (match Ast0.unwrap d with Ast0.MetaDecl(name,pure) | Ast0.MetaField(name,pure) | Ast0.MetaFieldList(name,_,pure) -> pure | _ -> Ast0.Impure) in let stmt r k s = bind (bind (pure_mcodekind (Ast0.get_mcodekind s)) (k s)) (match Ast0.unwrap s with Ast0.MetaStmt(name,pure) | Ast0.MetaStmtList(name,pure) -> pure | _ -> Ast0.Impure) in V0.flat_combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing ident expression typeC init param decl stmt donothing donothing donothing in let add_pure_list_binding name pure is_pure builder1 builder2 lst = match (checks_needed,pure) with (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) -> (match lst with [x] -> if (Ast0.lub_pure (is_pure x) pure) = pure then add_binding name (builder1 lst) else return_false (NotPure (pure,term name,builder1 lst)) | _ -> return_false (NotPureLength (term name))) | (false,_) | (_,Ast0.Impure) -> add_binding name (builder2 lst) in let add_pure_binding name pure is_pure builder x = match (checks_needed,pure) with (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) -> if (Ast0.lub_pure (is_pure x) pure) = pure then add_binding name (builder x) else return_false (NotPure (pure,term name, builder x)) | (false,_) | (_,Ast0.Impure) -> add_binding name (builder x) in let do_elist_match builder el lst = match Ast0.unwrap el with Ast0.MetaExprList(name,lenname,pure) -> (*how to handle lenname? should it be an option type and always None?*) failwith "expr list pattern not supported in iso" (*add_pure_list_binding name pure pure_sp_code.V0.combiner_expression (function lst -> Ast0.ExprTag(List.hd lst)) (function lst -> Ast0.DotsExprTag(build_dots builder lst)) lst*) | _ -> failwith "not possible" in let do_plist_match builder pl lst = match Ast0.unwrap pl with Ast0.MetaParamList(name,lename,pure) -> failwith "param list pattern not supported in iso" (*add_pure_list_binding name pure pure_sp_code.V0.combiner_parameter (function lst -> Ast0.ParamTag(List.hd lst)) (function lst -> Ast0.DotsParamTag(build_dots builder lst)) lst*) | _ -> failwith "not possible" in let do_slist_match builder sl lst = match Ast0.unwrap sl with Ast0.MetaStmtList(name,pure) -> add_pure_list_binding name pure pure_sp_code.VT0.combiner_rec_statement (function lst -> Ast0.StmtTag(List.hd lst)) (function lst -> Ast0.DotsStmtTag(build_dots builder lst)) lst | _ -> failwith "not possible" in let do_nolist_match _ _ = failwith "not possible" in let rec match_ident pattern id = match Ast0.unwrap pattern with Ast0.MetaId(name,_,_,pure) -> (add_pure_binding name pure pure_sp_code.VT0.combiner_rec_ident (function id -> Ast0.IdentTag id) id) | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported" | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported" | up -> if not(checks_needed) or not(context_required) or is_context id then match (up,Ast0.unwrap id) with (Ast0.Id(namea),Ast0.Id(nameb)) -> if mcode_equal namea nameb then check_mcode namea nameb else return false | (Ast0.DisjId(_,ids,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.OptIdent(ida),Ast0.OptIdent(idb)) | (Ast0.UniqueIdent(ida),Ast0.UniqueIdent(idb)) -> match_ident ida idb | (_,Ast0.OptIdent(idb)) | (_,Ast0.UniqueIdent(idb)) -> match_ident pattern idb | _ -> return false else return_false (ContextRequired (Ast0.IdentTag id)) in (* should we do something about matching metavars against ...? *) let rec match_expr pattern expr = match Ast0.unwrap pattern with Ast0.MetaExpr(name,_,ty,form,pure) -> let form_ok = match (form,expr) with (Ast.ANY,_) -> true | (Ast.CONST,e) -> let rec matches e = match Ast0.unwrap e with Ast0.Constant _ | Ast0.StringConstant _ -> true | Ast0.Ident(c) -> (match Ast0.unwrap c with Ast0.Id(nm) -> let nm = Ast0.unwrap_mcode nm in (* all caps is a const *) Str.string_match all_caps nm 0 | _ -> false) | Ast0.Cast(lp,ty,rp,e) -> matches e | Ast0.SizeOfExpr(se,exp) -> true | Ast0.SizeOfType(se,lp,ty,rp) -> true | Ast0.MetaExpr(nm,_,_,Ast.CONST,p) -> (Ast0.lub_pure p pure) = pure | _ -> false in matches e | (Ast.ID,e) | (Ast.LocalID,e) -> let rec matches e = match Ast0.unwrap e with Ast0.Ident(c) -> true | Ast0.Cast(lp,ty,rp,e) -> matches e | Ast0.MetaExpr(nm,_,_,Ast.ID,p) -> (Ast0.lub_pure p pure) = pure | _ -> false in matches e in if form_ok then match ty with Some ts -> if List.exists (function Type_cocci.MetaType(_,_,_) -> true | _ -> false) ts then (match ts with [Type_cocci.MetaType(tyname,_,_)] -> let expty = match (Ast0.unwrap expr,Ast0.get_type expr) with (* easier than updating type inferencer to manage multiple types *) (Ast0.MetaExpr(_,_,Some tts,_,_),_) -> Some tts | (_,Some ty) -> Some [ty] | _ -> None in (match expty with Some expty -> let tyname = Ast0.rewrap_mcode name tyname in conjunct_bindings (add_pure_binding name pure pure_sp_code.VT0.combiner_rec_expression (function expr -> Ast0.ExprTag expr) expr) (function bindings -> let attempts = List.map (function expty -> (try add_pure_binding tyname Ast0.Impure (function _ -> Ast0.Impure) (function ty -> Ast0.TypeCTag ty) (Ast0.rewrap expr (Ast0.reverse_type expty)) bindings with Ast0.TyConv -> Printf.printf "warning: unconvertible type"; return false bindings)) expty in if List.exists (function Fail _ -> false | OK x -> true) attempts then (* not sure why this is ok. can there be more than one OK? *) OK (List.concat (List.map (function Fail _ -> [] | OK x -> x) attempts)) else Fail (TypeMatch (List.map (function Fail r -> r | OK x -> failwith "not possible") attempts))) | _ -> (*Printf.printf "warning: type metavar can only match one type";*) return false) | _ -> failwith "mixture of metatype and other types not supported") else let expty = Ast0.get_type expr in if List.exists (function t -> Type_cocci.compatible t expty) ts then add_pure_binding name pure pure_sp_code.VT0.combiner_rec_expression (function expr -> Ast0.ExprTag expr) expr else return false | None -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_expression (function expr -> Ast0.ExprTag expr) expr else return false | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported" | Ast0.MetaExprList(_,_,_) -> failwith "metaexprlist not supported" | up -> if not(checks_needed) or not(context_required) or is_context expr then match (up,Ast0.unwrap expr) with (Ast0.Ident(ida),Ast0.Ident(idb)) -> match_ident ida idb | (Ast0.Constant(consta),Ast0.Constant(constb)) -> if mcode_equal consta constb then check_mcode consta constb else return false | (Ast0.StringConstant(la,stra,ra), Ast0.StringConstant(lb,strb,rb)) -> conjunct_many_bindings [check_mcode la lb; check_mcode rb rb; match_dots match_frag is_strlist_matcher do_nolist_match stra strb] | (Ast0.FunCall(fna,lp1,argsa,rp1),Ast0.FunCall(fnb,lp,argsb,rp)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; match_expr fna fnb; match_dots match_expr is_elist_matcher do_elist_match argsa argsb] | (Ast0.Assignment(lefta,opa,righta,_), Ast0.Assignment(leftb,opb,rightb,_)) -> if mcode_equal opa opb then conjunct_many_bindings [check_mcode opa opb; match_expr lefta leftb; match_expr righta rightb] else return false | (Ast0.Sequence(lefta,opa,righta), Ast0.Sequence(leftb,opb,rightb)) -> if mcode_equal opa opb then conjunct_many_bindings [check_mcode opa opb; match_expr lefta leftb; match_expr righta rightb] else return false | (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a), Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; match_expr exp1a exp1b; match_option match_expr exp2a exp2b; match_expr exp3a exp3b] | (Ast0.Postfix(expa,opa),Ast0.Postfix(expb,opb)) -> if mcode_equal opa opb then conjunct_bindings (check_mcode opa opb) (match_expr expa expb) else return false | (Ast0.Infix(expa,opa),Ast0.Infix(expb,opb)) -> if mcode_equal opa opb then conjunct_bindings (check_mcode opa opb) (match_expr expa expb) else return false | (Ast0.Unary(expa,opa),Ast0.Unary(expb,opb)) -> if mcode_equal opa opb then conjunct_bindings (check_mcode opa opb) (match_expr expa expb) else return false | (Ast0.Binary(lefta,opa,righta),Ast0.Binary(leftb,opb,rightb)) -> if mcode_equal opa opb then conjunct_many_bindings [check_mcode opa opb; match_expr lefta leftb; match_expr righta rightb] else return false | (Ast0.Paren(lp1,expa,rp1),Ast0.Paren(lp,expb,rp)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; match_expr expa expb] | (Ast0.ArrayAccess(exp1a,lb1,exp2a,rb1), Ast0.ArrayAccess(exp1b,lb,exp2b,rb)) -> conjunct_many_bindings [check_mcode lb1 lb; check_mcode rb1 rb; match_expr exp1a exp1b; match_expr exp2a exp2b] | (Ast0.RecordAccess(expa,opa,fielda), Ast0.RecordAccess(expb,op,fieldb)) | (Ast0.RecordPtAccess(expa,opa,fielda), Ast0.RecordPtAccess(expb,op,fieldb)) -> conjunct_many_bindings [check_mcode opa op; match_expr expa expb; match_ident fielda fieldb] | (Ast0.Cast(lp1,tya,rp1,expa),Ast0.Cast(lp,tyb,rp,expb)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; match_typeC tya tyb; match_expr expa expb] | (Ast0.SizeOfExpr(szf1,expa),Ast0.SizeOfExpr(szf,expb)) -> conjunct_bindings (check_mcode szf1 szf) (match_expr expa expb) | (Ast0.SizeOfType(szf1,lp1,tya,rp1), Ast0.SizeOfType(szf,lp,tyb,rp)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; check_mcode szf1 szf; match_typeC tya tyb] | (Ast0.Constructor(lp1,tya,rp1,inita), Ast0.Constructor(lp,tyb,rp,initb)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; match_typeC tya tyb; match_init inita initb] | (Ast0.TypeExp(tya),Ast0.TypeExp(tyb)) -> match_typeC tya tyb | (Ast0.EComma(cm1),Ast0.EComma(cm)) -> check_mcode cm1 cm | (Ast0.DisjExpr(_,expsa,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.NestExpr(_,exp_dotsa,_,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.Edots(d,None),Ast0.Edots(d1,None)) | (Ast0.Ecircles(d,None),Ast0.Ecircles(d1,None)) | (Ast0.Estars(d,None),Ast0.Estars(d1,None)) -> check_mcode d d1 | (Ast0.Edots(ed,None),Ast0.Edots(ed1,Some wc)) | (Ast0.Ecircles(ed,None),Ast0.Ecircles(ed1,Some wc)) | (Ast0.Estars(ed,None),Ast0.Estars(ed1,Some wc)) -> (* hope that mcode of edots is unique somehow *) conjunct_bindings (check_mcode ed ed1) (let (edots_whencode_allowed,_,_) = whencode_allowed in if edots_whencode_allowed then add_dot_binding ed (Ast0.ExprTag wc) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Edots(_,Some _),_) | (Ast0.Ecircles(_,Some _),_) | (Ast0.Estars(_,Some _),_) -> failwith "whencode not allowed in a pattern1" | (Ast0.OptExp(expa),Ast0.OptExp(expb)) | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> match_expr expa expb | (_,Ast0.OptExp(expb)) | (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb | _ -> return false else return_false (ContextRequired (Ast0.ExprTag expr)) and match_frag e1 e2 = (* not an entry point, must be identical *) match (Ast0.unwrap e1,Ast0.unwrap e2) with (Ast0.ConstantFragment(str1),Ast0.ConstantFragment(str2)) -> if mcode_equal str1 str2 then check_mcode str1 str2 else return false | (Ast0.FormatFragment(pct1,fmt1), Ast0.FormatFragment(pct2,fmt2)) -> conjunct_many_bindings [check_mcode pct1 pct2; match_format fmt1 fmt2] | (Ast0.Strdots(d1),Ast0.Strdots(d2)) -> check_mcode d1 d2 | (Ast0.MetaFormatList(pct,name,lenname),_) -> failwith "not allowed in iso" | _ -> return false and match_format e1 e2 = (* not an entry point, must be identical *) match (Ast0.unwrap e1,Ast0.unwrap e2) with (Ast0.ConstantFormat(str1),Ast0.ConstantFormat(str2)) -> if mcode_equal str1 str2 then check_mcode str1 str2 else return false | (Ast0.MetaFormat(name,constraints),_) -> failwith "not allowed in iso" | _ -> return false (* the special case for function types prevents the eg T X; -> T X = E; iso from applying, which doesn't seem very relevant, but it also avoids a mysterious bug that is obtained with eg int attach(...); *) and match_typeC pattern t = match Ast0.unwrap pattern with Ast0.MetaType(name,pure) -> (match Ast0.unwrap t with Ast0.FunctionType(tya,lp1a,paramsa,rp1a) -> return false | _ -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_typeC (function ty -> Ast0.TypeCTag ty) t) | up -> if not(checks_needed) or not(context_required) or is_context t then match (up,Ast0.unwrap t) with (Ast0.ConstVol(cva,tya),Ast0.ConstVol(cvb,tyb)) -> if mcode_equal cva cvb then conjunct_bindings (check_mcode cva cvb) (match_typeC tya tyb) else return false | (Ast0.BaseType(tya,stringsa),Ast0.BaseType(tyb,stringsb)) -> if tya = tyb then match_list check_mcode (function _ -> false) (function _ -> failwith "") stringsa stringsb else return false | (Ast0.Signed(signa,tya),Ast0.Signed(signb,tyb)) -> if mcode_equal signa signb then conjunct_bindings (check_mcode signa signb) (match_option match_typeC tya tyb) else return false | (Ast0.Pointer(tya,star1),Ast0.Pointer(tyb,star)) -> conjunct_bindings (check_mcode star1 star) (match_typeC tya tyb) | (Ast0.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), Ast0.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) -> conjunct_many_bindings [check_mcode stara starb; check_mcode lp1a lp1b; check_mcode rp1a rp1b; check_mcode lp2a lp2b; check_mcode rp2a rp2b; match_typeC tya tyb; match_dots match_param is_plist_matcher do_plist_match paramsa paramsb] | (Ast0.FunctionType(tya,lp1a,paramsa,rp1a), Ast0.FunctionType(tyb,lp1b,paramsb,rp1b)) -> conjunct_many_bindings [check_mcode lp1a lp1b; check_mcode rp1a rp1b; match_option match_typeC tya tyb; match_dots match_param is_plist_matcher do_plist_match paramsa paramsb] | (Ast0.Array(tya,lb1,sizea,rb1),Ast0.Array(tyb,lb,sizeb,rb)) -> conjunct_many_bindings [check_mcode lb1 lb; check_mcode rb1 rb; match_typeC tya tyb; match_option match_expr sizea sizeb] | (Ast0.Decimal(dec1,lp1,len1,comma1,prec_opt1,rp1), Ast0.Decimal(dec2,lp2,len2,comma2,prec_opt2,rp2)) -> conjunct_many_bindings [check_mcode dec1 dec2; check_mcode lp1 lp2; match_expr len1 len2; match_option check_mcode comma1 comma2; match_option match_expr prec_opt1 prec_opt2; check_mcode rp1 rp2] | (Ast0.EnumName(kinda,Some namea), Ast0.EnumName(kindb,Some nameb)) -> conjunct_bindings (check_mcode kinda kindb) (match_ident namea nameb) | (Ast0.EnumDef(tya,lb1,idsa,rb1), Ast0.EnumDef(tyb,lb,idsb,rb)) -> conjunct_many_bindings [check_mcode lb1 lb; check_mcode rb1 rb; match_typeC tya tyb; match_dots match_expr no_list do_nolist_match idsa idsb] | (Ast0.StructUnionName(kinda,Some namea), Ast0.StructUnionName(kindb,Some nameb)) -> if mcode_equal kinda kindb then conjunct_bindings (check_mcode kinda kindb) (match_ident namea nameb) else return false | (Ast0.StructUnionDef(tya,lb1,declsa,rb1), Ast0.StructUnionDef(tyb,lb,declsb,rb)) -> conjunct_many_bindings [check_mcode lb1 lb; check_mcode rb1 rb; match_typeC tya tyb; match_dots match_decl no_list do_nolist_match declsa declsb] | (Ast0.TypeName(namea),Ast0.TypeName(nameb)) -> if mcode_equal namea nameb then check_mcode namea nameb else return false | (Ast0.DisjType(_,typesa,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.OptType(tya),Ast0.OptType(tyb)) | (Ast0.UniqueType(tya),Ast0.UniqueType(tyb)) -> match_typeC tya tyb | (_,Ast0.OptType(tyb)) | (_,Ast0.UniqueType(tyb)) -> match_typeC pattern tyb | _ -> return false else return_false (ContextRequired (Ast0.TypeCTag t)) and match_decl pattern d = match Ast0.unwrap pattern with Ast0.MetaDecl(name,pure) -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_declaration (function d -> Ast0.DeclTag d) d | Ast0.MetaField(name,pure) -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_declaration (function d -> Ast0.DeclTag d) d | Ast0.MetaFieldList(name,_,pure) -> failwith "metafieldlist not supporte" | up -> if not(checks_needed) or not(context_required) or is_context d then match (up,Ast0.unwrap d) with (Ast0.Init(stga,tya,ida,eq1,inia,sc1), Ast0.Init(stgb,tyb,idb,eq,inib,sc)) -> if bool_match_option mcode_equal stga stgb then conjunct_many_bindings [check_mcode eq1 eq; check_mcode sc1 sc; match_option check_mcode stga stgb; match_typeC tya tyb; match_ident ida idb; match_init inia inib] else return false | (Ast0.UnInit(stga,tya,ida,sc1),Ast0.UnInit(stgb,tyb,idb,sc)) -> if bool_match_option mcode_equal stga stgb then conjunct_many_bindings [check_mcode sc1 sc; match_option check_mcode stga stgb; match_typeC tya tyb; match_ident ida idb] else return false | (Ast0.MacroDecl(namea,lp1,argsa,rp1,sc1), Ast0.MacroDecl(nameb,lp,argsb,rp,sc)) -> conjunct_many_bindings [match_ident namea nameb; check_mcode lp1 lp; check_mcode rp1 rp; check_mcode sc1 sc; match_dots match_expr is_elist_matcher do_elist_match argsa argsb] | (Ast0.MacroDeclInit(namea,lp1,argsa,rp1,eq1,ini1,sc1), Ast0.MacroDeclInit(nameb,lp,argsb,rp,eq,ini,sc)) -> conjunct_many_bindings [match_ident namea nameb; check_mcode lp1 lp; check_mcode rp1 rp; check_mcode eq1 eq; check_mcode sc1 sc; match_dots match_expr is_elist_matcher do_elist_match argsa argsb; match_init ini1 ini] | (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) -> conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb) | (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) -> conjunct_bindings (check_mcode sc1 sc) (conjunct_bindings (match_typeC tya tyb) (match_typeC ida idb)) | (Ast0.DisjDecl(_,declsa,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.Ddots(d1,None),Ast0.Ddots(d,None)) -> check_mcode d1 d | (Ast0.Ddots(dd,None),Ast0.Ddots(d,Some wc)) -> conjunct_bindings (check_mcode dd d) (* hope that mcode of ddots is unique somehow *) (let (ddots_whencode_allowed,_,_) = whencode_allowed in if ddots_whencode_allowed then add_dot_binding dd (Ast0.DeclTag wc) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Ddots(_,Some _),_) -> failwith "whencode not allowed in a pattern1" | (Ast0.OptDecl(decla),Ast0.OptDecl(declb)) | (Ast0.UniqueDecl(decla),Ast0.UniqueDecl(declb)) -> match_decl decla declb | (_,Ast0.OptDecl(declb)) | (_,Ast0.UniqueDecl(declb)) -> match_decl pattern declb | _ -> return false else return_false (ContextRequired (Ast0.DeclTag d)) and match_init pattern i = match Ast0.unwrap pattern with Ast0.MetaInit(name,pure) -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_initialiser (function ini -> Ast0.InitTag ini) i | up -> if not(checks_needed) or not(context_required) or is_context i then match (up,Ast0.unwrap i) with (Ast0.InitExpr(expa),Ast0.InitExpr(expb)) -> match_expr expa expb | (Ast0.InitList(lb1,initlista,rb1,oa), Ast0.InitList(lb,initlistb,rb,ob)) when oa = ob -> conjunct_many_bindings [check_mcode lb1 lb; check_mcode rb1 rb; match_dots match_init no_list do_nolist_match initlista initlistb] | (Ast0.InitGccExt(designators1,e1,inia), Ast0.InitGccExt(designators2,e2,inib)) -> conjunct_many_bindings [match_list match_designator (function _ -> false) (function _ -> failwith "") designators1 designators2; check_mcode e1 e2; match_init inia inib] | (Ast0.InitGccName(namea,c1,inia),Ast0.InitGccName(nameb,c,inib)) -> conjunct_many_bindings [check_mcode c1 c; match_ident namea nameb; match_init inia inib] | (Ast0.IComma(c1),Ast0.IComma(c)) -> check_mcode c1 c | (Ast0.Idots(d1,None),Ast0.Idots(d,None)) -> check_mcode d1 d | (Ast0.Idots(id,None),Ast0.Idots(d,Some wc)) -> conjunct_bindings (check_mcode id d) (* hope that mcode of edots is unique somehow *) (let (_,idots_whencode_allowed,_) = whencode_allowed in if idots_whencode_allowed then add_dot_binding id (Ast0.InitTag wc) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Idots(_,Some _),_) -> failwith "whencode not allowed in a pattern2" | (Ast0.OptIni(ia),Ast0.OptIni(ib)) | (Ast0.UniqueIni(ia),Ast0.UniqueIni(ib)) -> match_init ia ib | (_,Ast0.OptIni(ib)) | (_,Ast0.UniqueIni(ib)) -> match_init pattern ib | _ -> return false else return_false (ContextRequired (Ast0.InitTag i)) and match_designator pattern d = match (pattern,d) with (Ast0.DesignatorField(dota,ida),Ast0.DesignatorField(dotb,idb)) -> conjunct_bindings (check_mcode dota dotb) (match_ident ida idb) | (Ast0.DesignatorIndex(lba,expa,rba), Ast0.DesignatorIndex(lbb,expb,rbb)) -> conjunct_many_bindings [check_mcode lba lbb; match_expr expa expb; check_mcode rba rbb] | (Ast0.DesignatorRange(lba,mina,dotsa,maxa,rba), Ast0.DesignatorRange(lbb,minb,dotsb,maxb,rbb)) -> conjunct_many_bindings [check_mcode lba lbb; match_expr mina minb; check_mcode dotsa dotsb; match_expr maxa maxb; check_mcode rba rbb] | _ -> return false and match_param pattern p = match Ast0.unwrap pattern with Ast0.MetaParam(name,pure) -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_parameter (function p -> Ast0.ParamTag p) p | Ast0.MetaParamList(name,_,pure) -> failwith "metaparamlist not supported" | up -> if not(checks_needed) or not(context_required) or is_context p then match (up,Ast0.unwrap p) with (Ast0.VoidParam(tya),Ast0.VoidParam(tyb)) -> match_typeC tya tyb | (Ast0.Param(tya,ida),Ast0.Param(tyb,idb)) -> conjunct_bindings (match_typeC tya tyb) (match_option match_ident ida idb) | (Ast0.PComma(c1),Ast0.PComma(c)) -> check_mcode c1 c | (Ast0.Pdots(d1),Ast0.Pdots(d)) | (Ast0.Pcircles(d1),Ast0.Pcircles(d)) -> check_mcode d1 d | (Ast0.OptParam(parama),Ast0.OptParam(paramb)) | (Ast0.UniqueParam(parama),Ast0.UniqueParam(paramb)) -> match_param parama paramb | (_,Ast0.OptParam(paramb)) | (_,Ast0.UniqueParam(paramb)) -> match_param pattern paramb | _ -> return false else return_false (ContextRequired (Ast0.ParamTag p)) and match_statement pattern s = match Ast0.unwrap pattern with Ast0.MetaStmt(name,pure) -> (match Ast0.unwrap s with Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> return false (* ... is not a single statement *) | _ -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_statement (function ty -> Ast0.StmtTag ty) s) | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported" | up -> if not(checks_needed) or not(context_required) or is_context s then match (up,Ast0.unwrap s) with (Ast0.FunDecl(_,fninfoa,namea,lp1,paramsa,rp1,lb1,bodya,rb1), Ast0.FunDecl(_,fninfob,nameb,lp,paramsb,rp,lb,bodyb,rb)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; check_mcode lb1 lb; check_mcode rb1 rb; match_fninfo fninfoa fninfob; match_ident namea nameb; match_dots match_param is_plist_matcher do_plist_match paramsa paramsb; match_dots match_statement is_slist_matcher do_slist_match bodya bodyb] | (Ast0.Decl(_,decla),Ast0.Decl(_,declb)) -> match_decl decla declb | (Ast0.Seq(lb1,bodya,rb1),Ast0.Seq(lb,bodyb,rb)) -> (* seqs can only match if they are all minus (plus code allowed) or all context (plus code not allowed in the body). we could be more permissive if the expansions of the isos are also all seqs, but this would be hard to check except at top level, and perhaps not worth checking even in that case. Overall, the issue is that braces are used where single statements are required, and something not satisfying these conditions can cause a single statement to become a non-single statement after the transformation. example: if { ... -foo(); ... } if we let the sequence convert to just -foo(); then we produce invalid code. For some reason, single_statement can't deal with this case, perhaps because it starts introducing too many braces? don't remember the exact problem... *) conjunct_bindings (check_mcode lb1 lb) (conjunct_bindings (check_mcode rb1 rb) (if not(checks_needed) or is_minus s or (is_context s && List.for_all is_pure_context (Ast0.undots bodyb)) then match_dots match_statement is_slist_matcher do_slist_match bodya bodyb else return_false (Braces(s)))) | (Ast0.ExprStatement(expa,sc1),Ast0.ExprStatement(expb,sc)) -> conjunct_bindings (check_mcode sc1 sc) (match_option match_expr expa expb) | (Ast0.IfThen(if1,lp1,expa,rp1,branch1a,_), Ast0.IfThen(if2,lp2,expb,rp2,branch1b,_)) -> conjunct_many_bindings [check_mcode if1 if2; check_mcode lp1 lp2; check_mcode rp1 rp2; match_expr expa expb; match_statement branch1a branch1b] | (Ast0.IfThenElse(if1,lp1,expa,rp1,branch1a,e1,branch2a,_), Ast0.IfThenElse(if2,lp2,expb,rp2,branch1b,e2,branch2b,_)) -> conjunct_many_bindings [check_mcode if1 if2; check_mcode lp1 lp2; check_mcode rp1 rp2; check_mcode e1 e2; match_expr expa expb; match_statement branch1a branch1b; match_statement branch2a branch2b] | (Ast0.While(w1,lp1,expa,rp1,bodya,_), Ast0.While(w,lp,expb,rp,bodyb,_)) -> conjunct_many_bindings [check_mcode w1 w; check_mcode lp1 lp; check_mcode rp1 rp; match_expr expa expb; match_statement bodya bodyb] | (Ast0.Do(d1,bodya,w1,lp1,expa,rp1,_), Ast0.Do(d,bodyb,w,lp,expb,rp,_)) -> conjunct_many_bindings [check_mcode d1 d; check_mcode w1 w; check_mcode lp1 lp; check_mcode rp1 rp; match_statement bodya bodyb; match_expr expa expb] | (Ast0.For(f1,lp1,firsta,e2a,sc2a,e3a,rp1,bodya,_), Ast0.For(f,lp,firstb,e2b,sc2b,e3b,rp,bodyb,_)) -> let first = match (Ast0.unwrap firsta,Ast0.unwrap firstb) with (Ast0.ForExp(e1a,sc1a),Ast0.ForExp(e1b,sc1b)) -> conjunct_bindings (check_mcode sc2a sc2b) (match_option match_expr e1a e1b) | (Ast0.ForDecl (_,decla),Ast0.ForDecl (_,declb)) -> match_decl decla declb | _ -> return false in conjunct_many_bindings [check_mcode f1 f; check_mcode lp1 lp; first; check_mcode sc2a sc2b; check_mcode rp1 rp; match_option match_expr e2a e2b; match_option match_expr e3a e3b; match_statement bodya bodyb] | (Ast0.Iterator(nma,lp1,argsa,rp1,bodya,_), Ast0.Iterator(nmb,lp,argsb,rp,bodyb,_)) -> conjunct_many_bindings [match_ident nma nmb; check_mcode lp1 lp; check_mcode rp1 rp; match_dots match_expr is_elist_matcher do_elist_match argsa argsb; match_statement bodya bodyb] | (Ast0.Switch(s1,lp1,expa,rp1,lb1,declsa,casesa,rb1), Ast0.Switch(s,lp,expb,rp,lb,declsb,casesb,rb)) -> conjunct_many_bindings [check_mcode s1 s; check_mcode lp1 lp; check_mcode rp1 rp; check_mcode lb1 lb; check_mcode rb1 rb; match_expr expa expb; match_dots match_statement is_slist_matcher do_slist_match declsa declsb; match_dots match_case_line no_list do_nolist_match casesa casesb] | (Ast0.Break(b1,sc1),Ast0.Break(b,sc)) | (Ast0.Continue(b1,sc1),Ast0.Continue(b,sc)) -> conjunct_bindings (check_mcode b1 b) (check_mcode sc1 sc) | (Ast0.Label(l1,c1),Ast0.Label(l2,c)) -> conjunct_bindings (match_ident l1 l2) (check_mcode c1 c) | (Ast0.Goto(g1,l1,sc1),Ast0.Goto(g,l2,sc)) -> conjunct_many_bindings [check_mcode g1 g; check_mcode sc1 sc; match_ident l1 l2] | (Ast0.Return(r1,sc1),Ast0.Return(r,sc)) -> conjunct_bindings (check_mcode r1 r) (check_mcode sc1 sc) | (Ast0.ReturnExpr(r1,expa,sc1),Ast0.ReturnExpr(r,expb,sc)) -> conjunct_many_bindings [check_mcode r1 r; check_mcode sc1 sc; match_expr expa expb] | (Ast0.Disj(_,statement_dots_lista,_,_),_) -> failwith "disj not supported in patterns" | (Ast0.Nest(_,stmt_dotsa,_,[],multia), Ast0.Nest(_,stmt_dotsb,_,wc,multib)) -> if multia = multib then (match wc with [] -> (* not sure this is correct, perhaps too restrictive *) if not(checks_needed) or is_minus s or (is_context s && List.for_all is_pure_context (Ast0.undots stmt_dotsb)) then match_dots match_statement is_slist_matcher do_slist_match stmt_dotsa stmt_dotsb else return_false (Braces(s)) | _ -> return_false (Nest(s))) else return false (* diff kind of nest *) | (Ast0.Nest(_,stmt_dotsa,_,_,_),_) -> failwith "nest with whencode not supported in patterns" | (Ast0.Exp(expa),Ast0.Exp(expb)) -> match_expr expa expb | (Ast0.TopExp(expa),Ast0.TopExp(expb)) -> match_expr expa expb | (Ast0.Exp(expa),Ast0.TopExp(expb)) -> match_expr expa expb | (Ast0.TopInit(inita),Ast0.TopInit(initb)) -> match_init inita initb | (Ast0.Ty(tya),Ast0.Ty(tyb)) -> match_typeC tya tyb | (Ast0.Dots(d,[]),Ast0.Dots(d1,wc)) | (Ast0.Circles(d,[]),Ast0.Circles(d1,wc)) | (Ast0.Stars(d,[]),Ast0.Stars(d1,wc)) -> (match wc with [] -> check_mcode d d1 | _ -> let (_,_,dots_whencode_allowed) = whencode_allowed in if dots_whencode_allowed then conjunct_bindings (check_mcode d d1) (List.fold_left (function prev -> function | Ast0.WhenNot wc -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.DotsStmtTag wc)) | Ast0.WhenAlways wc -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.StmtTag wc)) | Ast0.WhenNotTrue wc -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.IsoWhenTTag wc)) | Ast0.WhenNotFalse wc -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.IsoWhenFTag wc)) | Ast0.WhenModifier(x) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.IsoWhenTag x))) (return true) wc) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Dots(_,_::_),_) | (Ast0.Circles(_,_::_),_) | (Ast0.Stars(_,_::_),_) -> failwith "whencode not allowed in a pattern3" | (Ast0.OptStm(rea),Ast0.OptStm(reb)) | (Ast0.UniqueStm(rea),Ast0.UniqueStm(reb)) -> match_statement rea reb | (_,Ast0.OptStm(reb)) | (_,Ast0.UniqueStm(reb)) -> match_statement pattern reb | _ -> return false else return_false (ContextRequired (Ast0.StmtTag s)) (* first should provide a subset of the information in the second *) and match_fninfo patterninfo cinfo = let patterninfo = List.sort compare patterninfo in let cinfo = List.sort compare cinfo in let rec loop = function (Ast0.FStorage(sta)::resta,Ast0.FStorage(stb)::restb) -> if mcode_equal sta stb then conjunct_bindings (check_mcode sta stb) (loop (resta,restb)) else return false | (Ast0.FType(tya)::resta,Ast0.FType(tyb)::restb) -> conjunct_bindings (match_typeC tya tyb) (loop (resta,restb)) | (Ast0.FInline(ia)::resta,Ast0.FInline(ib)::restb) -> if mcode_equal ia ib then conjunct_bindings (check_mcode ia ib) (loop (resta,restb)) else return false | (Ast0.FAttr(ia)::resta,Ast0.FAttr(ib)::restb) -> if mcode_equal ia ib then conjunct_bindings (check_mcode ia ib) (loop (resta,restb)) else return false | (x::resta,((y::_) as restb)) -> (match compare x y with -1 -> return false | 1 -> loop (resta,restb) | _ -> failwith "not possible") | _ -> return false in loop (patterninfo,cinfo) and match_case_line pattern c = if not(checks_needed) or not(context_required) or is_context c then match (Ast0.unwrap pattern,Ast0.unwrap c) with (Ast0.Default(d1,c1,codea),Ast0.Default(d,c,codeb)) -> conjunct_many_bindings [check_mcode d1 d; check_mcode c1 c; match_dots match_statement is_slist_matcher do_slist_match codea codeb] | (Ast0.Case(ca1,expa,c1,codea),Ast0.Case(ca,expb,c,codeb)) -> conjunct_many_bindings [check_mcode ca1 ca; check_mcode c1 c; match_expr expa expb; match_dots match_statement is_slist_matcher do_slist_match codea codeb] | (Ast0.DisjCase(_,case_linesa,_,_),_) -> failwith "not allowed in the pattern of an isomorphism" | (Ast0.OptCase(ca),Ast0.OptCase(cb)) -> match_case_line ca cb | (_,Ast0.OptCase(cb)) -> match_case_line pattern cb | _ -> return false else return_false (ContextRequired (Ast0.CaseLineTag c)) in let match_statement_dots x y = match_dots match_statement is_slist_matcher do_slist_match x y in (match_expr, match_decl, match_statement, match_typeC, match_statement_dots) let match_expr dochecks context_required whencode_allowed = let (fn,_,_,_,_) = match_maker dochecks context_required whencode_allowed in fn let match_decl dochecks context_required whencode_allowed = let (_,fn,_,_,_) = match_maker dochecks context_required whencode_allowed in fn let match_statement dochecks context_required whencode_allowed = let (_,_,fn,_,_) = match_maker dochecks context_required whencode_allowed in fn let match_typeC dochecks context_required whencode_allowed = let (_,_,_,fn,_) = match_maker dochecks context_required whencode_allowed in fn let match_statement_dots dochecks context_required whencode_allowed = let (_,_,_,_,fn) = match_maker dochecks context_required whencode_allowed in fn (* --------------------------------------------------------------------- *) (* make an entire tree MINUS *) let make_minus = let mcode (term,arity,info,mcodekind,pos,adj) = let new_mcodekind = match mcodekind with Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)) | _ -> failwith "make_minus: unexpected befaft") | Ast0.MINUS(mc) -> mcodekind (* in the part copied from the src term *) | _ -> failwith "make_minus mcode: unexpected mcodekind" in (term,arity,info,new_mcodekind,pos,adj) in let update_mc mcodekind e = match !mcodekind with Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> mcodekind := Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)) | _ -> failwith "make_minus: unexpected befaft") | Ast0.MINUS(_mc) -> () (* in the part copied from the src term *) | Ast0.PLUS _ -> failwith "make_minus donothing: unexpected plus mcodekind" | _ -> failwith "make_minus donothing: unexpected mcodekind" in let donothing r k e = let mcodekind = Ast0.get_mcodekind_ref e in let e = k e in update_mc mcodekind e; e in (* special case for whencode, because it isn't processed by contextneg, since it doesn't appear in the + code *) (* cases for dots and nests *) let expression r k e = let mcodekind = Ast0.get_mcodekind_ref e in match Ast0.unwrap e with Ast0.Edots(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Edots(mcode d,whencode)) | Ast0.Ecircles(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Ecircles(mcode d,whencode)) | Ast0.Estars(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Estars(mcode d,whencode)) | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> update_mc mcodekind e; Ast0.rewrap e (Ast0.NestExpr(mcode starter, r.VT0.rebuilder_rec_expression_dots expr_dots, mcode ender,whencode,multi)) | _ -> donothing r k e in let declaration r k e = let mcodekind = Ast0.get_mcodekind_ref e in match Ast0.unwrap e with Ast0.Ddots(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Ddots(mcode d,whencode)) | _ -> donothing r k e in let statement r k e = let mcodekind = Ast0.get_mcodekind_ref e in match Ast0.unwrap e with Ast0.Dots(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Dots(mcode d,whencode)) | Ast0.Circles(d,whencode) -> update_mc mcodekind e; Ast0.rewrap e (Ast0.Circles(mcode d,whencode)) | Ast0.Stars(d,whencode) -> update_mc mcodekind e; Ast0.rewrap e (Ast0.Stars(mcode d,whencode)) | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> update_mc mcodekind e; Ast0.rewrap e (Ast0.Nest (mcode starter,r.VT0.rebuilder_rec_statement_dots stmt_dots, mcode ender,whencode,multi)) | _ -> donothing r k e in let initialiser r k e = let mcodekind = Ast0.get_mcodekind_ref e in match Ast0.unwrap e with Ast0.Idots(d,whencode) -> (*don't recurse because whencode hasn't been processed by context_neg*) update_mc mcodekind e; Ast0.rewrap e (Ast0.Idots(mcode d,whencode)) | _ -> donothing r k e in let dots r k e = let info = Ast0.get_info e in let mcodekind = Ast0.get_mcodekind_ref e in match Ast0.unwrap e with Ast0.DOTS([]) -> (* if context is - this should be - as well. There are no tokens here though, so the bottom-up minusifier in context_neg leaves it as mixed (or context for sgrep2). It would be better to fix context_neg, but that would require a special case for each term with a dots subterm. *) (match !mcodekind with Ast0.MIXED(mc) | Ast0.CONTEXT(mc) -> (match !mc with (Ast.NOTHING,_,_) -> mcodekind := Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)); e | _ -> failwith "make_minus: unexpected befaft") (* code already processed by an enclosing iso *) | Ast0.MINUS(mc) -> e | _ -> failwith (Printf.sprintf "%d: make_minus donothingxxx: unexpected mcodekind: %s" info.Ast0.pos_info.Ast0.line_start (Dumper.dump e))) | _ -> donothing r k e in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode dots dots dots dots dots dots donothing expression donothing initialiser donothing declaration statement donothing donothing donothing (* --------------------------------------------------------------------- *) (* rebuild mcode cells in an instantiated alt *) (* mcodes will be side effected later with plus code, so we have to copy them on instantiating an isomorphism. One could wonder whether it would be better not to use side-effects, but they are convenient for insert_plus where is it useful to manipulate a list of the mcodes but side-effect a tree *) (* hmm... Insert_plus is called before Iso_pattern... *) let rebuild_mcode start_line = let copy_mcodekind = function Ast0.CONTEXT(mc) -> Ast0.CONTEXT(ref (!mc)) | Ast0.MINUS(mc) -> Ast0.MINUS(ref (!mc)) | Ast0.MIXED(mc) -> Ast0.MIXED(ref (!mc)) | Ast0.PLUS count -> (* this function is used elsewhere where we need to rebuild the indices, and so we allow PLUS code as well *) Ast0.PLUS count in let mcode (term,arity,info,mcodekind,pos,adj) = let info = match start_line with Some x -> let new_pos_info = {info.Ast0.pos_info with Ast0.line_start = x; Ast0.line_end = x; } in {info with Ast0.pos_info = new_pos_info} | None -> info in (term,arity,info,copy_mcodekind mcodekind,pos,adj) in let copy_one x = let old_info = Ast0.get_info x in let info = match start_line with Some x -> let new_pos_info = {old_info.Ast0.pos_info with Ast0.line_start = x; Ast0.line_end = x; } in {old_info with Ast0.pos_info = new_pos_info} | None -> old_info in {x with Ast0.info = info; Ast0.index = ref(Ast0.get_index x); Ast0.mcodekind = ref (copy_mcodekind (Ast0.get_mcodekind x))} in let donothing r k e = copy_one (k e) in (* case for control operators (if, etc) *) let statement r k e = let s = k e in let res = copy_one (Ast0.rewrap s (match Ast0.unwrap s with Ast0.Decl((info,mc),decl) -> Ast0.Decl((info,copy_mcodekind mc),decl) | Ast0.IfThen(iff,lp,tst,rp,branch,(info,mc,adj)) -> Ast0.IfThen(iff,lp,tst,rp,branch,(info,copy_mcodekind mc,adj)) | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,(info,mc,adj))-> Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2, (info,copy_mcodekind mc,adj)) | Ast0.While(whl,lp,exp,rp,body,(info,mc,adj)) -> Ast0.While(whl,lp,exp,rp,body,(info,copy_mcodekind mc,adj)) | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,(info,mc,adj)) -> Ast0.For(fr,lp,first,e2,sem2,e3,rp,body, (info,copy_mcodekind mc,adj)) | Ast0.Iterator(nm,lp,args,rp,body,(info,mc,adj)) -> Ast0.Iterator(nm,lp,args,rp,body,(info,copy_mcodekind mc,adj)) | Ast0.FunDecl ((info,mc),fninfo,name,lp,params,rp,lbrace,body,rbrace) -> Ast0.FunDecl ((info,copy_mcodekind mc), fninfo,name,lp,params,rp,lbrace,body,rbrace) | s -> s)) in Ast0.set_dots_bef_aft res (match Ast0.get_dots_bef_aft res with Ast0.NoDots -> Ast0.NoDots | Ast0.AddingBetweenDots s -> Ast0.AddingBetweenDots(r.VT0.rebuilder_rec_statement s) | Ast0.DroppingBetweenDots s -> Ast0.DroppingBetweenDots(r.VT0.rebuilder_rec_statement s)) in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing statement donothing donothing donothing (* --------------------------------------------------------------------- *) (* The problem of whencode. If an isomorphism contains dots in multiple rules, then the code that is matched cannot contain whencode, because we won't know which dots it goes with. Should worry about nests, but they aren't allowed in isomorphisms for the moment. *) let count_edots = let option_default = 0 in let bind x y = x + y in let exprfn r k e = match Ast0.unwrap e with Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> 1 | _ -> 0 in V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_exprfn = exprfn} let count_idots = let option_default = 0 in let bind x y = x + y in let initfn r k e = match Ast0.unwrap e with Ast0.Idots(_,_) -> 1 | _ -> 0 in V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_initfn = initfn} let count_dots = let option_default = 0 in let bind x y = x + y in let stmtfn r k e = match Ast0.unwrap e with Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> 1 | _ -> 0 in V0.combiner bind option_default {V0.combiner_functions with VT0.combiner_stmtfn = stmtfn} (* --------------------------------------------------------------------- *) let lookup name bindings mv_bindings = try Common.Left (List.assoc (term name) bindings) with Not_found -> (* failure is not possible anymore *) Common.Right (List.assoc (term name) mv_bindings) (* mv_bindings is for the fresh metavariables that are introduced by the isomorphism *) let instantiate bindings mv_bindings = let mcode x = let (hidden,others) = List.partition (function Ast0.HiddenVarTag _ -> true | _ -> false) (Ast0.get_pos x) in let new_names = match hidden with [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name,_,_))])] -> (try (* not at all sure that this is good enough *) match lookup name bindings mv_bindings with Common.Left(Ast0.HiddenVarTag(ids)) -> ids | _ -> failwith "not possible" with Not_found -> (*can't fail because checks_needed could be false?*) []) | [] -> [] (* no hidden metavars allowed *) | _ -> failwith "badly compiled mcode" in Ast0.set_pos (new_names@others) x in let donothing r k e = k e in (* cases where metavariables can occur *) let identfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaId(name,constraints,seed,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_ident (match lookup name bindings mv_bindings with Common.Left(Ast0.IdentTag(id)) -> id | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaId (Ast0.set_mcode_data new_mv name,constraints,seed,pure))) | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported" | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported" | _ -> e in (* case for list metavariables *) let rec elist r same_dots = function [] -> [] | [x] -> (match Ast0.unwrap x with Ast0.MetaExprList(name,lenname,pure) -> failwith "meta_expr_list in iso not supported" (*match lookup name bindings mv_bindings with Common.Left(Ast0.DotsExprTag(exp)) -> (match same_dots exp with Some l -> l | None -> failwith "dots put in incompatible context") | Common.Left(Ast0.ExprTag(exp)) -> [exp] | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> failwith "MetaExprList in SP not supported"*) | _ -> [r.VT0.rebuilder_rec_expression x]) | x::xs -> (r.VT0.rebuilder_rec_expression x)::(elist r same_dots xs) in let rec plist r same_dots = function [] -> [] | [x] -> (match Ast0.unwrap x with Ast0.MetaParamList(name,lenname,pure) -> failwith "meta_param_list in iso not supported" (*match lookup name bindings mv_bindings with Common.Left(Ast0.DotsParamTag(param)) -> (match same_dots param with Some l -> l | None -> failwith "dots put in incompatible context") | Common.Left(Ast0.ParamTag(param)) -> [param] | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> failwith "MetaExprList in SP not supported"*) | _ -> [r.VT0.rebuilder_rec_parameter x]) | x::xs -> (r.VT0.rebuilder_rec_parameter x)::(plist r same_dots xs) in let rec slist r same_dots = function [] -> [] | [x] -> (match Ast0.unwrap x with Ast0.MetaStmtList(name,pure) -> (match lookup name bindings mv_bindings with Common.Left(Ast0.DotsStmtTag(stm)) -> (match same_dots stm with Some l -> l | None -> failwith "dots put in incompatible context") | Common.Left(Ast0.StmtTag(stm)) -> [stm] | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> failwith "MetaExprList in SP not supported") | _ -> [r.VT0.rebuilder_rec_statement x]) | x::xs -> (r.VT0.rebuilder_rec_statement x)::(slist r same_dots xs) in let same_dots d = match Ast0.unwrap d with Ast0.DOTS(l) -> Some l |_ -> None in let same_circles d = match Ast0.unwrap d with Ast0.CIRCLES(l) -> Some l |_ -> None in let same_stars d = match Ast0.unwrap d with Ast0.STARS(l) -> Some l |_ -> None in let dots list_fn r k d = Ast0.rewrap d (match Ast0.unwrap d with Ast0.DOTS(l) -> Ast0.DOTS(list_fn r same_dots l) | Ast0.CIRCLES(l) -> Ast0.CIRCLES(list_fn r same_circles l) | Ast0.STARS(l) -> Ast0.STARS(list_fn r same_stars l)) in let exprfn r k old_e = (* need to keep the original code for ! optim *) let e = k old_e in let e1 = match Ast0.unwrap e with Ast0.MetaExpr(name,constraints,x,form,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_expression (match lookup name bindings mv_bindings with Common.Left(Ast0.ExprTag(exp)) -> Ast0.clear_test_exp exp | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> let new_types = match x with None -> None | Some types -> let rec renamer = function Type_cocci.MetaType(name,keep,inherited) -> (match lookup (name,(),(),(),None,-1) bindings mv_bindings with Common.Left(Ast0.TypeCTag(t)) -> Ast0.ast0_type_to_type t | Common.Left(_) -> failwith "iso pattern: unexpected type" | Common.Right(new_mv) -> Type_cocci.MetaType(new_mv,keep,inherited)) | Type_cocci.ConstVol(cv,ty) -> Type_cocci.ConstVol(cv,renamer ty) | Type_cocci.Pointer(ty) -> Type_cocci.Pointer(renamer ty) | Type_cocci.FunctionPointer(ty) -> Type_cocci.FunctionPointer(renamer ty) | Type_cocci.Array(ty) -> Type_cocci.Array(renamer ty) | t -> t in Some(List.map renamer types) in Ast0.clear_test_exp (Ast0.rewrap e (Ast0.MetaExpr (Ast0.set_mcode_data new_mv name,constraints, new_types,form,pure)))) | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported" | Ast0.MetaExprList(namea,lenname,pure) -> failwith "metaexprlist not supported" | Ast0.Unary(exp,unop) -> (match Ast0.unwrap_mcode unop with (* propagate negation only when the propagated and the encountered negation have the same transformation, when there is nothing added to the original one, and when there is nothing added to the expression into which we are doing the propagation. This may be too conservative. *) Ast.Not -> let was_meta = (* k e doesn't change the outer structure of the term, only the metavars *) match Ast0.unwrap old_e with Ast0.Unary(exp,_) -> (match Ast0.unwrap exp with Ast0.MetaExpr(name,constraints,x,form,pure) -> true | _ -> false) | _ -> failwith "not possible" in let nomodif = function Ast0.MINUS(x) -> (match !x with (Ast.NOREPLACEMENT,_) -> true | _ -> false) | Ast0.CONTEXT(x) | Ast0.MIXED(x) -> (match !x with (Ast.NOTHING,_,_) -> true | _ -> false) | _ -> failwith "plus not possible" in let same_modif newop oldop = (* only propagate ! is they have the same modification and no + code on the old one (the new one from the iso surely has no + code) *) match (newop,oldop) with (Ast0.MINUS(x1),Ast0.MINUS(x2)) -> nomodif oldop | (Ast0.CONTEXT(x1),Ast0.CONTEXT(x2)) -> nomodif oldop | (Ast0.MIXED(x1),Ast0.MIXED(x2)) -> nomodif oldop | _ -> false in if was_meta then let idcont x = x in let rec negate e (*for rewrapping*) res (*code to process*) k = (* k accumulates parens, to keep negation outside if no propagation is possible *) if nomodif (Ast0.get_mcodekind e) then match Ast0.unwrap res with Ast0.Unary(e1,op) when Ast0.unwrap_mcode op = Ast.Not && same_modif (Ast0.get_mcode_mcodekind unop) (Ast0.get_mcode_mcodekind op) -> k e1 | Ast0.Edots(_,_) -> k (Ast0.rewrap e (Ast0.unwrap res)) | Ast0.Paren(lp,e1,rp) -> negate e e1 (function x -> k (Ast0.rewrap res (Ast0.Paren(lp,x,rp)))) | Ast0.Binary(e1,op,e2) when same_modif (Ast0.get_mcode_mcodekind unop) (Ast0.get_mcode_mcodekind op) -> let reb nop = Ast0.rewrap_mcode op (Ast.Logical(nop)) in let k1 x = k (Ast0.rewrap e x) in (match Ast0.unwrap_mcode op with Ast.Logical(Ast.Inf) -> k1 (Ast0.Binary(e1,reb Ast.SupEq,e2)) | Ast.Logical(Ast.Sup) -> k1 (Ast0.Binary(e1,reb Ast.InfEq,e2)) | Ast.Logical(Ast.InfEq) -> k1 (Ast0.Binary(e1,reb Ast.Sup,e2)) | Ast.Logical(Ast.SupEq) -> k1 (Ast0.Binary(e1,reb Ast.Inf,e2)) | Ast.Logical(Ast.Eq) -> k1 (Ast0.Binary(e1,reb Ast.NotEq,e2)) | Ast.Logical(Ast.NotEq) -> k1 (Ast0.Binary(e1,reb Ast.Eq,e2)) | Ast.Logical(Ast.AndLog) -> k1 (Ast0.Binary(negate_reb e e1 idcont, reb Ast.OrLog, negate_reb e e2 idcont)) | Ast.Logical(Ast.OrLog) -> k1 (Ast0.Binary(negate_reb e e1 idcont, reb Ast.AndLog, negate_reb e e2 idcont)) | _ -> Ast0.rewrap e (Ast0.Unary(k res, Ast0.rewrap_mcode op Ast.Not))) | Ast0.DisjExpr(lp,exps,mids,rp) -> (* use res because it is the transformed argument *) let exps = List.map (function e1 -> negate_reb e e1 k) exps in Ast0.rewrap res (Ast0.DisjExpr(lp,exps,mids,rp)) | _ -> (*use e, because this might be the toplevel expression*) Ast0.rewrap e (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not)) else Ast0.rewrap e (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not)) and negate_reb e e1 k = (* used when ! is propagated to multiple places, to avoid duplicating mcode cells *) let start_line = Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in (rebuild_mcode start_line).VT0.rebuilder_rec_expression (negate e e1 k) in negate e exp idcont else e | _ -> e) | Ast0.Edots(d,_) -> (try (match List.assoc (dot_term d) bindings with Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Edots(d,Some exp)) | _ -> failwith "unexpected binding") with Not_found -> e) | Ast0.Ecircles(d,_) -> (try (match List.assoc (dot_term d) bindings with Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Ecircles(d,Some exp)) | _ -> failwith "unexpected binding") with Not_found -> e) | Ast0.Estars(d,_) -> (try (match List.assoc (dot_term d) bindings with Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Estars(d,Some exp)) | _ -> failwith "unexpected binding") with Not_found -> e) | _ -> e in if Ast0.get_test_exp old_e then Ast0.set_test_exp e1 else e1 in let tyfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaType(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_typeC (match lookup name bindings mv_bindings with Common.Left(Ast0.TypeCTag(ty)) -> ty | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaType(Ast0.set_mcode_data new_mv name,pure))) | _ -> e in let initfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaInit(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_initialiser (match lookup name bindings mv_bindings with Common.Left(Ast0.InitTag(ty)) -> ty | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaInit(Ast0.set_mcode_data new_mv name,pure))) | _ -> e in let declfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaDecl(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_declaration (match lookup name bindings mv_bindings with Common.Left(Ast0.DeclTag(d)) -> d | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaDecl(Ast0.set_mcode_data new_mv name, pure))) | Ast0.MetaField(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_declaration (match lookup name bindings mv_bindings with Common.Left(Ast0.DeclTag(d)) -> d | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaField(Ast0.set_mcode_data new_mv name, pure))) | Ast0.MetaFieldList(name,lenname,pure) -> failwith "metafieldlist not supported" | Ast0.Ddots(d,_) -> (try (match List.assoc (dot_term d) bindings with Ast0.DeclTag(exp) -> Ast0.rewrap e (Ast0.Ddots(d,Some exp)) | _ -> failwith "unexpected binding") with Not_found -> e) | _ -> e in let paramfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaParam(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_parameter (match lookup name bindings mv_bindings with Common.Left(Ast0.ParamTag(param)) -> param | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaParam(Ast0.set_mcode_data new_mv name, pure))) | Ast0.MetaParamList(name,lenname,pure) -> failwith "metaparamlist not supported" | _ -> e in let whenfn (_,v) = match v with Ast0.DotsStmtTag(stms) -> Ast0.WhenNot stms | Ast0.StmtTag(stm) -> Ast0.WhenAlways stm | Ast0.IsoWhenTTag(stm) -> Ast0.WhenNotTrue stm | Ast0.IsoWhenFTag(stm) -> Ast0.WhenNotFalse stm | Ast0.IsoWhenTag(x) -> Ast0.WhenModifier(x) | _ -> failwith "unexpected binding" in let stmtfn r k e = let e = k e in match Ast0.unwrap e with Ast0.MetaStmt(name,pure) -> (rebuild_mcode None).VT0.rebuilder_rec_statement (match lookup name bindings mv_bindings with Common.Left(Ast0.StmtTag(stm)) -> stm | Common.Left(_) -> failwith "not possible 1" | Common.Right(new_mv) -> Ast0.rewrap e (Ast0.MetaStmt(Ast0.set_mcode_data new_mv name,pure))) | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported" | Ast0.Dots(d,_) -> Ast0.rewrap e (Ast0.Dots (d, List.map whenfn (List.filter (function (x,v) -> x = (dot_term d)) bindings))) | Ast0.Circles(d,_) -> Ast0.rewrap e (Ast0.Circles (d, List.map whenfn (List.filter (function (x,v) -> x = (dot_term d)) bindings))) | Ast0.Stars(d,_) -> Ast0.rewrap e (Ast0.Stars (d, List.map whenfn (List.filter (function (x,v) -> x = (dot_term d)) bindings))) | _ -> e in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode (dots elist) donothing (dots plist) (dots slist) donothing donothing identfn exprfn tyfn initfn paramfn declfn stmtfn donothing donothing donothing (* --------------------------------------------------------------------- *) let is_minus e = match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false let context_required e = not(is_minus e) && not !Flag.sgrep_mode2 let disj_fail bindings e = match bindings with Some x -> Printf.fprintf stderr "no disj available at this type"; e | None -> e (* isomorphism code is by default CONTEXT *) let merge_plus model_mcode e_mcode = match model_mcode with Ast0.MINUS(mc) -> (* add the replacement information at the root *) (match e_mcode with Ast0.MINUS(emc) -> emc := (match (!mc,!emc) with ((Ast.NOREPLACEMENT,_),(x,t)) | ((x,_),(Ast.NOREPLACEMENT,t)) -> (x,t) | _ -> failwith "how can we combine minuses?") | _ -> failwith "not possible 6") | Ast0.CONTEXT(mc) -> (match e_mcode with Ast0.CONTEXT(emc) -> (* keep the logical line info as in the model *) let (mba,tb,ta) = !mc in let (eba,_,_) = !emc in (* merging may be required when a term is replaced by a subterm *) let merged = match (mba,eba) with (x,Ast.NOTHING) | (Ast.NOTHING,x) -> x | (Ast.BEFORE(b1,it1),Ast.BEFORE(b2,it2)) -> Ast.BEFORE(b1@b2,Ast.lub_count it1 it2) | (Ast.BEFORE(b,it1),Ast.AFTER(a,it2)) -> Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2) | (Ast.BEFORE(b1,it1),Ast.BEFOREAFTER(b2,a,it2)) -> Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2) | (Ast.AFTER(a,it1),Ast.BEFORE(b,it2)) -> Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2) | (Ast.AFTER(a1,it1),Ast.AFTER(a2,it2)) -> Ast.AFTER(a2@a1,Ast.lub_count it1 it2) | (Ast.AFTER(a1,it1),Ast.BEFOREAFTER(b,a2,it2)) -> Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2) | (Ast.BEFOREAFTER(b1,a,it1),Ast.BEFORE(b2,it2)) -> Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2) | (Ast.BEFOREAFTER(b,a1,it1),Ast.AFTER(a2,it2)) -> Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2) | (Ast.BEFOREAFTER(b1,a1,it1),Ast.BEFOREAFTER(b2,a2,it2)) -> Ast.BEFOREAFTER(b1@b2,a2@a1,Ast.lub_count it1 it2) in emc := (merged,tb,ta) | Ast0.MINUS(emc) -> let (anything_bef_aft,_,_) = !mc in let (anythings,t) = !emc in (match (anything_bef_aft,anythings) with (Ast.BEFORE(b1,it1),Ast.NOREPLACEMENT) -> emc := (Ast.REPLACEMENT(b1,it1),t) | (Ast.AFTER(a1,it1),Ast.NOREPLACEMENT) -> emc := (Ast.REPLACEMENT(a1,it1),t) | (Ast.BEFOREAFTER(b1,a1,it1),Ast.NOREPLACEMENT) -> emc := (Ast.REPLACEMENT(b1@a1,it1),t) | (Ast.NOTHING,Ast.NOREPLACEMENT) -> emc := (Ast.NOREPLACEMENT,t) | (Ast.BEFORE(b1,it1),Ast.REPLACEMENT(a2,it2)) -> emc := (Ast.REPLACEMENT(b1@a2,Ast.lub_count it1 it2),t) | (Ast.AFTER(a1,it1),Ast.REPLACEMENT(a2,it2)) -> emc := (Ast.REPLACEMENT(a2@a1,Ast.lub_count it1 it2),t) | (Ast.BEFOREAFTER(b1,a1,it1),Ast.REPLACEMENT(a2,it2)) -> emc := (Ast.REPLACEMENT(b1@a2@a1,Ast.lub_count it1 it2),t) | (Ast.NOTHING,Ast.REPLACEMENT(a2,it2)) -> ()) (* no change *) | Ast0.MIXED(_) -> failwith "how did this become mixed?" | _ -> failwith "not possible 7") | Ast0.MIXED(_) -> failwith "not possible 8" | Ast0.PLUS _ -> failwith "not possible 9" let copy_plus printer minusify model e = if !Flag.sgrep_mode2 then e (* no plus code, can cause a "not possible" error, so just avoid it *) else begin let e = match Ast0.get_mcodekind model with Ast0.MINUS(mc) -> minusify e | Ast0.CONTEXT(mc) -> e | _ -> failwith "not possible: copy_plus\n" in merge_plus (Ast0.get_mcodekind model) (Ast0.get_mcodekind e); e end let copy_minus printer minusify model e = match Ast0.get_mcodekind model with Ast0.MINUS(mc) -> minusify e | Ast0.CONTEXT(mc) -> e | Ast0.MIXED(_) -> if !Flag.sgrep_mode2 then e else failwith "not possible 8" | Ast0.PLUS _ -> failwith "not possible 9" let whencode_allowed prev_ecount prev_icount prev_dcount ecount icount dcount rest = (* actually, if ecount or dcount is 0, the flag doesn't matter, because it won't be tested *) let other_ecount = (* number of edots *) List.fold_left (function rest -> function (_,ec,ic,dc) -> ec + rest) prev_ecount rest in let other_icount = (* number of dots *) List.fold_left (function rest -> function (_,ec,ic,dc) -> ic + rest) prev_icount rest in let other_dcount = (* number of dots *) List.fold_left (function rest -> function (_,ec,ic,dc) -> dc + rest) prev_dcount rest in (ecount = 0 or other_ecount = 0, icount = 0 or other_icount = 0, dcount = 0 or other_dcount = 0) (* copy the befores and afters to the instantiated code *) let extra_copy_stmt_plus model e = (if not !Flag.sgrep_mode2 (* sgrep has no plus code, so nothing to do *) then (match Ast0.unwrap model with Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_) | Ast0.Decl((info,bef),_) -> (match Ast0.unwrap e with Ast0.FunDecl((info,bef1),_,_,_,_,_,_,_,_) | Ast0.Decl((info,bef1),_) -> merge_plus bef bef1 | _ -> merge_plus bef (Ast0.get_mcodekind e)) | Ast0.IfThen(_,_,_,_,_,(_,aft,_)) | Ast0.IfThenElse(_,_,_,_,_,_,_,(_,aft,_)) | Ast0.While(_,_,_,_,_,(_,aft,_)) | Ast0.For(_,_,_,_,_,_,_,_,(_,aft,_)) | Ast0.Iterator(_,_,_,_,_,(_,aft,_)) -> (match Ast0.unwrap e with Ast0.IfThen(_,_,_,_,_,(_,aft1,_)) | Ast0.IfThenElse(_,_,_,_,_,_,_,(_,aft1,_)) | Ast0.While(_,_,_,_,_,(_,aft1,_)) | Ast0.For(_,_,_,_,_,_,_,_,(_,aft1,_)) | Ast0.Iterator(_,_,_,_,_,(_,aft1,_)) -> merge_plus aft aft1 | _ -> merge_plus aft (Ast0.get_mcodekind e)) | _ -> ())); e let extra_copy_other_plus model e = e (* --------------------------------------------------------------------- *) let mv_count = ref 0 let new_mv (_,s) = let ct = !mv_count in mv_count := !mv_count + 1; "_"^s^"_"^(string_of_int ct) let get_name = function Ast.MetaMetaDecl(ar,nm) -> (nm,function nm -> Ast.MetaMetaDecl(ar,nm)) | Ast.MetaIdDecl(ar,nm) -> (nm,function nm -> Ast.MetaIdDecl(ar,nm)) | Ast.MetaFreshIdDecl(nm,seed) -> (nm,function nm -> Ast.MetaFreshIdDecl(nm,seed)) | Ast.MetaTypeDecl(ar,nm) -> (nm,function nm -> Ast.MetaTypeDecl(ar,nm)) | Ast.MetaInitDecl(ar,nm) -> (nm,function nm -> Ast.MetaInitDecl(ar,nm)) | Ast.MetaInitListDecl(ar,nm,nm1) -> (nm,function nm -> Ast.MetaInitListDecl(ar,nm,nm1)) | Ast.MetaListlenDecl(nm) -> failwith "should not be rebuilt" | Ast.MetaParamDecl(ar,nm) -> (nm,function nm -> Ast.MetaParamDecl(ar,nm)) | Ast.MetaParamListDecl(ar,nm,nm1) -> (nm,function nm -> Ast.MetaParamListDecl(ar,nm,nm1)) | Ast.MetaConstDecl(ar,nm,ty) -> (nm,function nm -> Ast.MetaConstDecl(ar,nm,ty)) | Ast.MetaErrDecl(ar,nm) -> (nm,function nm -> Ast.MetaErrDecl(ar,nm)) | Ast.MetaExpDecl(ar,nm,ty) -> (nm,function nm -> Ast.MetaExpDecl(ar,nm,ty)) | Ast.MetaIdExpDecl(ar,nm,ty) -> (nm,function nm -> Ast.MetaIdExpDecl(ar,nm,ty)) | Ast.MetaLocalIdExpDecl(ar,nm,ty) -> (nm,function nm -> Ast.MetaLocalIdExpDecl(ar,nm,ty)) | Ast.MetaExpListDecl(ar,nm,nm1) -> (nm,function nm -> Ast.MetaExpListDecl(ar,nm,nm1)) | Ast.MetaDeclDecl(ar,nm) -> (nm,function nm -> Ast.MetaDeclDecl(ar,nm)) | Ast.MetaFieldListDecl(ar,nm,nm1) -> (nm,function nm -> Ast.MetaFieldListDecl(ar,nm,nm1)) | Ast.MetaFieldDecl(ar,nm) -> (nm,function nm -> Ast.MetaFieldDecl(ar,nm)) | Ast.MetaStmDecl(ar,nm) -> (nm,function nm -> Ast.MetaStmDecl(ar,nm)) | Ast.MetaStmListDecl(ar,nm) -> (nm,function nm -> Ast.MetaStmListDecl(ar,nm)) | Ast.MetaFuncDecl(ar,nm) -> (nm,function nm -> Ast.MetaFuncDecl(ar,nm)) | Ast.MetaLocalFuncDecl(ar,nm) -> (nm,function nm -> Ast.MetaLocalFuncDecl(ar,nm)) | Ast.MetaPosDecl(ar,nm) -> (nm,function nm -> Ast.MetaPosDecl(ar,nm)) | Ast.MetaFragListDecl(ar,nm,nm1) -> (nm,function nm -> Ast.MetaFragListDecl(ar,nm,nm1)) | Ast.MetaFmtDecl(ar,nm) -> (nm,function nm -> Ast.MetaFmtDecl(ar,nm)) | Ast.MetaAnalysisDecl(ar,nm) -> (nm,function nm -> Ast.MetaAnalysisDecl(ar,nm)) | Ast.MetaDeclarerDecl(ar,nm) -> (nm,function nm -> Ast.MetaDeclarerDecl(ar,nm)) | Ast.MetaIteratorDecl(ar,nm) -> (nm,function nm -> Ast.MetaIteratorDecl(ar,nm)) let make_new_metavars metavars bindings = let new_metavars = List.filter (function mv -> let (s,_) = get_name mv in try let _ = List.assoc s bindings in false with Not_found -> true) metavars in List.split (List.map (function mv -> let (s,rebuild) = get_name mv in let new_s = (!current_rule,new_mv s) in (rebuild new_s, (s,new_s))) new_metavars) (* --------------------------------------------------------------------- *) let do_nothing x = x let mkdisj matcher metavars alts e instantiater mkiso disj_maker minusify rebuild_mcodes name printer extra_plus update_others has_context = let call_instantiate bindings mv_bindings alts pattern has_context = List.concat (List.map (function (a,_,_,_) -> nub (* no need to create duplicates when the bindings have no effect *) (List.map (function bindings -> let instantiated = instantiater bindings mv_bindings (rebuild_mcodes a) in let plus_added = if has_context (* ie if pat is not just a metavara *) then copy_plus printer minusify e (extra_plus e instantiated) else instantiated in if pattern = a then plus_added else (* iso tracking *) Ast0.set_iso plus_added ((name,mkiso a)::(Ast0.get_iso e))) (* keep count, not U *) bindings)) alts) in let rec inner_loop all_alts prev_ecount prev_icount prev_dcount = function [] -> Common.Left (prev_ecount, prev_icount, prev_dcount) | ((pattern,ecount,icount,dcount)::rest) -> let wc = whencode_allowed prev_ecount prev_icount prev_dcount ecount dcount icount rest in (match matcher true (context_required e) wc pattern e init_env with Fail(reason) -> if reason = NonMatch || not !Flag_parsing_cocci.show_iso_failures then () else (match matcher false false wc pattern e init_env with OK _ -> interpret_reason name (Ast0.get_line e) reason (function () -> printer e) | _ -> ()); inner_loop all_alts (prev_ecount + ecount) (prev_icount + icount) (prev_dcount + dcount) rest | OK (bindings : ((Ast.meta_name * 'a) list list)) -> let all_alts = (* apply update_others to all patterns other than the matched one. This is used to desigate the others as test expressions in the TestExpression case *) (List.map (function (x,e,i,d) as all -> if x = pattern then all else (update_others x,e,i,d)) (List.hd all_alts)) :: (List.map (List.map (function (x,e,i,d) -> (update_others x,e,i,d))) (List.tl all_alts)) in (match List.concat all_alts with [x] -> Common.Left (prev_ecount, prev_icount, prev_dcount) | all_alts -> let (new_metavars,mv_bindings) = make_new_metavars metavars (nub(List.concat bindings)) in Common.Right (new_metavars, call_instantiate bindings mv_bindings all_alts pattern (has_context pattern)))) in let rec outer_loop prev_ecount prev_icount prev_dcount = function [] | [[_]] (*only one alternative*) -> (0,[],e) (* nothing matched *) | (alts::rest) as all_alts -> match inner_loop all_alts prev_ecount prev_icount prev_dcount alts with Common.Left(prev_ecount, prev_icount, prev_dcount) -> outer_loop prev_ecount prev_icount prev_dcount rest | Common.Right (new_metavars,res) -> (1,new_metavars, copy_minus printer minusify e (disj_maker res)) in let (count,metavars,e) = outer_loop 0 0 0 alts in (count, metavars, e) (* no one should ever look at the information stored in these mcodes *) let disj_starter lst = let old_info = Ast0.get_info(List.hd lst) in let new_pos_info = { old_info.Ast0.pos_info with Ast0.line_end = old_info.Ast0.pos_info.Ast0.line_start; Ast0.logical_end = old_info.Ast0.pos_info.Ast0.logical_start; } in let info = { Ast0.pos_info = new_pos_info; Ast0.attachable_start = false; Ast0.attachable_end = false; Ast0.mcode_start = []; Ast0.mcode_end = []; Ast0.strings_before = []; Ast0.strings_after = []; Ast0.isSymbolIdent = false; } in Ast0.make_mcode_info "(" info let disj_ender lst = let old_info = Ast0.get_info(List.hd lst) in let new_pos_info = { old_info.Ast0.pos_info with Ast0.line_start = old_info.Ast0.pos_info.Ast0.line_end; Ast0.logical_start = old_info.Ast0.pos_info.Ast0.logical_end; } in let info = { Ast0.pos_info = new_pos_info; Ast0.attachable_start = false; Ast0.attachable_end = false; Ast0.mcode_start = []; Ast0.mcode_end = []; Ast0.strings_before = []; Ast0.strings_after = []; Ast0.isSymbolIdent = false; } in Ast0.make_mcode_info ")" info let disj_mid _ = Ast0.make_mcode "|" let make_disj_type tl = let mids = match tl with [] -> failwith "bad disjunction" | x::xs -> List.map disj_mid xs in Ast0.context_wrap (Ast0.DisjType(disj_starter tl,tl,mids,disj_ender tl)) let make_disj_stmt_list tl = let mids = match tl with [] -> failwith "bad disjunction" | x::xs -> List.map disj_mid xs in Ast0.context_wrap (Ast0.Disj(disj_starter tl,tl,mids,disj_ender tl)) let make_disj_expr model el = let mids = match el with [] -> failwith "bad disjunction" | x::xs -> List.map disj_mid xs in let update_arg x = if Ast0.get_arg_exp model then Ast0.set_arg_exp x else x in let update_test x = let x = if Ast0.get_test_pos model then Ast0.set_test_pos x else x in if Ast0.get_test_exp model then Ast0.set_test_exp x else x in let el = List.map update_arg (List.map update_test el) in Ast0.context_wrap (Ast0.DisjExpr(disj_starter el,el,mids,disj_ender el)) let make_disj_decl dl = let mids = match dl with [] -> failwith "bad disjunction" | x::xs -> List.map disj_mid xs in Ast0.context_wrap (Ast0.DisjDecl(disj_starter dl,dl,mids,disj_ender dl)) let make_disj_stmt sl = let dotify x = Ast0.context_wrap (Ast0.DOTS[x]) in let mids = match sl with [] -> failwith "bad disjunction" | x::xs -> List.map disj_mid xs in Ast0.context_wrap (Ast0.Disj(disj_starter sl,List.map dotify sl,mids,disj_ender sl)) let transform_type (metavars,alts,name) e = match alts with (Ast0.TypeCTag(_)::_)::_ -> (* start line is given to any leaves in the iso code *) let start_line = Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in let alts = List.map (List.map (function Ast0.TypeCTag(p) -> (p,count_edots.VT0.combiner_rec_typeC p, count_idots.VT0.combiner_rec_typeC p, count_dots.VT0.combiner_rec_typeC p) | _ -> failwith "invalid alt")) alts in mkdisj match_typeC metavars alts e (function b -> function mv_b -> (instantiate b mv_b).VT0.rebuilder_rec_typeC) (function t -> Ast0.TypeCTag t) make_disj_type make_minus.VT0.rebuilder_rec_typeC (rebuild_mcode start_line).VT0.rebuilder_rec_typeC name Unparse_ast0.typeC extra_copy_other_plus do_nothing (function x -> match Ast0.unwrap x with Ast0.MetaType _ -> false | _ -> true) | _ -> (0,[],e) let transform_expr (metavars,alts,name) e = let process update_others = (* start line is given to any leaves in the iso code *) let start_line = Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in let alts = List.map (List.map (function Ast0.ExprTag(p) | Ast0.ArgExprTag(p) | Ast0.TestExprTag(p) -> (p,count_edots.VT0.combiner_rec_expression p, count_idots.VT0.combiner_rec_expression p, count_dots.VT0.combiner_rec_expression p) | _ -> failwith "invalid alt")) alts in mkdisj match_expr metavars alts e (function b -> function mv_b -> (instantiate b mv_b).VT0.rebuilder_rec_expression) (function e -> Ast0.ExprTag e) (make_disj_expr e) make_minus.VT0.rebuilder_rec_expression (rebuild_mcode start_line).VT0.rebuilder_rec_expression name Unparse_ast0.expression extra_copy_other_plus update_others (function x -> match Ast0.unwrap x with Ast0.MetaExpr _ | Ast0.MetaExprList _ | Ast0.MetaErr _ -> false | _ -> true) in match alts with (Ast0.ExprTag(_)::r)::rs -> (* hack to accomodate ToTestExpression case, where the first pattern is a normal expression, but the others are test expressions *) let others = r @ (List.concat rs) in let is_test = function Ast0.TestExprTag(_) -> true | _ -> false in if List.for_all is_test others then process Ast0.set_test_exp else if List.exists is_test others then failwith "inconsistent iso" else process do_nothing | (Ast0.ArgExprTag(_)::_)::_ when Ast0.get_arg_exp e -> process do_nothing | (Ast0.TestExprTag(_)::_)::_ when Ast0.get_test_pos e -> process Ast0.set_test_exp | _ -> (0,[],e) let transform_decl (metavars,alts,name) e = match alts with (Ast0.DeclTag(_)::_)::_ -> (* start line is given to any leaves in the iso code *) let start_line = Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in let alts = List.map (List.map (function Ast0.DeclTag(p) -> (p,count_edots.VT0.combiner_rec_declaration p, count_idots.VT0.combiner_rec_declaration p, count_dots.VT0.combiner_rec_declaration p) | _ -> failwith "invalid alt")) alts in mkdisj match_decl metavars alts e (function b -> function mv_b -> (instantiate b mv_b).VT0.rebuilder_rec_declaration) (function d -> Ast0.DeclTag d) make_disj_decl make_minus.VT0.rebuilder_rec_declaration (rebuild_mcode start_line).VT0.rebuilder_rec_declaration name Unparse_ast0.declaration extra_copy_other_plus do_nothing (function _ -> true (* no metavars *)) | _ -> (0,[],e) let transform_stmt (metavars,alts,name) e = match alts with (Ast0.StmtTag(_)::_)::_ -> (* start line is given to any leaves in the iso code *) let start_line = Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in let alts = List.map (List.map (function Ast0.StmtTag(p) -> (p,count_edots.VT0.combiner_rec_statement p, count_idots.VT0.combiner_rec_statement p, count_dots.VT0.combiner_rec_statement p) | _ -> failwith "invalid alt")) alts in mkdisj match_statement metavars alts e (function b -> function mv_b -> (instantiate b mv_b).VT0.rebuilder_rec_statement) (function s -> Ast0.StmtTag s) make_disj_stmt make_minus.VT0.rebuilder_rec_statement (rebuild_mcode start_line).VT0.rebuilder_rec_statement name (Unparse_ast0.statement "") extra_copy_stmt_plus do_nothing (function x -> match Ast0.unwrap x with Ast0.MetaStmt _ | Ast0.MetaStmtList _ -> false | _ -> true) | _ -> (0,[],e) (* sort of a hack, because there is no disj at top level *) let transform_top (metavars,alts,name) e = match Ast0.unwrap e with Ast0.NONDECL(declstm) -> (try let strip alts = List.map (List.map (function Ast0.DotsStmtTag(d) -> (match Ast0.unwrap d with Ast0.DOTS([s]) -> Ast0.StmtTag(s) | _ -> raise (Failure "")) | _ -> raise (Failure ""))) alts in let (count,mv,s) = transform_stmt (metavars,strip alts,name) declstm in (count,mv,Ast0.rewrap e (Ast0.NONDECL(s))) with Failure _ -> (0,[],e)) | Ast0.CODE(stmts) -> let (count,mv,res) = match alts with (Ast0.DotsStmtTag(_)::_)::_ -> (* start line is given to any leaves in the iso code *) let start_line = Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in let alts = List.map (List.map (function Ast0.DotsStmtTag(p) -> (p,count_edots.VT0.combiner_rec_statement_dots p, count_idots.VT0.combiner_rec_statement_dots p, count_dots.VT0.combiner_rec_statement_dots p) | _ -> failwith "invalid alt")) alts in mkdisj match_statement_dots metavars alts stmts (function b -> function mv_b -> (instantiate b mv_b).VT0.rebuilder_rec_statement_dots) (function s -> Ast0.DotsStmtTag s) (function x -> Ast0.rewrap e (Ast0.DOTS([make_disj_stmt_list x]))) (function x -> make_minus.VT0.rebuilder_rec_statement_dots x) (rebuild_mcode start_line).VT0.rebuilder_rec_statement_dots name Unparse_ast0.statement_dots extra_copy_other_plus do_nothing (function _ -> true) | _ -> (0,[],stmts) in (count,mv,Ast0.rewrap e (Ast0.CODE res)) | _ -> (0,[],e) (* --------------------------------------------------------------------- *) let transform (alts : isomorphism) t = (* the following ugliness is because rebuilder only returns a new term *) let extra_meta_decls = ref ([] : Ast_cocci.metavar list) in let in_limit n = function None -> true | Some n1 -> n < n1 or ((if !Flag_parsing_cocci.show_iso_failures then Common.pr2_once "execeeded iso threshold, see -iso_limit option"); false) in let bind x y = x + y in let option_default = 0 in let exprfn r k e = let (e_count,e) = k e in if in_limit e_count !Flag_parsing_cocci.iso_limit then let (count,extra_meta,exp) = transform_expr alts e in extra_meta_decls := extra_meta @ !extra_meta_decls; (bind count e_count,exp) else (e_count,e) in let declfn r k e = let (e_count,e) = k e in if in_limit e_count !Flag_parsing_cocci.iso_limit then let (count,extra_meta,dec) = transform_decl alts e in extra_meta_decls := extra_meta @ !extra_meta_decls; (bind count e_count,dec) else (e_count,e) in let stmtfn r k e = let (e_count,e) = k e in if in_limit e_count !Flag_parsing_cocci.iso_limit then let (count,extra_meta,stm) = transform_stmt alts e in extra_meta_decls := extra_meta @ !extra_meta_decls; (bind count e_count,stm) else (e_count,e) in let typefn r k e = let (continue,e_count,e) = match Ast0.unwrap e with Ast0.Signed(signb,tyb) -> (* Hack! How else to prevent iso from applying under an unsigned??? *) (true,0,e) | _ -> let (e_count,e) = k e in if in_limit e_count !Flag_parsing_cocci.iso_limit then (true,e_count,e) else (false,e_count,e) in if continue then let (count,extra_meta,ty) = transform_type alts e in extra_meta_decls := extra_meta @ !extra_meta_decls; (bind count e_count,ty) else (e_count,e) in let topfn r k e = let (e_count,e) = k e in if in_limit e_count !Flag_parsing_cocci.iso_limit then let (count,extra_meta,ty) = transform_top alts e in extra_meta_decls := extra_meta @ !extra_meta_decls; (bind count e_count,ty) else (e_count,e) in let res = V0.combiner_rebuilder bind option_default {V0.combiner_rebuilder_functions with VT0.combiner_rebuilder_exprfn = exprfn; VT0.combiner_rebuilder_tyfn = typefn; VT0.combiner_rebuilder_declfn = declfn; VT0.combiner_rebuilder_stmtfn = stmtfn; VT0.combiner_rebuilder_topfn = topfn} in let (_,res) = res.VT0.top_level t in (!extra_meta_decls,res) (* --------------------------------------------------------------------- *) (* should be done by functorizing the parser to use wrap or context_wrap *) let rewrap = let mcode (x,a,i,mc,pos,adj) = (x,a,i,Ast0.context_befaft(),pos,adj) in let donothing r k e = Ast0.context_wrap(Ast0.unwrap(k e)) in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing let rewrap_anything = function Ast0.DotsExprTag(d) -> Ast0.DotsExprTag(rewrap.VT0.rebuilder_rec_expression_dots d) | Ast0.DotsInitTag(d) -> Ast0.DotsInitTag(rewrap.VT0.rebuilder_rec_initialiser_list d) | Ast0.DotsParamTag(d) -> Ast0.DotsParamTag(rewrap.VT0.rebuilder_rec_parameter_list d) | Ast0.DotsStmtTag(d) -> Ast0.DotsStmtTag(rewrap.VT0.rebuilder_rec_statement_dots d) | Ast0.DotsDeclTag(d) -> Ast0.DotsDeclTag(rewrap.VT0.rebuilder_rec_declaration_dots d) | Ast0.DotsCaseTag(d) -> Ast0.DotsCaseTag(rewrap.VT0.rebuilder_rec_case_line_dots d) | Ast0.IdentTag(d) -> Ast0.IdentTag(rewrap.VT0.rebuilder_rec_ident d) | Ast0.ExprTag(d) -> Ast0.ExprTag(rewrap.VT0.rebuilder_rec_expression d) | Ast0.ArgExprTag(d) -> Ast0.ArgExprTag(rewrap.VT0.rebuilder_rec_expression d) | Ast0.TestExprTag(d) -> Ast0.TestExprTag(rewrap.VT0.rebuilder_rec_expression d) | Ast0.TypeCTag(d) -> Ast0.TypeCTag(rewrap.VT0.rebuilder_rec_typeC d) | Ast0.InitTag(d) -> Ast0.InitTag(rewrap.VT0.rebuilder_rec_initialiser d) | Ast0.ParamTag(d) -> Ast0.ParamTag(rewrap.VT0.rebuilder_rec_parameter d) | Ast0.DeclTag(d) -> Ast0.DeclTag(rewrap.VT0.rebuilder_rec_declaration d) | Ast0.StmtTag(d) -> Ast0.StmtTag(rewrap.VT0.rebuilder_rec_statement d) | Ast0.ForInfoTag(d) -> Ast0.ForInfoTag(rewrap.VT0.rebuilder_rec_forinfo d) | Ast0.CaseLineTag(d) -> Ast0.CaseLineTag(rewrap.VT0.rebuilder_rec_case_line d) | Ast0.TopTag(d) -> Ast0.TopTag(rewrap.VT0.rebuilder_rec_top_level d) | Ast0.IsoWhenTag(_) | Ast0.IsoWhenTTag(_) | Ast0.IsoWhenFTag(_) -> failwith "only for isos within iso phase" | Ast0.MetaPosTag(p) -> Ast0.MetaPosTag(p) | Ast0.HiddenVarTag(p) -> Ast0.HiddenVarTag(p) (* not sure it is possible *) (* --------------------------------------------------------------------- *) let apply_isos isos rule rule_name = if isos = [] then ([],rule) else begin current_rule := rule_name; let isos = List.map (function (metavars,iso,name) -> (metavars,List.map (List.map rewrap_anything) iso,name)) isos in let (extra_meta,rule) = List.split (List.map (function t -> List.fold_left (function (extra_meta,t) -> function iso -> let (new_extra_meta,t) = transform iso t in (new_extra_meta@extra_meta,t)) ([],t) isos) rule) in (List.concat extra_meta, (Compute_lines.compute_lines true) rule) end coccinelle-1.0.0-rc19/parsing_cocci/parse_cocci.mli0000644000175000017500000000406012247442615021143 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./parse_cocci.mli" exception Bad_virt of string val process : string (* filename *) -> string option (* iso filename *) -> bool (* verbose? *) -> (Ast_cocci.metavar list list) * (Ast_cocci.rule list) * Ast_cocci.meta_name list list list (*fvs of the rule*) * Ast_cocci.meta_name list list list (*negated pos vars*) * (Ast_cocci.meta_name list list list (*used after list*) * (*fresh used after list*) Ast_cocci.meta_name list list list * (*fresh used after list seeds*) Ast_cocci.meta_name list list list) * Ast_cocci.meta_name list list list (*positions list*) * (string list option (*non metavars in - code, for grep*) * string list option (*non metavars in - code, for glimpse/google*)* (Str.regexp * Str.regexp list) option(*cocci-grep result, if any*) * (*non metavars in - code, for other tools*) Get_constants2.combine option) * (* true if string constants need to be parsed *) bool coccinelle-1.0.0-rc19/main.ml0000644000175000017500000012366712247442614014657 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./main.ml" open Common module FC = Flag_cocci (*****************************************************************************) (* Flags *) (*****************************************************************************) (* In addition to flags that can be tweaked via -xxx options (cf the * full list of options in "the spatch options" section below), the * spatch program also depends on external files, described in * globals/config.ml, mainly a standard.h and standard.iso file *) let cocci_file = ref "" let output_file = ref "" let inplace_modif = ref false (* but keeps nothing *) let backup_suffix = ref (None : string option) (* suffix for backup if one is desired *) let outplace_modif = ref false (* generates a .cocci_res *) let preprocess = ref false (* run the C preprocessor before cocci *) let compat_mode = ref false let ignore_unknown_opt = ref false (* somehow obsolete now *) let dir = ref false let kbuild_info = ref "" let macro_file = ref "" (* test mode *) let test_mode = ref false let test_all = ref false let test_okfailed = ref false let test_regression_okfailed = ref false let expected_score_file = ref "" let allow_update_score_file = ref true (* action mode *) let action = ref "" (* works with -test but also in "normal" spatch mode *) let compare_with_expected = ref false let distrib_index = ref (None : int option) let distrib_max = ref (None : int option) let mod_distrib = ref false (*****************************************************************************) (* Profiles *) (*****************************************************************************) (* pair of (list of flags to set true, list of flags to set false *) let very_quiet_profile = ( [ ], [ (* FC.show_diff; just leave this as it is *) Common.print_to_stderr; Flag.show_misc; Flag.show_trying; Flag.show_transinfo; FC.show_c; FC.show_cocci; FC.show_flow; FC.show_before_fixed_flow; FC.show_ctl_tex; FC.show_ctl_text; FC.show_binding_in_out; FC.verbose_cocci; Flag_parsing_c.show_parsing_error; Flag_parsing_c.verbose_lexing; Flag_parsing_c.verbose_parsing; Flag_parsing_c.verbose_type; Flag_parsing_c.verbose_cfg; Flag_parsing_c.verbose_unparsing; Flag_parsing_c.verbose_visit; Flag_parsing_c.verbose_cpp_ast; Flag_matcher.verbose_matcher; Flag_matcher.debug_engine; Flag_parsing_c.debug_unparsing; Flag_parsing_cocci.show_SP; Flag_parsing_cocci.show_iso_failures; Flag_ctl.verbose_ctl_engine; Flag_ctl.verbose_match; ]) let quiet_profile = ( [ Common.print_to_stderr ], [ (* FC.show_diff; just leave this as it is *) Flag.show_misc; Flag.show_trying; Flag.show_transinfo; FC.show_c; FC.show_cocci; FC.show_flow; FC.show_before_fixed_flow; FC.show_ctl_tex; FC.show_ctl_text; FC.show_binding_in_out; FC.verbose_cocci; Flag_parsing_c.show_parsing_error; Flag_parsing_c.verbose_lexing; Flag_parsing_c.verbose_parsing; Flag_parsing_c.verbose_type; Flag_parsing_c.verbose_cfg; Flag_parsing_c.verbose_unparsing; Flag_parsing_c.verbose_visit; Flag_parsing_c.verbose_cpp_ast; Flag_matcher.verbose_matcher; Flag_matcher.debug_engine; Flag_parsing_c.debug_unparsing; Flag_parsing_cocci.show_SP; Flag_parsing_cocci.show_iso_failures; Flag_ctl.verbose_ctl_engine; Flag_ctl.verbose_match; ]) (* some information that is useful in seeing why a semantic patch doesn't work properly *) let debug_profile = ( [ Common.print_to_stderr; Flag.show_misc; Flag.show_transinfo; FC.show_diff; FC.show_cocci; FC.show_binding_in_out; FC.show_dependencies; Flag_parsing_cocci.keep_ml_script; Flag_parsing_cocci.show_iso_failures; FC.verbose_cocci; Flag_parsing_c.verbose_cfg; Flag_parsing_c.verbose_unparsing; Flag_parsing_c.verbose_visit; Flag_matcher.verbose_matcher; Flag_parsing_c.show_parsing_error; ], [ Flag.show_misc; FC.show_c; FC.show_flow; FC.show_before_fixed_flow; FC.show_ctl_tex; FC.show_ctl_text; Flag_parsing_cocci.show_SP; Flag_ctl.verbose_ctl_engine; Flag_ctl.verbose_match; Flag_matcher.debug_engine; Flag_parsing_c.debug_unparsing; Flag_parsing_c.verbose_type; Flag_parsing_c.verbose_parsing; ]) let pad_profile = ( [ FC.show_diff; Common.print_to_stderr; ], [ Flag.show_misc; Flag.show_transinfo; FC.show_c; FC.show_cocci; FC.show_flow; FC.show_before_fixed_flow; FC.show_ctl_tex; FC.show_ctl_text; FC.show_binding_in_out; Flag_parsing_cocci.show_SP; Flag_parsing_cocci.show_iso_failures; Flag_ctl.verbose_ctl_engine; Flag_ctl.verbose_match; Flag_matcher.debug_engine; Flag_parsing_c.debug_unparsing; Flag_parsing_c.verbose_type; Flag_parsing_c.verbose_parsing; ]) let run_profile p = let (set_to_true, set_to_false) = p in List.iter (fun x -> x := false) set_to_false; List.iter (fun x -> x := true) set_to_true (*****************************************************************************) (* The spatch options *) (*****************************************************************************) let usage_msg = "Usage: " ^ basename Sys.argv.(0) ^ " --sp-file [-o ] [--iso-file ] [options]" ^ "\n" ^ "Options are:" (* forward reference trick *) let short_usage_func = ref (fun () -> ()) let long_usage_func = ref (fun () -> ()) (* The short_options are user-oriented. The other options are for * the developers of coccinelle or advanced-users that know * quite well the underlying semantics of coccinelle. *) (* will be printed when use only ./spatch. For the rest you have to * use -longhelp to see them. *) let short_options = [ "--sp-file", Arg.Set_string cocci_file, " the semantic patch file"; "-o", Arg.Set_string output_file, " the output file"; "--in-place", Arg.Set inplace_modif, " do the modification on the file directly"; "--backup-suffix", Arg.String (function s -> backup_suffix := Some s), " suffix to use when making a backup for inplace"; "--out-place", Arg.Set outplace_modif, " store modifications in a .cocci_res file"; "--reverse", Arg.Set Flag_parsing_cocci.interpret_inverted, " invert the semantic patch before applying it"; "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)), " set number of diff context lines"; "--partial-match", Arg.Set Flag_ctl.partial_match, " report partial matches of the SP on the C file"; "--iso-file", Arg.Set_string Config.std_iso, " (default=" ^ !Config.std_iso ^")"; "--macro-file", Arg.Set_string macro_file, " "; "--macro-file-builtins", Arg.Set_string Config.std_h, " (default=" ^ !Config.std_h ^ ")"; "--recursive-includes", Arg.Unit (function _ -> FC.include_options := FC.I_REALLY_ALL_INCLUDES), " causes all available include files, both those included in the C file(s) and those included in header files, to be used"; "--all-includes", Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES), " causes all available include files included in the C file(s) to be used"; "--no-includes", Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES), " causes not even local include files to be used"; "--local-includes", Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES), " causes local include files to be used"; "--ignore-unknown-options", Arg.Set ignore_unknown_opt, " For integration in a toolchain (must be set before the first unknown option)"; "--include-headers", Arg.Set Flag.include_headers, " process header files independently"; "-I", Arg.String (fun x -> FC.include_path:= x::!FC.include_path), " containing the header files"; "--include", Arg.String (fun x -> FC.extra_includes:=x::!FC.extra_includes), " file to consider as being included"; "--preprocess", Arg.Set preprocess, " run the C preprocessor before applying the semantic match"; "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode"; "--dir", Arg.Set dir, " process all files in directory recursively"; "--no-scanner", Arg.Unit (function _ -> Flag.scanner := Flag.NoScanner), " no indexing"; "--use-glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse), " works with -dir, use info generated by glimpseindex"; "--use-idutils", Arg.String (function s -> Flag_parsing_cocci.id_utils_index := s; Flag.scanner := Flag.IdUtils), " find relevant files using id-utils"; "--use-coccigrep", Arg.Unit (function _ -> Flag.scanner := Flag.CocciGrep), " find relevant files using cocci grep"; "--patch", Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)), (" path name with respect to which a patch should be created\n"^ " \"\" for a file in the current directory"); "--kbuild-info", Arg.Set_string kbuild_info, " improve -dir by grouping related c files"; "--pyoutput", Arg.Set_string Flag.pyoutput, " Sets output routine: Standard values: "; "--version", Arg.Unit (fun () -> let withpython = if Pycocci.python_support then "with" else "without" in let whichregexp = if !Regexp.pcre_support then "with PCRE support" else "with Str regexp support " in Printf.printf "spatch version %s %s Python support and %s\n" Config.version withpython whichregexp; exit 0; ), " guess what"; "--date", Arg.Unit (fun () -> Printf.printf "version: $Date$"; raise (Common.UnixExit 0) ), " guess what"; "--shorthelp", Arg.Unit (fun () -> !short_usage_func(); raise (Common.UnixExit 0) ), " see short list of options"; "--longhelp", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " see all the available options in different categories"; "-help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " "; "--help", Arg.Unit (fun () -> !long_usage_func(); raise (Common.UnixExit 0) ), " "; ] (* the format is a list of triples: * (title of section * (optional) explanation of sections * option list) *) let other_options = [ "aliases and obsolete options", "", [ "--sp", Arg.Unit (function _ -> failwith "impossible"), " command line semantic patch"; "--iso", Arg.Set_string Config.std_iso, " short option of --iso-file"; "--cocci-file", Arg.Set_string cocci_file, " the semantic patch file"; (* "-c", Arg.Set_string cocci_file, " short option of -sp_file"; *) ]; "most useful show options", "", [ "--show-diff" , Arg.Set FC.show_diff, " "; "--no-show-diff" , Arg.Clear FC.show_diff, " "; "--force-diff" , Arg.Set FC.force_diff, "show diff even if only spacing changes"; "--show-flow" , Arg.Set FC.show_flow, " "; (* works in conjunction with -show_ctl_text *) "--ctl-inline-let", Arg.Unit (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " "; "--ctl-show-mcodekind", Arg.Unit (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true), " "; "--show-bindings", Arg.Set FC.show_binding_in_out, " "; "--show-transinfo", Arg.Set Flag.show_transinfo, " "; "--show-misc", Arg.Set Flag.show_misc, " "; "--show-trying", Arg.Set Flag.show_trying, " show the name of each function being processed"; "--show-dependencies", Arg.Unit (function _ -> FC.show_dependencies := true; FC.show_binding_in_out := true), " show the dependencies related to each rule"; ]; "verbose subsystems options", "", [ "--verbose-ctl-engine", Arg.Unit (function _ -> Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " "; "--verbose-match", Arg.Set Flag_ctl.verbose_match, " "; "--verbose-engine", Arg.Set Flag_matcher.debug_engine, " "; "--graphical-trace", Arg.Set Flag_ctl.graphical_trace, " generate a pdf file representing the matching process"; "--gt-without-label", Arg.Unit (function _ -> Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true), " remove graph label (requires option -graphical-trace)"; "--parse-error-msg", Arg.Set Flag_parsing_c.show_parsing_error, " "; "--verbose-parsing", Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true; Flag_parsing_c.show_parsing_error := true), " "; "--type-error-msg", Arg.Set Flag_parsing_c.verbose_type, " "; (* could also use Flag_parsing_c.options_verbose *) ]; "other show options", "", [ "--show-c" , Arg.Set FC.show_c, " "; "--show-cocci" , Arg.Set FC.show_cocci, " "; "--show-before-fixed-flow" , Arg.Set FC.show_before_fixed_flow, " "; "--show-ctl-tex" , Arg.Set FC.show_ctl_tex, " "; "--show-ctl-text" , Arg.Set FC.show_ctl_text, " "; "--show-SP" , Arg.Set Flag_parsing_cocci.show_SP, " "; ]; "debug C parsing/unparsing", "", [ "--debug-cpp", Arg.Set Flag_parsing_c.debug_cpp, " "; "--debug-lexer", Arg.Set Flag_parsing_c.debug_lexer , " "; "--debug-etdt", Arg.Set Flag_parsing_c.debug_etdt , " "; "--debug-typedef", Arg.Set Flag_parsing_c.debug_typedef, " "; "--filter-msg", Arg.Set Flag_parsing_c.filter_msg , " filter some cpp message when the macro is a \"known\" cpp construct"; "--filter-define-error", Arg.Set Flag_parsing_c.filter_define_error," "; "--filter-msg-define-error", Arg.Set Flag_parsing_c.filter_msg_define_error, " filter the error msg"; "--filter-passed-level", Arg.Set_int Flag_parsing_c.filter_passed_level," "; (* debug cfg doesn't seem to have any effect, so drop it as an option *) (* "--debug_cfg", Arg.Set Flag_parsing_c.debug_cfg , " "; *) "--debug-unparsing", Arg.Set Flag_parsing_c.debug_unparsing, " "; ]; (* could use Flag_parsing_c.options_debug_with_title instead *) "shortcut for enabling/disabling a set of debugging options at once", "", [ (* todo: other profile ? *) "--quiet", Arg.Unit (fun () -> run_profile quiet_profile), " "; "--very-quiet", Arg.Unit (fun () -> run_profile very_quiet_profile), " "; "--debug", Arg.Unit (fun () -> run_profile debug_profile), " "; "--pad", Arg.Unit (fun () -> run_profile pad_profile), " "; ]; "bench options", "", [ "--profile", Arg.Unit (function () -> Common.profile := Common.PALL) , " gather timing information about the main coccinelle functions"; "--bench", Arg.Int (function x -> Flag_ctl.bench := x), " for profiling the CTL engine"; "--timeout", Arg.Int (fun x -> FC.timeout := Some x), " timeout in seconds"; "--steps", Arg.Int (fun x -> Flag_ctl.steps := Some x), " max number of model checking steps per code unit"; "--iso-limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x), " max depth of iso application"; "--no-iso-limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None), " disable limit on max depth of iso application"; "--track-iso", Arg.Set Flag.track_iso_usage, " gather information about isomorphism usage"; "--disable-iso", Arg.String (fun s -> Flag_parsing_cocci.disabled_isos := s :: !Flag_parsing_cocci.disabled_isos), " disable a specific isomorphism"; "--profile-iso", Arg.Unit (function () -> Common.profile := (*post_engine not included, because it doesn't use isos*) PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]), " gather information about the cost of isomorphism usage" ]; "change of algorithm options", "", [ (* "--popl", Arg.Set FC.popl, " simplified SmPL, for the popl paper"; "--popl_mark_all", Arg.Unit (function _ -> FC.popl := true; Flag_popl.mark_all := true), " simplified SmPL, for the popl paper"; "--popl_keep_all_wits", Arg.Unit (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true), " simplified SmPL, for the popl paper"; "--hrule", Arg.String (function s -> Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES), " semantic patch generation"; *) "--keep-comments", Arg.Set Flag_parsing_c.keep_comments, " keep comments around removed code"; "--loop", Arg.Set Flag_ctl.loop_in_src_code, " "; "--no-loops", Arg.Set Flag_parsing_c.no_loops, " drop all back edges derived from looping constructs - unsafe"; "--no-gotos", Arg.Set Flag_parsing_c.no_gotos, " drop all jumps derived from gotos - unsafe"; "--no-saved-typedefs", Arg.Clear Flag_cocci.use_saved_typedefs, " drop all inferred typedefs from one parse of some code to the next"; "--ocaml-regexps", Arg.Clear Regexp.pcre_support, " use OCaml Str regular expressions for constraints"; "--l1", Arg.Clear Flag_parsing_c.label_strategy_2, " "; "--ifdef-to-if", Arg.Set FC.ifdef_to_if, " convert ifdef to if (experimental)"; "--no-ifdef-to-if", Arg.Clear FC.ifdef_to_if, " convert ifdef to if (experimental)"; "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " "; "--noif0-passing", Arg.Clear Flag_parsing_c.if0_passing, " "; "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " "; "--undefined", Arg.String (Flag_parsing_c.add Flag_parsing_c.undefined), " "; "--noadd-typedef-root", Arg.Clear Flag_parsing_c.add_typedef_root, " "; (* could use Flag_parsing_c.options_algo instead *) "--disallow-nested-exps", Arg.Set Flag_matcher.disallow_nested_exps, " disallow an expresion pattern from matching a term and its subterm"; "--disable-worth-trying-opt", Arg.Clear Flag.worth_trying_opt, " "; "--selected-only", Arg.Set FC.selected_only, " only show selected files"; "--only-return-is-error-exit", Arg.Set Flag_matcher.only_return_is_error_exit, "if this flag is not set, then break and continue are also error exits"; (* the following is a hack to make it easier to add code in sgrep-like code, essentially to compensate for the fact that we don't have any way of printing things out *) "--allow-inconsistent-paths", Arg.Set Flag_matcher.allow_inconsistent_paths, " if this flag is set don't check for inconsistent paths; dangerous"; "--no-safe-expressions", Arg.Set Flag_matcher.no_safe_expressions, " make an expression disjunction not prioritise the topmost disjunct"; "--int-bits", Arg.Int Flag_parsing_c.set_int_bits, " the number of bits in an unsigned int"; "--long-bits", Arg.Int Flag_parsing_c.set_long_bits, " the number of bits in an unsigned long"; "--linux-spacing", Arg.Unit Flag_parsing_c.set_linux_spacing, " spacing of + code follows the conventions of Linux"; "--smpl-spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing, " spacing of + code follows the semantic patch"; "-D", Arg.String Flag.set_defined_virtual_rules, " indicate that a virtual rule should be considered to be matched"; "--c++", Arg.Set Flag.c_plus_plus, " make a small attempt to parse C++ files"; "--ibm", Arg.Set Flag.ibm, " make a small attempt to parse IBM C files"; ]; "misc options", "", [ "--debugger", Arg.Set Common.debugger, " option to set if launch spatch in ocamldebug"; "--disable-once", Arg.Set Common.disable_pr2_once, " to print more messages"; "--show-trace-profile", Arg.Set Common.show_trace_profile, " show trace"; "--save-tmp-files", Arg.Set Common.save_tmp_files, " "; "--external-analysis-file", Arg.String (Externalanalysis.load_external_results), " import results from an external analysis"; ]; "concurrency", "", [ "--index", Arg.Int (function x -> distrib_index := Some x) , " the processor to use for this run of spatch"; "--max", Arg.Int (function x -> distrib_max := Some x) , " the number of processors available"; "--mod-distrib", Arg.Set mod_distrib, " use mod to distribute files among the processors"; ]; "pad options", "", [ "--use-cache", Arg.Set Flag_parsing_c.use_cache, " use .ast_raw pre-parsed cached C file"; "--cache-prefix", Arg.String (function s -> Flag_parsing_c.cache_prefix := Some s; Flag_parsing_c.use_cache := true), " directory of cached ASTs, sets --use-cache"; (* could use Flag_parsing_c.options_pad instead *) "--cache-limit", Arg.Int (function n -> Flag_parsing_c.cache_limit := Some n; Flag_parsing_c.use_cache := true), " maximum number of cached ASTs, sets --use-cache"; ]; "test mode and test options (works with tests/ or .ok files)", "The test options don't work with the --sp-file and so on.", [ "--test", Arg.Set test_mode, " launch spatch on tests/file.[c,cocci]"; "--testall", Arg.Set test_all, " launch spatch on all files in tests/ having a .res"; "--test-okfailed", Arg.Set test_okfailed, " generates .{ok,failed,spatch_ok} files using .res files"; "--test-regression-okfailed", Arg.Set test_regression_okfailed, " process the .{ok,failed,spatch_ok} files in current dir"; "--compare-with-expected", Arg.Set compare_with_expected, " use also file.res"; "--expected-score-file", Arg.Set_string expected_score_file, " which score file to compare with in -testall"; "--no-update-score-file", Arg.Clear allow_update_score_file, " do not update the score file when -testall succeeds"; "--relax-include-path", Arg.Set FC.relax_include_path, " "; ]; "action mode", ("The action options don't work with the --sp-file and so on." ^ "\n" ^ "It's for the other (internal) uses of the spatch program." ), (* -token_c, -parse_c, etc *) ((Common.options_of_actions action (Test_parsing_c.actions())) ++ [ (let s = "--parse-cocci" in s, Arg.Unit (fun () -> action := s), " "); (let s = "--compare-c" in s, Arg.Unit (fun () -> action := s), " "); ]); ] let all_options = short_options ++ List.concat (List.map Common.thd3 other_options) (* I don't want the -help and --help that are appended by Arg.align *) let arg_align2 xs = Arg.align xs +> List.rev +> Common.drop 2 +> List.rev (* Ignore unknown option This simplifies the integration of Coccinelle in toolchain. For instance, spatch can then be used as a checker in the Linux build system. *) let check_include_path () = let opt = Array.get Sys.argv !Arg.current in let is_include_re = Str.regexp "-I\\(.*\\)" in if Str.string_match is_include_re opt 0 then let path = Str.matched_group 1 opt in FC.include_path:= path::!FC.include_path else () let rec arg_parse_no_fail l f msg = try check_include_path (); Arg.parse_argv Sys.argv l f msg; with | Arg.Bad emsg -> arg_parse_no_fail l f msg | Arg.Help msg -> (* printf "%s" msg; exit 0; *) raise (Impossible 165) (* -help is specified in speclist *) (* copy paste of Arg.parse. Don't want the default -help msg *) let arg_parse2 l f msg argv = (try Arg.parse_argv argv l f msg; with | Arg.Bad emsg -> (* eprintf "%s" msg; exit 2; *) if not !ignore_unknown_opt then begin let xs = Common.lines emsg in (* take only head, it's where the error msg is *) pr2 (List.hd xs); !short_usage_func(); raise (Common.UnixExit (2)) end else arg_parse_no_fail l f msg; | Arg.Help msg -> (* printf "%s" msg; exit 0; *) raise (Impossible 166) (* -help is specified in speclist *) ) let short_usage () = begin Common.short_usage usage_msg short_options; pr2 ""; pr2 "Example of use:"; pr2 " ./spatch --sp-file foo.cocci foo.c -o /tmp/newfoo.c"; pr2 ""; end let long_usage () = Common.long_usage usage_msg short_options other_options let _ = short_usage_func := short_usage let _ = long_usage_func := long_usage (*****************************************************************************) (* Helpers *) (*****************************************************************************) (* for fresh identifier information *) let adjust_stdin cfiles k = match cfiles with [] -> failwith "not possible" | cfile::_ -> let newin = try let (dir, base, ext) = Common.dbe_of_filename cfile in let varfile = Common.filename_of_dbe (dir, base, "var") in if ext =$= "c" && Common.lfile_exists varfile then Some varfile else None with Invalid_argument("Filename.chop_extension") -> None in Common.redirect_stdin_opt newin k let glimpse_filter2 (_,query,_,_) dir = match query with None -> pr2 "no inferred glimpse keywords"; None | Some queries -> let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in let rec loop = function [] -> None (* error, eg due to pattern too big *) | query::queries -> Printf.fprintf stderr "%s\n" ("glimpse request = " ^ query); let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in let (glimpse_res,stat) = Common.cmd_to_list_and_status command in match stat with Unix.WEXITED(0) | Unix.WEXITED(1) -> Some (glimpse_res +> List.filter (fun file -> List.mem (Common.filesuffix file) suffixes)) | _ -> loop queries (* error, eg due to pattern too big *) in loop queries let glimpse_filter a b = Common.profile_code "glimpse_filter" (fun () -> glimpse_filter2 a b) let coccigrep_filter2 (_,_,query,_) dir = match query with None -> pr2 "no inferred keywords"; None | Some query -> Some (Test_parsing_c.get_files dir +> List.filter (Cocci_grep.interpret query)) let coccigrep_filter a b = Common.profile_code "coccigrep_filter" (fun () -> coccigrep_filter2 a b) let idutils_filter (_,_,_,query) dir = match query with None -> pr2 "no inferred idutils keywords"; None | Some query -> let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in let files = Id_utils.interpret dir query in Some (files +> List.filter (fun file -> List.mem (Common.filesuffix file) suffixes)) (*****************************************************************************) (* Main action *) (*****************************************************************************) let rec main_action xs = let (cocci_files,xs) = List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in (match (!cocci_file,cocci_files) with "",[fl] -> cocci_file := fl | _,[] -> () | _ -> failwith "only one .cocci file allowed"); Iteration.base_file_list := xs; let rec toploop = function [] -> failwith "no C files provided" | x::xs -> (* a more general solution would be to use * Common.files_of_dir_or_files (x::xs) * as some elements in xs may also be directories, or individual * files. *) dir := (Common.is_directory x); if !cocci_file =$= "" then failwith "I need a cocci file, use --sp-file "; if !dir && !Flag.patch =*= None then (match xs with | [] -> Flag.patch := Some (Cocci.normalize_path x) | _ -> pr2 ("warning: patch output can only be created when only one\n"^ "directory is specified or when the -patch flag is used") ); Flag.dir := x; let (cocci_infos,constants) = Cocci.pre_engine (!cocci_file, !Config.std_iso) in let infiles = Common.profile_code "Main.infiles computation" (fun () -> match !dir, !kbuild_info, !Flag.scanner, xs with (* glimpse *) | false, _, _, _ -> [x::xs] | true, s, (Flag.Glimpse|Flag.IdUtils|Flag.CocciGrep), _ when s <> "" -> failwith "--use-xxx filters do not work with --kbuild" | true, "", Flag.Glimpse, [] -> (*if not (null xs) then failwith "--use-glimpse can accept only one dir"*) let files = match glimpse_filter constants x with None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) | true, "", Flag.IdUtils, [] -> (*if not (null xs) then failwith "--id-utils can accept only one dir"*) let files = match idutils_filter constants x with None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) | true, "", Flag.CocciGrep, [] -> (*if not (null xs) then failwith "--id-utils can accept only one dir"*) let files = match coccigrep_filter constants x with None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) (* normal *) | true, "", _, _ -> Test_parsing_c.get_files (join " " (x::xs)) +> List.map (fun x -> [x]) (* kbuild *) | true, kbuild_info_file,_,_ -> let dirs = Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d") in let info = Kbuild.parse_kbuild_info kbuild_info_file in let groups = Kbuild.files_in_dirs dirs info in groups +> List.map (function Kbuild.Group xs -> xs) ) in (* make cache unique in parallel case *) (match (!distrib_index,!Flag_parsing_c.cache_prefix) with (Some index,Some str) -> Flag_parsing_c.cache_prefix := Some (Printf.sprintf "%s/d%d" str index) | _ -> ()); let infiles = match (!distrib_index,!distrib_max) with (None,None) -> infiles | (Some index,Some max) -> (if index >= max then failwith "index starts at 0, and so must be less than max"); if !mod_distrib then let rec loop ct = function [] -> [] | x::xs -> if (ct mod max) =|= index then x::(loop (ct+1) xs) else loop (ct+1) xs in loop 0 infiles else begin let all_files = List.length infiles in let regions = (all_files + (max - 1)) / max in let this_min = index * regions in let this_max = (index+1) * regions in let rec loop ct = function [] -> [] | x::xs -> if this_min <= ct && ct < this_max then x::(loop (ct+1) xs) else loop (ct+1) xs in loop 0 infiles end | _ -> failwith "inconsistent distribution information" in let outfiles = Common.profile_code "Main.outfiles computation" (fun () -> let res = infiles +> List.fold_left (fun prev cfiles -> if (not !Flag.worth_trying_opt) or Cocci.worth_trying cfiles constants then begin pr2 ("HANDLING: " ^ (join " " cfiles)); (*pr2 (List.hd(Common.cmd_to_list "free -m | grep Mem"));*) flush stderr; Common.timeout_function_opt !FC.timeout (fun () -> Common.report_if_take_time 10 (join " " cfiles) (fun () -> try let optfile = if !output_file <> "" && !compat_mode then Some !output_file else None in List.rev (adjust_stdin cfiles (fun () -> Common.redirect_stdout_opt optfile (fun () -> (* this is the main call *) Cocci.full_engine cocci_infos cfiles ))) @ prev with | Common.UnixExit x -> raise (Common.UnixExit x) | Pycocci.Pycocciexception -> raise Pycocci.Pycocciexception | e -> if !dir then begin pr2 ("EXN:" ^ Printexc.to_string e); prev (* *) end else raise e)) end else prev) [] in res) in let outfiles = List.rev outfiles in (match Iteration.get_pending_instance() with None -> (x,xs,cocci_infos,outfiles) | Some (files,virt_rules,virt_ids) -> if outfiles = [] or outfiles = [] or not !FC.show_diff or !inplace_modif then begin (if !inplace_modif then generate_outfiles outfiles x xs); Flag.defined_virtual_rules := virt_rules; Flag.defined_virtual_env := virt_ids; Common.erase_temp_files(); Common.clear_pr2_once(); distrib_index := None; distrib_max := None; toploop files end else begin Common.pr2 "Out of place transformation not compatible with iteration. Aborting.\n consider using -no_show_diff or -in_place"; (x,xs,cocci_infos,outfiles) end) in let (x,xs,cocci_infos,outfiles) = toploop xs in Cocci.post_engine cocci_infos; Common.profile_code "Main.result analysis" (fun () -> Ctlcocci_integration.print_bench(); generate_outfiles outfiles x xs; if !compare_with_expected then Testing.compare_with_expected outfiles) and generate_outfiles outfiles x (* front file *) xs (* other files *) = let outfiles = Cocci.check_duplicate_modif outfiles in outfiles +> List.iter (fun (infile, outopt) -> outopt +> Common.do_option (fun outfile -> if !inplace_modif then begin (match !backup_suffix with Some backup_suffix -> Common.command2 ("cp "^infile^" "^infile^backup_suffix) | None -> ()); Common.command2 ("cp "^outfile^" "^infile); end; if !outplace_modif then Common.command2 ("cp "^outfile^" "^infile^".cocci_res") (* potential source of security pb if the /tmp/ file is * a symlink, so simpler to not produce any regular file * (files created by Common.new_temp_file are still ok) * anymore in /tmp. *) (* if !output_file =$= "" then begin let tmpfile = "/tmp/"^Common.basename infile in pr2 (spf "One file modified. Result is here: %s" tmpfile); Common.command2 ("cp "^outfile^" "^tmpfile); end *) )); if !output_file <> "" && not !compat_mode then (match outfiles with | [infile, Some outfile] when infile =$= x && null xs -> Common.command2 ("cp " ^outfile^ " " ^ !output_file) | [infile, None] when infile =$= x && null xs -> Common.command2 ("cp " ^infile^ " " ^ !output_file) | _ -> failwith ("-o can not be applied because there are multiple " ^ "modified files")) let fix_chars s = if (String.length s) > 2 && String.get s 0 = '-' && not (String.get s 1 = '-') then "-"^(String.concat "-" (Str.split (Str.regexp_string "_") s)) else s let rec fix_idutils = function [] -> [] | ["--use-idutils"] -> ["--use-idutils";".id-utils.index"] | "--use-idutils"::second::rest when String.length second > 0 && String.get second 0 = '-' -> "--use-idutils"::".id-utils.index" :: (fix_idutils (second :: rest)) | x :: rest -> x :: (fix_idutils rest) (*****************************************************************************) (* The coccinelle main entry point *) (*****************************************************************************) let main () = begin let arglist = Array.to_list Sys.argv in let arglist = Command_line.command_line arglist in let arglist = List.map fix_chars arglist in let arglist = fix_idutils arglist in let contains_cocci = (* rather a hack... don't want to think about all possible options *) List.exists (function x -> Filename.check_suffix x ".cocci") arglist && not (List.mem "--parse-cocci" arglist) in if not (null (Common.inter_set arglist ["--cocci-file";"--sp-file";"--sp";"--test";"--testall"; "--test-okfailed";"--test-regression-okfailed"])) or contains_cocci then run_profile quiet_profile; let args = ref [] in (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*) (* this call can set up many global flag variables via the cmd line *) arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg (Array.of_list arglist); args := List.filter (function arg -> if Filename.check_suffix arg ".cocci" then begin (if !cocci_file = "" then cocci_file := arg else failwith "only one .cocci file allowed"); false end else true) !args; (match (!Flag_parsing_c.cache_prefix,!distrib_index) with (Some cp,Some n) -> Flag_parsing_c.cache_prefix := Some (Printf.sprintf "%s_%d" cp n) | _ -> ()); (* julia hack so that one can override directories specified on * the command line. *) (if !dir then let chosen_dir = if List.length !args > 1 then begin let chosen = List.hd !args in Flag.dir := chosen; pr2 ("ignoring all but the last specified directory: "^chosen); args := [chosen]; chosen end else List.hd !args in if !FC.include_path =*= [] then FC.include_path := [Filename.concat chosen_dir "include"]); args := List.rev !args; if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$")) then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci"; if !Config.std_iso <> "" then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso"; if !Config.std_h <> "" then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h"; if !Config.std_h <> "" then Parse_c.init_defs_builtins !Config.std_h; if !macro_file <> "" then Parse_c.init_defs_macros !macro_file; (* must be done after Arg.parse, because Common.profile is set by it *) Common.profile_code "Main total" (fun () -> let all_actions = Test_parsing_c.actions() in (match (!args) with (* --------------------------------------------------------- *) (* The test framework. Works with tests/ or .ok and .failed *) (* --------------------------------------------------------- *) | [x] when !test_mode -> begin let prefix = "tests/" in let testfile = x ^ ".cocci" in if Sys.file_exists (prefix ^ testfile) then begin (if !FC.include_path = [] then FC.include_path := [prefix^"include"]); Testing.testone prefix x !compare_with_expected end else if Sys.file_exists testfile then begin (if !FC.include_path = [] then FC.include_path := ["include"]); Testing.testone "" x !compare_with_expected end else Printf.fprintf stderr "ERROR: File %s does not exist\n" testfile end | [] when !test_all -> (if !FC.include_path = [] then FC.include_path := ["tests/include"]); let score_file = if !expected_score_file <> "" then !expected_score_file else "tests/SCORE_expected.sexp" in Testing.testall score_file !allow_update_score_file | [] when !test_regression_okfailed -> Testing.test_regression_okfailed () | ((x::xs) as cfiles) when !test_okfailed -> (* do its own timeout on FC.timeout internally *) FC.relax_include_path := true; adjust_stdin cfiles (fun () -> Testing.test_okfailed !cocci_file cfiles ) (* --------------------------------------------------------- *) (* Actions, useful to debug subpart of coccinelle *) (* --------------------------------------------------------- *) | xs when List.mem !action (Common.action_list all_actions) -> Common.do_action !action xs all_actions | [] when !action =$= "--parse-cocci" -> Testing.test_parse_cocci !cocci_file (* I think this is used by some scripts in some Makefile for our * big-tests. So don't remove. *) | [file1;file2] when !action =$= "--compare-c" -> Test_parsing_c.test_compare_c file1 file2 (* result = unix code *) (* could add the Test_parsing_c.test_actions such as -parse_c & co *) (* --------------------------------------------------------- *) (* This is the main entry *) (* --------------------------------------------------------- *) | x::xs -> main_action (x::xs) (* --------------------------------------------------------- *) (* empty entry *) (* --------------------------------------------------------- *) | [] -> short_usage() )); if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin ignore(Pycocci.pyrun_simplestring "cocci.finalise()"); if !Flag.show_misc then Common.pr2 "Finalizing python\n"; Pycocci.py_finalize (); end end let main_with_better_error_report () = if !Common.debugger then main () else try main () with | Unix.Unix_error (e, "stat", filename) -> Printf.fprintf stderr "ERROR: File %s does not exist: %s\n" filename (Unix.error_message e); raise (UnixExit (-1)) | Parse_cocci.Bad_virt s -> Printf.fprintf stderr "virtual rule %s not supported\n" s; raise (UnixExit (-1)) (*****************************************************************************) let start = Common.main_boilerplate (fun () -> main_with_better_error_report (); Ctlcocci_integration.print_bench(); ) coccinelle-1.0.0-rc19/credits.txt0000644000175000017500000000076612247437436015577 0ustar eugeneugenThanks to - Alexander Faroy for the vim SmPL mode - Didier Le Botlan for the name of the tool: spatch. - A guy from Cornell for suggesting the term "semantic patch". Thanks to - Francois Pottier and Yann Regis-Gianas for menhir and menhirlib/ - arty@users.sourceforge.net for pycaml/ - Jane Street for ocamlsexp/ - Richard Jones for his dumper module, Thanks of course also to Stallman, Linus, Leroy, Knuth and their acolytes for respectively Emacs, Linux, OCaml, and (La)TeX. coccinelle-1.0.0-rc19/authors.txt0000644000175000017500000000202712247437436015617 0ustar eugeneugenHere are the authors and maintainers of the different parts of coccinelle: * Julia Lawall - parsing_cocci/ (parsing SmPL, isomorphism handling) - engine/ (ast_cocci to ctl, sgrep) - ctl/ (symbolic model checker) - tools/ - standard.iso * Yoann Padioleau - parsing_c/ (parsing C, unparsing C, type checking, control flow, C diff) - engine/ (pattern matching and transforming, unparsing, ctl integration) - main.ml, cocci.ml (driver), testing.ml - configure, txt files, Makefiles - globals/ - extra/, tools/, scripts/ - commons/ (utility functions, e.g. for logging, profiling, regression testing) - editors/emacs/cocci.el - standard.h * Rene Rydhof Hansen - Original version of the model checker in ctl/ - editors/emacs/cocci-ediff.el - scripts/extractor.awk * Henrik stuart - python/ (python SmPL extension and a coccinelle GUI) * Nicolas Palix - ocaml/ (OCaml SmPL extension) - scripts/spatch.bash_completion * All - tests/ demos/ coccinelle-1.0.0-rc19/tests/0000755000175000017500000000000012247437555014534 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/signed.c0000644000175000017500000000006512247437436016150 0ustar eugeneugenint main() { signed x; unsigned a; return x; } coccinelle-1.0.0-rc19/tests/memset.cocci0000644000175000017500000000176312247437436017035 0ustar eugeneugen// have to duplicate a lot of rules because T E only matches if E has a known // type, even if T is not used elsewhere. @@ type T, T2; expression x; expression E1,E2,E; @@ - x = (T)kmalloc(E1,E2) ... when != x = E - memset((T2)x,0,E1); @@ type T, T2; type T1; T1 *x; expression E2,E; @@ - x = (T)kmalloc(sizeof(T1),E2) ... when != x = E - memset((T2)x,0,sizeof(*x)); @@ type T, T2; type T1; T1 *x; expression E2,E; @@ - x = (T)kmalloc(sizeof(*x),E2) ... when != x = E - memset((T2)x,0,sizeof(T1)); // --------------------------------------------------------------------- @@ type T, T1, T2; identifier x; expression E1,E2,E; @@ - T1 x = (T)kmalloc(E1,E2); ... when != x = E - memset((T2)x,0,E1); @@ type T, T2; type T1; identifier x; expression E2,E; @@ - T1 x = (T)kmalloc(sizeof(T1),E2); ... when != x = E - memset((T2)x,0,sizeof(*x)); @@ type T, T2; type T1; identifier x; expression E2,E; @@ - T1 x = (T)kmalloc(sizeof(*x),E2); ... when != x = E - memset((T2)x,0,sizeof(T1)); coccinelle-1.0.0-rc19/tests/posiso.res0000644000175000017500000000020012247437436016551 0ustar eugeneugenint main () { int *x; if (!x) x = a; else x = b; if (x == a) x = a; else x = b; if (!x) x = a; if (x == a) x = a; } coccinelle-1.0.0-rc19/tests/switch.cocci0000644000175000017500000000001612247437436017032 0ustar eugeneugen@@ @@ - f(); coccinelle-1.0.0-rc19/tests/ab.c0000644000175000017500000000006112247437436015255 0ustar eugeneugenint main () { foo = 5; a = 12; xxx = 12; } coccinelle-1.0.0-rc19/tests/rptr.res0000644000175000017500000000005412247437436016233 0ustar eugeneugenint foo(struct resource *r) { return 1; } coccinelle-1.0.0-rc19/tests/remove_call.cocci0000644000175000017500000000024512247437436020025 0ustar eugeneugen@@ identifier FN; type T; identifier x; expression y; @@ ( - T x = <+... FN(...) ...+>; | - y = <+... FN(...) ...+>; | - FN(...); | - return <+... FN(...) ...+>; ) coccinelle-1.0.0-rc19/tests/end_commas.cocci0000644000175000017500000000015212247437436017637 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, ..., + .dev = { .name = E, } }; coccinelle-1.0.0-rc19/tests/sw.cocci0000644000175000017500000000003012247437436016156 0ustar eugeneugen@@ @@ - f(...) { ... } coccinelle-1.0.0-rc19/tests/arg.res0000644000175000017500000000007112247437436016014 0ustar eugeneugenint main () { foo(); foo(1); foo(2); foo(1,2); } coccinelle-1.0.0-rc19/tests/decl_star.c0000644000175000017500000000005712247437436016640 0ustar eugeneugenint main () { int *x; int x; return x; } coccinelle-1.0.0-rc19/tests/incdir.cocci0000644000175000017500000000003112247437436016776 0ustar eugeneugen@@ char *x; @@ - x + 12 coccinelle-1.0.0-rc19/tests/bigrepl.c0000644000175000017500000000042112247437436016317 0ustar eugeneugenint main () { one(argument1(nested, argument), argument2(nested, argument), foo(), argument3(nested, argument)); one(argument1(nested, argument), argument2(nested, argument), foo(), a(b)); one(argument1(nested, argument), argument2(nested, argument), foo()); } coccinelle-1.0.0-rc19/tests/smallfn.cocci0000644000175000017500000000004512247437436017167 0ustar eugeneugen@@ statement S; @@ { S } +foo(); coccinelle-1.0.0-rc19/tests/cst_null.cocci0000644000175000017500000000034412247437436017360 0ustar eugeneugen// test x != NULL <=> NULL != x iso, and x != NULL => x iso @r@ expression x; expression E1,E2; statement S2; @@ - x = kmalloc(E1,E2) + x = kzalloc(E1,E2) ... if (x!=NULL) { ... - memset(x,0,E1); ... } else S2 coccinelle-1.0.0-rc19/tests/trailwhite.cocci0000644000175000017500000000004512247437436017707 0ustar eugeneugen@@ type T; expression E; @@ -(T) E coccinelle-1.0.0-rc19/tests/rem1.cocci0000644000175000017500000000003412247437436016375 0ustar eugeneugen@@ @@ - if (...) { foo(); }coccinelle-1.0.0-rc19/tests/condexp.c0000644000175000017500000000040612247437436016336 0ustar eugeneugenint main(int argc, char *argv[]) { // ... dpy = XOpenDisplay (displayname); if (!dpy) { fprintf (stderr, "%s: unable to open display \"%s\"\n", ProgramName, XDisplayName (displayname)); Exit (1); } screenno = DefaultScreen (dpy); // ... } coccinelle-1.0.0-rc19/tests/topdec_ver2.res0000644000175000017500000000021412247437436017456 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ int x; static const struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/minusdots_ver1.res0000644000175000017500000000003012247437436020220 0ustar eugeneugenvoid main(int i) { } coccinelle-1.0.0-rc19/tests/wierdinit.c0000644000175000017500000000021112247437436016666 0ustar eugeneugen static int cmm_ioctl() { dev_link_t *link; char *ioctl_names[CM_IOC_MAXNR + 1] = { [_IOC_NR(CM_IOSDBGLVL)] "CM4000_DBGLVL", }; } coccinelle-1.0.0-rc19/tests/labels_metastatement.c0000644000175000017500000000025212247437436021072 0ustar eugeneugenint foo(int i) { if(1) { x = 3; z = 4; } // we don't want that it add both foo on the } and on the endif // (note: but need correct endif accrochage) } coccinelle-1.0.0-rc19/tests/ifadd.res0000644000175000017500000000013312247437436016311 0ustar eugeneugenint main() { while (y) { if (x) { one(); two(); foo(); } } } coccinelle-1.0.0-rc19/tests/lid.cocci0000644000175000017500000000004612247437436016304 0ustar eugeneugen@@ local idexpression x; @@ - x + 12 coccinelle-1.0.0-rc19/tests/header_modif.h0000644000175000017500000000002012247437436017301 0ustar eugeneugen int foo(int); coccinelle-1.0.0-rc19/tests/cast.cocci0000644000175000017500000000004612247437436016466 0ustar eugeneugen@@ struct xxx *E; @@ - E->foo = 12; coccinelle-1.0.0-rc19/tests/retmacro.res0000644000175000017500000000153112247437436017061 0ustar eugeneugen#define REG_PATTERN_TEST(R, M, W) \ { \ for (pat = 0; pat < ARRAY_SIZE(test); pat++) { \ if (value != (test[pat] & W & M)) { \ return 1; \ } \ } \ } #define REG_PATTERN_TEST2(R, M, W) \ { \ for (pat = 0; pat < ARRAY_SIZE(test); pat++) { \ if (value != (test[pat] & W & M)) { \ } \ } \ } coccinelle-1.0.0-rc19/tests/switch.res0000644000175000017500000000010312247437436016540 0ustar eugeneugenint main () { switch (x) { default: break; case X: } } coccinelle-1.0.0-rc19/tests/wierd_argument.c0000644000175000017500000000037112247437436017713 0ustar eugeneugenstatic void ewx_i2c_setlines(snd_i2c_bus_t *bus, int clk, int data) { ice1712_t *ice = snd_magic_cast(ice1712_t, bus->private_data, return); ice1712_t *ice = snd_magic_cast(ice1712_t, bus->private_data, ); unsigned char tmp = 0; tmp++; } coccinelle-1.0.0-rc19/tests/toplevel_macrostmt.res0000644000175000017500000000011012247437436021160 0ustar eugeneugenvoid main(int i) { } module_param(x, int , y); MODULE_AUTHOR("me"); coccinelle-1.0.0-rc19/tests/fieldsmin.res0000644000175000017500000000003612247437436017216 0ustar eugeneugenstruct foo x = { .c = 3, }; coccinelle-1.0.0-rc19/tests/stm6.c0000644000175000017500000000005712247437436015571 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/metastatement2.c0000644000175000017500000000010012247437436017622 0ustar eugeneugenvoid main(int i) { f(); { replace(); replace(); } g(); } coccinelle-1.0.0-rc19/tests/exp.c0000644000175000017500000000014312247437436015470 0ustar eugeneugenint main(int i) { int k = foo(); if(1) { foo(); } else { foo(); } foo(); } coccinelle-1.0.0-rc19/tests/disjexpr.cocci0000644000175000017500000000006712247437436017367 0ustar eugeneugen@@ identifier fld; @@ ( - v.fld + v->fld | - v + *v ) coccinelle-1.0.0-rc19/tests/attradd.cocci0000644000175000017500000000021312247437436017153 0ustar eugeneugen@@ identifier f; @@ char + __attribute__((aligned(1))) f; @@ identifier f; @@ f(...) { ... } + // some comment + // some other comment coccinelle-1.0.0-rc19/tests/test12.res0000644000175000017500000000007012247437436016364 0ustar eugeneugenvoid main(int foo) { f(1, 2); foo(); g(2); } coccinelle-1.0.0-rc19/tests/struct.c0000644000175000017500000000022512247437436016221 0ustar eugeneugenstruct foo { int x; struct bar first; int y; struct xxx second; int z; }; int main() { struct foo *a; f(a->first); f(a->second); } coccinelle-1.0.0-rc19/tests/ifdef2.res0000644000175000017500000000045712247437436016412 0ustar eugeneugen#include #include #include #ifdef CONFIG_NKERNEL #include #include unsigned long maxsize = 0; #endif #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/param_end.res0000644000175000017500000000036512247437436017177 0ustar eugeneugenint one () { return; } int two (int a, int b) { return; } int three (int a) { return; } int four (int a) { return; } int yone () { return; } int ytwo (int a, int b) { return; } int ythree (int a) { return; } int yfour (int a) { return; } coccinelle-1.0.0-rc19/tests/null.cocci0000644000175000017500000000142112247437436016504 0ustar eugeneugen// The first two rules only work when there is only one reference. @@ expression *x; type T; expression e; expression f; @@ if(x == NULL) { ... when != x = e ( return x; | ( *x | *((T)x) | f(...,x,...) | f(...,(T)x,...) ) ) ... } @@ expression *x; type T; expression e; expression f; statement S; @@ if(x != NULL) S else { ... when != x = e ( return x; | ( *x | *((T)x) | f(...,x,...) | f(...,(T)x,...) ) ) ... } @@ expression *x; type T1, T2, T3; expression e; expression f; statement S; @@ x = (T1) kmalloc(...); ... when != \( if(x == NULL) { ... return ...; } \| if(x == NULL) S else { ... return ...; } \| x = e; \) ( return x; | ( *x | *((T2)x) | f(...,x,...) | f(...,(T3)x,...) ) ) coccinelle-1.0.0-rc19/tests/ret.c0000644000175000017500000000011312247437436015463 0ustar eugeneugenint f(int x) { int x; f(); if (E) { return 0; } g(); return 0; } coccinelle-1.0.0-rc19/tests/a_and_e.cocci0000644000175000017500000000007212247437436017101 0ustar eugeneugen@@ expression X, Y; @@ g(); + f(Y, 0); ... f(X,Y); coccinelle-1.0.0-rc19/tests/mini_null_ref.cocci0000644000175000017500000000022512247437436020355 0ustar eugeneugen@r@ type T; expression E; identifier i,fld; statement S; @@ - T i = E->fld; + T i; ... when != E when != i if (E == NULL) S + i = E->fld; coccinelle-1.0.0-rc19/tests/gilles-question.c0000644000175000017500000000010612247437436020017 0ustar eugeneugenvoid main(int i) { f(0); if(1) { g(0); } g(0); } coccinelle-1.0.0-rc19/tests/ifields.cocci0000644000175000017500000000054712247437436017161 0ustar eugeneugen@ object @ typedef IFace; typedef IFaceVtbl; type Tobj; field list[nilla] F; @@ typedef struct tag_obj { F - const IFaceVtbl *lpVtbl; + IFace IFace_iface; ... } Tobj; @@ identifier obj; identifier vtbl; initializer list[object.nilla] E; @@ static struct IFaceImpl obj = { E, - &vtbl, + { &vtbl, 4, }, ..., }; coccinelle-1.0.0-rc19/tests/b2.res0000644000175000017500000000025012247437436015545 0ustar eugeneugenint main () { if (1) { if (x > 1 ) { foo(); bar(); brk(); } } else aaa(); if (1) while (x > 1 ) { foo(); bar(); brk(); } else aaa(); foo(); brk(); } coccinelle-1.0.0-rc19/tests/badexp1.cocci0000644000175000017500000000010112247437436017050 0ustar eugeneugen@@ expression x; @@ foo(x); ... + 3 + x(...,y,...) + * 27 coccinelle-1.0.0-rc19/tests/orexp.res0000644000175000017500000000002412247437436016376 0ustar eugeneugenint main() { 4; } coccinelle-1.0.0-rc19/tests/starprint.res0000644000175000017500000000011012247437436017263 0ustar eugeneugentypedef int *LPINT; int foo(int *x, int **y) { return *x == **y; } coccinelle-1.0.0-rc19/tests/addif.cocci0000644000175000017500000000025412247437436016604 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + /* some comment */ + int xxx() { + /* a comment by itself */ + return 12;/* another comment */ } + #endif int f(...) { ... } coccinelle-1.0.0-rc19/tests/ar.c0000644000175000017500000000026712247437436015305 0ustar eugeneugenstruct bar { struct foo *a; struct foo b[27]; }; int main() { struct foo *x; struct bar *y; struct foo z[15]; x->y = 12; y->a->y = 12; y->b[7].y = 12; z[15].y = 12; } coccinelle-1.0.0-rc19/tests/video_ver2.c0000644000175000017500000000176612247437436016754 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; switch (cmd) { case VIDIOCGTUNER: { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, &v, sizeof(v))) return -EFAULT; return 0; } case VIDIOCSTUNER: { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v))) return -EFAULT; if (v.tuner != 0) return -EINVAL; /* Only 1 tuner so no setting needed ! */ return 0; } case VIDIOCSFREQ: if (copy_from_user(&typhoon->curfreq, arg, sizeof(typhoon->curfreq))) return -EFAULT; typhoon_setfreq(typhoon, typhoon->curfreq); return 0; } return -ENOIOCTLCMD; } coccinelle-1.0.0-rc19/tests/bad_define.res0000644000175000017500000000000012247437436017273 0ustar eugeneugencoccinelle-1.0.0-rc19/tests/iterprint.cocci0000644000175000017500000000032312247437436017552 0ustar eugeneugen@@ expression bitmap, size; identifier bit; statement S1; iterator name for_each_set_bit; @@ -for(bit = 0; bit < size; bit++) +for_each_set_bit(bit, bitmap, size) -{ - if (test_bit(bit, bitmap)) S1 -} coccinelle-1.0.0-rc19/tests/ip2.c0000644000175000017500000000027012247437436015367 0ustar eugeneugenvoid GetInfoDestTV(short sNoFo) { if(sNoFo == 1) printf("one"); else if(sNoFo == 2) printf("two"); else if(sNoFo == 2) printf("three"); else printf("other"); } coccinelle-1.0.0-rc19/tests/replace_typedef.res0000644000175000017500000000020012247437436020370 0ustar eugeneugentypedef struct foo { int x; } foo_t; typedef int int_t; int main() { struct foo x; int y; x.x = 12; return x.x + y; } coccinelle-1.0.0-rc19/tests/return_implicit.res0000644000175000017500000000006412247437436020456 0ustar eugeneugenvoid main(void) { foo(); return -ENODEV; } coccinelle-1.0.0-rc19/tests/armatch.c0000644000175000017500000000011412247437436016311 0ustar eugeneugenint main () { int foo[4]; int *x; return sizeof(foo) + sizeof(x); } coccinelle-1.0.0-rc19/tests/same_expr.cocci0000644000175000017500000000003612247437436017516 0ustar eugeneugen@@ expression E; @@ - f(E,E);coccinelle-1.0.0-rc19/tests/gotobreak.cocci0000644000175000017500000000013212247437436017505 0ustar eugeneugen@@ identifier config; @@ config(...) { <... - return; + return 0; ...> } coccinelle-1.0.0-rc19/tests/hd.res0000644000175000017500000000005412247437436015637 0ustar eugeneugen#include "hd.h" int f(int x) { return x; } coccinelle-1.0.0-rc19/tests/condexp.cocci0000644000175000017500000000022512247437436017173 0ustar eugeneugen@@ identifier displayname; @@ ( -XDisplayName(NULL) +getenv("DISPLAY") | -XDisplayName(displayname) +displayname ? displayname : getenv("DISPLAY") ) coccinelle-1.0.0-rc19/tests/retmacro.cocci0000644000175000017500000000010312247437436017342 0ustar eugeneugen@@ expression E, E1; @@ - sizeof(E)/sizeof(E[E1]) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/tests/test9.c0000644000175000017500000000026012247437436015744 0ustar eugeneugenvoid main(int foo) { f(1); // f(1); // if uncoment then problems g(2); if(1) { h(3); } else { h(4); } // if uncomment then problems { i++; } } coccinelle-1.0.0-rc19/tests/minstruct.res0000644000175000017500000000020512247437436017272 0ustar eugeneugenstatic struct i2c_client client_template = { .dev = {.name = "(unset)"}, .id = -1, .driver = &i2c_driver_videotext }; coccinelle-1.0.0-rc19/tests/inherited.c0000644000175000017500000000010512247437436016645 0ustar eugeneugenvoid main(int i) { g(1); //f(2); h(2); h2(2); foo(1); } coccinelle-1.0.0-rc19/tests/define_exp.res0000644000175000017500000000015312247437436017352 0ustar eugeneugen#define IRQ_T(info) ((info->flags & ASYNC_SHARE_IRQ) ? IRQF_SHARED : IRQF_DISABLED) void main(int i) { } coccinelle-1.0.0-rc19/tests/switch_label.c0000644000175000017500000000016312247437436017336 0ustar eugeneugenint main () { switch (event) { case CS_EVENT_CARD_REMOVAL: one(); two(); three(); break; } } coccinelle-1.0.0-rc19/tests/const1.cocci0000644000175000017500000000011012247437436016733 0ustar eugeneugen@@ identifier func;@@ func (...) { - const char *i; + float i; ... } coccinelle-1.0.0-rc19/tests/dc_close.c0000644000175000017500000000030012247437436016442 0ustar eugeneugenvoid __init initicc(struct IsdnCardState *cs) { int val, eval; INIT_WORK(&cs->work, icc_bh, cs); cs->setstack_d = setstack_icc; cs->DC_Close = DC_Close_icc; cs->dc.icc.mon_rx = NULL; } coccinelle-1.0.0-rc19/tests/stm2.cocci0000644000175000017500000000004612247437436016421 0ustar eugeneugen@@ statement S; @@ f(); - S g(); coccinelle-1.0.0-rc19/tests/compare.res0000644000175000017500000000065712247437436016703 0ustar eugeneugenstruct aic7xxx_host { struct aic7xxx_cmd_queue { struct scsi_cmnd *head; struct scsi_cmnd *tail; } completeq; unsigned char msg_buf[13]; /* The message for the target */ unsigned char msg_type; #define MSG_TYPE_NONE 0x00 #define MSG_TYPE_INITIATOR_MSGOUT 0x01 #define MSG_TYPE_INITIATOR_MSGIN 0x02 unsigned char msg_len; /* Length of message */ unsigned char msg_index; /* Index into msg_buf array */ }; coccinelle-1.0.0-rc19/tests/pb_distribute_type3.cocci0000644000175000017500000000012112247437436021511 0ustar eugeneugen@@ type T; //fresh identifier y; @@ foo(...) { T + y, x; ... } coccinelle-1.0.0-rc19/tests/twoproto.res0000644000175000017500000000023712247437436017144 0ustar eugeneugenstatic void tc574_config(dev_link_t *link); static int tc574_attach(struct pcmcia_device *link) { } static void tc574_detach(struct pcmcia_device *link) { } coccinelle-1.0.0-rc19/tests/bigin.c0000644000175000017500000000041012247437436015761 0ustar eugeneugen// indentation algorithm is not perfect here, because it doesn't know how // much to outdent. But it gives the illusion of working. int main() { if (x) if (x) if (x) if (x) if (x) if (x) blah(); foo(); } coccinelle-1.0.0-rc19/tests/smallfn.c0000644000175000017500000000040612247437436016332 0ustar eugeneugenint main () { if (y) { one(); } else { two(); } while (y) { one(); } do { one(); } while(y); switch (y) { case 12:one(); case 27:two(); } { one(); } } int main () { if (y) { one(); } else { two(); } } coccinelle-1.0.0-rc19/tests/const_adding.res0000644000175000017500000000013312247437436017676 0ustar eugeneugenvoid main(int i) { const struct file_operations a; const struct file_operations b; } coccinelle-1.0.0-rc19/tests/type_annotated.c0000644000175000017500000000023412247437436017713 0ustar eugeneugenvoid f1(int z) { struct foo i; struct foo2 j; int k; j+i.foo+j.foo; } void f2(struct foo i) { struct foo2 j; int k; j+i.foo+j.foo; } coccinelle-1.0.0-rc19/tests/strid.c0000644000175000017500000000005512247437436016023 0ustar eugeneugenint main () { struct foo *a; print(a); } coccinelle-1.0.0-rc19/tests/test5.res0000644000175000017500000000113312247437436016307 0ustar eugeneugen/* * If still have an edge from the startif to endif (AfterNode), * with a if-then-and-else, then rene will see this edge, * and that means that the ctl engine will see this direct path from * startif to endif as a valid execution path. So on this program, * CTL will reject the formula f(X) ... g(X) because * when we take the direct path (which should not exist I repeat), * we can't find a later g(1). */ void main() { f(1); if(1) { h(1); } else { h(1); } // g(1); // if add this then the CTL even with the direct path will this time // accept, but we cheat. } coccinelle-1.0.0-rc19/tests/inherited_ver1.res0000644000175000017500000000011012247437436020145 0ustar eugeneugenvoid main(int i) { //g(1); f(2); hh(2); hh22(2); bar(1); } coccinelle-1.0.0-rc19/tests/minenum.c0000644000175000017500000000003212247437436016341 0ustar eugeneugenenum h { x, a, z, q, b }; coccinelle-1.0.0-rc19/tests/tup.cocci0000644000175000017500000000052712247437436016350 0ustar eugeneugen@ rule1 @ identifier I; identifier f; @@ struct block_device_operations I = { .ioctl = f, }; @@ identifier rule1.f; expression A, B, C; identifier inodename, filename, cmd, arg; @@ f(struct inode *inodename, struct file *filename, unsigned int cmd, unsigned long arg) { <... - cdrom_ioctl(A, inodename, cmd, arg) + xxx() ...> } coccinelle-1.0.0-rc19/tests/nstruct.c0000644000175000017500000000006712247437436016403 0ustar eugeneugenstruct saa5249_device { struct i2c_client *client; }; coccinelle-1.0.0-rc19/tests/warnon.cocci0000644000175000017500000000010612247437436017035 0ustar eugeneugen@@ //identifier f; expression E; @@ * WARN_ON(E && !irqs_disabled()) coccinelle-1.0.0-rc19/tests/b2.c0000644000175000017500000000023312247437436015177 0ustar eugeneugenint main () { if (1) { if (x > 1 ) { foo(); brk(); } } else aaa(); if (1) while (x > 1 ) { foo(); brk(); } else aaa(); foo(); brk(); } coccinelle-1.0.0-rc19/tests/headers.res0000644000175000017500000000072712247437436016666 0ustar eugeneugenstatic void empeg_close (struct usb_serial_port *port, struct file *filp); static void empeg_close (struct usb_serial_port *port, struct file * filp) { } static int empeg_write (struct usb_serial_port *port, const unsigned char *buf, int count) { usb_fill_bulk_urb (empeg_write_bulk_callback); } static void empeg_write_bulk_callback (struct urb *urb) { } static void empeg_read_bulk_callback (struct urb *urb) { usb_fill_bulk_urb(empeg_read_bulk_callback); } coccinelle-1.0.0-rc19/tests/addfield.c0000644000175000017500000000007712247437436016436 0ustar eugeneugenstruct i2c_client I = { .name = E, .foo = 16, }; coccinelle-1.0.0-rc19/tests/deref.c0000644000175000017500000000010612247437436015760 0ustar eugeneugenint main () { int **q; foo(*q+12); xxx(q[0]+12); yyy(q+12); } coccinelle-1.0.0-rc19/tests/addbefore.c0000644000175000017500000000011112247437436016602 0ustar eugeneugenint main () { if (x) { goto out; } after(); out: return 0; } coccinelle-1.0.0-rc19/tests/axnet.cocci0000644000175000017500000000043512247437436016655 0ustar eugeneugen@@ expression E; identifier link; @@ - void + int axnet_config(struct pcmcia_device *link) { <... ( if (E) { ... axnet_release(...); ... - return; + return -ENODEV; } | if (E) { ... cs_error(...); ... - return; + return -ENODEV; } ) ...> } coccinelle-1.0.0-rc19/tests/jloop1.cocci0000644000175000017500000000021312247437436016734 0ustar eugeneugen@@ @@ // TODO: Marche pas void cpu_idle(...) { <... - int idle = pm_idle; <... - idle(); + nkidle(); ...> ...> } coccinelle-1.0.0-rc19/tests/video_ver3.c0000644000175000017500000000116012247437436016741 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; switch (cmd) { case VIDIOCGTUNER: { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, &v, sizeof(v))) return -EFAULT; return 0; } } return -ENOIOCTLCMD; } coccinelle-1.0.0-rc19/tests/type_ver2.c0000644000175000017500000000005012247437436016610 0ustar eugeneugenint foo() { int x[10]; return 0; } coccinelle-1.0.0-rc19/tests/constty.cocci0000644000175000017500000000004412247437436017235 0ustar eugeneugen@@ type T; const T x; @@ - f(x,T); coccinelle-1.0.0-rc19/tests/stm1.cocci0000644000175000017500000000007212247437436016417 0ustar eugeneugen@@ statement S; @@ f(); S g(); @script:python@ @@ coccinelle-1.0.0-rc19/tests/inclifdef.c0000644000175000017500000000010312247437436016613 0ustar eugeneugen#include #ifdef CONFIG #include #endif coccinelle-1.0.0-rc19/tests/stm2.c0000644000175000017500000000005712247437436015565 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/array_size.res0000644000175000017500000000012212247437436017410 0ustar eugeneugen#define MAX_SETUP_STRINGS ARRAY_SIZE(setup_strings) #define SETUP_BUFFER_SIZE 200 coccinelle-1.0.0-rc19/tests/anon.cocci0000644000175000017500000000055312247437436016472 0ustar eugeneugen// the case where the third argument is something else (with a type) (delayed) // pointer type @ is_delayed @ type local_type; local_type *device; expression E; identifier fld; @@ schedule_delayed_work(&device->fld,E) @ rule2 @ is_delayed.local_type *device; identifier is_delayed.fld; @@ - schedule_work(&device->fld) + schedule_delayed_work(&device->fld, 0) coccinelle-1.0.0-rc19/tests/a_and_e_ver1.res0000644000175000017500000000014112247437436017544 0ustar eugeneugenvoid main(int i) { g(); f(2, 0); if(1) f(1,2); else f(2,2); // return 1; } coccinelle-1.0.0-rc19/tests/partial.cocci0000644000175000017500000000005512247437436017170 0ustar eugeneugen@@ statement S; @@ - PAGE_SIZE + PAGE_SIZE2 coccinelle-1.0.0-rc19/tests/stm4.c0000644000175000017500000000005712247437436015567 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/smallfn.res0000644000175000017500000000101212247437436016673 0ustar eugeneugenint main () { if (y) { { one(); foo(); } foo(); } else { { two(); foo(); } foo(); } foo(); while (y) { { one(); foo(); } foo(); } foo(); { do { one(); foo(); } foo(); while(y); foo(); } switch (y) { case 12: foo();one(); foo(); case 27: foo();two(); foo(); } foo(); { one(); foo(); } foo(); } int main () { if (y) { { one(); foo(); } foo(); } else { { two(); foo(); } foo(); } foo(); } coccinelle-1.0.0-rc19/tests/multiplus.c0000644000175000017500000000063612247437436016741 0ustar eugeneugenstatic void xm_link_timer(void *arg) { struct net_device *dev = arg; struct skge_port *skge = netdev_priv(arg); struct skge_hw *hw = skge->hw; int port = skge->port; if (!netif_running(dev)) return; if (netif_carrier_ok(dev)) { xm_read16(hw, port, XM_ISRC); if (!(xm_read16(hw, port, XM_ISRC) & XM_IS_INP_ASS)) goto nochange; } nochange: schedule_delayed_work(&skge->link_thread, LINK_HZ); } coccinelle-1.0.0-rc19/tests/typedef_double.c0000644000175000017500000000021212247437436017663 0ustar eugeneugentypedef struct stlpcibrd { unsigned short vendid; unsigned short devid; int brdtype; } stlpcibrd_t; int main () { sema_init(x); } coccinelle-1.0.0-rc19/tests/decmeta.c0000644000175000017500000000015712247437436016303 0ustar eugeneugenint main () { decimal(TEN,FIVE) x1; decimal(10,5) x2; decimal(20,5) x3; return x1 + x2 + x3 + 6 + 7; } coccinelle-1.0.0-rc19/tests/enum.cocci0000644000175000017500000000012312247437436016474 0ustar eugeneugen@@ expression *E; @@ ( E == - 0 + NULL | E != - 0 + NULL | E = - 0 + NULL ) coccinelle-1.0.0-rc19/tests/print_return.cocci0000644000175000017500000000017312247437436020270 0ustar eugeneugen@@ expression E; identifier config; @@ config(struct pcmcia_device *link) { ... + return bar(); - return 0; } coccinelle-1.0.0-rc19/tests/badpost.cocci0000644000175000017500000000021312247437436017164 0ustar eugeneugen@x@ position p; identifier f; expression E; @@ - f(3, + f(3, E@p,...) @@ position x.p; identifier g; expression E; @@ - g(3,E@p,...);coccinelle-1.0.0-rc19/tests/shared_brace.c0000644000175000017500000000017112247437436017277 0ustar eugeneugen int __init ixj_init(void) { if (pci_present()) { if ((probe = ixj_probe_pci(&cnt)) < 0) { return probe; } } } coccinelle-1.0.0-rc19/tests/arraysz.cocci0000644000175000017500000000012112247437436017221 0ustar eugeneugen@ disable all @ type T; const T[] E; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/tests/ifdefmeta2.cocci0000644000175000017500000000004712247437436017543 0ustar eugeneugen@@ expression E,E1; @@ -E1=alloca(E); coccinelle-1.0.0-rc19/tests/structfoo.c0000644000175000017500000000005612247437436016727 0ustar eugeneugenstruct foo my_foo[] = { .a = 1, .u.b = 42, }; coccinelle-1.0.0-rc19/tests/enum.res0000644000175000017500000000032312247437436016207 0ustar eugeneugentypedef enum { } another_test; typedef enum { xxx #ifdef FOO ,bar #endif } another_test2; typedef enum { xxx } this_one_works; static reg_errcode_t regex_compile () { unsigned char *pending_exact = NULL; } coccinelle-1.0.0-rc19/tests/regexp3.cocci0000644000175000017500000000175612247437436017122 0ustar eugeneugen@anyid@ type t; identifier id; constant char [] cst; fresh identifier new = id ## "_is_constant"; @@ t id = cst; +t new; @contains@ type t; identifier anyid.id; constant char [] anyid.cst =~ ".*FOO"; fresh identifier contains = id ##"_equals_cst_that_contains_FOO"; @@ t id = cst; +t contains; @nocontain@ type t; identifier anyid.id; constant char [] anyid.cst !~ ".*FOO"; fresh identifier nocontain = id ##"_equals_cst_that_doesn_t_contain_FOO"; @@ t id = cst; +t nocontain; @endsby@ type t; identifier anyid.id; constant char [] anyid.cst =~ ".*FOO$"; fresh identifier endsby = id ##"_equals_cst_that_ends_by_FOO"; @@ t id = cst; +t endsby; @beginsby@ type t; identifier anyid.id; constant char [] anyid.cst =~ "^FOO"; fresh identifier beginsby = id ##"_equals_cst_that_begins_by_FOO"; @@ t id = cst; +t beginsby; @format@ type t; identifier anyid.id; constant char [] anyid.cst =~ ".*%s"; fresh identifier strformat = id ##"_is_a_format_for_at_least_a_string"; @@ t id = cst; +t strformat; coccinelle-1.0.0-rc19/tests/video1_ver1.c0000644000175000017500000002501312247437436017023 0ustar eugeneugen/* Typhoon Radio Card driver for radio support * (c) 1999 Dr. Henrik Seidel * * Card manufacturer: * http://194.18.155.92/idc/prod2.idc?nr=50753&lang=e * * Notes on the hardware * * This card has two output sockets, one for speakers and one for line. * The speaker output has volume control, but only in four discrete * steps. The line output has neither volume control nor mute. * * The card has auto-stereo according to its manual, although it all * sounds mono to me (even with the Win/DOS drivers). Maybe it's my * antenna - I really don't know for sure. * * Frequency control is done digitally. * * Volume control is done digitally, but there are only four different * possible values. So you should better always turn the volume up and * use line control. I got the best results by connecting line output * to the sound card microphone input. For such a configuration the * volume control has no effect, since volume control only influences * the speaker output. * * There is no explicit mute/unmute. So I set the radio frequency to a * value where I do expect just noise and turn the speaker volume down. * The frequency change is necessary since the card never seems to be * completely silent. */ #include /* Modules */ #include /* Initdata */ #include /* check_region, request_region */ #include /* radio card status report */ #include /* outb, outb_p */ #include /* copy to/from user */ #include /* kernel radio structs */ #include /* CONFIG_RADIO_TYPHOON_* */ #define BANNER "Typhoon Radio Card driver v0.1\n" #ifndef CONFIG_RADIO_TYPHOON_PORT #define CONFIG_RADIO_TYPHOON_PORT -1 #endif #ifndef CONFIG_RADIO_TYPHOON_MUTEFREQ #define CONFIG_RADIO_TYPHOON_MUTEFREQ 0 #endif #ifndef CONFIG_PROC_FS #undef CONFIG_RADIO_TYPHOON_PROC_FS #endif struct typhoon_device { int users; int iobase; int curvol; int muted; unsigned long curfreq; unsigned long mutefreq; }; static void typhoon_setvol_generic(struct typhoon_device *dev, int vol); static int typhoon_setfreq_generic(struct typhoon_device *dev, unsigned long frequency); static int typhoon_setfreq(struct typhoon_device *dev, unsigned long frequency); static void typhoon_mute(struct typhoon_device *dev); static void typhoon_unmute(struct typhoon_device *dev); static int typhoon_setvol(struct typhoon_device *dev, int vol); static int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg); static int typhoon_open(struct video_device *dev, int flags); static void typhoon_close(struct video_device *dev); #ifdef CONFIG_RADIO_TYPHOON_PROC_FS static int typhoon_get_info(char *buf, char **start, off_t offset, int len); #endif static void typhoon_setvol_generic(struct typhoon_device *dev, int vol) { vol >>= 14; /* Map 16 bit to 2 bit */ vol &= 3; outb_p(vol / 2, dev->iobase); /* Set the volume, high bit. */ outb_p(vol % 2, dev->iobase + 2); /* Set the volume, low bit. */ } static int typhoon_setfreq_generic(struct typhoon_device *dev, unsigned long frequency) { unsigned long outval; unsigned long x; /* * The frequency transfer curve is not linear. The best fit I could * get is * * outval = -155 + exp((f + 15.55) * 0.057)) * * where frequency f is in MHz. Since we don't have exp in the kernel, * I approximate this function by a third order polynomial. * */ x = frequency / 160; outval = (x * x + 2500) / 5000; outval = (outval * x + 5000) / 10000; outval -= (10 * x * x + 10433) / 20866; outval += 4 * x - 11505; outb_p((outval >> 8) & 0x01, dev->iobase + 4); outb_p(outval >> 9, dev->iobase + 6); outb_p(outval & 0xff, dev->iobase + 8); return 0; } static int typhoon_setfreq(struct typhoon_device *dev, unsigned long frequency) { typhoon_setfreq_generic(dev, frequency); dev->curfreq = frequency; return 0; } static void typhoon_mute(struct typhoon_device *dev) { if (dev->muted == 1) return; typhoon_setvol_generic(dev, 0); typhoon_setfreq_generic(dev, dev->mutefreq); dev->muted = 1; } static void typhoon_unmute(struct typhoon_device *dev) { if (dev->muted == 0) return; typhoon_setfreq_generic(dev, dev->curfreq); typhoon_setvol_generic(dev, dev->curvol); dev->muted = 0; } static int typhoon_setvol(struct typhoon_device *dev, int vol) { if (dev->muted && vol != 0) { /* user is unmuting the card */ dev->curvol = vol; typhoon_unmute(dev); return 0; } if (vol == dev->curvol) /* requested volume == current */ return 0; if (vol == 0) { /* volume == 0 means mute the card */ typhoon_mute(dev); dev->curvol = vol; return 0; } typhoon_setvol_generic(dev, vol); dev->curvol = vol; return 0; } static int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; switch (cmd) { case VIDIOCGCAP: { struct video_capability v; v.type = VID_TYPE_TUNER; v.channels = 1; v.audios = 1; /* No we don't do pictures */ v.maxwidth = 0; v.maxheight = 0; v.minwidth = 0; v.minheight = 0; strcpy(v.name, "Typhoon Radio"); if (copy_to_user(arg, &v, sizeof(v))) return -EFAULT; return 0; } case VIDIOCGTUNER: { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, &v, sizeof(v))) return -EFAULT; return 0; } case VIDIOCSTUNER: { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v))) return -EFAULT; if (v.tuner != 0) return -EINVAL; /* Only 1 tuner so no setting needed ! */ return 0; } case VIDIOCGFREQ: if (copy_to_user(arg, &typhoon->curfreq, sizeof(typhoon->curfreq))) return -EFAULT; return 0; case VIDIOCSFREQ: if (copy_from_user(&typhoon->curfreq, arg, sizeof(typhoon->curfreq))) return -EFAULT; typhoon_setfreq(typhoon, typhoon->curfreq); return 0; case VIDIOCGAUDIO: { struct video_audio v; memset(&v, 0, sizeof(v)); v.flags |= VIDEO_AUDIO_MUTABLE | VIDEO_AUDIO_VOLUME; v.mode |= VIDEO_SOUND_MONO; v.volume = typhoon->curvol; v.step = 1 << 14; strcpy(v.name, "Typhoon Radio"); if (copy_to_user(arg, &v, sizeof(v))) return -EFAULT; return 0; } case VIDIOCSAUDIO: { struct video_audio v; if (copy_from_user(&v, arg, sizeof(v))) return -EFAULT; if (v.audio) return -EINVAL; if (v.flags & VIDEO_AUDIO_MUTE) typhoon_mute(typhoon); else typhoon_unmute(typhoon); if (v.flags & VIDEO_AUDIO_VOLUME) typhoon_setvol(typhoon, v.volume); return 0; } default: return -ENOIOCTLCMD; } } static int typhoon_open(struct video_device *dev, int flags) { struct typhoon_device *typhoon = dev->priv; if (typhoon->users) return -EBUSY; typhoon->users++; return 0; } static void typhoon_close(struct video_device *dev) { struct typhoon_device *typhoon = dev->priv; typhoon->users--; } static struct typhoon_device typhoon_unit = { iobase: CONFIG_RADIO_TYPHOON_PORT, curfreq: CONFIG_RADIO_TYPHOON_MUTEFREQ, mutefreq: CONFIG_RADIO_TYPHOON_MUTEFREQ, }; static struct video_device typhoon_radio = { owner: THIS_MODULE, name: "Typhoon Radio", type: VID_TYPE_TUNER, hardware: VID_HARDWARE_TYPHOON, open: typhoon_open, close: typhoon_close, ioctl: typhoon_ioctl, }; #ifdef CONFIG_RADIO_TYPHOON_PROC_FS static int typhoon_get_info(char *buf, char **start, off_t offset, int len) { char *out = buf; #ifdef MODULE #define MODULEPROCSTRING "Driver loaded as a module" #else #define MODULEPROCSTRING "Driver compiled into kernel" #endif /* output must be kept under PAGE_SIZE */ out += sprintf(out, BANNER); out += sprintf(out, "Load type: " MODULEPROCSTRING "\n\n"); out += sprintf(out, "frequency = %lu kHz\n", typhoon_unit.curfreq >> 4); out += sprintf(out, "volume = %d\n", typhoon_unit.curvol); out += sprintf(out, "mute = %s\n", typhoon_unit.muted ? "on" : "off"); out += sprintf(out, "iobase = 0x%x\n", typhoon_unit.iobase); out += sprintf(out, "mute frequency = %lu kHz\n", typhoon_unit.mutefreq >> 4); return out - buf; } #endif /* CONFIG_RADIO_TYPHOON_PROC_FS */ MODULE_AUTHOR("Dr. Henrik Seidel"); MODULE_DESCRIPTION("A driver for the Typhoon radio card (a.k.a. EcoRadio)."); MODULE_LICENSE("GPL"); MODULE_PARM(io, "i"); MODULE_PARM_DESC(io, "I/O address of the Typhoon card (0x316 or 0x336)"); MODULE_PARM(mutefreq, "i"); MODULE_PARM_DESC(mutefreq, "Frequency used when muting the card (in kHz)"); MODULE_PARM(radio_nr, "i"); EXPORT_NO_SYMBOLS; static int io = -1; static int radio_nr = -1; #ifdef MODULE static unsigned long mutefreq = 0; #endif static int __init typhoon_init(void) { #ifdef MODULE if (io == -1) { printk(KERN_ERR "radio-typhoon: You must set an I/O address with io=0x316 or io=0x336\n"); return -EINVAL; } typhoon_unit.iobase = io; if (mutefreq < 87000 || mutefreq > 108500) { printk(KERN_ERR "radio-typhoon: You must set a frequency (in kHz) used when muting the card,\n"); printk(KERN_ERR "radio-typhoon: e.g. with \"mutefreq=87500\" (87000 <= mutefreq <= 108500)\n"); return -EINVAL; } typhoon_unit.mutefreq = mutefreq; #endif /* MODULE */ printk(KERN_INFO BANNER); io = typhoon_unit.iobase; if (!request_region(io, 8, "typhoon")) { printk(KERN_ERR "radio-typhoon: port 0x%x already in use\n", typhoon_unit.iobase); return -EBUSY; } typhoon_radio.priv = &typhoon_unit; if (video_register_device(&typhoon_radio, VFL_TYPE_RADIO, radio_nr) == -1) { release_region(io, 8); return -EINVAL; } printk(KERN_INFO "radio-typhoon: port 0x%x.\n", typhoon_unit.iobase); printk(KERN_INFO "radio-typhoon: mute frequency is %lu kHz.\n", typhoon_unit.mutefreq); typhoon_unit.mutefreq <<= 4; /* mute card - prevents noisy bootups */ typhoon_mute(&typhoon_unit); #ifdef CONFIG_RADIO_TYPHOON_PROC_FS if (!create_proc_info_entry("driver/radio-typhoon", 0, NULL, typhoon_get_info)) printk(KERN_ERR "radio-typhoon: registering /proc/driver/radio-typhoon failed\n"); #endif return 0; } static void __exit typhoon_cleanup_module(void) { #ifdef CONFIG_RADIO_TYPHOON_PROC_FS remove_proc_entry("driver/radio-typhoon", NULL); #endif video_unregister_device(&typhoon_radio); release_region(io, 8); } module_init(typhoon_init); module_exit(typhoon_cleanup_module); coccinelle-1.0.0-rc19/tests/switchtest.cocci0000644000175000017500000000044312247437436017736 0ustar eugeneugen@ switch_1 @ statement S_1,S_2; position p1,p2; @@ switch (...) { case 2:@p1 S_1 case 4:@p2 S_2 } @ script:python @ stmt_1 << switch_1.S_1;stmt_2 << switch_1.S_2; p1 << switch_1.p1;p2 << switch_1.p2; @@ print "--- switch" print stmt_1 print stmt_2 coccinelle-1.0.0-rc19/tests/comment_brace2.res0000644000175000017500000000016712247437436020131 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ { release_region(); continue; } return 0; } coccinelle-1.0.0-rc19/tests/test0.c0000644000175000017500000000005512247437436015735 0ustar eugeneugenint main(int i) { f(1); f(2); f(1); } coccinelle-1.0.0-rc19/tests/makes_a_loop.c0000644000175000017500000000037412247437436017333 0ustar eugeneugenstatic void * skel_probe(struct usb_device *udev, unsigned int ifnum, const struct usb_device_id *id) { if (retval) { foo(); for (minor = 0; minor < MAX_DEVICES; ++minor) { if (minor_table[minor] == NULL) goto out; } } out: return; } coccinelle-1.0.0-rc19/tests/ty.res0000644000175000017500000000006512247437436015702 0ustar eugeneugenint main () { const struct foo x; return 12; } coccinelle-1.0.0-rc19/tests/ty1.cocci0000644000175000017500000000010712247437436016247 0ustar eugeneugen@@ type T; identifier fn; @@ fn(...) { T x; - foo(int,T); } coccinelle-1.0.0-rc19/tests/ifadd.cocci0000644000175000017500000000005312247437436016601 0ustar eugeneugen@@ @@ if (...) { ... + foo(); // two(); } coccinelle-1.0.0-rc19/tests/initializer_many_fields.cocci0000644000175000017500000000005712247437436022433 0ustar eugeneugen@@ @@ *struct foo x = { .b = 15, .c = 22, }; coccinelle-1.0.0-rc19/tests/type.cocci0000644000175000017500000000010612247437436016512 0ustar eugeneugen@@ type T; @@ foo(...) { <... - T x; + T *x; ...> } coccinelle-1.0.0-rc19/tests/branchparen.cocci0000644000175000017500000000003012247437436020010 0ustar eugeneugen@@ @@ + foo(); xxx();coccinelle-1.0.0-rc19/tests/metahex.res0000644000175000017500000000001712247437436016676 0ustar eugeneugenint main() { } coccinelle-1.0.0-rc19/tests/strid2.c0000644000175000017500000000020612247437436016103 0ustar eugeneugenint main () { struct foo *a; enum foo1 *b; struct foo a1; enum foo1 b1; print(a); print(b); print(a1.x); print(b1); } coccinelle-1.0.0-rc19/tests/format2.cocci0000644000175000017500000000024312247437436017105 0ustar eugeneugen@r@ format d =~ ".x$"; position p; @@ foo@p("...%@d@...") @@ position r.p; @@ -foo@p(...); @script:ocaml@ d << r.d; @@ Printf.printf "format string is %s\n" d coccinelle-1.0.0-rc19/tests/nestplus.c0000644000175000017500000000007312247437436016553 0ustar eugeneugenint foo() { if (x) { xxx(); return;} yyy(); xxx(); } coccinelle-1.0.0-rc19/tests/paren1.c0000644000175000017500000000004312247437436016061 0ustar eugeneugenint main () { return (x) && y; } coccinelle-1.0.0-rc19/tests/getc.res0000644000175000017500000000011512247437436016164 0ustar eugeneugenint IFoo_QueryInterface(int *iface, long *riid, void **ppv) { return 12; } coccinelle-1.0.0-rc19/tests/minusall.res0000644000175000017500000000000012247437436017057 0ustar eugeneugencoccinelle-1.0.0-rc19/tests/reserved.cocci0000644000175000017500000000017512247437436017356 0ustar eugeneugen@@ expression type; expression error; expression list; @@ - f(type,type); - f(list,list,list); - f(error,error,error,error);coccinelle-1.0.0-rc19/tests/twoproto.cocci0000644000175000017500000000027012247437436017430 0ustar eugeneugen@@ identifier f, p_dev, link; @@ f(struct pcmcia_device * - p_dev + link ) { ... - dev_link_t *link = dev_to_instance(p_dev); ... } coccinelle-1.0.0-rc19/tests/decl2.cocci0000644000175000017500000000017612247437436016531 0ustar eugeneugen// pb: foo doesn't get added @@ identifier ioctl, cmd, arg; @@ ioctl(int cmd, void *arg) { ... - x + y ... } coccinelle-1.0.0-rc19/tests/hil1.cocci0000644000175000017500000000002012247437436016361 0ustar eugeneugen@@ @@ - 12 + 5 coccinelle-1.0.0-rc19/tests/reserved.c0000644000175000017500000000012712247437436016515 0ustar eugeneugenint main() { f(1,1); f(2,2,2); f(3,3,3,3); f(1,2); f(2,3,2); f(3,4,3,3); } coccinelle-1.0.0-rc19/tests/return.c0000644000175000017500000000015412247437436016215 0ustar eugeneugenvoid foo(int y) { int x; if (x) { aaa(); bbb(); return; } if (x) { aaa(); bbb(); return; } ccc(); } coccinelle-1.0.0-rc19/tests/kr.res0000644000175000017500000000004512247437436015660 0ustar eugeneugenint a(x) b c; { y = (j) r; } coccinelle-1.0.0-rc19/tests/ppos.cocci0000644000175000017500000000055512247437436016522 0ustar eugeneugen@a@ position p; identifier f; expression E; @@ f(...) { <... when strict ( E@p = ERR_PTR(...) | E@p = NULL ) ...> return E; } @b exists@ identifier f, fld; expression E,E1,E2; position p1, p2 != a.p; @@ f(...) { ( ... when any E@p2 = E1 ... when != E->fld when != E = E2 return@p1 E; | ... when != E->fld when != E = E2 return@p1 E; ) } coccinelle-1.0.0-rc19/tests/cards.res0000644000175000017500000000000712247437436016336 0ustar eugeneugenint x; coccinelle-1.0.0-rc19/tests/dropf.res0000644000175000017500000000005212247437436016354 0ustar eugeneugenint main() { x = f(1 + 3) + f(3 + 3); } coccinelle-1.0.0-rc19/tests/multi_inc.c0000644000175000017500000000006312247437436016660 0ustar eugeneugen#include "multi_inc1.h" int main () { f(xxx); } coccinelle-1.0.0-rc19/tests/switch_case.c0000644000175000017500000000015512247437436017173 0ustar eugeneugenvoid main(void) { switch(1) { case CASE1: case1(); break; case CASE2: case2(); break; } } coccinelle-1.0.0-rc19/tests/attradd.c0000644000175000017500000000003212247437436016314 0ustar eugeneugenint main () { char f; } coccinelle-1.0.0-rc19/tests/expopt3_ver2.c0000644000175000017500000000020112247437436017227 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner v; f(v.field1, v.field2); } coccinelle-1.0.0-rc19/tests/const1.c0000644000175000017500000000006612247437436016107 0ustar eugeneugenvoid foo(int j) { const char *i; int i; i++; } coccinelle-1.0.0-rc19/tests/three_types.cocci0000644000175000017500000000061512247437436020071 0ustar eugeneugen@ non_delayed_fn disable all @ type local_type; local_type *device; identifier fld, fn; @@ INIT_WORK(&device->fld, - fn, device + fn ); @ rule7a disable all @ identifier dataq, non_delayed_fn.fn, non_delayed_fn.fld; type non_delayed_fn.local_type; @@ fn ( - void *dataq + struct work_struct *workq ) { <... - dataq + container_of(workq,local_type,fld) ...> } coccinelle-1.0.0-rc19/tests/memory.c0000644000175000017500000000017112247437436016205 0ustar eugeneugen#define BAD_MAGIC(q,m) 0 int __queue_add(Queue_t *queue, Scsi_Cmnd *SCpnt, int head) { if (BAD_MAGIC(1,12)) BUG(); } coccinelle-1.0.0-rc19/tests/expopt.c0000644000175000017500000000005312247437436016213 0ustar eugeneugenint main() { int *x; f(x); *x = 7; } coccinelle-1.0.0-rc19/tests/julia10.res0000644000175000017500000000004312247437436016507 0ustar eugeneugenint main(int x) { f(); g(); } coccinelle-1.0.0-rc19/tests/serio.cocci0000644000175000017500000000052412247437436016656 0ustar eugeneugen@ rule1 @ type T; identifier lock; @@ T { ... struct semaphore lock; ... }; @ rule1a @ type rule1.T; T data; identifier rule1.lock; @@ - init_MUTEX + mutex_init (&data. - lock + new_lock ) @@ type rule1.T; identifier rule1.lock; @@ T { ... - struct semaphore lock; + struct mutex new_lock; ... }; coccinelle-1.0.0-rc19/tests/km.res0000644000175000017500000000012712247437436015654 0ustar eugeneugenint main() { int *data = kzalloc(element->string.length + 1, GFP_KERNEL); foo(); } coccinelle-1.0.0-rc19/tests/macro.c0000644000175000017500000000025612247437436016002 0ustar eugeneugen#define SC_FCMND(fcmnd) ((Scsi_Cmnd *)((long)fcmnd - (long)&(((Scsi_Cmnd *)0)->SCp))) int main() { return ((Scsi_Cmnd *)((long)fcmnd - (long)&(((Scsi_Cmnd *)0)->SCp))); } coccinelle-1.0.0-rc19/tests/multivars.c0000644000175000017500000000006712247437436016727 0ustar eugeneugenvoid main(int i) { f(1+2+v.field1,1+2+v.field1); } coccinelle-1.0.0-rc19/tests/video_ver1.c0000644000175000017500000000200312247437436016734 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; if (cmd == VIDIOCGTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v)) != 0) ret(-EFAULT); else {} if (v.tuner) /* Only 1 tuner */ ret(-EINVAL); v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, v, sizeof(v))) ret(-EFAULT); else {} ret(0); }/* else if (cmd == VIDIOCSTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v))) ret(-EFAULT); else {} if (v.tuner != 0) ret(-EINVAL); ret(0); } else if(cmd == VIDIOCSFREQ) { if (copy_from_user(typhoon->curfreq, arg, sizeof(typhoon->curfreq))) ret(-EFAULT); else {} typhoon_setfreq(typhoon, typhoon->curfreq); ret(0); }*/ return -ENOIOCTLCMD; } coccinelle-1.0.0-rc19/tests/mult.c0000644000175000017500000000006712247437436015662 0ustar eugeneugen// doesn't match int main() { xxx(27); goo(27); } coccinelle-1.0.0-rc19/tests/useless_cast.cocci0000644000175000017500000000007512247437436020233 0ustar eugeneugen@r@ type T; identifier x; T E; @@ T x = - (T) E; coccinelle-1.0.0-rc19/tests/static.cocci0000644000175000017500000000007012247437436017020 0ustar eugeneugen@@ statement S; identifier f; @@ static f(...) { - S } coccinelle-1.0.0-rc19/tests/rem2.res0000644000175000017500000000004212247437436016106 0ustar eugeneugenint main () { xxx(); yyy(); } coccinelle-1.0.0-rc19/tests/badcomma.cocci0000644000175000017500000000010112247437436017267 0ustar eugeneugen@@ @@ - struct usb_serial_device_type + struct usb_serial_driver coccinelle-1.0.0-rc19/tests/exp.res0000644000175000017500000000014312247437436016037 0ustar eugeneugenint main(int i) { int k = bar(); if(1) { bar(); } else { bar(); } bar(); } coccinelle-1.0.0-rc19/tests/badfree.cocci0000644000175000017500000000021112247437436017116 0ustar eugeneugen@@ expression x; expression E; expression f; @@ free(x); ... WHEN != x = E + printf("possible use after free!!\n"); f(...,x,...); coccinelle-1.0.0-rc19/tests/braces.cocci0000644000175000017500000000003212247437436016766 0ustar eugeneugen@@ @@ - { foo(); - } coccinelle-1.0.0-rc19/tests/dc_close.cocci0000644000175000017500000000037712247437436017316 0ustar eugeneugen@@ //identifier rule3.d_fill_fifo; struct IsdnCardState *cs; identifier E; @@ ... when != cs->DC_Send_Data ( + cs->DC_Send_Data = d_fill_fifo; cs->DC_Close = E; | + cs->DC_Send_Data = &d_fill_fifo; cs->DC_Close = &E; ) ... when != cs->DC_Send_Data coccinelle-1.0.0-rc19/tests/edots.cocci0000644000175000017500000000004112247437436016645 0ustar eugeneugen@@ identifier x; @@ - x[...] + xcoccinelle-1.0.0-rc19/tests/nocast.c0000644000175000017500000000015612247437436016167 0ustar eugeneugenint main (unsigned int __nocast gfp_mask, int x) { buf = kmalloc(sizeof *send_buf + buf_size, gfp_mask); } coccinelle-1.0.0-rc19/tests/localid.cocci0000644000175000017500000000017512247437436017146 0ustar eugeneugen@@ local idexpression int x; @@ - f(x); @@ idexpression int x; @@ - f(x); + g(x); @@ idexpression x; @@ - f(x); + h(x); coccinelle-1.0.0-rc19/tests/fn_todo.res0000644000175000017500000000051212247437436016673 0ustar eugeneugenstatic void task_kill_later(struct asd_ascb *ascb) { struct asd_ha_struct *asd_ha = ascb->ha; struct sas_ha_struct *sas_ha = &asd_ha->sas_ha; struct Scsi_Host *shost = sas_ha->core.shost; struct sas_task *task = ascb->uldd_task; INIT_WORK(&task->abort_work, sas_task_abort); queue_work(shost->work_q, &task->abort_work); } coccinelle-1.0.0-rc19/tests/not_converted.cocci0000644000175000017500000000107012247437436020403 0ustar eugeneugen// A variable is used between two affectations. // // Confidence: High // Copyright: (C) Nicolas Palix, Julia Lawall, DIKU. GPLv2. // URL: // Options: -ifdef_to_if @filter@ local idexpression E; expression Er; @@ E = Er; @r @ local idexpression filter.E; position b; position e,f; expression E1; expression E2; @@ E@b = E1; ... when != E when strict ( E@f = <+...E...+>; | E@e = E2; ) @script:python@ p1 << r.b; p2 << r.e; p3 << r.f; @@ cocci.include_match(False) @script:python@ p1 << r.b; p2 << r.e; @@ cocci.print_main("",p1) cocci.print_secs("",p2) coccinelle-1.0.0-rc19/tests/pb_distribute_type.c0000644000175000017500000000016112247437436020574 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.0-rc19/tests/edots_ver1.res0000644000175000017500000000006512247437436017321 0ustar eugeneugenvoid main(int i) { foo; bar; f(foo + bar); } coccinelle-1.0.0-rc19/tests/constrem.res0000644000175000017500000000000112247437436017066 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/protox.res0000644000175000017500000000005312247437436016576 0ustar eugeneugenint f(int x); int f(int x) { return 12; } coccinelle-1.0.0-rc19/tests/match_init.cocci0000644000175000017500000000005212247437436017650 0ustar eugeneugen@@ expression x; @@ -x = 3 +a=12 ... f(x)coccinelle-1.0.0-rc19/tests/multichars.res0000644000175000017500000000007512247437436017422 0ustar eugeneugenint main () { f('XYZ',12); f('X\nY',12); f('\n',12); } coccinelle-1.0.0-rc19/tests/nocast.cocci0000644000175000017500000000016712247437436017027 0ustar eugeneugen@@ identifier f, gfp; type T; @@ f(..., - T gfp + gfp_t gfp , ...) { ... kmalloc(...,gfp) ... } coccinelle-1.0.0-rc19/tests/td.cocci0000644000175000017500000000005012247437436016136 0ustar eugeneugen@@ type T; @@ T { - int a; + int b; }; coccinelle-1.0.0-rc19/tests/addif2.c0000644000175000017500000000010512247437436016023 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/ip2.cocci0000644000175000017500000000010712247437436016224 0ustar eugeneugen@@ statement s1, s2; @@ if(...) +{trace("ifelel"); s1 +} else s2 coccinelle-1.0.0-rc19/tests/pb_distribute_type2.res0000644000175000017500000000016612247437436021232 0ustar eugeneugenint foo() { int *x; return 0; } int foo() { int **x; return 0; } int foo() { int (*x)[45]; return 0; } coccinelle-1.0.0-rc19/tests/double_lines.c0000644000175000017500000000010212247437436017333 0ustar eugeneugenint main () { test(); foo(); foo(); foo(); endtest(); } coccinelle-1.0.0-rc19/tests/test12.cocci0000644000175000017500000000006612247437436016660 0ustar eugeneugen@@ expression X, Y; @@ - f(X) + f(X, Y) ... g(Y) coccinelle-1.0.0-rc19/tests/addaft.res0000644000175000017500000000010612247437436016465 0ustar eugeneugenint main () { foo(); bar(); foo(); bar(); foo(); bar(); } coccinelle-1.0.0-rc19/tests/keep_comma.c0000644000175000017500000000013012247437436016770 0ustar eugeneugenint main () { foo(); snd_assert(!atomic_read(&substream->runtime->mmap_count), ); } coccinelle-1.0.0-rc19/tests/tydisj.cocci0000644000175000017500000000036312247437436017044 0ustar eugeneugen@func@ typedef int64_t; typedef uint64_t; identifier f; position p; expression E; type T; {int,unsigned,long,unsigned long} i; @@ ( int64_t | uint64_t ) f(...) { ( int64_t | uint64_t ) a; ... + xxx(); return <+... i <<@p E ...+>; ... } coccinelle-1.0.0-rc19/tests/badexp.c0000644000175000017500000000004212247437436016135 0ustar eugeneugenint main() { foo(a); b = a; } coccinelle-1.0.0-rc19/tests/const1bis.cocci0000644000175000017500000000013012247437436017433 0ustar eugeneugen@disable add_signed@ identifier func;@@ func (...) { - const int i; + float i; ... } coccinelle-1.0.0-rc19/tests/headers.cocci0000644000175000017500000000030212247437436017142 0ustar eugeneugen@ rule1 @ identifier f; @@ usb_fill_bulk_urb(f) @ rule2 extends rule1 @ identifier p1, p2; @@ - void f(struct urb *p1, struct pt_regs *p2) + void f(struct urb *p1) { ... when != p2 } coccinelle-1.0.0-rc19/tests/ctr_unit_test.c0000644000175000017500000000060612247437436017566 0ustar eugeneugen int classA(int i) { if(classA()) { x=0; } UnitTestEntry("A1"); if(MethodA1()) { } if(MethodA2()) { } UnitTestEntry("A3"); if(MethodA3()) { } if(MethodA4()) { } } int classB(int i) { if(classB()) { x=0; } if(MethodB1()) { } UnitTestEntry("B2"); if(MethodB2()) { } if(MethodB3()) { } UnitTestEntry("B4"); if(MethodB4()) { } } int lastfunction(int i) { } coccinelle-1.0.0-rc19/tests/minstruct.cocci0000644000175000017500000000014512247437436017564 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, + .dev = { .name = E, }, }; coccinelle-1.0.0-rc19/tests/badzero.c0000644000175000017500000000023212247437436016321 0ustar eugeneugenint main () { int *x; int *y; int z; if (y - x == 0) return; if ((y - x) == 0) return; if (y - z == 0) return; if ((y - z) == 0) return; } coccinelle-1.0.0-rc19/tests/addbeforeafter.res0000644000175000017500000000013712247437436020203 0ustar eugeneugenint main () { if (x) { foo(); goto out; bar(); } after(); out: return 0; } coccinelle-1.0.0-rc19/tests/param.c0000644000175000017500000000002712247437436015775 0ustar eugeneugenvoid foo() { return; } coccinelle-1.0.0-rc19/tests/pb_distribute_type.res0000644000175000017500000000016612247437436021150 0ustar eugeneugenint foo() { int *x; return 0; } int foo() { int **x; return 0; } int foo() { int (*x)[45]; return 0; } coccinelle-1.0.0-rc19/tests/double_switch.c0000644000175000017500000000070412247437436017532 0ustar eugeneugen static NTSTATUS get_line_control(int fd, SERIAL_LINE_CONTROL* slc) { #ifdef CMSPAR switch (port.c_cflag & (PARENB | PARODD | CMSPAR)) #else switch (port.c_cflag & (PARENB | PARODD)) #endif { case 0: slc->Parity = NOPARITY; break; case PARENB: slc->Parity = EVENPARITY; break; case PARENB|PARODD: slc->Parity = ODDPARITY; break; } return STATUS_SUCCESS; } coccinelle-1.0.0-rc19/tests/lvalue.res0000644000175000017500000000012712247437436016535 0ustar eugeneugenint main() { f(x) = f(x) + 1; *f(x) = 12; // or maybe f(x) has to be in parens? } coccinelle-1.0.0-rc19/tests/positionc.c0000644000175000017500000000037312247437436016710 0ustar eugeneugenint main () { if (foo(6,7)) x = ret; else x = ret; if (foo(6,7)) x = ret; else x = ret; if (foo(7,7)) x = ret; else x = ret; if (bar(6,7)) x = ret; else x = ret; if (bar(6,7)) x = ret; else x = ret; if (bar(7,7)) x = ret; else x = ret; } coccinelle-1.0.0-rc19/tests/define_chip_t.c0000644000175000017500000000054212247437436017457 0ustar eugeneugen#define chip_t vortex_t //#define chip_t float static int snd_vortex_pcm_hw_params(snd_pcm_substream_t * substream, snd_pcm_hw_params_t * hw_params) { chip_t *chip = snd_pcm_substream_chip(substream); stream_t *stream = (stream_t *) (substream->runtime->private_data); snd_pcm_sgbuf_t *sgbuf; int err; } float main(float x) { float y; } coccinelle-1.0.0-rc19/tests/lvalue.cocci0000644000175000017500000000002212247437436017016 0ustar eugeneugen@@ @@ - x + f(x) coccinelle-1.0.0-rc19/tests/badexp1.c0000644000175000017500000000004112247437436016215 0ustar eugeneugenint main() { foo(a); a(y); } coccinelle-1.0.0-rc19/tests/testprint.cocci0000644000175000017500000000017012247437436017566 0ustar eugeneugen@ rule1 @ expression X,Y,Z; @@ f(X); ... when any, strict g(Z); ... when any, strict - h(Y); + h(X,Y,Z); coccinelle-1.0.0-rc19/tests/ctr_unit_test.cocci0000644000175000017500000000250712247437436020426 0ustar eugeneugen@ rule1 @ identifier C, i; @@ int C(int i) { ... if(C()) { ... } ... + if(UnitTest()) { + int c; + C(); + } } @@ identifier TestMethod, i; expression name; statement S1,S2; identifier rule1.C; // if put identifier name; then cocci does not help // to say that there is a partial match :( @@ // int C(int i) { // ... // UnitTestEntry(name); // if(TestMethod()) { ... } // ... // if(UnitTest()) { // int c; // ... //+ c = C(); //+ Console.WriteLine("invoking test", name); //+ c.TestMethod(); // } // } // int C(int i) { // <... UnitTestEntry(...); ...> // UnitTestEntry(name); // if(TestMethod()) { ... } // <... UnitTestEntry(...); ...> // } // or simply (does not work ) // int C(int i) { // <... // UnitTestEntry(name); // if(TestMethod()) { ... } // ...> // } // or int C(int i) { // <... UnitTestEntry(name); if(TestMethod()) { ... } ...> // <... UnitTestEntry(...); if(...) { ... } ...> <... S1 ...> UnitTestEntry(name); if(TestMethod()) { ... } <... S2 ...> // <... UnitTestEntry(...); if(...) { ... } ...> // <... UnitTestEntry(name); if(TestMethod()) { ... } ...> } @@ identifier rule1.C, i, c; @@ int C(int i) { ... if(UnitTest()) { struct foo c; ... + c = C(); + Console.WriteLine("invoking test", name); + c.TestMethod(); } } coccinelle-1.0.0-rc19/tests/test8.cocci0000644000175000017500000000016512247437436016605 0ustar eugeneugen@@ identifier bar; identifier i; identifier func; @@ func( + char i, int bar) { ... - int i; ... } coccinelle-1.0.0-rc19/tests/retest.res0000644000175000017500000000007412247437436016554 0ustar eugeneugenint main () { foo(); if (f(x)) return 3; bar(); } coccinelle-1.0.0-rc19/tests/null_bool.c0000644000175000017500000000020712247437436016662 0ustar eugeneugenint main () { if (x != NULL) return; if (a && x != NULL && b) return; if (x) return; if (a && x && b) return; x = x + 20; } coccinelle-1.0.0-rc19/tests/positions3.cocci0000644000175000017500000000042212247437436017644 0ustar eugeneugen@rule1@ expression E; position p1,p2,p3,p4; @@ * f(E@p1, xxx, E@p2); ... * f(E@p3, xxx, E@p4); @@ expression rule1.E; position p1,p2; @@ * g(E@p1, xxx, E); ... * g(E, xxx, E@p2); @@ expression rule1.E; position p1,p2; @@ * h(E, xxx, E@p1); ... * h(E@p2, xxx, E); coccinelle-1.0.0-rc19/tests/anon.res0000644000175000017500000000061712247437436016204 0ustar eugeneugentypedef struct { struct work_struct ppa_tq; /* Polling interrupt stuff */ } ppa_struct; static void ppa_interrupt(void *data) { ppa_struct *dev = (ppa_struct *) data; schedule_delayed_work(&dev->ppa_tq, 1); } static int ppa_queuecommand(struct scsi_cmnd *cmd, void (*done) (struct scsi_cmnd *)) { ppa_struct *dev = ppa_dev(cmd->device->host); schedule_delayed_work(&dev->ppa_tq,0); } coccinelle-1.0.0-rc19/tests/pb_distribute_type2.c0000644000175000017500000000016112247437436020656 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.0-rc19/tests/ret2.c0000644000175000017500000000011312247437436015545 0ustar eugeneugenint main() { if (foo()) xxx(); xxx(); if (foo()) return; return; } coccinelle-1.0.0-rc19/tests/toplevel_struct.res0000644000175000017500000000365112247437436020510 0ustar eugeneugenstruct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info2 = usb_storage_proc_info2, .foo = 12, .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; /* For a device that is "Not Ready" */ unsigned char usb_stor_sense_notready[18] = { [0] = 0x70, /* current error */ [2] = 0x02, /* not ready */ [7] = 0x0a, /* additional length */ [12] = 0x04, /* not ready */ [13] = 0x03 /* manual intervention */ }; void usb_storage_proc_info(int i) { g(1); } void usb_storage_proc_info2(int i) { g(27); } void not_usb_storage_proc_info(int i) { f(1); } coccinelle-1.0.0-rc19/tests/dropbr.cocci0000644000175000017500000000005312247437436017022 0ustar eugeneugen@@ @@ if (...) - { - bar( + foo( ); - } coccinelle-1.0.0-rc19/tests/a3d.c0000644000175000017500000000054612247437436015352 0ustar eugeneugenstruct a3d { struct gameport adc; struct input_dev dev; }; static void a3d_connect(struct gameport *gameport, struct gameport_dev *dev) { struct a3d *a3d; a3d->adc.idbus = BUS_GAMEPORT; a3d->dev.idbus = BUS_GAMEPORT; } static void a3d_connect(struct gameport *gameport, struct gameport_dev *dev) { struct a3d *a3d; a3d->adc.idbus = BUS_GAMEPORT; } coccinelle-1.0.0-rc19/tests/posmult.c0000644000175000017500000000017212247437436016401 0ustar eugeneugenint main() { int *x = NULL; int *y = NULL; if (r) x = ALLOC(); y = ALLOC(); if (!x) return; if (!y) return; } coccinelle-1.0.0-rc19/tests/pt_regs_summary0000644000175000017500000001044412247437436017700 0ustar eugeneugenThe semantic patch that does transformation first checks that linux/interrupt.h is included. This header file specifies the type of request_irq. There are multiple definitions of request_irq and the ones in the following two files still expect a parameter with a pt_regs-typed parameter. Nevertheless, these files also include linux/interrupt.h, and so it seems that the definitions should be changed accordingly. arch/h8300/platform/h8s/ints.c arch/arm26/kernel/irq.c The semantic patch then identifies an interrupt handler function as one that is passed to request_irq, checks that the definition of this function is static (so we don't have to worry about calls to it from other files), updates its parameter list if there are no references to its regs parameter, updates any calls to it where the last argument is NULL, and inserts a warning message in any calls that have a non-NULL argument. The purpose of the warning, rather than just dropping the argument, is that dropping the argument may cause some variables to no longer be used, and thus other changes might be useful. However, in the files that trigger the collateral evolution there is never a direct call to the interrupt handling function, either with NULL or some other value as the final argument. The sgrep semantic patch detects the negation of the above: cases where either linux/interrupt.h is not included, or the interrupt handling function is not static, or the interrupt handling function uses its pt_regs-typed parameter. Files that are transformed: --- /home/julia/linux-2.6/arch/cris/arch-v10/drivers/gpio.c --- /home/julia/linux-2.6/arch/cris/arch-v10/kernel/fasttimer.c --- /home/julia/linux-2.6/arch/cris/arch-v32/drivers/cryptocop.c --- /home/julia/linux-2.6/arch/cris/arch-v32/drivers/gpio.c --- /home/julia/linux-2.6/arch/cris/arch-v32/drivers/sync_serial.c --- /home/julia/linux-2.6/arch/cris/arch-v32/kernel/fasttimer.c In all of the above, the transformation applies straightforwardly. The interrupt handling function is static and it does not use its pt_regs-typed parameter. --- /home/julia/linux-2.6/arch/cris/kernel/irq.c In this file the change is to remove the pt_regs-typed argument from __do_IRQ. The enclosing function now has no need for the pt_regs-typed parameter, but we have not constructed the semantic patch to transform it and its callers. Indeed, its callers appear never to be called themselves. --- /home/julia/linux-2.6/arch/v850/kernel/gbus_int.c In this file the interrupt handling function calls handle_irq with its pt_regs-typed argument. But handle_irq doesn't need this argument, as noted below. --- /home/julia/linux-2.6/arch/v850/kernel/irq.c This file contains the definition of handle_irq. It passes its pt_regs-typed argument to the function __do_IRQ. But __do_IRQ no longer wants a pt_regs-typed argument either. And so we can remove it from both the call and the parameter list, enabling the transformation in gbus_int.c and rte_me2_cb.c. PROBLEM: The .h file should have been updated as well, but this does not seem to have been done. --- /home/julia/linux-2.6/arch/v850/kernel/rte_me2_cb.c In this file the interrupt handling function calls handle_irq with its pt_regs-typed argument. But handle_irq doesn't need this argument, as noted above. --- /home/julia/linux-2.6/drivers/spi/au1550_spi.c This file was added to the Linux kernel source tree quite recently: commit 63bd23591e6c3891d34e4c6dba7c6aa41b05caad Author: Jan Nikitenko Date: Tue May 8 00:32:25 2007 -0700 Other cases, noted by sgrep: --- /home/julia/linux-2.6/arch/cris/arch-v32/kernel/arbiter.c In this case, the transformation should apply, but the pt_regs-typed parameter is used in what appears to be debugging code, which has to be changed by hand. --- /home/julia/linux-2.6/arch/m68knommu/kernel/comempci.c In this case, the interrupt handler has the wrong signature, as it returns void rather than irqreturn_t. Perhaps this file is dead code. --- /home/julia/linux-2.6/arch/blackfin/oprofile/timer_int.c In this case, the file doesn't (directly) include linux/interrupt.h. It is not clear what definition of request_irq is being used and thus what type is expected for the interrupt handling functioncoccinelle-1.0.0-rc19/tests/structfoo.cocci0000644000175000017500000000013612247437436017564 0ustar eugeneugen@@ declarer name FOO; @@ - struct foo my_foo[] = { - .a = 1, - .u.b = 42, - }; + FOO(1, 42); coccinelle-1.0.0-rc19/tests/eb1.cocci0000644000175000017500000000050712247437436016205 0ustar eugeneugen@rule1@ identifier p; identifier func; identifier fdl; @@ func(...) { <+... Packet p; ... ( - p.fdl + p->fdl | - &p + p ) ...+> } @rule2@ identifier p; identifier func; statement S; @@ func(...) { ... Packet - p + *p = SCMalloc(SIZE_OF_PACKET) ; ... ++if (p == NULL) return 0; S ... ++SCFree(p); return ...; } coccinelle-1.0.0-rc19/tests/local.res0000644000175000017500000000005212247437436016334 0ustar eugeneugenint f(int a, int b, int yy) { return 0; } coccinelle-1.0.0-rc19/tests/formatlist.c0000644000175000017500000000043412247437436017063 0ustar eugeneugenint main () { foo("xyz %d abc"); foo("xyz %d %d abc"); foo("mno %d %d abc"); foo("mno %d abc %d %d abc %d"); foo("xyz %d abc %d %d abc %d"); foo("xyz %d abc %d %d abc %d mno"); foo("xyz %d abc %d %d abc %d %d abc %d"); foo("xyz %d abc %d %d abc"); foo("xyz abc"); } coccinelle-1.0.0-rc19/tests/tyex.c0000644000175000017500000000024512247437436015670 0ustar eugeneugen typedef struct { double x; double y; char *name; } Location; int main () { Location a; Location *b; foo (a.x,a.y,a.name); foo (b->x,b->y,b->name); } coccinelle-1.0.0-rc19/tests/pb_distribute_type.cocci0000644000175000017500000000007512247437436021436 0ustar eugeneugen@@ type T; @@ foo(...) { - T x; + T *x; ... } coccinelle-1.0.0-rc19/tests/local.cocci0000644000175000017500000000014212247437436016623 0ustar eugeneugen@@ local function f; identifier x, y; @@ f( + int a, int b, - int x, int y ) { ... } coccinelle-1.0.0-rc19/tests/structfoo.res0000644000175000017500000000001412247437436017270 0ustar eugeneugenFOO(1, 42); coccinelle-1.0.0-rc19/tests/const_adding.cocci0000644000175000017500000000020712247437436020167 0ustar eugeneugen@@ identifier I; @@ ( const struct file_operations I; | + const struct file_operations I; ) //- const struct file_operations I; coccinelle-1.0.0-rc19/tests/yloop.cocci0000644000175000017500000000027112247437436016676 0ustar eugeneugen@@ identifier buffer; identifier hostptr; @@ arxescsi_proc_info ( + struct Scsi_Host *hostptr, char *buffer) { ... - hostptr = scsi_host_hn_get(hostno); ... } coccinelle-1.0.0-rc19/tests/labels_metastatement2.cocci0000644000175000017500000000007412247437436022014 0ustar eugeneugen@@ statement S; @@ if (x) S // if S1 else S2 + else foo();coccinelle-1.0.0-rc19/tests/rule3.cocci0000644000175000017500000000041012247437436016561 0ustar eugeneugen@@ // struct us_data *E1; // struct us_data E1; expression E1; expression E2; @@ //- usb_stor_clear_halt(E1->pusb_dev,E2) //- usb_stor_clear_halt(E1.pusb_dev,E2) - usb_clear_halt(E1->pusb_dev, E2) + usb_stor_clear_halt(E1, E2) //error words = [usb_clear_halt] coccinelle-1.0.0-rc19/tests/exp.cocci0000644000175000017500000000002612247437436016326 0ustar eugeneugen@@ @@ - foo() + bar()coccinelle-1.0.0-rc19/tests/string.cocci0000644000175000017500000000010712247437436017040 0ustar eugeneugen@@ identifier I; @@ - MODULE_PARM(I, "i"); + module_param(I, int, 0); coccinelle-1.0.0-rc19/tests/initializer_iso.c0000644000175000017500000000037312247437436020076 0ustar eugeneugen struct SHT template = { .field1 = 1, .proc_info = my_proc_info, .field2 = 2, }; int my_proc_info(int i) { } int foo(struct SHT * tpnt) { tpnt->proc_info = my_proc_info2; } int my_proc_info2(int i) { } int not_proc_info(int i) { } coccinelle-1.0.0-rc19/tests/strid2.cocci0000644000175000017500000000012312247437436016737 0ustar eugeneugen@r@ expression struct *a; @@ -a +f(a,12) @s@ expression enum *a; @@ -a +f(a,12) coccinelle-1.0.0-rc19/tests/disjexpr.c0000644000175000017500000000005312247437436016524 0ustar eugeneugenint main (int i) { f(v.fld, v, v.fld2); } coccinelle-1.0.0-rc19/tests/addfield.cocci0000644000175000017500000000016512247437436017272 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, ..., + .dev = { .name = E, }, }; coccinelle-1.0.0-rc19/tests/foura.cocci0000644000175000017500000000011012247437436016640 0ustar eugeneugen@ rule1 @ expression E; @@ h(E); @ rule2 extends rule1 @ @@ - i(E); coccinelle-1.0.0-rc19/tests/shadow.c0000644000175000017500000000006012247437436016157 0ustar eugeneugenstruct foo bar; struct foo bar = { .a = 12 }; coccinelle-1.0.0-rc19/tests/na.cocci0000644000175000017500000000006112247437436016127 0ustar eugeneugen@r @ expression E; constant C; @@ - !E & C + 12 coccinelle-1.0.0-rc19/tests/type_ver2.res0000644000175000017500000000005112247437436017160 0ustar eugeneugenint foo() { int *x[10]; return 0; } coccinelle-1.0.0-rc19/tests/ifdefmeta3.c0000644000175000017500000000014412247437436016704 0ustar eugeneugenint main () { f(); if (foo) { one(); #ifdef ONE two(); #endif three(); } g(); } coccinelle-1.0.0-rc19/tests/hd.c0000644000175000017500000000006312247437436015270 0ustar eugeneugen#include "hd.h" int f(int x, int y) { return x; } coccinelle-1.0.0-rc19/tests/rule19a.cocci0000644000175000017500000000023112247437436017012 0ustar eugeneugen@@ identifier interrupt; statement S; @@ interrupt(...) { ... ( + spin_unlock(&cs->lock); return; | S + spin_unlock(&cs->lock); ) } coccinelle-1.0.0-rc19/tests/max.cocci0000644000175000017500000000023212247437436016316 0ustar eugeneugen@x@ position pc,pm,pi; expression E; @@ if@pc (E@pm) return i@pi; @@ position x.pc,x.pm,x.pi; expression E; @@ if@pc (E@pm) - return i@pi; + return 3; coccinelle-1.0.0-rc19/tests/addbefore.res0000644000175000017500000000012412247437436017155 0ustar eugeneugenint main () { if (x) { foo(); goto out; } after(); out: return 0; } coccinelle-1.0.0-rc19/tests/test6.cocci0000644000175000017500000000007612247437436016604 0ustar eugeneugen@@ expression X; @@ - f(X) + f(X, "foo") //error words = [f]coccinelle-1.0.0-rc19/tests/const_implicit_iso.cocci0000644000175000017500000000005112247437436021422 0ustar eugeneugen@@ identifier x; @@ - int x; + float x; coccinelle-1.0.0-rc19/tests/match_const.c0000644000175000017500000000001512247437436017174 0ustar eugeneugenconst int x; coccinelle-1.0.0-rc19/tests/minusall.cocci0000644000175000017500000000002712247437436017357 0ustar eugeneugen@@ @@ - f(...) { ... }coccinelle-1.0.0-rc19/tests/bad_typedef.cocci0000644000175000017500000000024212247437436020000 0ustar eugeneugen@ rule1 @ type T; identifier lock; @@ T { ... struct semaphore lock; ... }; @@ type rule1.T; identifier rule1.lock; T *x; @@ - x->lock + x->new_lock coccinelle-1.0.0-rc19/tests/define_exp.c0000644000175000017500000000015312247437436017003 0ustar eugeneugen#define IRQ_T(info) ((info->flags & ASYNC_SHARE_IRQ) ? \ SA_SHIRQ : SA_INTERRUPT) void main(int i) { } coccinelle-1.0.0-rc19/tests/fnty.cocci0000644000175000017500000000050312247437436016512 0ustar eugeneugen@structure@ identifier idtype, y; type t; position p; @@ struct idtype { ... t (*y)(...);@p ... }; @bad@ identifier structure.idtype, y; type t; position p != structure.p; @@ struct idtype { ... t y;@p ... }; @depends on !bad@ identifier structure.idtype; @@ struct - idtype + newname { ... }; coccinelle-1.0.0-rc19/tests/ar.cocci0000644000175000017500000000010512247437436016132 0ustar eugeneugen@@ struct foo *x; @@ - x->y = 12; @@ struct foo x; @@ - x.y = 12; coccinelle-1.0.0-rc19/tests/null_type.cocci0000644000175000017500000000004012247437436017541 0ustar eugeneugen@@ expression *X; @@ - X + f(X)coccinelle-1.0.0-rc19/tests/armatch.cocci0000644000175000017500000000010112247437436017143 0ustar eugeneugen@@ type T; T[] x; expression y; @@ ( sizeof(x) | * sizeof(y) )coccinelle-1.0.0-rc19/tests/edots_ver1.c0000644000175000017500000000011512247437436016746 0ustar eugeneugenvoid main(int i) { foo[45]; bar[45+v.field]; f(foo[45] + bar[45]); } coccinelle-1.0.0-rc19/tests/struct_typedef.res0000644000175000017500000000035212247437436020311 0ustar eugeneugentypedef struct dvb2_frontend { struct dvb_frontend_ops ops; } xx_t; typedef struct { u8 RESET :1; u8 IDLE :1; u8 STOP :1; u8 HIRQ0 :1; u8 HIRQ1 :1; u8 na0 :1; u8 HABAV :1; u8 na1 :1; } bcm3510_register_value; coccinelle-1.0.0-rc19/tests/regexp.res0000644000175000017500000000062312247437436016540 0ustar eugeneugenint main(void) { int foo; int foo_begins_by_foo; int foo_ends_by_foo; int foo_contains_foo; int foo_is_an_id; int bar; int bar_doesn_t_contain_foo; int bar_is_an_id; int foobar; int foobar_begins_by_foo; int foobar_contains_foo; int foobar_is_an_id; int barfoobar; int barfoobar_contains_foo; int barfoobar_is_an_id; int barfoo; int barfoo_ends_by_foo; int barfoo_contains_foo; int barfoo_is_an_id; } coccinelle-1.0.0-rc19/tests/ret2.cocci0000644000175000017500000000005312247437436016406 0ustar eugeneugen@@ @@ - return; @@ @@ + bar(); xxx(); coccinelle-1.0.0-rc19/tests/exitc.c0000644000175000017500000000006612247437436016014 0ustar eugeneugenint main () { f(a1); f(a2); f(done); f(a4); } coccinelle-1.0.0-rc19/tests/p9.cocci0000644000175000017500000000010412247437436016057 0ustar eugeneugen@@ fresh identifier i = "v"; type T; @@ f(...,T + i ,...) {...} coccinelle-1.0.0-rc19/tests/pb_tag_symbols.cocci0000644000175000017500000000015712247437436020543 0ustar eugeneugen@@ identifier arg; identifier v; expression E1;//, E2; @@ - if(copy_from_user(v,arg) != 0) return E1; else { }coccinelle-1.0.0-rc19/tests/useless_cast.res0000644000175000017500000000052512247437436017744 0ustar eugeneugen // from: http://kernelnewbies.org/KernelJanitors/Todo struct device { struct netdev_private *priv; struct netdev_private2 *priv2; }; struct device *dev; struct netdev_private *np = dev->priv; struct netdev_private *np2 = (struct netdev_private *) dev->priv2; struct netdev_private *np3 = (struct netdev_private *) dev; coccinelle-1.0.0-rc19/tests/kmalloc.c0000644000175000017500000000040012247437436016312 0ustar eugeneugenint main() { struct bar *y; struct foo *x = kmalloc(sizeof(struct foo),GPF_KERNEL); if (!x) return -ENOMEM; y = kmalloc(sizeof(struct bar),GPF_KERNEL); if (!y) return -ENOMEM; memset(x,0,sizeof(struct foo)); memset(y,0,sizeof(struct bar)); } coccinelle-1.0.0-rc19/tests/doubleswitch.cocci0000644000175000017500000000002012247437436020220 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/cptr.c0000644000175000017500000000004012247437436015640 0ustar eugeneugenstatic const char *str = "..."; coccinelle-1.0.0-rc19/tests/signed.res0000644000175000017500000000006512247437436016517 0ustar eugeneugenint main() { signed y; unsigned b; return x; } coccinelle-1.0.0-rc19/tests/ty_tyexp.c0000644000175000017500000000012512247437436016561 0ustar eugeneugenvoid main(double z) { int x; int y; } int main(int z) { } int main2(int z); coccinelle-1.0.0-rc19/tests/of.res0000644000175000017500000000055612247437436015657 0ustar eugeneugenstatic struct iommu_table *iommu_table_find(struct iommu_table * tbl) { for (node = NULL; (node = of_find_all_nodes(node)); ) { if (x) { return it; of_node_put(node); } } } static struct iommu_table *iommu_table_find(struct iommu_table * tbl) { for (node = NULL; (node = something(node)); ) { if (x) { of_node_put(node); return it; } } } coccinelle-1.0.0-rc19/tests/testifdef.cocci0000644000175000017500000000025612247437436017514 0ustar eugeneugen@exists@ local idexpression x; statement S; constant C; @@ * x = kmalloc(...) ... if (x == NULL) S ... when != x when != if (...) { <+...x...+> } * return \(-C\|NULL\); coccinelle-1.0.0-rc19/tests/struct.cocci0000644000175000017500000000030312247437436017054 0ustar eugeneugen@ r1 @ identifier X,Y; @@ struct foo { ... struct bar X; ... struct xxx Y; ... }; @@ struct foo *a; identifier r1.X; @@ - f(a->X); @@ struct foo *a; identifier r1.Y; @@ - f(a->Y); coccinelle-1.0.0-rc19/tests/fields.cocci0000644000175000017500000000007212247437436017001 0ustar eugeneugen@@ @@ struct foo x = { + .a = 1, + .b = 2, + .c = 3, }; coccinelle-1.0.0-rc19/tests/send_pci10000644000175000017500000000227212247437436016325 0ustar eugeneugenSend to: davej@codemonkey.org.uk, linux-kernel@vger.kernel.org, kernel-janitors@vger.kernel.org Subject: [PATCH 1/2]: drivers/char: remove unnecessary pci_dev_put --------------------------------------- From: Julia Lawall pci_get_class implicitly does a pci_dev_put on its second argument, so pci_dev_put is only needed if there is a break out of the loop. The semantic match detecting this problem is as follows: // @@ expression dev; expression E; @@ * pci_dev_put(dev) ... when != dev = E ( * pci_get_device(...,dev) | * pci_get_device_reverse(...,dev) | * pci_get_subsys(...,dev) | * pci_get_class(...,dev) ) // Signed-off-by: Julia Lawall --- diff -up a/drivers/char/agp/amd-k7-agp.c b/drivers/char/agp/amd-k7-agp.c --- a/drivers/char/agp/amd-k7-agp.c 2007-11-15 07:33:31.000000000 +0100 +++ b/drivers/char/agp/amd-k7-agp.c 2007-11-15 07:40:48.000000000 +0100 @@ -436,10 +436,6 @@ static int __devinit agp_amdk7_probe(str return -ENODEV; } cap_ptr = pci_find_capability(gfxcard, PCI_CAP_ID_AGP); - if (!cap_ptr) { - pci_dev_put(gfxcard); - continue; - } } /* With so many variants of NVidia cards, it's simpler just coccinelle-1.0.0-rc19/tests/headers.c0000644000175000017500000000100312247437436016303 0ustar eugeneugenstatic void empeg_close (struct usb_serial_port *port, struct file *filp); static void empeg_close (struct usb_serial_port *port, struct file * filp) { } static int empeg_write (struct usb_serial_port *port, const unsigned char *buf, int count) { usb_fill_bulk_urb (empeg_write_bulk_callback); } static void empeg_write_bulk_callback (struct urb *urb, struct pt_regs *regs) { } static void empeg_read_bulk_callback (struct urb *urb, struct pt_regs *regs) { usb_fill_bulk_urb(empeg_read_bulk_callback); } coccinelle-1.0.0-rc19/tests/ptrar.res0000644000175000017500000000015512247437436016376 0ustar eugeneugenint main () { struct foo *x; struct foo y[12]; *12 = 4; *20 = 2; a = sizeof 20; b = sizeof 12; } coccinelle-1.0.0-rc19/tests/proto_ver1.c0000644000175000017500000000042112247437436016773 0ustar eugeneugenvoid bch_l2l1(struct PStack *st, int pr, void *arg); void bch_sched_event(struct BCState *bcs, int event); void bch_empty_fifo(struct BCState *bcs, int count); void bch_sched_event(struct BCState *bcs, int event) { bcs->event |= 1 << event; schedule_work(&bcs->work); } coccinelle-1.0.0-rc19/tests/fn_todo.c0000644000175000017500000000054212247437436016327 0ustar eugeneugenstatic void task_kill_later(struct asd_ascb *ascb) { struct asd_ha_struct *asd_ha = ascb->ha; struct sas_ha_struct *sas_ha = &asd_ha->sas_ha; struct Scsi_Host *shost = sas_ha->core.shost; struct sas_task *task = ascb->uldd_task; INIT_WORK(&task->abort_work, (void (*)(void *))sas_task_abort, task); queue_work(shost->work_q, &task->abort_work); } coccinelle-1.0.0-rc19/tests/incpos.c0000644000175000017500000000011712247437436016170 0ustar eugeneugen#include #include "two" #include #include "four" #include coccinelle-1.0.0-rc19/tests/type_ver1.res0000644000175000017500000000005412247437436017162 0ustar eugeneugenint foo() { struct foo *x; return 0; } coccinelle-1.0.0-rc19/tests/fsh.res0000644000175000017500000000004412247437436016023 0ustar eugeneugenint main () { f(c); g(foo-c); } coccinelle-1.0.0-rc19/tests/decl_split.cocci0000644000175000017500000000007412247437436017657 0ustar eugeneugen@@ @@ int func(int i) { - int x, y; //- int x; }coccinelle-1.0.0-rc19/tests/topdec_ver2.c0000644000175000017500000000020612247437436017110 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ int x; static struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/bad_ptr_print.cocci0000644000175000017500000000004312247437436020360 0ustar eugeneugen@@ expression E; @@ - f(E) + g(E) coccinelle-1.0.0-rc19/tests/kr.c0000644000175000017500000000005612247437436015313 0ustar eugeneugenint a(x) b c; { y = (j) r; foo(); } coccinelle-1.0.0-rc19/tests/nest.cocci0000644000175000017500000000036012247437436016504 0ustar eugeneugen@@ local function proc_info_func; @@ proc_info_func(...) { <... - hostno + hostptr->host_no ...> } @@ local function proc_info_func; @@ proc_info_func(...) { foo(); <... - xxx + hostptr->host_no ...> } coccinelle-1.0.0-rc19/tests/test2.c0000644000175000017500000000010212247437436015730 0ustar eugeneugenvoid main() { f(1,2,3); if(1) g(1); else g(1); } coccinelle-1.0.0-rc19/tests/ifzz.res0000644000175000017500000000014312247437436016225 0ustar eugeneugenif 0 char c; #endif size_t foo(void) { size_t i = 1; #if 0 TRACE("\n"); #endif return i; } coccinelle-1.0.0-rc19/tests/video4.cocci0000644000175000017500000000020512247437436016723 0ustar eugeneugen@@ identifier v; identifier fld; expression E; @@ struct foo v; m(); <... f(E); <... * v.fld ...> g(E); ...> n(); coccinelle-1.0.0-rc19/tests/multi_func.c0000644000175000017500000000015612247437436017045 0ustar eugeneugenvoid fn1(int i) { foo_lock(); i++; } void fn2(int i) { foo_unlock(); i++; } void fn3(int i) { i++; } coccinelle-1.0.0-rc19/tests/doundo.cocci0000644000175000017500000000006712247437436017027 0ustar eugeneugen@@ @@ - foo(); + xxx(); @@ @@ - xxx(); + new_foo(); coccinelle-1.0.0-rc19/tests/of.cocci0000644000175000017500000000036412247437436016143 0ustar eugeneugen@r@ identifier d; expression e; @@ for (d = NULL; (d = of_find_all_nodes(d)); ) {... ? return e; + of_node_put(d); ...} @r1@ identifier d; expression e; @@ for (d = NULL; (d = something(d)); ) {... + of_node_put(d); ? return e; ...} coccinelle-1.0.0-rc19/tests/longconst.cocci0000644000175000017500000000051712247437436017545 0ustar eugeneugen@@ expression E; long E1; int E2; @@ - E1 = E2 << E; + E1 = f(E2, "int"); @@ expression E; long E1; unsigned int E2; @@ - E1 = E2 << E; + E1 = f(E2, "unsigned"); @@ expression E; long E1; long E2; @@ - E1 = E2 << E; + E1 = f(E2, "long"); @@ expression E; long E1; unsigned long E2; @@ - E1 = E2 << E; + E1 = f(E2, "unsigned long"); coccinelle-1.0.0-rc19/tests/four.cocci0000644000175000017500000000035612247437436016513 0ustar eugeneugen@ rule1 @ expression E; @@ f(E); @ rule2 @ expression rule1.E; @@ - g(E); //---------------------------------------------------------------------------- @ rule3 @ expression E; @@ - h(E); @ rule4 @ expression rule3.E; @@ - i(E); coccinelle-1.0.0-rc19/tests/gilles-question.res0000644000175000017500000000007412247437436020372 0ustar eugeneugenvoid main(int i) { f(0); if(1) { } } coccinelle-1.0.0-rc19/tests/param.res0000644000175000017500000000000212247437436016335 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/comments.c0000644000175000017500000000003412247437436016520 0ustar eugeneugen int main() { return 0; } coccinelle-1.0.0-rc19/tests/incdir.c0000644000175000017500000000006412247437436016146 0ustar eugeneugen#include "sub/incdir2.c" int main () { foo(x); } coccinelle-1.0.0-rc19/tests/opt.c0000644000175000017500000000003112247437436015472 0ustar eugeneugenint main () { yyy(); } coccinelle-1.0.0-rc19/tests/ifdefmeta4.res0000644000175000017500000000003712247437436017255 0ustar eugeneugenint main () { // a comment } coccinelle-1.0.0-rc19/tests/comment.c0000644000175000017500000000010012247437436016327 0ustar eugeneugenvoid f(int i) { x = 1/* comment*/ ; x = /* comment*/1 ; } coccinelle-1.0.0-rc19/tests/unl.cocci0000644000175000017500000000010212247437436016323 0ustar eugeneugen@@ expression e; statement S; @@ - if (e) S + if (unlikely(e)) S coccinelle-1.0.0-rc19/tests/tyex.res0000644000175000017500000000031312247437436016233 0ustar eugeneugen typedef struct { double x; double y; } Point; typedef struct {char *name; Point p;}Location; int main () { Location a; Location *b; foo (a.p.x,a.p.y,a.name); foo (b->p.x,b->p.y,b->name); } coccinelle-1.0.0-rc19/tests/testifdef.c0000644000175000017500000023411512247437436016661 0ustar eugeneugen/* * * Hardware accelerated Matrox Millennium I, II, Mystique, G100, G200 and G400 * * (c) 1998-2002 Petr Vandrovec * * Portions Copyright (c) 2001 Matrox Graphics Inc. * * Version: 1.65 2002/08/14 * * MTRR stuff: 1998 Tom Rini * * Contributors: "menion?" * Betatesting, fixes, ideas * * "Kurt Garloff" * Betatesting, fixes, ideas, videomodes, videomodes timmings * * "Tom Rini" * MTRR stuff, PPC cleanups, betatesting, fixes, ideas * * "Bibek Sahu" * Access device through readb|w|l and write b|w|l * Extensive debugging stuff * * "Daniel Haun" * Testing, hardware cursor fixes * * "Scott Wood" * Fixes * * "Gerd Knorr" * Betatesting * * "Kelly French" * "Fernando Herrera" * Betatesting, bug reporting * * "Pablo Bianucci" * Fixes, ideas, betatesting * * "Inaky Perez Gonzalez" * Fixes, enhandcements, ideas, betatesting * * "Ryuichi Oikawa" * PPC betatesting, PPC support, backward compatibility * * "Paul Womar" * "Owen Waller" * PPC betatesting * * "Thomas Pornin" * Alpha betatesting * * "Pieter van Leuven" * "Ulf Jaenicke-Roessler" * G100 testing * * "H. Peter Arvin" * Ideas * * "Cort Dougan" * CHRP fixes and PReP cleanup * * "Mark Vojkovich" * G400 support * * "Samuel Hocevar" * Fixes * * "Anton Altaparmakov" * G400 MAX/non-MAX distinction * * "Ken Aaker" * memtype extension (needed for GXT130P RS/6000 adapter) * * "Uns Lider" * G100 PLNWT fixes * * "Denis Zaitsev" * Fixes * * "Mike Pieper" * TVOut enhandcements, V4L2 control interface. * * "Diego Biurrun" * DFP testing * * (following author is not in any relation with this code, but his code * is included in this driver) * * Based on framebuffer driver for VBE 2.0 compliant graphic boards * (c) 1998 Gerd Knorr * * (following author is not in any relation with this code, but his ideas * were used when writing this driver) * * FreeVBE/AF (Matrox), "Shawn Hargreaves" * */ #include #define __OLD_VIDIOC_ #include "matroxfb_base.h" #include "matroxfb_misc.h" #include "matroxfb_accel.h" #include "matroxfb_DAC1064.h" #include "matroxfb_Ti3026.h" #include "matroxfb_maven.h" #include "matroxfb_crtc2.h" #include "matroxfb_g450.h" #include #include #include #ifdef CONFIG_PPC_PMAC #include unsigned char nvram_read_byte(int); static int default_vmode = VMODE_NVRAM; static int default_cmode = CMODE_NVRAM; #endif static void matroxfb_unregister_device(struct matrox_fb_info* minfo); /* --------------------------------------------------------------------- */ /* * card parameters */ /* --------------------------------------------------------------------- */ static struct fb_var_screeninfo vesafb_defined = { 640,480,640,480,/* W,H, W, H (virtual) load xres,xres_virtual*/ 0,0, /* virtual -> visible no offset */ 8, /* depth -> load bits_per_pixel */ 0, /* greyscale ? */ {0,0,0}, /* R */ {0,0,0}, /* G */ {0,0,0}, /* B */ {0,0,0}, /* transparency */ 0, /* standard pixel format */ FB_ACTIVATE_NOW, -1,-1, FB_ACCELF_TEXT, /* accel flags */ 39721L,48L,16L,33L,10L, 96L,2L,~0, /* No sync info */ FB_VMODE_NONINTERLACED, 0, {0,0,0,0,0} }; /* --------------------------------------------------------------------- */ static void update_crtc2(WPMINFO unsigned int pos) { struct matroxfb_dh_fb_info* info = ACCESS_FBINFO(crtc2.info); /* Make sure that displays are compatible */ if (info && (info->fbcon.var.bits_per_pixel == ACCESS_FBINFO(fbcon).var.bits_per_pixel) && (info->fbcon.var.xres_virtual == ACCESS_FBINFO(fbcon).var.xres_virtual) && (info->fbcon.var.green.length == ACCESS_FBINFO(fbcon).var.green.length) ) { switch (ACCESS_FBINFO(fbcon).var.bits_per_pixel) { case 16: case 32: pos = pos * 8; if (info->interlaced) { mga_outl(0x3C2C, pos); mga_outl(0x3C28, pos + ACCESS_FBINFO(fbcon).var.xres_virtual * ACCESS_FBINFO(fbcon).var.bits_per_pixel / 8); } else { mga_outl(0x3C28, pos); } break; } } } static void matroxfb_crtc1_panpos(WPMINFO2) { if (ACCESS_FBINFO(crtc1.panpos) >= 0) { unsigned long flags; int panpos; matroxfb_DAC_lock_irqsave(flags); panpos = ACCESS_FBINFO(crtc1.panpos); if (panpos >= 0) { unsigned int extvga_reg; ACCESS_FBINFO(crtc1.panpos) = -1; /* No update pending anymore */ extvga_reg = mga_inb(M_EXTVGA_INDEX); mga_setr(M_EXTVGA_INDEX, 0x00, panpos); if (extvga_reg != 0x00) { mga_outb(M_EXTVGA_INDEX, extvga_reg); } } matroxfb_DAC_unlock_irqrestore(flags); } } static irqreturn_t matrox_irq(int irq, void *dev_id) { u_int32_t status; int handled = 0; MINFO_FROM(dev_id); status = mga_inl(M_STATUS); if (status & 0x20) { mga_outl(M_ICLEAR, 0x20); ACCESS_FBINFO(crtc1.vsync.cnt)++; matroxfb_crtc1_panpos(PMINFO2); wake_up_interruptible(&ACCESS_FBINFO(crtc1.vsync.wait)); handled = 1; } if (status & 0x200) { mga_outl(M_ICLEAR, 0x200); ACCESS_FBINFO(crtc2.vsync.cnt)++; wake_up_interruptible(&ACCESS_FBINFO(crtc2.vsync.wait)); handled = 1; } return IRQ_RETVAL(handled); } int matroxfb_enable_irq(WPMINFO int reenable) { u_int32_t bm; if (ACCESS_FBINFO(devflags.accelerator) == FB_ACCEL_MATROX_MGAG400) bm = 0x220; else bm = 0x020; if (!test_and_set_bit(0, &ACCESS_FBINFO(irq_flags))) { if (request_irq(ACCESS_FBINFO(pcidev)->irq, matrox_irq, IRQF_SHARED, "matroxfb", MINFO)) { clear_bit(0, &ACCESS_FBINFO(irq_flags)); return -EINVAL; } /* Clear any pending field interrupts */ mga_outl(M_ICLEAR, bm); mga_outl(M_IEN, mga_inl(M_IEN) | bm); } else if (reenable) { u_int32_t ien; ien = mga_inl(M_IEN); if ((ien & bm) != bm) { printk(KERN_DEBUG "matroxfb: someone disabled IRQ [%08X]\n", ien); mga_outl(M_IEN, ien | bm); } } return 0; } static void matroxfb_disable_irq(WPMINFO2) { if (test_and_clear_bit(0, &ACCESS_FBINFO(irq_flags))) { /* Flush pending pan-at-vbl request... */ matroxfb_crtc1_panpos(PMINFO2); if (ACCESS_FBINFO(devflags.accelerator) == FB_ACCEL_MATROX_MGAG400) mga_outl(M_IEN, mga_inl(M_IEN) & ~0x220); else mga_outl(M_IEN, mga_inl(M_IEN) & ~0x20); free_irq(ACCESS_FBINFO(pcidev)->irq, MINFO); } } int matroxfb_wait_for_sync(WPMINFO u_int32_t crtc) { struct matrox_vsync *vs; unsigned int cnt; int ret; switch (crtc) { case 0: vs = &ACCESS_FBINFO(crtc1.vsync); break; case 1: if (ACCESS_FBINFO(devflags.accelerator) != FB_ACCEL_MATROX_MGAG400) { return -ENODEV; } vs = &ACCESS_FBINFO(crtc2.vsync); break; default: return -ENODEV; } ret = matroxfb_enable_irq(PMINFO 0); if (ret) { return ret; } cnt = vs->cnt; ret = wait_event_interruptible_timeout(vs->wait, cnt != vs->cnt, HZ/10); if (ret < 0) { return ret; } if (ret == 0) { matroxfb_enable_irq(PMINFO 1); return -ETIMEDOUT; } return 0; } /* --------------------------------------------------------------------- */ static void matrox_pan_var(WPMINFO struct fb_var_screeninfo *var) { unsigned int pos; unsigned short p0, p1, p2; #ifdef CONFIG_FB_MATROX_32MB unsigned int p3; #endif int vbl; unsigned long flags; CRITFLAGS DBG(__FUNCTION__) if (ACCESS_FBINFO(dead)) return; ACCESS_FBINFO(fbcon).var.xoffset = var->xoffset; ACCESS_FBINFO(fbcon).var.yoffset = var->yoffset; pos = (ACCESS_FBINFO(fbcon).var.yoffset * ACCESS_FBINFO(fbcon).var.xres_virtual + ACCESS_FBINFO(fbcon).var.xoffset) * ACCESS_FBINFO(curr.final_bppShift) / 32; pos += ACCESS_FBINFO(curr.ydstorg.chunks); p0 = ACCESS_FBINFO(hw).CRTC[0x0D] = pos & 0xFF; p1 = ACCESS_FBINFO(hw).CRTC[0x0C] = (pos & 0xFF00) >> 8; p2 = ACCESS_FBINFO(hw).CRTCEXT[0] = (ACCESS_FBINFO(hw).CRTCEXT[0] & 0xB0) | ((pos >> 16) & 0x0F) | ((pos >> 14) & 0x40); #ifdef CONFIG_FB_MATROX_32MB p3 = ACCESS_FBINFO(hw).CRTCEXT[8] = pos >> 21; #endif /* FB_ACTIVATE_VBL and we can acquire interrupts? Honor FB_ACTIVATE_VBL then... */ vbl = (var->activate & FB_ACTIVATE_VBL) && (matroxfb_enable_irq(PMINFO 0) == 0); CRITBEGIN matroxfb_DAC_lock_irqsave(flags); mga_setr(M_CRTC_INDEX, 0x0D, p0); mga_setr(M_CRTC_INDEX, 0x0C, p1); #ifdef CONFIG_FB_MATROX_32MB if (ACCESS_FBINFO(devflags.support32MB)) mga_setr(M_EXTVGA_INDEX, 0x08, p3); #endif if (vbl) { ACCESS_FBINFO(crtc1.panpos) = p2; } else { /* Abort any pending change */ ACCESS_FBINFO(crtc1.panpos) = -1; mga_setr(M_EXTVGA_INDEX, 0x00, p2); } matroxfb_DAC_unlock_irqrestore(flags); update_crtc2(PMINFO pos); CRITEND } static void matroxfb_remove(WPMINFO int dummy) { /* Currently we are holding big kernel lock on all dead & usecount updates. * Destroy everything after all users release it. Especially do not unregister * framebuffer and iounmap memory, neither fbmem nor fbcon-cfb* does not check * for device unplugged when in use. * In future we should point mmio.vbase & video.vbase somewhere where we can * write data without causing too much damage... */ ACCESS_FBINFO(dead) = 1; if (ACCESS_FBINFO(usecount)) { /* destroy it later */ return; } matroxfb_unregister_device(MINFO); unregister_framebuffer(&ACCESS_FBINFO(fbcon)); matroxfb_g450_shutdown(PMINFO2); #ifdef CONFIG_MTRR if (ACCESS_FBINFO(mtrr.vram_valid)) mtrr_del(ACCESS_FBINFO(mtrr.vram), ACCESS_FBINFO(video.base), ACCESS_FBINFO(video.len)); #endif mga_iounmap(ACCESS_FBINFO(mmio.vbase)); mga_iounmap(ACCESS_FBINFO(video.vbase)); release_mem_region(ACCESS_FBINFO(video.base), ACCESS_FBINFO(video.len_maximum)); release_mem_region(ACCESS_FBINFO(mmio.base), 16384); #ifdef CONFIG_FB_MATROX_MULTIHEAD kfree(minfo); #endif } /* * Open/Release the frame buffer device */ static int matroxfb_open(struct fb_info *info, int user) { MINFO_FROM_INFO(info); DBG_LOOP(__FUNCTION__) if (ACCESS_FBINFO(dead)) { return -ENXIO; } ACCESS_FBINFO(usecount)++; if (user) { ACCESS_FBINFO(userusecount)++; } return(0); } static int matroxfb_release(struct fb_info *info, int user) { MINFO_FROM_INFO(info); DBG_LOOP(__FUNCTION__) if (user) { if (0 == --ACCESS_FBINFO(userusecount)) { matroxfb_disable_irq(PMINFO2); } } if (!(--ACCESS_FBINFO(usecount)) && ACCESS_FBINFO(dead)) { matroxfb_remove(PMINFO 0); } return(0); } static int matroxfb_pan_display(struct fb_var_screeninfo *var, struct fb_info* info) { MINFO_FROM_INFO(info); DBG(__FUNCTION__) matrox_pan_var(PMINFO var); return 0; } static int matroxfb_get_final_bppShift(CPMINFO int bpp) { int bppshft2; DBG(__FUNCTION__) bppshft2 = bpp; if (!bppshft2) { return 8; } if (isInterleave(MINFO)) bppshft2 >>= 1; if (ACCESS_FBINFO(devflags.video64bits)) bppshft2 >>= 1; return bppshft2; } static int matroxfb_test_and_set_rounding(CPMINFO int xres, int bpp) { int over; int rounding; DBG(__FUNCTION__) switch (bpp) { case 0: return xres; case 4: rounding = 128; break; case 8: rounding = 64; /* doc says 64; 32 is OK for G400 */ break; case 16: rounding = 32; break; case 24: rounding = 64; /* doc says 64; 32 is OK for G400 */ break; default: rounding = 16; /* on G400, 16 really does not work */ if (ACCESS_FBINFO(devflags.accelerator) == FB_ACCEL_MATROX_MGAG400) rounding = 32; break; } if (isInterleave(MINFO)) { rounding *= 2; } over = xres % rounding; if (over) xres += rounding-over; return xres; } static int matroxfb_pitch_adjust(CPMINFO int xres, int bpp) { const int* width; int xres_new; DBG(__FUNCTION__) if (!bpp) return xres; width = ACCESS_FBINFO(capable.vxres); if (ACCESS_FBINFO(devflags.precise_width)) { while (*width) { if ((*width >= xres) && (matroxfb_test_and_set_rounding(PMINFO *width, bpp) == *width)) { break; } width++; } xres_new = *width; } else { xres_new = matroxfb_test_and_set_rounding(PMINFO xres, bpp); } return xres_new; } static int matroxfb_get_cmap_len(struct fb_var_screeninfo *var) { DBG(__FUNCTION__) switch (var->bits_per_pixel) { case 4: return 16; /* pseudocolor... 16 entries HW palette */ case 8: return 256; /* pseudocolor... 256 entries HW palette */ case 16: return 16; /* directcolor... 16 entries SW palette */ /* Mystique: truecolor, 16 entries SW palette, HW palette hardwired into 1:1 mapping */ case 24: return 16; /* directcolor... 16 entries SW palette */ /* Mystique: truecolor, 16 entries SW palette, HW palette hardwired into 1:1 mapping */ case 32: return 16; /* directcolor... 16 entries SW palette */ /* Mystique: truecolor, 16 entries SW palette, HW palette hardwired into 1:1 mapping */ } return 16; /* return something reasonable... or panic()? */ } static int matroxfb_decode_var(CPMINFO struct fb_var_screeninfo *var, int *visual, int *video_cmap_len, unsigned int* ydstorg) { struct RGBT { unsigned char bpp; struct { unsigned char offset, length; } red, green, blue, transp; signed char visual; }; static const struct RGBT table[]= { { 8,{ 0,8},{0,8},{0,8},{ 0,0},MX_VISUAL_PSEUDOCOLOR}, {15,{10,5},{5,5},{0,5},{15,1},MX_VISUAL_DIRECTCOLOR}, {16,{11,5},{5,6},{0,5},{ 0,0},MX_VISUAL_DIRECTCOLOR}, {24,{16,8},{8,8},{0,8},{ 0,0},MX_VISUAL_DIRECTCOLOR}, {32,{16,8},{8,8},{0,8},{24,8},MX_VISUAL_DIRECTCOLOR} }; struct RGBT const *rgbt; unsigned int bpp = var->bits_per_pixel; unsigned int vramlen; unsigned int memlen; DBG(__FUNCTION__) switch (bpp) { case 4: if (!ACCESS_FBINFO(capable.cfb4)) return -EINVAL; break; case 8: break; case 16: break; case 24: break; case 32: break; default: return -EINVAL; } *ydstorg = 0; vramlen = ACCESS_FBINFO(video.len_usable); if (var->yres_virtual < var->yres) var->yres_virtual = var->yres; if (var->xres_virtual < var->xres) var->xres_virtual = var->xres; var->xres_virtual = matroxfb_pitch_adjust(PMINFO var->xres_virtual, bpp); memlen = var->xres_virtual * bpp * var->yres_virtual / 8; if (memlen > vramlen) { var->yres_virtual = vramlen * 8 / (var->xres_virtual * bpp); memlen = var->xres_virtual * bpp * var->yres_virtual / 8; } /* There is hardware bug that no line can cross 4MB boundary */ /* give up for CFB24, it is impossible to easy workaround it */ /* for other try to do something */ if (!ACCESS_FBINFO(capable.cross4MB) && (memlen > 0x400000)) { if (bpp == 24) { /* sorry */ } else { unsigned int linelen; unsigned int m1 = linelen = var->xres_virtual * bpp / 8; unsigned int m2 = PAGE_SIZE; /* or 128 if you do not need PAGE ALIGNED address */ unsigned int max_yres; while (m1) { int t; while (m2 >= m1) m2 -= m1; t = m1; m1 = m2; m2 = t; } m2 = linelen * PAGE_SIZE / m2; *ydstorg = m2 = 0x400000 % m2; max_yres = (vramlen - m2) / linelen; if (var->yres_virtual > max_yres) var->yres_virtual = max_yres; } } /* YDSTLEN contains only signed 16bit value */ if (var->yres_virtual > 32767) var->yres_virtual = 32767; /* we must round yres/xres down, we already rounded y/xres_virtual up if it was possible. We should return -EINVAL, but I disagree */ if (var->yres_virtual < var->yres) var->yres = var->yres_virtual; if (var->xres_virtual < var->xres) var->xres = var->xres_virtual; if (var->xoffset + var->xres > var->xres_virtual) var->xoffset = var->xres_virtual - var->xres; if (var->yoffset + var->yres > var->yres_virtual) var->yoffset = var->yres_virtual - var->yres; if (bpp == 16 && var->green.length == 5) { bpp--; /* an artificial value - 15 */ } for (rgbt = table; rgbt->bpp < bpp; rgbt++); #define SETCLR(clr)\ var->clr.offset = rgbt->clr.offset;\ var->clr.length = rgbt->clr.length SETCLR(red); SETCLR(green); SETCLR(blue); SETCLR(transp); #undef SETCLR *visual = rgbt->visual; if (bpp > 8) dprintk("matroxfb: truecolor: " "size=%d:%d:%d:%d, shift=%d:%d:%d:%d\n", var->transp.length, var->red.length, var->green.length, var->blue.length, var->transp.offset, var->red.offset, var->green.offset, var->blue.offset); *video_cmap_len = matroxfb_get_cmap_len(var); dprintk(KERN_INFO "requested %d*%d/%dbpp (%d*%d)\n", var->xres, var->yres, var->bits_per_pixel, var->xres_virtual, var->yres_virtual); return 0; } static int matroxfb_setcolreg(unsigned regno, unsigned red, unsigned green, unsigned blue, unsigned transp, struct fb_info *fb_info) { #ifdef CONFIG_FB_MATROX_MULTIHEAD struct matrox_fb_info* minfo = container_of(fb_info, struct matrox_fb_info, fbcon); #endif DBG(__FUNCTION__) /* * Set a single color register. The values supplied are * already rounded down to the hardware's capabilities * (according to the entries in the `var' structure). Return * != 0 for invalid regno. */ if (regno >= ACCESS_FBINFO(curr.cmap_len)) return 1; if (ACCESS_FBINFO(fbcon).var.grayscale) { /* gray = 0.30*R + 0.59*G + 0.11*B */ red = green = blue = (red * 77 + green * 151 + blue * 28) >> 8; } red = CNVT_TOHW(red, ACCESS_FBINFO(fbcon).var.red.length); green = CNVT_TOHW(green, ACCESS_FBINFO(fbcon).var.green.length); blue = CNVT_TOHW(blue, ACCESS_FBINFO(fbcon).var.blue.length); transp = CNVT_TOHW(transp, ACCESS_FBINFO(fbcon).var.transp.length); switch (ACCESS_FBINFO(fbcon).var.bits_per_pixel) { case 4: case 8: mga_outb(M_DAC_REG, regno); mga_outb(M_DAC_VAL, red); mga_outb(M_DAC_VAL, green); mga_outb(M_DAC_VAL, blue); break; case 16: if (regno >= 16) break; { u_int16_t col = (red << ACCESS_FBINFO(fbcon).var.red.offset) | (green << ACCESS_FBINFO(fbcon).var.green.offset) | (blue << ACCESS_FBINFO(fbcon).var.blue.offset) | (transp << ACCESS_FBINFO(fbcon).var.transp.offset); /* for 1:5:5:5 */ ACCESS_FBINFO(cmap[regno]) = col | (col << 16); } break; case 24: case 32: if (regno >= 16) break; ACCESS_FBINFO(cmap[regno]) = (red << ACCESS_FBINFO(fbcon).var.red.offset) | (green << ACCESS_FBINFO(fbcon).var.green.offset) | (blue << ACCESS_FBINFO(fbcon).var.blue.offset) | (transp << ACCESS_FBINFO(fbcon).var.transp.offset); /* 8:8:8:8 */ break; } return 0; } static void matroxfb_init_fix(WPMINFO2) { struct fb_fix_screeninfo *fix = &ACCESS_FBINFO(fbcon).fix; DBG(__FUNCTION__) strcpy(fix->id,"MATROX"); fix->xpanstep = 8; /* 8 for 8bpp, 4 for 16bpp, 2 for 32bpp */ fix->ypanstep = 1; fix->ywrapstep = 0; fix->mmio_start = ACCESS_FBINFO(mmio.base); fix->mmio_len = ACCESS_FBINFO(mmio.len); fix->accel = ACCESS_FBINFO(devflags.accelerator); } static void matroxfb_update_fix(WPMINFO2) { struct fb_fix_screeninfo *fix = &ACCESS_FBINFO(fbcon).fix; DBG(__FUNCTION__) fix->smem_start = ACCESS_FBINFO(video.base) + ACCESS_FBINFO(curr.ydstorg.bytes); fix->smem_len = ACCESS_FBINFO(video.len_usable) - ACCESS_FBINFO(curr.ydstorg.bytes); } static int matroxfb_check_var(struct fb_var_screeninfo *var, struct fb_info *info) { int err; int visual; int cmap_len; unsigned int ydstorg; MINFO_FROM_INFO(info); if (ACCESS_FBINFO(dead)) { return -ENXIO; } if ((err = matroxfb_decode_var(PMINFO var, &visual, &cmap_len, &ydstorg)) != 0) return err; return 0; } static int matroxfb_set_par(struct fb_info *info) { int err; int visual; int cmap_len; unsigned int ydstorg; struct fb_var_screeninfo *var; MINFO_FROM_INFO(info); DBG(__FUNCTION__) if (ACCESS_FBINFO(dead)) { return -ENXIO; } var = &info->var; if ((err = matroxfb_decode_var(PMINFO var, &visual, &cmap_len, &ydstorg)) != 0) return err; ACCESS_FBINFO(fbcon.screen_base) = vaddr_va(ACCESS_FBINFO(video.vbase)) + ydstorg; matroxfb_update_fix(PMINFO2); ACCESS_FBINFO(fbcon).fix.visual = visual; ACCESS_FBINFO(fbcon).fix.type = FB_TYPE_PACKED_PIXELS; ACCESS_FBINFO(fbcon).fix.type_aux = 0; ACCESS_FBINFO(fbcon).fix.line_length = (var->xres_virtual * var->bits_per_pixel) >> 3; { unsigned int pos; ACCESS_FBINFO(curr.cmap_len) = cmap_len; ydstorg += ACCESS_FBINFO(devflags.ydstorg); ACCESS_FBINFO(curr.ydstorg.bytes) = ydstorg; ACCESS_FBINFO(curr.ydstorg.chunks) = ydstorg >> (isInterleave(MINFO)?3:2); if (var->bits_per_pixel == 4) ACCESS_FBINFO(curr.ydstorg.pixels) = ydstorg; else ACCESS_FBINFO(curr.ydstorg.pixels) = (ydstorg * 8) / var->bits_per_pixel; ACCESS_FBINFO(curr.final_bppShift) = matroxfb_get_final_bppShift(PMINFO var->bits_per_pixel); { struct my_timming mt; struct matrox_hw_state* hw; int out; matroxfb_var2my(var, &mt); mt.crtc = MATROXFB_SRC_CRTC1; /* CRTC1 delays */ switch (var->bits_per_pixel) { case 0: mt.delay = 31 + 0; break; case 16: mt.delay = 21 + 8; break; case 24: mt.delay = 17 + 8; break; case 32: mt.delay = 16 + 8; break; default: mt.delay = 31 + 8; break; } hw = &ACCESS_FBINFO(hw); down_read(&ACCESS_FBINFO(altout).lock); for (out = 0; out < MATROXFB_MAX_OUTPUTS; out++) { if (ACCESS_FBINFO(outputs[out]).src == MATROXFB_SRC_CRTC1 && ACCESS_FBINFO(outputs[out]).output->compute) { ACCESS_FBINFO(outputs[out]).output->compute(ACCESS_FBINFO(outputs[out]).data, &mt); } } up_read(&ACCESS_FBINFO(altout).lock); ACCESS_FBINFO(crtc1).pixclock = mt.pixclock; ACCESS_FBINFO(crtc1).mnp = mt.mnp; ACCESS_FBINFO(hw_switch->init(PMINFO &mt)); pos = (var->yoffset * var->xres_virtual + var->xoffset) * ACCESS_FBINFO(curr.final_bppShift) / 32; pos += ACCESS_FBINFO(curr.ydstorg.chunks); hw->CRTC[0x0D] = pos & 0xFF; hw->CRTC[0x0C] = (pos & 0xFF00) >> 8; hw->CRTCEXT[0] = (hw->CRTCEXT[0] & 0xF0) | ((pos >> 16) & 0x0F) | ((pos >> 14) & 0x40); hw->CRTCEXT[8] = pos >> 21; ACCESS_FBINFO(hw_switch->restore(PMINFO2)); update_crtc2(PMINFO pos); down_read(&ACCESS_FBINFO(altout).lock); for (out = 0; out < MATROXFB_MAX_OUTPUTS; out++) { if (ACCESS_FBINFO(outputs[out]).src == MATROXFB_SRC_CRTC1 && ACCESS_FBINFO(outputs[out]).output->program) { ACCESS_FBINFO(outputs[out]).output->program(ACCESS_FBINFO(outputs[out]).data); } } for (out = 0; out < MATROXFB_MAX_OUTPUTS; out++) { if (ACCESS_FBINFO(outputs[out]).src == MATROXFB_SRC_CRTC1 && ACCESS_FBINFO(outputs[out]).output->start) { ACCESS_FBINFO(outputs[out]).output->start(ACCESS_FBINFO(outputs[out]).data); } } up_read(&ACCESS_FBINFO(altout).lock); matrox_cfbX_init(PMINFO2); } } ACCESS_FBINFO(initialized) = 1; return 0; } static int matroxfb_get_vblank(WPMINFO struct fb_vblank *vblank) { unsigned int sts1; matroxfb_enable_irq(PMINFO 0); memset(vblank, 0, sizeof(*vblank)); vblank->flags = FB_VBLANK_HAVE_VCOUNT | FB_VBLANK_HAVE_VSYNC | FB_VBLANK_HAVE_VBLANK | FB_VBLANK_HAVE_HBLANK; sts1 = mga_inb(M_INSTS1); vblank->vcount = mga_inl(M_VCOUNT); /* BTW, on my PIII/450 with G400, reading M_INSTS1 byte makes this call about 12% slower (1.70 vs. 2.05 us per ioctl()) */ if (sts1 & 1) vblank->flags |= FB_VBLANK_HBLANKING; if (sts1 & 8) vblank->flags |= FB_VBLANK_VSYNCING; if (vblank->vcount >= ACCESS_FBINFO(fbcon).var.yres) vblank->flags |= FB_VBLANK_VBLANKING; if (test_bit(0, &ACCESS_FBINFO(irq_flags))) { vblank->flags |= FB_VBLANK_HAVE_COUNT; /* Only one writer, aligned int value... it should work without lock and without atomic_t */ vblank->count = ACCESS_FBINFO(crtc1).vsync.cnt; } return 0; } static struct matrox_altout panellink_output = { .name = "Panellink output", }; static int matroxfb_ioctl(struct fb_info *info, unsigned int cmd, unsigned long arg) { void __user *argp = (void __user *)arg; MINFO_FROM_INFO(info); DBG(__FUNCTION__) if (ACCESS_FBINFO(dead)) { return -ENXIO; } switch (cmd) { case FBIOGET_VBLANK: { struct fb_vblank vblank; int err; err = matroxfb_get_vblank(PMINFO &vblank); if (err) return err; if (copy_to_user(argp, &vblank, sizeof(vblank))) return -EFAULT; return 0; } case FBIO_WAITFORVSYNC: { u_int32_t crt; if (get_user(crt, (u_int32_t __user *)arg)) return -EFAULT; return matroxfb_wait_for_sync(PMINFO crt); } case MATROXFB_SET_OUTPUT_MODE: { struct matroxioc_output_mode mom; struct matrox_altout *oproc; int val; if (copy_from_user(&mom, argp, sizeof(mom))) return -EFAULT; if (mom.output >= MATROXFB_MAX_OUTPUTS) return -ENXIO; down_read(&ACCESS_FBINFO(altout.lock)); oproc = ACCESS_FBINFO(outputs[mom.output]).output; if (!oproc) { val = -ENXIO; } else if (!oproc->verifymode) { if (mom.mode == MATROXFB_OUTPUT_MODE_MONITOR) { val = 0; } else { val = -EINVAL; } } else { val = oproc->verifymode(ACCESS_FBINFO(outputs[mom.output]).data, mom.mode); } if (!val) { if (ACCESS_FBINFO(outputs[mom.output]).mode != mom.mode) { ACCESS_FBINFO(outputs[mom.output]).mode = mom.mode; val = 1; } } up_read(&ACCESS_FBINFO(altout.lock)); if (val != 1) return val; switch (ACCESS_FBINFO(outputs[mom.output]).src) { case MATROXFB_SRC_CRTC1: matroxfb_set_par(info); break; case MATROXFB_SRC_CRTC2: { struct matroxfb_dh_fb_info* crtc2; down_read(&ACCESS_FBINFO(crtc2.lock)); crtc2 = ACCESS_FBINFO(crtc2.info); if (crtc2) crtc2->fbcon.fbops->fb_set_par(&crtc2->fbcon); up_read(&ACCESS_FBINFO(crtc2.lock)); } break; } return 0; } case MATROXFB_GET_OUTPUT_MODE: { struct matroxioc_output_mode mom; struct matrox_altout *oproc; int val; if (copy_from_user(&mom, argp, sizeof(mom))) return -EFAULT; if (mom.output >= MATROXFB_MAX_OUTPUTS) return -ENXIO; down_read(&ACCESS_FBINFO(altout.lock)); oproc = ACCESS_FBINFO(outputs[mom.output]).output; if (!oproc) { val = -ENXIO; } else { mom.mode = ACCESS_FBINFO(outputs[mom.output]).mode; val = 0; } up_read(&ACCESS_FBINFO(altout.lock)); if (val) return val; if (copy_to_user(argp, &mom, sizeof(mom))) return -EFAULT; return 0; } case MATROXFB_SET_OUTPUT_CONNECTION: { u_int32_t tmp; int i; int changes; if (copy_from_user(&tmp, argp, sizeof(tmp))) return -EFAULT; for (i = 0; i < 32; i++) { if (tmp & (1 << i)) { if (i >= MATROXFB_MAX_OUTPUTS) return -ENXIO; if (!ACCESS_FBINFO(outputs[i]).output) return -ENXIO; switch (ACCESS_FBINFO(outputs[i]).src) { case MATROXFB_SRC_NONE: case MATROXFB_SRC_CRTC1: break; default: return -EBUSY; } } } if (ACCESS_FBINFO(devflags.panellink)) { if (tmp & MATROXFB_OUTPUT_CONN_DFP) { if (tmp & MATROXFB_OUTPUT_CONN_SECONDARY) return -EINVAL; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { if (ACCESS_FBINFO(outputs[i]).src == MATROXFB_SRC_CRTC2) { return -EBUSY; } } } } changes = 0; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { if (tmp & (1 << i)) { if (ACCESS_FBINFO(outputs[i]).src != MATROXFB_SRC_CRTC1) { changes = 1; ACCESS_FBINFO(outputs[i]).src = MATROXFB_SRC_CRTC1; } } else if (ACCESS_FBINFO(outputs[i]).src == MATROXFB_SRC_CRTC1) { changes = 1; ACCESS_FBINFO(outputs[i]).src = MATROXFB_SRC_NONE; } } if (!changes) return 0; matroxfb_set_par(info); return 0; } case MATROXFB_GET_OUTPUT_CONNECTION: { u_int32_t conn = 0; int i; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { if (ACCESS_FBINFO(outputs[i]).src == MATROXFB_SRC_CRTC1) { conn |= 1 << i; } } if (put_user(conn, (u_int32_t __user *)arg)) return -EFAULT; return 0; } case MATROXFB_GET_AVAILABLE_OUTPUTS: { u_int32_t conn = 0; int i; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { if (ACCESS_FBINFO(outputs[i]).output) { switch (ACCESS_FBINFO(outputs[i]).src) { case MATROXFB_SRC_NONE: case MATROXFB_SRC_CRTC1: conn |= 1 << i; break; } } } if (ACCESS_FBINFO(devflags.panellink)) { if (conn & MATROXFB_OUTPUT_CONN_DFP) conn &= ~MATROXFB_OUTPUT_CONN_SECONDARY; if (conn & MATROXFB_OUTPUT_CONN_SECONDARY) conn &= ~MATROXFB_OUTPUT_CONN_DFP; } if (put_user(conn, (u_int32_t __user *)arg)) return -EFAULT; return 0; } case MATROXFB_GET_ALL_OUTPUTS: { u_int32_t conn = 0; int i; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { if (ACCESS_FBINFO(outputs[i]).output) { conn |= 1 << i; } } if (put_user(conn, (u_int32_t __user *)arg)) return -EFAULT; return 0; } case VIDIOC_QUERYCAP: { struct v4l2_capability r; memset(&r, 0, sizeof(r)); strcpy(r.driver, "matroxfb"); strcpy(r.card, "Matrox"); sprintf(r.bus_info, "PCI:%s", pci_name(ACCESS_FBINFO(pcidev))); r.version = KERNEL_VERSION(1,0,0); r.capabilities = V4L2_CAP_VIDEO_OUTPUT; if (copy_to_user(argp, &r, sizeof(r))) return -EFAULT; return 0; } case VIDIOC_QUERYCTRL: { struct v4l2_queryctrl qctrl; int err; if (copy_from_user(&qctrl, argp, sizeof(qctrl))) return -EFAULT; down_read(&ACCESS_FBINFO(altout).lock); if (!ACCESS_FBINFO(outputs[1]).output) { err = -ENXIO; } else if (ACCESS_FBINFO(outputs[1]).output->getqueryctrl) { err = ACCESS_FBINFO(outputs[1]).output->getqueryctrl(ACCESS_FBINFO(outputs[1]).data, &qctrl); } else { err = -EINVAL; } up_read(&ACCESS_FBINFO(altout).lock); if (err >= 0 && copy_to_user(argp, &qctrl, sizeof(qctrl))) return -EFAULT; return err; } case VIDIOC_G_CTRL: { struct v4l2_control ctrl; int err; if (copy_from_user(&ctrl, argp, sizeof(ctrl))) return -EFAULT; down_read(&ACCESS_FBINFO(altout).lock); if (!ACCESS_FBINFO(outputs[1]).output) { err = -ENXIO; } else if (ACCESS_FBINFO(outputs[1]).output->getctrl) { err = ACCESS_FBINFO(outputs[1]).output->getctrl(ACCESS_FBINFO(outputs[1]).data, &ctrl); } else { err = -EINVAL; } up_read(&ACCESS_FBINFO(altout).lock); if (err >= 0 && copy_to_user(argp, &ctrl, sizeof(ctrl))) return -EFAULT; return err; } case VIDIOC_S_CTRL_OLD: case VIDIOC_S_CTRL: { struct v4l2_control ctrl; int err; if (copy_from_user(&ctrl, argp, sizeof(ctrl))) return -EFAULT; down_read(&ACCESS_FBINFO(altout).lock); if (!ACCESS_FBINFO(outputs[1]).output) { err = -ENXIO; } else if (ACCESS_FBINFO(outputs[1]).output->setctrl) { err = ACCESS_FBINFO(outputs[1]).output->setctrl(ACCESS_FBINFO(outputs[1]).data, &ctrl); } else { err = -EINVAL; } up_read(&ACCESS_FBINFO(altout).lock); return err; } } return -ENOTTY; } /* 0 unblank, 1 blank, 2 no vsync, 3 no hsync, 4 off */ static int matroxfb_blank(int blank, struct fb_info *info) { int seq; int crtc; CRITFLAGS MINFO_FROM_INFO(info); DBG(__FUNCTION__) if (ACCESS_FBINFO(dead)) return 1; switch (blank) { case FB_BLANK_NORMAL: seq = 0x20; crtc = 0x00; break; /* works ??? */ case FB_BLANK_VSYNC_SUSPEND: seq = 0x20; crtc = 0x10; break; case FB_BLANK_HSYNC_SUSPEND: seq = 0x20; crtc = 0x20; break; case FB_BLANK_POWERDOWN: seq = 0x20; crtc = 0x30; break; default: seq = 0x00; crtc = 0x00; break; } CRITBEGIN mga_outb(M_SEQ_INDEX, 1); mga_outb(M_SEQ_DATA, (mga_inb(M_SEQ_DATA) & ~0x20) | seq); mga_outb(M_EXTVGA_INDEX, 1); mga_outb(M_EXTVGA_DATA, (mga_inb(M_EXTVGA_DATA) & ~0x30) | crtc); CRITEND return 0; } static struct fb_ops matroxfb_ops = { .owner = THIS_MODULE, .fb_open = matroxfb_open, .fb_release = matroxfb_release, .fb_check_var = matroxfb_check_var, .fb_set_par = matroxfb_set_par, .fb_setcolreg = matroxfb_setcolreg, .fb_pan_display =matroxfb_pan_display, .fb_blank = matroxfb_blank, .fb_ioctl = matroxfb_ioctl, /* .fb_fillrect = , */ /* .fb_copyarea = , */ /* .fb_imageblit = , */ /* .fb_cursor = , */ }; #define RSDepth(X) (((X) >> 8) & 0x0F) #define RS8bpp 0x1 #define RS15bpp 0x2 #define RS16bpp 0x3 #define RS32bpp 0x4 #define RS4bpp 0x5 #define RS24bpp 0x6 #define RSText 0x7 #define RSText8 0x8 /* 9-F */ static struct { struct fb_bitfield red, green, blue, transp; int bits_per_pixel; } colors[] = { { { 0, 8, 0}, { 0, 8, 0}, { 0, 8, 0}, { 0, 0, 0}, 8 }, { { 10, 5, 0}, { 5, 5, 0}, { 0, 5, 0}, { 15, 1, 0}, 16 }, { { 11, 5, 0}, { 5, 6, 0}, { 0, 5, 0}, { 0, 0, 0}, 16 }, { { 16, 8, 0}, { 8, 8, 0}, { 0, 8, 0}, { 24, 8, 0}, 32 }, { { 0, 8, 0}, { 0, 8, 0}, { 0, 8, 0}, { 0, 0, 0}, 4 }, { { 16, 8, 0}, { 8, 8, 0}, { 0, 8, 0}, { 0, 0, 0}, 24 }, { { 0, 6, 0}, { 0, 6, 0}, { 0, 6, 0}, { 0, 0, 0}, 0 }, /* textmode with (default) VGA8x16 */ { { 0, 6, 0}, { 0, 6, 0}, { 0, 6, 0}, { 0, 0, 0}, 0 }, /* textmode hardwired to VGA8x8 */ }; /* initialized by setup, see explanation at end of file (search for MODULE_PARM_DESC) */ static unsigned int mem; /* "matrox:mem:xxxxxM" */ static int option_precise_width = 1; /* cannot be changed, option_precise_width==0 must imply noaccel */ static int inv24; /* "matrox:inv24" */ static int cross4MB = -1; /* "matrox:cross4MB" */ static int disabled; /* "matrox:disabled" */ static int noaccel; /* "matrox:noaccel" */ static int nopan; /* "matrox:nopan" */ static int no_pci_retry; /* "matrox:nopciretry" */ static int novga; /* "matrox:novga" */ static int nobios; /* "matrox:nobios" */ static int noinit = 1; /* "matrox:init" */ static int inverse; /* "matrox:inverse" */ static int sgram; /* "matrox:sgram" */ #ifdef CONFIG_MTRR static int mtrr = 1; /* "matrox:nomtrr" */ #endif static int grayscale; /* "matrox:grayscale" */ static int dev = -1; /* "matrox:dev:xxxxx" */ static unsigned int vesa = ~0; /* "matrox:vesa:xxxxx" */ static int depth = -1; /* "matrox:depth:xxxxx" */ static unsigned int xres; /* "matrox:xres:xxxxx" */ static unsigned int yres; /* "matrox:yres:xxxxx" */ static unsigned int upper = ~0; /* "matrox:upper:xxxxx" */ static unsigned int lower = ~0; /* "matrox:lower:xxxxx" */ static unsigned int vslen; /* "matrox:vslen:xxxxx" */ static unsigned int left = ~0; /* "matrox:left:xxxxx" */ static unsigned int right = ~0; /* "matrox:right:xxxxx" */ static unsigned int hslen; /* "matrox:hslen:xxxxx" */ static unsigned int pixclock; /* "matrox:pixclock:xxxxx" */ static int sync = -1; /* "matrox:sync:xxxxx" */ static unsigned int fv; /* "matrox:fv:xxxxx" */ static unsigned int fh; /* "matrox:fh:xxxxxk" */ static unsigned int maxclk; /* "matrox:maxclk:xxxxM" */ static int dfp; /* "matrox:dfp */ static int dfp_type = -1; /* "matrox:dfp:xxx */ static int memtype = -1; /* "matrox:memtype:xxx" */ static char outputs[8]; /* "matrox:outputs:xxx" */ #ifndef MODULE static char videomode[64]; /* "matrox:mode:xxxxx" or "matrox:xxxxx" */ #endif static int matroxfb_getmemory(WPMINFO unsigned int maxSize, unsigned int *realSize){ vaddr_t vm; unsigned int offs; unsigned int offs2; unsigned char orig; unsigned char bytes[32]; unsigned char* tmp; DBG(__FUNCTION__) vm = ACCESS_FBINFO(video.vbase); maxSize &= ~0x1FFFFF; /* must be X*2MB (really it must be 2 or X*4MB) */ /* at least 2MB */ if (maxSize < 0x0200000) return 0; if (maxSize > 0x2000000) maxSize = 0x2000000; mga_outb(M_EXTVGA_INDEX, 0x03); orig = mga_inb(M_EXTVGA_DATA); mga_outb(M_EXTVGA_DATA, orig | 0x80); tmp = bytes; for (offs = 0x100000; offs < maxSize; offs += 0x200000) *tmp++ = mga_readb(vm, offs); for (offs = 0x100000; offs < maxSize; offs += 0x200000) mga_writeb(vm, offs, 0x02); mga_outb(M_CACHEFLUSH, 0x00); for (offs = 0x100000; offs < maxSize; offs += 0x200000) { if (mga_readb(vm, offs) != 0x02) break; mga_writeb(vm, offs, mga_readb(vm, offs) - 0x02); if (mga_readb(vm, offs)) break; } tmp = bytes; for (offs2 = 0x100000; offs2 < maxSize; offs2 += 0x200000) mga_writeb(vm, offs2, *tmp++); mga_outb(M_EXTVGA_INDEX, 0x03); mga_outb(M_EXTVGA_DATA, orig); *realSize = offs - 0x100000; #ifdef CONFIG_FB_MATROX_MILLENIUM ACCESS_FBINFO(interleave) = !(!isMillenium(MINFO) || ((offs - 0x100000) & 0x3FFFFF)); #endif return 1; } struct video_board { int maxvram; int maxdisplayable; int accelID; struct matrox_switch* lowlevel; }; #ifdef CONFIG_FB_MATROX_MILLENIUM static struct video_board vbMillennium = {0x0800000, 0x0800000, FB_ACCEL_MATROX_MGA2064W, &matrox_millennium}; static struct video_board vbMillennium2 = {0x1000000, 0x0800000, FB_ACCEL_MATROX_MGA2164W, &matrox_millennium}; static struct video_board vbMillennium2A = {0x1000000, 0x0800000, FB_ACCEL_MATROX_MGA2164W_AGP, &matrox_millennium}; #endif /* CONFIG_FB_MATROX_MILLENIUM */ #ifdef CONFIG_FB_MATROX_MYSTIQUE static struct video_board vbMystique = {0x0800000, 0x0800000, FB_ACCEL_MATROX_MGA1064SG, &matrox_mystique}; #endif /* CONFIG_FB_MATROX_MYSTIQUE */ #ifdef CONFIG_FB_MATROX_G static struct video_board vbG100 = {0x0800000, 0x0800000, FB_ACCEL_MATROX_MGAG100, &matrox_G100}; static struct video_board vbG200 = {0x1000000, 0x1000000, FB_ACCEL_MATROX_MGAG200, &matrox_G100}; #ifdef CONFIG_FB_MATROX_32MB /* from doc it looks like that accelerator can draw only to low 16MB :-( Direct accesses & displaying are OK for whole 32MB */ static struct video_board vbG400 = {0x2000000, 0x1000000, FB_ACCEL_MATROX_MGAG400, &matrox_G100}; #else static struct video_board vbG400 = {0x2000000, 0x1000000, FB_ACCEL_MATROX_MGAG400, &matrox_G100}; #endif #endif #define DEVF_VIDEO64BIT 0x0001 #define DEVF_SWAPS 0x0002 #define DEVF_SRCORG 0x0004 #define DEVF_DUALHEAD 0x0008 #define DEVF_CROSS4MB 0x0010 #define DEVF_TEXT4B 0x0020 /* #define DEVF_recycled 0x0040 */ /* #define DEVF_recycled 0x0080 */ #define DEVF_SUPPORT32MB 0x0100 #define DEVF_ANY_VXRES 0x0200 #define DEVF_TEXT16B 0x0400 #define DEVF_CRTC2 0x0800 #define DEVF_MAVEN_CAPABLE 0x1000 #define DEVF_PANELLINK_CAPABLE 0x2000 #define DEVF_G450DAC 0x4000 #define DEVF_GCORE (DEVF_VIDEO64BIT | DEVF_SWAPS | DEVF_CROSS4MB) #define DEVF_G2CORE (DEVF_GCORE | DEVF_ANY_VXRES | DEVF_MAVEN_CAPABLE | DEVF_PANELLINK_CAPABLE | DEVF_SRCORG | DEVF_DUALHEAD) #define DEVF_G100 (DEVF_GCORE) /* no doc, no vxres... */ #define DEVF_G200 (DEVF_G2CORE) #define DEVF_G400 (DEVF_G2CORE | DEVF_SUPPORT32MB | DEVF_TEXT16B | DEVF_CRTC2) /* if you'll find how to drive DFP... */ #define DEVF_G450 (DEVF_GCORE | DEVF_ANY_VXRES | DEVF_SUPPORT32MB | DEVF_TEXT16B | DEVF_CRTC2 | DEVF_G450DAC | DEVF_SRCORG | DEVF_DUALHEAD) #define DEVF_G550 (DEVF_G450) static struct board { unsigned short vendor, device, rev, svid, sid; unsigned int flags; unsigned int maxclk; enum mga_chip chip; struct video_board* base; const char* name; } dev_list[] = { #ifdef CONFIG_FB_MATROX_MILLENIUM {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL, 0xFF, 0, 0, DEVF_TEXT4B, 230000, MGA_2064, &vbMillennium, "Millennium (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL_2, 0xFF, 0, 0, DEVF_SWAPS, 220000, MGA_2164, &vbMillennium2, "Millennium II (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL_2_AGP, 0xFF, 0, 0, DEVF_SWAPS, 250000, MGA_2164, &vbMillennium2A, "Millennium II (AGP)"}, #endif #ifdef CONFIG_FB_MATROX_MYSTIQUE {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MYS, 0x02, 0, 0, DEVF_VIDEO64BIT | DEVF_CROSS4MB, 180000, MGA_1064, &vbMystique, "Mystique (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MYS, 0xFF, 0, 0, DEVF_VIDEO64BIT | DEVF_SWAPS | DEVF_CROSS4MB, 220000, MGA_1164, &vbMystique, "Mystique 220 (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MYS_AGP, 0x02, 0, 0, DEVF_VIDEO64BIT | DEVF_CROSS4MB, 180000, MGA_1064, &vbMystique, "Mystique (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MYS_AGP, 0xFF, 0, 0, DEVF_VIDEO64BIT | DEVF_SWAPS | DEVF_CROSS4MB, 220000, MGA_1164, &vbMystique, "Mystique 220 (AGP)"}, #endif #ifdef CONFIG_FB_MATROX_G {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G100_MM, 0xFF, 0, 0, DEVF_G100, 230000, MGA_G100, &vbG100, "MGA-G100 (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G100_AGP, 0xFF, 0, 0, DEVF_G100, 230000, MGA_G100, &vbG100, "MGA-G100 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_PCI, 0xFF, 0, 0, DEVF_G200, 250000, MGA_G200, &vbG200, "MGA-G200 (PCI)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, PCI_SS_VENDOR_ID_MATROX, PCI_SS_ID_MATROX_GENERIC, DEVF_G200, 220000, MGA_G200, &vbG200, "MGA-G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, PCI_SS_VENDOR_ID_MATROX, PCI_SS_ID_MATROX_MYSTIQUE_G200_AGP, DEVF_G200, 230000, MGA_G200, &vbG200, "Mystique G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, PCI_SS_VENDOR_ID_MATROX, PCI_SS_ID_MATROX_MILLENIUM_G200_AGP, DEVF_G200, 250000, MGA_G200, &vbG200, "Millennium G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, PCI_SS_VENDOR_ID_MATROX, PCI_SS_ID_MATROX_MARVEL_G200_AGP, DEVF_G200, 230000, MGA_G200, &vbG200, "Marvel G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, PCI_SS_VENDOR_ID_SIEMENS_NIXDORF, PCI_SS_ID_SIEMENS_MGA_G200_AGP, DEVF_G200, 230000, MGA_G200, &vbG200, "MGA-G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, 0xFF, 0, 0, DEVF_G200, 230000, MGA_G200, &vbG200, "G200 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G400, 0x80, PCI_SS_VENDOR_ID_MATROX, PCI_SS_ID_MATROX_MILLENNIUM_G400_MAX_AGP, DEVF_G400, 360000, MGA_G400, &vbG400, "Millennium G400 MAX (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G400, 0x80, 0, 0, DEVF_G400, 300000, MGA_G400, &vbG400, "G400 (AGP)"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G400, 0xFF, 0, 0, DEVF_G450, 360000, MGA_G450, &vbG400, "G450"}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G550, 0xFF, 0, 0, DEVF_G550, 360000, MGA_G550, &vbG400, "G550"}, #endif {0, 0, 0xFF, 0, 0, 0, 0, 0, NULL, NULL}}; #ifndef MODULE static struct fb_videomode defaultmode = { /* 640x480 @ 60Hz, 31.5 kHz */ NULL, 60, 640, 480, 39721, 40, 24, 32, 11, 96, 2, 0, FB_VMODE_NONINTERLACED }; #endif /* !MODULE */ static int hotplug = 0; static void setDefaultOutputs(WPMINFO2) { unsigned int i; const char* ptr; ACCESS_FBINFO(outputs[0]).default_src = MATROXFB_SRC_CRTC1; if (ACCESS_FBINFO(devflags.g450dac)) { ACCESS_FBINFO(outputs[1]).default_src = MATROXFB_SRC_CRTC1; ACCESS_FBINFO(outputs[2]).default_src = MATROXFB_SRC_CRTC1; } else if (dfp) { ACCESS_FBINFO(outputs[2]).default_src = MATROXFB_SRC_CRTC1; } ptr = outputs; for (i = 0; i < MATROXFB_MAX_OUTPUTS; i++) { char c = *ptr++; if (c == 0) { break; } if (c == '0') { ACCESS_FBINFO(outputs[i]).default_src = MATROXFB_SRC_NONE; } else if (c == '1') { ACCESS_FBINFO(outputs[i]).default_src = MATROXFB_SRC_CRTC1; } else if (c == '2' && ACCESS_FBINFO(devflags.crtc2)) { ACCESS_FBINFO(outputs[i]).default_src = MATROXFB_SRC_CRTC2; } else { printk(KERN_ERR "matroxfb: Unknown outputs setting\n"); break; } } /* Nullify this option for subsequent adapters */ outputs[0] = 0; } static int initMatrox2(WPMINFO struct board* b){ unsigned long ctrlptr_phys = 0; unsigned long video_base_phys = 0; unsigned int memsize; int err; static struct pci_device_id intel_82437[] = { { PCI_DEVICE(PCI_VENDOR_ID_INTEL, PCI_DEVICE_ID_INTEL_82437) }, { }, }; DBG(__FUNCTION__) /* set default values... */ vesafb_defined.accel_flags = FB_ACCELF_TEXT; ACCESS_FBINFO(hw_switch) = b->base->lowlevel; ACCESS_FBINFO(devflags.accelerator) = b->base->accelID; ACCESS_FBINFO(max_pixel_clock) = b->maxclk; printk(KERN_INFO "matroxfb: Matrox %s detected\n", b->name); ACCESS_FBINFO(capable.plnwt) = 1; ACCESS_FBINFO(chip) = b->chip; ACCESS_FBINFO(capable.srcorg) = b->flags & DEVF_SRCORG; ACCESS_FBINFO(devflags.video64bits) = b->flags & DEVF_VIDEO64BIT; if (b->flags & DEVF_TEXT4B) { ACCESS_FBINFO(devflags.vgastep) = 4; ACCESS_FBINFO(devflags.textmode) = 4; ACCESS_FBINFO(devflags.text_type_aux) = FB_AUX_TEXT_MGA_STEP16; } else if (b->flags & DEVF_TEXT16B) { ACCESS_FBINFO(devflags.vgastep) = 16; ACCESS_FBINFO(devflags.textmode) = 1; ACCESS_FBINFO(devflags.text_type_aux) = FB_AUX_TEXT_MGA_STEP16; } else { ACCESS_FBINFO(devflags.vgastep) = 8; ACCESS_FBINFO(devflags.textmode) = 1; ACCESS_FBINFO(devflags.text_type_aux) = FB_AUX_TEXT_MGA_STEP8; } #ifdef CONFIG_FB_MATROX_32MB ACCESS_FBINFO(devflags.support32MB) = (b->flags & DEVF_SUPPORT32MB) != 0; #endif ACCESS_FBINFO(devflags.precise_width) = !(b->flags & DEVF_ANY_VXRES); ACCESS_FBINFO(devflags.crtc2) = (b->flags & DEVF_CRTC2) != 0; ACCESS_FBINFO(devflags.maven_capable) = (b->flags & DEVF_MAVEN_CAPABLE) != 0; ACCESS_FBINFO(devflags.dualhead) = (b->flags & DEVF_DUALHEAD) != 0; ACCESS_FBINFO(devflags.dfp_type) = dfp_type; ACCESS_FBINFO(devflags.g450dac) = (b->flags & DEVF_G450DAC) != 0; ACCESS_FBINFO(devflags.textstep) = ACCESS_FBINFO(devflags.vgastep) * ACCESS_FBINFO(devflags.textmode); ACCESS_FBINFO(devflags.textvram) = 65536 / ACCESS_FBINFO(devflags.textmode); setDefaultOutputs(PMINFO2); if (b->flags & DEVF_PANELLINK_CAPABLE) { ACCESS_FBINFO(outputs[2]).data = MINFO; ACCESS_FBINFO(outputs[2]).output = &panellink_output; ACCESS_FBINFO(outputs[2]).src = ACCESS_FBINFO(outputs[2]).default_src; ACCESS_FBINFO(outputs[2]).mode = MATROXFB_OUTPUT_MODE_MONITOR; ACCESS_FBINFO(devflags.panellink) = 1; } if (ACCESS_FBINFO(capable.cross4MB) < 0) ACCESS_FBINFO(capable.cross4MB) = b->flags & DEVF_CROSS4MB; if (b->flags & DEVF_SWAPS) { ctrlptr_phys = pci_resource_start(ACCESS_FBINFO(pcidev), 1); video_base_phys = pci_resource_start(ACCESS_FBINFO(pcidev), 0); ACCESS_FBINFO(devflags.fbResource) = PCI_BASE_ADDRESS_0; } else { ctrlptr_phys = pci_resource_start(ACCESS_FBINFO(pcidev), 0); video_base_phys = pci_resource_start(ACCESS_FBINFO(pcidev), 1); ACCESS_FBINFO(devflags.fbResource) = PCI_BASE_ADDRESS_1; } err = -EINVAL; if (!ctrlptr_phys) { printk(KERN_ERR "matroxfb: control registers are not available, matroxfb disabled\n"); goto fail; } if (!video_base_phys) { printk(KERN_ERR "matroxfb: video RAM is not available in PCI address space, matroxfb disabled\n"); goto fail; } memsize = b->base->maxvram; if (!request_mem_region(ctrlptr_phys, 16384, "matroxfb MMIO")) { goto fail; } if (!request_mem_region(video_base_phys, memsize, "matroxfb FB")) { goto failCtrlMR; } ACCESS_FBINFO(video.len_maximum) = memsize; /* convert mem (autodetect k, M) */ if (mem < 1024) mem *= 1024; if (mem < 0x00100000) mem *= 1024; if (mem && (mem < memsize)) memsize = mem; err = -ENOMEM; if (mga_ioremap(ctrlptr_phys, 16384, MGA_IOREMAP_MMIO, &ACCESS_FBINFO(mmio.vbase))) { printk(KERN_ERR "matroxfb: cannot ioremap(%lX, 16384), matroxfb disabled\n", ctrlptr_phys); goto failVideoMR; } ACCESS_FBINFO(mmio.base) = ctrlptr_phys; ACCESS_FBINFO(mmio.len) = 16384; ACCESS_FBINFO(video.base) = video_base_phys; if (mga_ioremap(video_base_phys, memsize, MGA_IOREMAP_FB, &ACCESS_FBINFO(video.vbase))) { printk(KERN_ERR "matroxfb: cannot ioremap(%lX, %d), matroxfb disabled\n", video_base_phys, memsize); goto failCtrlIO; } { u_int32_t cmd; u_int32_t mga_option; pci_read_config_dword(ACCESS_FBINFO(pcidev), PCI_OPTION_REG, &mga_option); pci_read_config_dword(ACCESS_FBINFO(pcidev), PCI_COMMAND, &cmd); mga_option &= 0x7FFFFFFF; /* clear BIG_ENDIAN */ mga_option |= MX_OPTION_BSWAP; /* disable palette snooping */ cmd &= ~PCI_COMMAND_VGA_PALETTE; if (pci_dev_present(intel_82437)) { if (!(mga_option & 0x20000000) && !ACCESS_FBINFO(devflags.nopciretry)) { printk(KERN_WARNING "matroxfb: Disabling PCI retries due to i82437 present\n"); } mga_option |= 0x20000000; ACCESS_FBINFO(devflags.nopciretry) = 1; } pci_write_config_dword(ACCESS_FBINFO(pcidev), PCI_COMMAND, cmd); pci_write_config_dword(ACCESS_FBINFO(pcidev), PCI_OPTION_REG, mga_option); ACCESS_FBINFO(hw).MXoptionReg = mga_option; /* select non-DMA memory for PCI_MGA_DATA, otherwise dump of PCI cfg space can lock PCI bus */ /* maybe preinit() candidate, but it is same... for all devices... at this time... */ pci_write_config_dword(ACCESS_FBINFO(pcidev), PCI_MGA_INDEX, 0x00003C00); } err = -ENXIO; matroxfb_read_pins(PMINFO2); if (ACCESS_FBINFO(hw_switch)->preinit(PMINFO2)) { goto failVideoIO; } err = -ENOMEM; if (!matroxfb_getmemory(PMINFO memsize, &ACCESS_FBINFO(video.len)) || !ACCESS_FBINFO(video.len)) { printk(KERN_ERR "matroxfb: cannot determine memory size\n"); goto failVideoIO; } ACCESS_FBINFO(devflags.ydstorg) = 0; ACCESS_FBINFO(video.base) = video_base_phys; ACCESS_FBINFO(video.len_usable) = ACCESS_FBINFO(video.len); if (ACCESS_FBINFO(video.len_usable) > b->base->maxdisplayable) ACCESS_FBINFO(video.len_usable) = b->base->maxdisplayable; #ifdef CONFIG_MTRR if (mtrr) { ACCESS_FBINFO(mtrr.vram) = mtrr_add(video_base_phys, ACCESS_FBINFO(video.len), MTRR_TYPE_WRCOMB, 1); ACCESS_FBINFO(mtrr.vram_valid) = 1; printk(KERN_INFO "matroxfb: MTRR's turned on\n"); } #endif /* CONFIG_MTRR */ if (!ACCESS_FBINFO(devflags.novga)) request_region(0x3C0, 32, "matrox"); matroxfb_g450_connect(PMINFO2); ACCESS_FBINFO(hw_switch->reset(PMINFO2)); ACCESS_FBINFO(fbcon.monspecs.hfmin) = 0; ACCESS_FBINFO(fbcon.monspecs.hfmax) = fh; ACCESS_FBINFO(fbcon.monspecs.vfmin) = 0; ACCESS_FBINFO(fbcon.monspecs.vfmax) = fv; ACCESS_FBINFO(fbcon.monspecs.dpms) = 0; /* TBD */ /* static settings */ vesafb_defined.red = colors[depth-1].red; vesafb_defined.green = colors[depth-1].green; vesafb_defined.blue = colors[depth-1].blue; vesafb_defined.bits_per_pixel = colors[depth-1].bits_per_pixel; vesafb_defined.grayscale = grayscale; vesafb_defined.vmode = 0; if (noaccel) vesafb_defined.accel_flags &= ~FB_ACCELF_TEXT; ACCESS_FBINFO(fbops) = matroxfb_ops; ACCESS_FBINFO(fbcon.fbops) = &ACCESS_FBINFO(fbops); ACCESS_FBINFO(fbcon.pseudo_palette) = ACCESS_FBINFO(cmap); /* after __init time we are like module... no logo */ ACCESS_FBINFO(fbcon.flags) = hotplug ? FBINFO_FLAG_MODULE : FBINFO_FLAG_DEFAULT; ACCESS_FBINFO(fbcon.flags) |= FBINFO_PARTIAL_PAN_OK | /* Prefer panning for scroll under MC viewer/edit */ FBINFO_HWACCEL_COPYAREA | /* We have hw-assisted bmove */ FBINFO_HWACCEL_FILLRECT | /* And fillrect */ FBINFO_HWACCEL_IMAGEBLIT | /* And imageblit */ FBINFO_HWACCEL_XPAN | /* And we support both horizontal */ FBINFO_HWACCEL_YPAN; /* And vertical panning */ ACCESS_FBINFO(video.len_usable) &= PAGE_MASK; fb_alloc_cmap(&ACCESS_FBINFO(fbcon.cmap), 256, 1); #ifndef MODULE /* mode database is marked __init!!! */ if (!hotplug) { fb_find_mode(&vesafb_defined, &ACCESS_FBINFO(fbcon), videomode[0]?videomode:NULL, NULL, 0, &defaultmode, vesafb_defined.bits_per_pixel); } #endif /* !MODULE */ /* mode modifiers */ if (hslen) vesafb_defined.hsync_len = hslen; if (vslen) vesafb_defined.vsync_len = vslen; if (left != ~0) vesafb_defined.left_margin = left; if (right != ~0) vesafb_defined.right_margin = right; if (upper != ~0) vesafb_defined.upper_margin = upper; if (lower != ~0) vesafb_defined.lower_margin = lower; if (xres) vesafb_defined.xres = xres; if (yres) vesafb_defined.yres = yres; if (sync != -1) vesafb_defined.sync = sync; else if (vesafb_defined.sync == ~0) { vesafb_defined.sync = 0; if (yres < 400) vesafb_defined.sync |= FB_SYNC_HOR_HIGH_ACT; else if (yres < 480) vesafb_defined.sync |= FB_SYNC_VERT_HIGH_ACT; } /* fv, fh, maxclk limits was specified */ { unsigned int tmp; if (fv) { tmp = fv * (vesafb_defined.upper_margin + vesafb_defined.yres + vesafb_defined.lower_margin + vesafb_defined.vsync_len); if ((tmp < fh) || (fh == 0)) fh = tmp; } if (fh) { tmp = fh * (vesafb_defined.left_margin + vesafb_defined.xres + vesafb_defined.right_margin + vesafb_defined.hsync_len); if ((tmp < maxclk) || (maxclk == 0)) maxclk = tmp; } tmp = (maxclk + 499) / 500; if (tmp) { tmp = (2000000000 + tmp) / tmp; if (tmp > pixclock) pixclock = tmp; } } if (pixclock) { if (pixclock < 2000) /* > 500MHz */ pixclock = 4000; /* 250MHz */ if (pixclock > 1000000) pixclock = 1000000; /* 1MHz */ vesafb_defined.pixclock = pixclock; } /* FIXME: Where to move this?! */ #if defined(CONFIG_PPC_PMAC) #ifndef MODULE if (machine_is(powermac)) { struct fb_var_screeninfo var; if (default_vmode <= 0 || default_vmode > VMODE_MAX) default_vmode = VMODE_640_480_60; #ifdef CONFIG_NVRAM if (default_cmode == CMODE_NVRAM) default_cmode = nvram_read_byte(NV_CMODE); #endif if (default_cmode < CMODE_8 || default_cmode > CMODE_32) default_cmode = CMODE_8; if (!mac_vmode_to_var(default_vmode, default_cmode, &var)) { var.accel_flags = vesafb_defined.accel_flags; var.xoffset = var.yoffset = 0; /* Note: mac_vmode_to_var() does not set all parameters */ vesafb_defined = var; } } #endif /* !MODULE */ #endif /* CONFIG_PPC_PMAC */ vesafb_defined.xres_virtual = vesafb_defined.xres; if (nopan) { vesafb_defined.yres_virtual = vesafb_defined.yres; } else { vesafb_defined.yres_virtual = 65536; /* large enough to be INF, but small enough to yres_virtual * xres_virtual < 2^32 */ } matroxfb_init_fix(PMINFO2); ACCESS_FBINFO(fbcon.screen_base) = vaddr_va(ACCESS_FBINFO(video.vbase)); matroxfb_update_fix(PMINFO2); /* Normalize values (namely yres_virtual) */ matroxfb_check_var(&vesafb_defined, &ACCESS_FBINFO(fbcon)); /* And put it into "current" var. Do NOT program hardware yet, or we'll not take over * vgacon correctly. fbcon_startup will call fb_set_par for us, WITHOUT check_var, * and unfortunately it will do it BEFORE vgacon contents is saved, so it won't work * anyway. But we at least tried... */ ACCESS_FBINFO(fbcon.var) = vesafb_defined; err = -EINVAL; printk(KERN_INFO "matroxfb: %dx%dx%dbpp (virtual: %dx%d)\n", vesafb_defined.xres, vesafb_defined.yres, vesafb_defined.bits_per_pixel, vesafb_defined.xres_virtual, vesafb_defined.yres_virtual); printk(KERN_INFO "matroxfb: framebuffer at 0x%lX, mapped to 0x%p, size %d\n", ACCESS_FBINFO(video.base), vaddr_va(ACCESS_FBINFO(video.vbase)), ACCESS_FBINFO(video.len)); /* We do not have to set currcon to 0... register_framebuffer do it for us on first console * and we do not want currcon == 0 for subsequent framebuffers */ ACCESS_FBINFO(fbcon).device = &ACCESS_FBINFO(pcidev)->dev; if (register_framebuffer(&ACCESS_FBINFO(fbcon)) < 0) { goto failVideoIO; } printk("fb%d: %s frame buffer device\n", ACCESS_FBINFO(fbcon.node), ACCESS_FBINFO(fbcon.fix.id)); /* there is no console on this fb... but we have to initialize hardware * until someone tells me what is proper thing to do */ if (!ACCESS_FBINFO(initialized)) { printk(KERN_INFO "fb%d: initializing hardware\n", ACCESS_FBINFO(fbcon.node)); /* We have to use FB_ACTIVATE_FORCE, as we had to put vesafb_defined to the fbcon.var * already before, so register_framebuffer works correctly. */ vesafb_defined.activate |= FB_ACTIVATE_FORCE; fb_set_var(&ACCESS_FBINFO(fbcon), &vesafb_defined); } return 0; failVideoIO:; matroxfb_g450_shutdown(PMINFO2); mga_iounmap(ACCESS_FBINFO(video.vbase)); failCtrlIO:; mga_iounmap(ACCESS_FBINFO(mmio.vbase)); failVideoMR:; release_mem_region(video_base_phys, ACCESS_FBINFO(video.len_maximum)); failCtrlMR:; release_mem_region(ctrlptr_phys, 16384); fail:; return err; } static LIST_HEAD(matroxfb_list); static LIST_HEAD(matroxfb_driver_list); #define matroxfb_l(x) list_entry(x, struct matrox_fb_info, next_fb) #define matroxfb_driver_l(x) list_entry(x, struct matroxfb_driver, node) int matroxfb_register_driver(struct matroxfb_driver* drv) { struct matrox_fb_info* minfo; list_add(&drv->node, &matroxfb_driver_list); for (minfo = matroxfb_l(matroxfb_list.next); minfo != matroxfb_l(&matroxfb_list); minfo = matroxfb_l(minfo->next_fb.next)) { void* p; if (minfo->drivers_count == MATROXFB_MAX_FB_DRIVERS) continue; p = drv->probe(minfo); if (p) { minfo->drivers_data[minfo->drivers_count] = p; minfo->drivers[minfo->drivers_count++] = drv; } } return 0; } void matroxfb_unregister_driver(struct matroxfb_driver* drv) { struct matrox_fb_info* minfo; list_del(&drv->node); for (minfo = matroxfb_l(matroxfb_list.next); minfo != matroxfb_l(&matroxfb_list); minfo = matroxfb_l(minfo->next_fb.next)) { int i; for (i = 0; i < minfo->drivers_count; ) { if (minfo->drivers[i] == drv) { if (drv && drv->remove) drv->remove(minfo, minfo->drivers_data[i]); minfo->drivers[i] = minfo->drivers[--minfo->drivers_count]; minfo->drivers_data[i] = minfo->drivers_data[minfo->drivers_count]; } else i++; } } } static void matroxfb_register_device(struct matrox_fb_info* minfo) { struct matroxfb_driver* drv; int i = 0; list_add(&ACCESS_FBINFO(next_fb), &matroxfb_list); for (drv = matroxfb_driver_l(matroxfb_driver_list.next); drv != matroxfb_driver_l(&matroxfb_driver_list); drv = matroxfb_driver_l(drv->node.next)) { if (drv && drv->probe) { void *p = drv->probe(minfo); if (p) { minfo->drivers_data[i] = p; minfo->drivers[i++] = drv; if (i == MATROXFB_MAX_FB_DRIVERS) break; } } } minfo->drivers_count = i; } static void matroxfb_unregister_device(struct matrox_fb_info* minfo) { int i; list_del(&ACCESS_FBINFO(next_fb)); for (i = 0; i < minfo->drivers_count; i++) { struct matroxfb_driver* drv = minfo->drivers[i]; if (drv && drv->remove) drv->remove(minfo, minfo->drivers_data[i]); } } static int matroxfb_probe(struct pci_dev* pdev, const struct pci_device_id* dummy) { struct board* b; u_int16_t svid; u_int16_t sid; struct matrox_fb_info* minfo; int err; u_int32_t cmd; #ifndef CONFIG_FB_MATROX_MULTIHEAD static int registered = 0; #endif DBG(__FUNCTION__) svid = pdev->subsystem_vendor; sid = pdev->subsystem_device; for (b = dev_list; b->vendor; b++) { if ((b->vendor != pdev->vendor) || (b->device != pdev->device) || (b->rev < pdev->revision)) continue; if (b->svid) if ((b->svid != svid) || (b->sid != sid)) continue; break; } /* not match... */ if (!b->vendor) return -ENODEV; if (dev > 0) { /* not requested one... */ dev--; return -ENODEV; } pci_read_config_dword(pdev, PCI_COMMAND, &cmd); if (pci_enable_device(pdev)) { return -1; } #ifdef CONFIG_FB_MATROX_MULTIHEAD minfo = kmalloc(sizeof(*minfo), GFP_KERNEL); if (!minfo) return -1; #else if (registered) /* singlehead driver... */ return -1; minfo = &matroxfb_global_mxinfo; #endif memset(MINFO, 0, sizeof(*MINFO)); ACCESS_FBINFO(pcidev) = pdev; ACCESS_FBINFO(dead) = 0; ACCESS_FBINFO(usecount) = 0; ACCESS_FBINFO(userusecount) = 0; pci_set_drvdata(pdev, MINFO); /* DEVFLAGS */ ACCESS_FBINFO(devflags.memtype) = memtype; if (memtype != -1) noinit = 0; if (cmd & PCI_COMMAND_MEMORY) { ACCESS_FBINFO(devflags.novga) = novga; ACCESS_FBINFO(devflags.nobios) = nobios; ACCESS_FBINFO(devflags.noinit) = noinit; /* subsequent heads always needs initialization and must not enable BIOS */ novga = 1; nobios = 1; noinit = 0; } else { ACCESS_FBINFO(devflags.novga) = 1; ACCESS_FBINFO(devflags.nobios) = 1; ACCESS_FBINFO(devflags.noinit) = 0; } ACCESS_FBINFO(devflags.nopciretry) = no_pci_retry; ACCESS_FBINFO(devflags.mga_24bpp_fix) = inv24; ACCESS_FBINFO(devflags.precise_width) = option_precise_width; ACCESS_FBINFO(devflags.sgram) = sgram; ACCESS_FBINFO(capable.cross4MB) = cross4MB; spin_lock_init(&ACCESS_FBINFO(lock.DAC)); spin_lock_init(&ACCESS_FBINFO(lock.accel)); init_rwsem(&ACCESS_FBINFO(crtc2.lock)); init_rwsem(&ACCESS_FBINFO(altout.lock)); ACCESS_FBINFO(irq_flags) = 0; init_waitqueue_head(&ACCESS_FBINFO(crtc1.vsync.wait)); init_waitqueue_head(&ACCESS_FBINFO(crtc2.vsync.wait)); ACCESS_FBINFO(crtc1.panpos) = -1; err = initMatrox2(PMINFO b); if (!err) { #ifndef CONFIG_FB_MATROX_MULTIHEAD registered = 1; #endif matroxfb_register_device(MINFO); return 0; } #ifdef CONFIG_FB_MATROX_MULTIHEAD kfree(minfo); #endif return -1; } static void pci_remove_matrox(struct pci_dev* pdev) { struct matrox_fb_info* minfo; minfo = pci_get_drvdata(pdev); matroxfb_remove(PMINFO 1); } static struct pci_device_id matroxfb_devices[] = { #ifdef CONFIG_FB_MATROX_MILLENIUM {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL_2, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MIL_2_AGP, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, #endif #ifdef CONFIG_FB_MATROX_MYSTIQUE {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_MYS, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, #endif #ifdef CONFIG_FB_MATROX_G {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G100_MM, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G100_AGP, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_PCI, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G200_AGP, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G400, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, {PCI_VENDOR_ID_MATROX, PCI_DEVICE_ID_MATROX_G550, PCI_ANY_ID, PCI_ANY_ID, 0, 0, 0}, #endif {0, 0, 0, 0, 0, 0, 0} }; MODULE_DEVICE_TABLE(pci, matroxfb_devices); static struct pci_driver matroxfb_driver = { .name = "matroxfb", .id_table = matroxfb_devices, .probe = matroxfb_probe, .remove = pci_remove_matrox, }; /* **************************** init-time only **************************** */ #define RSResolution(X) ((X) & 0x0F) #define RS640x400 1 #define RS640x480 2 #define RS800x600 3 #define RS1024x768 4 #define RS1280x1024 5 #define RS1600x1200 6 #define RS768x576 7 #define RS960x720 8 #define RS1152x864 9 #define RS1408x1056 10 #define RS640x350 11 #define RS1056x344 12 /* 132 x 43 text */ #define RS1056x400 13 /* 132 x 50 text */ #define RS1056x480 14 /* 132 x 60 text */ #define RSNoxNo 15 /* 10-FF */ static struct { int xres, yres, left, right, upper, lower, hslen, vslen, vfreq; } timmings[] __initdata = { { 640, 400, 48, 16, 39, 8, 96, 2, 70 }, { 640, 480, 48, 16, 33, 10, 96, 2, 60 }, { 800, 600, 144, 24, 28, 8, 112, 6, 60 }, { 1024, 768, 160, 32, 30, 4, 128, 4, 60 }, { 1280, 1024, 224, 32, 32, 4, 136, 4, 60 }, { 1600, 1200, 272, 48, 32, 5, 152, 5, 60 }, { 768, 576, 144, 16, 28, 6, 112, 4, 60 }, { 960, 720, 144, 24, 28, 8, 112, 4, 60 }, { 1152, 864, 192, 32, 30, 4, 128, 4, 60 }, { 1408, 1056, 256, 40, 32, 5, 144, 5, 60 }, { 640, 350, 48, 16, 39, 8, 96, 2, 70 }, { 1056, 344, 96, 24, 59, 44, 160, 2, 70 }, { 1056, 400, 96, 24, 39, 8, 160, 2, 70 }, { 1056, 480, 96, 24, 36, 12, 160, 3, 60 }, { 0, 0, ~0, ~0, ~0, ~0, 0, 0, 0 } }; #define RSCreate(X,Y) ((X) | ((Y) << 8)) static struct { unsigned int vesa; unsigned int info; } *RSptr, vesamap[] __initdata = { /* default must be first */ { ~0, RSCreate(RSNoxNo, RS8bpp ) }, { 0x101, RSCreate(RS640x480, RS8bpp ) }, { 0x100, RSCreate(RS640x400, RS8bpp ) }, { 0x180, RSCreate(RS768x576, RS8bpp ) }, { 0x103, RSCreate(RS800x600, RS8bpp ) }, { 0x188, RSCreate(RS960x720, RS8bpp ) }, { 0x105, RSCreate(RS1024x768, RS8bpp ) }, { 0x190, RSCreate(RS1152x864, RS8bpp ) }, { 0x107, RSCreate(RS1280x1024, RS8bpp ) }, { 0x198, RSCreate(RS1408x1056, RS8bpp ) }, { 0x11C, RSCreate(RS1600x1200, RS8bpp ) }, { 0x110, RSCreate(RS640x480, RS15bpp) }, { 0x181, RSCreate(RS768x576, RS15bpp) }, { 0x113, RSCreate(RS800x600, RS15bpp) }, { 0x189, RSCreate(RS960x720, RS15bpp) }, { 0x116, RSCreate(RS1024x768, RS15bpp) }, { 0x191, RSCreate(RS1152x864, RS15bpp) }, { 0x119, RSCreate(RS1280x1024, RS15bpp) }, { 0x199, RSCreate(RS1408x1056, RS15bpp) }, { 0x11D, RSCreate(RS1600x1200, RS15bpp) }, { 0x111, RSCreate(RS640x480, RS16bpp) }, { 0x182, RSCreate(RS768x576, RS16bpp) }, { 0x114, RSCreate(RS800x600, RS16bpp) }, { 0x18A, RSCreate(RS960x720, RS16bpp) }, { 0x117, RSCreate(RS1024x768, RS16bpp) }, { 0x192, RSCreate(RS1152x864, RS16bpp) }, { 0x11A, RSCreate(RS1280x1024, RS16bpp) }, { 0x19A, RSCreate(RS1408x1056, RS16bpp) }, { 0x11E, RSCreate(RS1600x1200, RS16bpp) }, { 0x1B2, RSCreate(RS640x480, RS24bpp) }, { 0x184, RSCreate(RS768x576, RS24bpp) }, { 0x1B5, RSCreate(RS800x600, RS24bpp) }, { 0x18C, RSCreate(RS960x720, RS24bpp) }, { 0x1B8, RSCreate(RS1024x768, RS24bpp) }, { 0x194, RSCreate(RS1152x864, RS24bpp) }, { 0x1BB, RSCreate(RS1280x1024, RS24bpp) }, { 0x19C, RSCreate(RS1408x1056, RS24bpp) }, { 0x1BF, RSCreate(RS1600x1200, RS24bpp) }, { 0x112, RSCreate(RS640x480, RS32bpp) }, { 0x183, RSCreate(RS768x576, RS32bpp) }, { 0x115, RSCreate(RS800x600, RS32bpp) }, { 0x18B, RSCreate(RS960x720, RS32bpp) }, { 0x118, RSCreate(RS1024x768, RS32bpp) }, { 0x193, RSCreate(RS1152x864, RS32bpp) }, { 0x11B, RSCreate(RS1280x1024, RS32bpp) }, { 0x19B, RSCreate(RS1408x1056, RS32bpp) }, { 0x11F, RSCreate(RS1600x1200, RS32bpp) }, { 0x010, RSCreate(RS640x350, RS4bpp ) }, { 0x012, RSCreate(RS640x480, RS4bpp ) }, { 0x102, RSCreate(RS800x600, RS4bpp ) }, { 0x104, RSCreate(RS1024x768, RS4bpp ) }, { 0x106, RSCreate(RS1280x1024, RS4bpp ) }, { 0, 0 }}; static void __init matroxfb_init_params(void) { /* fh from kHz to Hz */ if (fh < 1000) fh *= 1000; /* 1kHz minimum */ /* maxclk */ if (maxclk < 1000) maxclk *= 1000; /* kHz -> Hz, MHz -> kHz */ if (maxclk < 1000000) maxclk *= 1000; /* kHz -> Hz, 1MHz minimum */ /* fix VESA number */ if (vesa != ~0) vesa &= 0x1DFF; /* mask out clearscreen, acceleration and so on */ /* static settings */ for (RSptr = vesamap; RSptr->vesa; RSptr++) { if (RSptr->vesa == vesa) break; } if (!RSptr->vesa) { printk(KERN_ERR "Invalid vesa mode 0x%04X\n", vesa); RSptr = vesamap; } { int res = RSResolution(RSptr->info)-1; if (left == ~0) left = timmings[res].left; if (!xres) xres = timmings[res].xres; if (right == ~0) right = timmings[res].right; if (!hslen) hslen = timmings[res].hslen; if (upper == ~0) upper = timmings[res].upper; if (!yres) yres = timmings[res].yres; if (lower == ~0) lower = timmings[res].lower; if (!vslen) vslen = timmings[res].vslen; if (!(fv||fh||maxclk||pixclock)) fv = timmings[res].vfreq; if (depth == -1) depth = RSDepth(RSptr->info); } } static int __init matrox_init(void) { int err; matroxfb_init_params(); err = pci_register_driver(&matroxfb_driver); dev = -1; /* accept all new devices... */ return err; } /* **************************** exit-time only **************************** */ static void __exit matrox_done(void) { pci_unregister_driver(&matroxfb_driver); } #ifndef MODULE /* ************************* init in-kernel code ************************** */ static int __init matroxfb_setup(char *options) { char *this_opt; DBG(__FUNCTION__) if (!options || !*options) return 0; while ((this_opt = strsep(&options, ",")) != NULL) { if (!*this_opt) continue; dprintk("matroxfb_setup: option %s\n", this_opt); if (!strncmp(this_opt, "dev:", 4)) dev = simple_strtoul(this_opt+4, NULL, 0); else if (!strncmp(this_opt, "depth:", 6)) { switch (simple_strtoul(this_opt+6, NULL, 0)) { case 0: depth = RSText; break; case 4: depth = RS4bpp; break; case 8: depth = RS8bpp; break; case 15:depth = RS15bpp; break; case 16:depth = RS16bpp; break; case 24:depth = RS24bpp; break; case 32:depth = RS32bpp; break; default: printk(KERN_ERR "matroxfb: unsupported color depth\n"); } } else if (!strncmp(this_opt, "xres:", 5)) xres = simple_strtoul(this_opt+5, NULL, 0); else if (!strncmp(this_opt, "yres:", 5)) yres = simple_strtoul(this_opt+5, NULL, 0); else if (!strncmp(this_opt, "vslen:", 6)) vslen = simple_strtoul(this_opt+6, NULL, 0); else if (!strncmp(this_opt, "hslen:", 6)) hslen = simple_strtoul(this_opt+6, NULL, 0); else if (!strncmp(this_opt, "left:", 5)) left = simple_strtoul(this_opt+5, NULL, 0); else if (!strncmp(this_opt, "right:", 6)) right = simple_strtoul(this_opt+6, NULL, 0); else if (!strncmp(this_opt, "upper:", 6)) upper = simple_strtoul(this_opt+6, NULL, 0); else if (!strncmp(this_opt, "lower:", 6)) lower = simple_strtoul(this_opt+6, NULL, 0); else if (!strncmp(this_opt, "pixclock:", 9)) pixclock = simple_strtoul(this_opt+9, NULL, 0); else if (!strncmp(this_opt, "sync:", 5)) sync = simple_strtoul(this_opt+5, NULL, 0); else if (!strncmp(this_opt, "vesa:", 5)) vesa = simple_strtoul(this_opt+5, NULL, 0); else if (!strncmp(this_opt, "maxclk:", 7)) maxclk = simple_strtoul(this_opt+7, NULL, 0); else if (!strncmp(this_opt, "fh:", 3)) fh = simple_strtoul(this_opt+3, NULL, 0); else if (!strncmp(this_opt, "fv:", 3)) fv = simple_strtoul(this_opt+3, NULL, 0); else if (!strncmp(this_opt, "mem:", 4)) mem = simple_strtoul(this_opt+4, NULL, 0); else if (!strncmp(this_opt, "mode:", 5)) strlcpy(videomode, this_opt+5, sizeof(videomode)); else if (!strncmp(this_opt, "outputs:", 8)) strlcpy(outputs, this_opt+8, sizeof(outputs)); else if (!strncmp(this_opt, "dfp:", 4)) { dfp_type = simple_strtoul(this_opt+4, NULL, 0); dfp = 1; } #ifdef CONFIG_PPC_PMAC else if (!strncmp(this_opt, "vmode:", 6)) { unsigned int vmode = simple_strtoul(this_opt+6, NULL, 0); if (vmode > 0 && vmode <= VMODE_MAX) default_vmode = vmode; } else if (!strncmp(this_opt, "cmode:", 6)) { unsigned int cmode = simple_strtoul(this_opt+6, NULL, 0); switch (cmode) { case 0: case 8: default_cmode = CMODE_8; break; case 15: case 16: default_cmode = CMODE_16; break; case 24: case 32: default_cmode = CMODE_32; break; } } #endif else if (!strcmp(this_opt, "disabled")) /* nodisabled does not exist */ disabled = 1; else if (!strcmp(this_opt, "enabled")) /* noenabled does not exist */ disabled = 0; else if (!strcmp(this_opt, "sgram")) /* nosgram == sdram */ sgram = 1; else if (!strcmp(this_opt, "sdram")) sgram = 0; else if (!strncmp(this_opt, "memtype:", 8)) memtype = simple_strtoul(this_opt+8, NULL, 0); else { int value = 1; if (!strncmp(this_opt, "no", 2)) { value = 0; this_opt += 2; } if (! strcmp(this_opt, "inverse")) inverse = value; else if (!strcmp(this_opt, "accel")) noaccel = !value; else if (!strcmp(this_opt, "pan")) nopan = !value; else if (!strcmp(this_opt, "pciretry")) no_pci_retry = !value; else if (!strcmp(this_opt, "vga")) novga = !value; else if (!strcmp(this_opt, "bios")) nobios = !value; else if (!strcmp(this_opt, "init")) noinit = !value; #ifdef CONFIG_MTRR else if (!strcmp(this_opt, "mtrr")) mtrr = value; #endif else if (!strcmp(this_opt, "inv24")) inv24 = value; else if (!strcmp(this_opt, "cross4MB")) cross4MB = value; else if (!strcmp(this_opt, "grayscale")) grayscale = value; else if (!strcmp(this_opt, "dfp")) dfp = value; else { strlcpy(videomode, this_opt, sizeof(videomode)); } } } return 0; } static int __initdata initialized = 0; static int __init matroxfb_init(void) { char *option = NULL; int err = 0; DBG(__FUNCTION__) if (fb_get_options("matroxfb", &option)) return -ENODEV; matroxfb_setup(option); if (disabled) return -ENXIO; if (!initialized) { initialized = 1; err = matrox_init(); } hotplug = 1; /* never return failure, user can hotplug matrox later... */ return err; } module_init(matroxfb_init); #else /* *************************** init module code **************************** */ MODULE_AUTHOR("(c) 1998-2002 Petr Vandrovec "); MODULE_DESCRIPTION("Accelerated FBDev driver for Matrox Millennium/Mystique/G100/G200/G400/G450/G550"); MODULE_LICENSE("GPL"); module_param(mem, int, 0); MODULE_PARM_DESC(mem, "Size of available memory in MB, KB or B (2,4,8,12,16MB, default=autodetect)"); module_param(disabled, int, 0); MODULE_PARM_DESC(disabled, "Disabled (0 or 1=disabled) (default=0)"); module_param(noaccel, int, 0); MODULE_PARM_DESC(noaccel, "Do not use accelerating engine (0 or 1=disabled) (default=0)"); module_param(nopan, int, 0); MODULE_PARM_DESC(nopan, "Disable pan on startup (0 or 1=disabled) (default=0)"); module_param(no_pci_retry, int, 0); MODULE_PARM_DESC(no_pci_retry, "PCI retries enabled (0 or 1=disabled) (default=0)"); module_param(novga, int, 0); MODULE_PARM_DESC(novga, "VGA I/O (0x3C0-0x3DF) disabled (0 or 1=disabled) (default=0)"); module_param(nobios, int, 0); MODULE_PARM_DESC(nobios, "Disables ROM BIOS (0 or 1=disabled) (default=do not change BIOS state)"); module_param(noinit, int, 0); MODULE_PARM_DESC(noinit, "Disables W/SG/SD-RAM and bus interface initialization (0 or 1=do not initialize) (default=0)"); module_param(memtype, int, 0); MODULE_PARM_DESC(memtype, "Memory type for G200/G400 (see Documentation/fb/matroxfb.txt for explanation) (default=3 for G200, 0 for G400)"); #ifdef CONFIG_MTRR module_param(mtrr, int, 0); MODULE_PARM_DESC(mtrr, "This speeds up video memory accesses (0=disabled or 1) (default=1)"); #endif module_param(sgram, int, 0); MODULE_PARM_DESC(sgram, "Indicates that G100/G200/G400 has SGRAM memory (0=SDRAM, 1=SGRAM) (default=0)"); module_param(inv24, int, 0); MODULE_PARM_DESC(inv24, "Inverts clock polarity for 24bpp and loop frequency > 100MHz (default=do not invert polarity)"); module_param(inverse, int, 0); MODULE_PARM_DESC(inverse, "Inverse (0 or 1) (default=0)"); #ifdef CONFIG_FB_MATROX_MULTIHEAD module_param(dev, int, 0); MODULE_PARM_DESC(dev, "Multihead support, attach to device ID (0..N) (default=all working)"); #else module_param(dev, int, 0); MODULE_PARM_DESC(dev, "Multihead support, attach to device ID (0..N) (default=first working)"); #endif module_param(vesa, int, 0); MODULE_PARM_DESC(vesa, "Startup videomode (0x000-0x1FF) (default=0x101)"); module_param(xres, int, 0); MODULE_PARM_DESC(xres, "Horizontal resolution (px), overrides xres from vesa (default=vesa)"); module_param(yres, int, 0); MODULE_PARM_DESC(yres, "Vertical resolution (scans), overrides yres from vesa (default=vesa)"); module_param(upper, int, 0); MODULE_PARM_DESC(upper, "Upper blank space (scans), overrides upper from vesa (default=vesa)"); module_param(lower, int, 0); MODULE_PARM_DESC(lower, "Lower blank space (scans), overrides lower from vesa (default=vesa)"); module_param(vslen, int, 0); MODULE_PARM_DESC(vslen, "Vertical sync length (scans), overrides lower from vesa (default=vesa)"); module_param(left, int, 0); MODULE_PARM_DESC(left, "Left blank space (px), overrides left from vesa (default=vesa)"); module_param(right, int, 0); MODULE_PARM_DESC(right, "Right blank space (px), overrides right from vesa (default=vesa)"); module_param(hslen, int, 0); MODULE_PARM_DESC(hslen, "Horizontal sync length (px), overrides hslen from vesa (default=vesa)"); module_param(pixclock, int, 0); MODULE_PARM_DESC(pixclock, "Pixelclock (ns), overrides pixclock from vesa (default=vesa)"); module_param(sync, int, 0); MODULE_PARM_DESC(sync, "Sync polarity, overrides sync from vesa (default=vesa)"); module_param(depth, int, 0); MODULE_PARM_DESC(depth, "Color depth (0=text,8,15,16,24,32) (default=vesa)"); module_param(maxclk, int, 0); MODULE_PARM_DESC(maxclk, "Startup maximal clock, 0-999MHz, 1000-999999kHz, 1000000-INF Hz"); module_param(fh, int, 0); MODULE_PARM_DESC(fh, "Startup horizontal frequency, 0-999kHz, 1000-INF Hz"); module_param(fv, int, 0); MODULE_PARM_DESC(fv, "Startup vertical frequency, 0-INF Hz\n" "You should specify \"fv:max_monitor_vsync,fh:max_monitor_hsync,maxclk:max_monitor_dotclock\"\n"); module_param(grayscale, int, 0); MODULE_PARM_DESC(grayscale, "Sets display into grayscale. Works perfectly with paletized videomode (4, 8bpp), some limitations apply to 16, 24 and 32bpp videomodes (default=nograyscale)"); module_param(cross4MB, int, 0); MODULE_PARM_DESC(cross4MB, "Specifies that 4MB boundary can be in middle of line. (default=autodetected)"); module_param(dfp, int, 0); MODULE_PARM_DESC(dfp, "Specifies whether to use digital flat panel interface of G200/G400 (0 or 1) (default=0)"); module_param(dfp_type, int, 0); MODULE_PARM_DESC(dfp_type, "Specifies DFP interface type (0 to 255) (default=read from hardware)"); module_param_string(outputs, outputs, sizeof(outputs), 0); MODULE_PARM_DESC(outputs, "Specifies which CRTC is mapped to which output (string of up to three letters, consisting of 0 (disabled), 1 (CRTC1), 2 (CRTC2)) (default=111 for Gx50, 101 for G200/G400 with DFP, and 100 for all other devices)"); #ifdef CONFIG_PPC_PMAC module_param_named(vmode, default_vmode, int, 0); MODULE_PARM_DESC(vmode, "Specify the vmode mode number that should be used (640x480 default)"); module_param_named(cmode, default_cmode, int, 0); MODULE_PARM_DESC(cmode, "Specify the video depth that should be used (8bit default)"); #endif int __init init_module(void){ DBG(__FUNCTION__) if (disabled) return -ENXIO; if (depth == 0) depth = RSText; else if (depth == 4) depth = RS4bpp; else if (depth == 8) depth = RS8bpp; else if (depth == 15) depth = RS15bpp; else if (depth == 16) depth = RS16bpp; else if (depth == 24) depth = RS24bpp; else if (depth == 32) depth = RS32bpp; else if (depth != -1) { printk(KERN_ERR "matroxfb: depth %d is not supported, using default\n", depth); depth = -1; } matrox_init(); /* never return failure; user can hotplug matrox later... */ return 0; } #endif /* MODULE */ module_exit(matrox_done); EXPORT_SYMBOL(matroxfb_register_driver); EXPORT_SYMBOL(matroxfb_unregister_driver); EXPORT_SYMBOL(matroxfb_wait_for_sync); EXPORT_SYMBOL(matroxfb_enable_irq); /* * Overrides for Emacs so that we follow Linus's tabbing style. * --------------------------------------------------------------------------- * Local variables: * c-basic-offset: 8 * End: */ coccinelle-1.0.0-rc19/tests/test_s.cocci0000644000175000017500000000012712247437436017035 0ustar eugeneugen@@ statement S1,S2; expression E; @@ if ( - E + 12 ) { S1 S2 } coccinelle-1.0.0-rc19/tests/bad_zero.cocci0000644000175000017500000000072312247437436017323 0ustar eugeneugen// to be used without isomorphisms @@ expression *E; @@ E == - 0 + NULL @@ expression *E; @@ - 0 + NULL == E @@ expression *E; @@ E != - 0 + NULL @@ expression *E; @@ - 0 + NULL != E // assignments @@ expression *E; expression E1; @@ (E = E1) == - 0 + NULL @@ expression *E; expression E1; @@ - 0 + NULL == (E = E1) @@ expression *E; expression E1; @@ (E = E1) != - 0 + NULL @@ expression *E; expression E1; @@ - 0 + NULL != (E = E1) coccinelle-1.0.0-rc19/tests/a3d.res0000644000175000017500000000056512247437436015722 0ustar eugeneugenstruct a3d { struct gameport adc; struct input_dev dev; }; static void a3d_connect(struct gameport *gameport, struct gameport_dev *dev) { struct a3d *a3d; a3d->adc.id.bustype = BUS_GAMEPORT; a3d->dev.id.bustype = BUS_GAMEPORT; } static void a3d_connect(struct gameport *gameport, struct gameport_dev *dev) { struct a3d *a3d; a3d->adc.id.bustype = BUS_GAMEPORT; } coccinelle-1.0.0-rc19/tests/fun.c0000644000175000017500000000003312247437436015462 0ustar eugeneugenint f(int x) { return x; } coccinelle-1.0.0-rc19/tests/trailwhite.c0000644000175000017500000000024612247437436017054 0ustar eugeneugenint main() { if (rep.nEvents) { if (! (tc = (XTimeCoord *) Xmalloc( (unsigned) (nbytes = (long) rep.nEvents * sizeof(XTimeCoord))))) { return; } } } coccinelle-1.0.0-rc19/tests/string.res0000644000175000017500000000004412247437436016551 0ustar eugeneugenMODULE_PARM(suppress_pollack, "x"); coccinelle-1.0.0-rc19/tests/error.c0000644000175000017500000000030212247437436016022 0ustar eugeneugen// for seeing when errorexit nodes are created int main () { int bad = -1; if (x < 100) return -ENOMEM; if (x < 100) return bad; if (x < 100) goto out; return 0; out: return bad; } coccinelle-1.0.0-rc19/tests/decl_star.cocci0000644000175000017500000000003412247437436017471 0ustar eugeneugen@@ type T; @@ - T x; + T y;coccinelle-1.0.0-rc19/tests/neststruct.cocci0000644000175000017500000000014212247437436017747 0ustar eugeneugen@r@ type T1; T1 *x; expression E,E2; @@ - x = kmalloc(sizeof(E),E2) + x = kzalloc(sizeof(E), E2) coccinelle-1.0.0-rc19/tests/ifd.cocci0000644000175000017500000000010212247437436016267 0ustar eugeneugen@@ @@ + #ifdef 0 + #ifdef 10 foo(); ... bar(); + #endif + #endif coccinelle-1.0.0-rc19/tests/ifelse.cocci0000644000175000017500000000240712247437436017006 0ustar eugeneugen// ifelse.cocci, 3 Aug 09 @ if_else_1 disable neg_if @ expression E_1_ie; statement S_1_ie, S_2_ie; position p_1_ie; @@ if@p_1_ie (E_1_ie) S_1_ie else S_2_ie @ script:python @ expr_1_ie << if_else_1.E_1_ie; loc_1_ie << if_else_1.p_1_ie; @@ print "--- ifelse" print loc_1_ie[0].line, " ", loc_1_ie[0].column, " ", expr_1_ie @ if_else_if_else disable neg_if @ expression E_1, E_2; statement S_1, S_2, S_3; position p_1, p_2, p_3; @@ if@p_1 (E_1) S_1 else if@p_2 (E_2) S_2 else S_3@p_3 @ script:python @ expr_1 << if_else_if_else.E_1; expr_2 << if_else_if_else.E_2; loc_1 << if_else_if_else.p_1; loc_2 << if_else_if_else.p_2; loc_3 << if_else_if_else.p_3; @@ print "--- ifelseifelse" print loc_1[0].line, " ", loc_1[0].column, " ", expr_1 print loc_2[0].line, " ", loc_2[0].column, " ", expr_2 cocci.include_match(False) @ script:python @ expr_1 << if_else_if_else.E_1; expr_2 << if_else_if_else.E_2; loc_1 << if_else_if_else.p_1; loc_2 << if_else_if_else.p_2; @@ print "--- ifelseif" print loc_1[0].line, " ", loc_1[0].column, " ", expr_1 print loc_2[0].line, " ", loc_2[0].column, " ", expr_2 coccinelle-1.0.0-rc19/tests/three.cocci0000644000175000017500000000076112247437436016647 0ustar eugeneugen@ rule1 @ identifier init; identifier XXX_attach, XXX_detach; // pad: XXX_detach useful ? @@ int init (...) { ... register_pccard_driver(&XXX_attach) ... } @ rule2 extends rule1 @ @@ init (...) { ... - register_pccard_driver(&XXX_attach); - return 0; + return pcmcia_register_driver(&ZZZ_driver); } @ rule3 extends rule1 @ identifier exit; @@ exit (...) { ... - unregister_pccard_driver(&dev_info); + pcmcia_unregister_driver(&XXX_attach); ... } coccinelle-1.0.0-rc19/tests/xfield.cocci0000644000175000017500000000010312247437436017001 0ustar eugeneugen@@ declarer name FOO; expression a,b,c; @@ - FOO(a,b,c); + int x; coccinelle-1.0.0-rc19/tests/argument.cocci0000644000175000017500000000006412247437436017356 0ustar eugeneugen@@ @@ - f(1,2,3); + g(3, 2, 1); @@ @@ - h(...); coccinelle-1.0.0-rc19/tests/anon.c0000644000175000017500000000060512247437436015632 0ustar eugeneugentypedef struct { struct work_struct ppa_tq; /* Polling interrupt stuff */ } ppa_struct; static void ppa_interrupt(void *data) { ppa_struct *dev = (ppa_struct *) data; schedule_delayed_work(&dev->ppa_tq, 1); } static int ppa_queuecommand(struct scsi_cmnd *cmd, void (*done) (struct scsi_cmnd *)) { ppa_struct *dev = ppa_dev(cmd->device->host); schedule_work(&dev->ppa_tq); } coccinelle-1.0.0-rc19/tests/typedef.res0000644000175000017500000000054512247437436016711 0ustar eugeneugentypedef struct bluecard_info_t { struct pcmcia_device *p_dev; } foo; static void should_work(u_long arg) { foo *info = (struct bluecard_info_t *)arg; unsigned int iobase = info->p_dev->io.BasePort1; } static void does_work(u_long arg) { struct bluecard_info_t *info = (struct bluecard_info_t *)arg; unsigned int iobase = info->p_dev->io.BasePort1; } coccinelle-1.0.0-rc19/tests/addfield.res0000644000175000017500000000014012247437436016774 0ustar eugeneugenstruct i2c_client I = { .foo = 16, .dev = { .name = E, }, }; coccinelle-1.0.0-rc19/tests/post.c0000644000175000017500000000016612247437436015666 0ustar eugeneugenint main() { f(3, foo + bar, 5); f(4, 3, 5); f(4, 3, 5); h(3, some + thing, 5); h(4, 3, 5); h(4, 3, 5); } coccinelle-1.0.0-rc19/tests/dropbr.c0000644000175000017500000000005212247437436016163 0ustar eugeneugenint main () { if (a) { bar(); } } coccinelle-1.0.0-rc19/tests/expopt3_ver1.c0000644000175000017500000000025512247437436017237 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner v; //&v.field; f(&v.field1, &v.field2, &v.field3, &v.field4); } coccinelle-1.0.0-rc19/tests/cptr.res0000644000175000017500000000004712247437436016216 0ustar eugeneugenstatic const char * const str = "..."; coccinelle-1.0.0-rc19/tests/expopt3_ver2.res0000644000175000017500000000020412247437436017601 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner *v; f(v->field1, v->field2); } coccinelle-1.0.0-rc19/tests/arparam.c0000644000175000017500000000010612247437436016316 0ustar eugeneugenint main(int q[1024]) { return 12; } int fn(int q[]) { return 12; } coccinelle-1.0.0-rc19/tests/minenum1.cocci0000644000175000017500000000007512247437436017267 0ustar eugeneugen@@ @@ enum h { ..., - a, - z, + qq, ..., b, ... }; coccinelle-1.0.0-rc19/tests/multitypedef.c0000644000175000017500000000025012247437436017406 0ustar eugeneugentypedef struct HYSDN_CARD { struct work_struct irq_queue; } hysdn_card; int ergo_inithardware(hysdn_card * card) { INIT_WORK(&card->irq_queue, ergo_irq_bh, card); } coccinelle-1.0.0-rc19/tests/positions3.c0000644000175000017500000000024312247437436017007 0ustar eugeneugenint main() { f(togo,xxx,togo); h(); g(togo,xxx,togo); i(); g(togo,xxx,togo); j(); f(togo,xxx,togo); h(togo,xxx,togo); j(); h(togo,xxx,togo); } coccinelle-1.0.0-rc19/tests/regexp.cocci0000644000175000017500000000111512247437436017024 0ustar eugeneugen@anyid@ type t; identifier id; fresh identifier new = id ## "_is_an_id"; @@ t id; +t new; @contains@ type t; identifier anyid.id =~ "foo"; fresh identifier contains = id ##"_contains_foo"; @@ t id; +t contains; @nocontain@ type t; identifier anyid.id !~ "foo"; fresh identifier nocontain = id ##"_doesn_t_contain_foo"; @@ t id; +t nocontain; @endsby@ type t; identifier anyid.id =~ "foo$"; fresh identifier endsby = id ##"_ends_by_foo"; @@ t id; +t endsby; @beginsby@ type t; identifier anyid.id =~ "^foo"; fresh identifier beginsby = id ##"_begins_by_foo"; @@ t id; +t beginsby; coccinelle-1.0.0-rc19/tests/bad_define.c0000644000175000017500000000002012247437436016726 0ustar eugeneugen#define x a + b coccinelle-1.0.0-rc19/tests/find_long.cocci0000644000175000017500000000010312247437436017465 0ustar eugeneugen@ C @ long E1; int E2; @@ ( - E1; + (long)E1; | - E2; + (int)E2; ) coccinelle-1.0.0-rc19/tests/disjexpr_ver2.res0000644000175000017500000000005612247437436020034 0ustar eugeneugenint main (int i) { f(v->fld, v->fld2, *v); } coccinelle-1.0.0-rc19/tests/incl.c0000644000175000017500000000016712247437436015627 0ustar eugeneugen#include #include #include #ifdef FOO #include #endif FOO coccinelle-1.0.0-rc19/tests/deref.cocci0000644000175000017500000000003412247437436016616 0ustar eugeneugen@@ int * x; @@ - x+12 + 12 coccinelle-1.0.0-rc19/tests/scope_problem.cocci0000644000175000017500000000013112247437436020360 0ustar eugeneugen@@ identifier a; expression E; @@ - int a; ... - foo(a); <... - a = E; ...>coccinelle-1.0.0-rc19/tests/cast_iso.c0000644000175000017500000000033612247437436016504 0ustar eugeneugenstatic int vx_hwdep_dsp_load(snd_hwdep_t *hw, snd_hwdep_dsp_image_t *dsp) { vx_core_t *vx = snd_magic_cast(vx_core_t, hw->private_data, return -ENXIO); ak4117_t *chip = snd_magic_cast(ak4117_t, (void *)data, return); } coccinelle-1.0.0-rc19/tests/three_types.c0000644000175000017500000000031012247437436017223 0ustar eugeneugentypedef struct _drm_via_blitq { struct work_struct wq; } drm_via_blitq_t; void via_init_dmablit(drm_device_t *dev) { drm_via_blitq_t *blitq; INIT_WORK(&blitq->wq, via_dmablit_workqueue,blitq); } coccinelle-1.0.0-rc19/tests/expopt3.res0000644000175000017500000000024212247437436016645 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner *v; pcm20_getflags(pcm20, &v->flags, &v->xxx, &v->signal); } coccinelle-1.0.0-rc19/tests/type_annotated_fields.cocci0000644000175000017500000000024112247437436022075 0ustar eugeneugen@@ struct sk_buff *skb; @@ // and not // @@ // expression skb; // @@ ( - &(skb->pkt_type) + &bt_cb(skb)->pkt_type | - skb->pkt_type + bt_cb(skb)->pkt_type ) coccinelle-1.0.0-rc19/tests/empty.c0000644000175000017500000000027212247437436016035 0ustar eugeneugenstatic int vlsi_hard_start_xmit(struct sk_buff *skb, struct net_device *ndev) { pci_restore_state(pdev, idev->cfg_space); if (ring_first(idev->tx_ring) == NULL) { } else ; } coccinelle-1.0.0-rc19/tests/arg.cocci0000644000175000017500000000012712247437436016305 0ustar eugeneugen//@@ //@@ // // foo(... //- ,bar() // ) @@ @@ foo(..., - bar(), ...) coccinelle-1.0.0-rc19/tests/fnty.res0000644000175000017500000000021512247437436016223 0ustar eugeneugenstruct newname { int (*x) (int); int (*y) (int); }; struct somefns { int (*x) (int); int y; }; struct nofns { int x; int y; }; coccinelle-1.0.0-rc19/tests/ifd.c0000644000175000017500000000010712247437436015436 0ustar eugeneugenint main () { one(); foo(); one(); one(); bar(); one(); } coccinelle-1.0.0-rc19/tests/decl_space.c0000644000175000017500000000005312247437436016756 0ustar eugeneugenint main () { int *x = y; int x = y; } coccinelle-1.0.0-rc19/tests/na.res0000644000175000017500000000014712247437436015645 0ustar eugeneugen#define FOO 10 void foo() { int i; if (12) return; 12; !i & !FOO; 12; 12; !i & !100; } coccinelle-1.0.0-rc19/tests/skip.res0000644000175000017500000000002712247437436016212 0ustar eugeneugenint main () { h(); } coccinelle-1.0.0-rc19/tests/longlongint.cocci0000644000175000017500000000010512247437436020062 0ustar eugeneugen@@ type T; identifier x,y; @@ - unsigned T x; - T y; ... when any coccinelle-1.0.0-rc19/tests/ioctl.cocci0000644000175000017500000000236012247437436016647 0ustar eugeneugen@fn@ identifier xyz_ioctl; identifier xyz_ops; @@ struct file_operations xyz_ops = { .ioctl = xyz_ioctl, }; @safe@ identifier fn.xyz_ioctl; identifier i; @@ static int xyz_ioctl(struct inode *i, ...) { ... when != i } @count disable braces1, braces2, braces3, braces4@ identifier fn.xyz_ioctl; statement S; @@ int xyz_ioctl(...) { <+... ( { ... when strict return ...; } | if (...) return ...; else S ) ...+> } @one depends on safe && !count@ identifier fn.xyz_ioctl; identifier i, f, cmd, arg; identifier ret; constant cret; statement S,S1; @@ -xyz_ioctl(struct inode *i, struct file *f, unsigned cmd, unsigned long arg) +xyz_ioctl(struct file *f, unsigned cmd, unsigned long arg) { ... when != S1 + lock_kernel(); S ... ( + unlock_kernel(); return ret; | + unlock_kernel(); return cret; ) } @call depends on one@ identifier fn.xyz_ioctl; expression E1, E2, E3, E4; @@ - xyz_ioctl(E1, E2, E3, E4) + xyz_ioctl(E2, E3, E4) // be sure the changes can be made before transforming // prototype has to be more complicated, because unsigned int can be // just unsigned @decl depends on one@ identifier xyz_ioctl; identifier xyz_ops; @@ struct file_operations xyz_ops = { - .ioctl = xyz_ioctl, + .unlocked_ioctl = xyz_ioctl, }; coccinelle-1.0.0-rc19/tests/protoassert.res0000644000175000017500000000026312247437436017633 0ustar eugeneugenstatic unsigned mii_rd(ioaddr_t ioaddr, u_char phyaddr, u_char phyreg); static struct pcmcia_driver ZZZ_driver = { .owner = THIS_MODULE, }; int init(void) { } coccinelle-1.0.0-rc19/tests/csw.cocci0000644000175000017500000000010412247437436016323 0ustar eugeneugen@@ @@ switch (x) { - case FOO: ... break; - case XYZ: ... break; } coccinelle-1.0.0-rc19/tests/bad_iso_example.c0000644000175000017500000000004712247437436020012 0ustar eugeneugenint main() { if ((x = 3)) return; } coccinelle-1.0.0-rc19/tests/type1.c0000644000175000017500000000004412247437436015736 0ustar eugeneugenint foo() { int x; return 0; } coccinelle-1.0.0-rc19/tests/remove_call.c0000644000175000017500000000014412247437436017165 0ustar eugeneugenint main () { int x = 3 + FN() + FN(); x = 3 + FN() + FN(); FN(); return 3 + FN() + FN(); } coccinelle-1.0.0-rc19/tests/line_before_last.cocci0000644000175000017500000000002012247437436021020 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/befS.res0000644000175000017500000000036512247437436016130 0ustar eugeneugenint main () { foo(); xxx(); foo(); if(y) { foo(); { foo(); rrr(); } } } int main () { foo(); xxx(); foo(); if(y) { foo(); rrr(); } } int d() {} int main2 () { foo(); yyy(); foo(); xxx(); } coccinelle-1.0.0-rc19/tests/foura.res0000644000175000017500000000004012247437436016353 0ustar eugeneugenint main () { f(1); h(2); } coccinelle-1.0.0-rc19/tests/fnptr.cocci0000644000175000017500000000003612247437436016664 0ustar eugeneugen@@ @@ - SA_INTERRUPT + foo() coccinelle-1.0.0-rc19/tests/const_adding.c0000644000175000017500000000012512247437436017330 0ustar eugeneugenvoid main(int i) { const struct file_operations a; struct file_operations b; } coccinelle-1.0.0-rc19/tests/nestone.res0000644000175000017500000000005112247437436016714 0ustar eugeneugenint foo() { if (x) { xxx(); return;} } coccinelle-1.0.0-rc19/tests/julia10.cocci0000644000175000017500000000005212247437436016776 0ustar eugeneugen@@ statement S; @@ f(); - S g(); - S coccinelle-1.0.0-rc19/tests/x.cocci0000644000175000017500000000006112247437436016000 0ustar eugeneugen@@ @@ + 25 + x + + 4 ... + 125 + x + + 48 coccinelle-1.0.0-rc19/tests/sizeptr.c0000644000175000017500000000017412247437436016400 0ustar eugeneugenint main () { int *x; int *y; size_t a; ssize_t b; ptrdiff_t c; foo(sizeof *x,a); foo(*x,b); foo(x-y,c); } coccinelle-1.0.0-rc19/tests/a.c0000644000175000017500000000011012247437436015106 0ustar eugeneugenint main () { int a; f(a); h(a); { int a; g(a); r(a); } } coccinelle-1.0.0-rc19/tests/x.c0000644000175000017500000000005712247437436015147 0ustar eugeneugenint main () { foo(x); foo(x); foo(x); } coccinelle-1.0.0-rc19/tests/test4.cocci0000644000175000017500000000010112247437436016567 0ustar eugeneugen@@ expression X,Y; @@ f(...,X,Y,...); ... - h(X); ... g(X); coccinelle-1.0.0-rc19/tests/xloop.c0000644000175000017500000000010012247437436016026 0ustar eugeneugenint main (int x) { f(); for (x=0; x!=10; x++) h(); g(); } coccinelle-1.0.0-rc19/tests/typeof.cocci0000644000175000017500000000006212247437436017040 0ustar eugeneugen@@ type T; T E; @@ - f(E); ... - f(sizeof(T)); coccinelle-1.0.0-rc19/tests/rcu3.cocci0000644000175000017500000000014212247437436016405 0ustar eugeneugen@@ type T; identifier I; expression E2; @@ - list_entry(I,T,E2) + list_entry(_X(I), T, E2) coccinelle-1.0.0-rc19/tests/b1.c0000644000175000017500000000016212247437436015177 0ustar eugeneugenint main () { while (1) { if (x > 1 ) { foo(); break; } } while (1) if (x > 1 ) { foo(); break; } } coccinelle-1.0.0-rc19/tests/macro_int16.res0000644000175000017500000000014112247437436017363 0ustar eugeneugen#define INT16 int //typedef int INT16; void main(void) { INT16 a, b, c; c = a - b; } coccinelle-1.0.0-rc19/tests/max.c0000644000175000017500000000005012247437436015456 0ustar eugeneugenint main () { if (x < 25) return i; } coccinelle-1.0.0-rc19/tests/symbol.cocci0000644000175000017500000000012712247437436017041 0ustar eugeneugen@f@ constant symbol; symbol f; @@ - f = symbol; @symbol@ // symbol g; @@ int g = 0; coccinelle-1.0.0-rc19/tests/list_test.cocci0000644000175000017500000000140512247437436017546 0ustar eugeneugen@@ @@ f( - a ) @@ @@ g( - a, b ) @@ @@ h( ..., - a, ..., b, ... ) @@ @@ int f( - int a ) { ... } @@ @@ int g( - int a, int b ) { ... } @@ @@ int h( ..., - int a, ..., int b, ... ) { ... } @@ @@ int f[] = { - a }; @@ @@ int g[] = { - a, b }; @@ @@ int h[] = { ..., - a, ..., b, ..., }; @@ @@ int i[] = { ..., a, ..., - b }; @@ @@ struct f { - int a; + int b; }; @@ @@ struct g { - int a; int b; }; @@ @@ struct h { ... - int a; ... int b; ... }; @@ @@ enum f { - a + b }; @@ @@ enum g { - a, b }; @@ @@ enum h { ..., - a, ..., b, ... }; @@ @@ enum i { ..., a, ..., - b }; @@ @@ -#define f(a) 3 @@ @@ - #define g(a,b) 3 @@ @@ - #define h(...,a,...,b,...) 3 coccinelle-1.0.0-rc19/tests/rem2.c0000644000175000017500000000006212247437436015541 0ustar eugeneugenint main () { xxx(); if (x) foo(); yyy(); } coccinelle-1.0.0-rc19/tests/video1bis.cocci0000644000175000017500000000015612247437436017423 0ustar eugeneugen@@ identifier arg; identifier v; statement S1; @@ - if (copy_from_user(v,arg,sizeof(v)) != 0) S1 else {} coccinelle-1.0.0-rc19/tests/nl.res0000644000175000017500000000005512247437436015656 0ustar eugeneugenint main() { if (y) return; y = y + 1; } coccinelle-1.0.0-rc19/tests/delete_function.c0000644000175000017500000000013312247437436020042 0ustar eugeneugenint first () { return 0; } int foo() { a(); a(); a(); } int last () { return 0; } coccinelle-1.0.0-rc19/tests/ifdefmeta1.c0000644000175000017500000000032112247437436016677 0ustar eugeneugenint main() { buf = alloca(3 #ifdef PLATFORM_A // platform a stuff +5 #endif #ifdef PLATFORM_B /* platform b stuff */ +2 #endif ); } coccinelle-1.0.0-rc19/tests/if2.c0000644000175000017500000000010512247437436015352 0ustar eugeneugenint main(int x) { for(x=1;x>1;x++) { xxx(2); xxx(1); } } coccinelle-1.0.0-rc19/tests/test10.cocci0000644000175000017500000000007512247437436016656 0ustar eugeneugen@@ expression X; @@ f(X) ... g(X) ... - h(X) + h(X, X) coccinelle-1.0.0-rc19/tests/rcu3.res0000644000175000017500000000034512247437436016123 0ustar eugeneugenstatic struct mtd_chip_driver *get_mtd_chip_driver (const char *name) { struct list_head *pos; struct mtd_chip_driver *this; this = list_entry(_X(pos), typeof(*this), list); this = list_entry(_X(pos), struct foo, list); } coccinelle-1.0.0-rc19/tests/inc.cocci0000644000175000017500000000013512247437436016304 0ustar eugeneugen@@ expression X; @@ - #define foo X + #define foobar X @@ expression T; @@ - #define xxx T coccinelle-1.0.0-rc19/tests/end_commas.c0000644000175000017500000000015412247437436017003 0ustar eugeneugenstatic struct i2c_client client_template = { .name = "adv7175_client", .driver = &i2c_driver_adv7175 }; coccinelle-1.0.0-rc19/tests/noty.c0000644000175000017500000000006212247437436015665 0ustar eugeneugenint main(int *x) { if (NULL == x) { return; } } coccinelle-1.0.0-rc19/tests/tdnl.res0000644000175000017500000000013612247437436016206 0ustar eugeneugenvoid main() { unknown_tyepdef_1 td1; td1.attr = (unknown_typedef_2) td2.attr; } coccinelle-1.0.0-rc19/tests/inclifdef.cocci0000644000175000017500000000007112247437436017455 0ustar eugeneugen@@ @@ #include + #include coccinelle-1.0.0-rc19/tests/multi_inc2.h0000644000175000017500000000001112247437436016740 0ustar eugeneugenint xxx; coccinelle-1.0.0-rc19/tests/typedef_double.cocci0000644000175000017500000000027412247437436020531 0ustar eugeneugen@ rule1 @ type T; identifier lock; @@ T { ... struct semaphore lock; ... }; @ rule1a @ type rule1.T; T data; identifier rule1.lock; @@ - sema_init + mutex_init (&data.lock) coccinelle-1.0.0-rc19/tests/julia10.c0000644000175000017500000000006112247437436016140 0ustar eugeneugenint main(int x) { f(); h(); g(); h(); } coccinelle-1.0.0-rc19/tests/switchdecl.cocci0000644000175000017500000000023412247437436017664 0ustar eugeneugen@ switch_1 @ statement S_1,S_2; position p1,p2; identifier x,y; @@ switch (...) { int x; int x; case 2:@p1 - x = y; case 4:@p2 S_2 } coccinelle-1.0.0-rc19/tests/remstruct.c0000644000175000017500000000043412247437436016727 0ustar eugeneugenstatic struct irqchip mpuio_irq_chip = { .ack = mpuio_ack_irq, .mask = mpuio_mask_irq, .unmask = mpuio_unmask_irq }; static struct irqchip xxx = { .a = 12, .b = 15, }; int hello ( String input ) { String input = input.lowercase(); printf(input); } coccinelle-1.0.0-rc19/tests/regexp2.c0000644000175000017500000000015012247437436016246 0ustar eugeneugen int main(void) { int t0 = FOO; int t1 = BAR; int t2 = FOOBAR; int t3 = BARFOOBAR; int t4 = BARFOO; } coccinelle-1.0.0-rc19/tests/expnest.res0000644000175000017500000000011512247437436016730 0ustar eugeneugenint main() { x = 3 + 4; x = f() + 15; x = 15 + g(); x = f() - g(); } coccinelle-1.0.0-rc19/tests/bitfield.c0000644000175000017500000000033512247437436016461 0ustar eugeneugenstruct dvb_frontend { struct dvb_frontend_ops* ops; }; typedef struct { u8 RESET :1; u8 IDLE :1; u8 STOP :1; u8 HIRQ0 :1; u8 HIRQ1 :1; u8 na0 :1; u8 HABAV :1; u8 na1 :1; } bcm3510_register_value; coccinelle-1.0.0-rc19/tests/topdec.res0000644000175000017500000000024512247437436016524 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ static LIST_HEAD(tun_dev_list); static const struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/undef1.cocci0000644000175000017500000000004012247437436016710 0ustar eugeneugen@@ identifier x; @@ - #undef x coccinelle-1.0.0-rc19/tests/test2.cocci0000644000175000017500000000007612247437436016600 0ustar eugeneugen@@ expression X,Y; @@ f(...,X,Y,...); ... - g(X); + h(X); coccinelle-1.0.0-rc19/tests/type_iso.cocci0000644000175000017500000000005512247437436017367 0ustar eugeneugen@@ struct SHT fops; @@ - fops.proc_info = 1;coccinelle-1.0.0-rc19/tests/ifadd.c0000644000175000017500000000011612247437436015743 0ustar eugeneugenint main() { while (y) { if (x) { one(); two(); } } } coccinelle-1.0.0-rc19/tests/addtoo.res0000644000175000017500000000010612247437436016514 0ustar eugeneugenint main () { bar(); foo(); bar(); foo(); bar(); foo(); } coccinelle-1.0.0-rc19/tests/loop.res0000644000175000017500000000004712247437436016217 0ustar eugeneugenint main() { while (1) { x : 15; } } coccinelle-1.0.0-rc19/tests/ben.c0000644000175000017500000000074612247437436015451 0ustar eugeneugenGType lasso_provider_get_type() { static GType this_type = 0; if (!this_type) { static const GTypeInfo this_info = { sizeof (LassoProviderClass), NULL, NULL, (GClassInitFunc) class_init, NULL, NULL, sizeof(LassoProvider), 0, (GInstanceInitFunc) instance_init, NULL }; this_type = g_type_register_static(LASSO_TYPE_NODE, "LassoProvider", &this_info, 0); } return this_type; } coccinelle-1.0.0-rc19/tests/const.c0000644000175000017500000000007312247437436016024 0ustar eugeneugenvoid foo(const char *text) { strcat(buf->data, text); } coccinelle-1.0.0-rc19/tests/test8.c0000644000175000017500000000011712247437436015744 0ustar eugeneugenvoid main(int foo) { float k; int i; float j; { j++; } } coccinelle-1.0.0-rc19/tests/topdec.c0000644000175000017500000000023712247437436016156 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ static LIST_HEAD(tun_dev_list); static struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/csw.c0000644000175000017500000000036412247437436015475 0ustar eugeneugenint main() { switch (x) { case XYZ: link->state &= ~DEV_PRESENT; if (link->state & DEV_CONFIG) { bluecard_close(info); bluecard_release(link); } break; case MID: mid(); break; case FOO: bar(); break; } } coccinelle-1.0.0-rc19/tests/bugloop.res0000644000175000017500000000025612247437436016717 0ustar eugeneugenstatic int stir_transmit_thread(void *arg) { while (x) { /* if suspending, then power off and wait */ if (unlikely(freezing(current))) { refrigerator(); } } } coccinelle-1.0.0-rc19/tests/ifdefmeta.res0000644000175000017500000000105012247437436017165 0ustar eugeneugenint main() { buf = malloc(3 #ifdef PLATFORM_A + 5 + 50 #endif #ifdef PLATFORM_B + 2 #endif ); buf = malloc(3 #ifdef PLATFORM_A + 5 + 50 #endif #ifdef PLATFORM_B + 2 #endif ); } int other() { buf = alloca(3 #ifdef PLATFORM_A // platform a stuff +5 #endif #ifdef PLATFORM_B /* platform b stuff */ +2 #endif ); buf = alloca(3 +5 +2 ); } int third() { buf = malloc(3 + 5 + 2); buf = malloc(3 + 5 + 2); } coccinelle-1.0.0-rc19/tests/const_implicit_iso.res0000644000175000017500000000005312247437436021135 0ustar eugeneugenvoid main(double y) { const float x; } coccinelle-1.0.0-rc19/tests/extra.c0000644000175000017500000000025612247437436016024 0ustar eugeneugen#ifdef FIRST int main (int a, struct foo *b, struct bar *c) { a = b->x; return c->d; } #else int main (int a, struct foo *xyz) { a = xyz->x; return xyz->d; } #endif coccinelle-1.0.0-rc19/tests/varargs.res0000644000175000017500000000015212247437436016710 0ustar eugeneugen static void fas216_log_command(FAS216_Info *info, int level, struct scsi_cmnd *SCpnt, char *fmt, ...) {} coccinelle-1.0.0-rc19/tests/minfn.res0000644000175000017500000000013412247437436016352 0ustar eugeneugenint main () { return first; } int main () { return third; } int main () { return fifth; } coccinelle-1.0.0-rc19/tests/match_no_meta.res0000644000175000017500000000005512247437436020043 0ustar eugeneugenvoid main(int i) { foo(1); bar(2); } coccinelle-1.0.0-rc19/tests/cptr.cocci0000644000175000017500000000014412247437436016503 0ustar eugeneugen@@ identifier str; expression E; @@ -static const char *str +static const char * const str = E; coccinelle-1.0.0-rc19/tests/ifzer.cocci0000644000175000017500000000002012247437436016643 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/nest3.cocci0000644000175000017500000000017012247437436016566 0ustar eugeneugen@@ identifier i; identifier func; @@ - int i; <... when != i - for (i = ...; i < ...; i++) f(...); + f(1); ...> coccinelle-1.0.0-rc19/tests/check_order2.c0000644000175000017500000000032512247437436017230 0ustar eugeneugenint main () { g(five); g(four); g(three); g(two); g(one); f(one, 1); f(two, 2); f(three, 3); f(four, 4); f(five, 5); f(one, 10); f(two, 20); f(three, 30); f(four, 40); f(five, 50); } coccinelle-1.0.0-rc19/tests/test_s.c0000644000175000017500000000067512247437436016207 0ustar eugeneugenint main () { if (x-one) { one(); } if (x-two) { one(); two(); } if (x-three) { one(); two(); three(); } if (two) { while (x) { one(); } while (x) { one(); two(); } } if (one) { while (x) { one(); } } if (three) { while (x) { one(); } while (x) { one(); two(); } while (x) { one(); two(); } } } coccinelle-1.0.0-rc19/tests/inc.res0000644000175000017500000000002112247437436016007 0ustar eugeneugen#define foobar 3 coccinelle-1.0.0-rc19/tests/badfree.c0000644000175000017500000000006712247437436016271 0ustar eugeneugenint main() { free(x); if (a) { foo(a,x,b); } } coccinelle-1.0.0-rc19/tests/ifend.cocci0000644000175000017500000000004312247437436016616 0ustar eugeneugen@@ @@ - #include coccinelle-1.0.0-rc19/tests/pmac.res0000644000175000017500000000034112247437436016163 0ustar eugeneugen#ifdef CONFIG_PPC_HAS_FEATURE_CALLS #include #else #include #endif static int snd_pmac_register_sleep_notifier(pmac_t *chip); static int snd_pmac_unregister_sleep_notifier(pmac_t *chip); coccinelle-1.0.0-rc19/tests/struct.res0000644000175000017500000000016612247437436016574 0ustar eugeneugenstruct foo { int x; struct bar first; int y; struct xxx second; int z; }; int main() { struct foo *a; } coccinelle-1.0.0-rc19/tests/addtoo.c0000644000175000017500000000023012247437436016143 0ustar eugeneugenint main () { if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); foo(); } coccinelle-1.0.0-rc19/tests/doublepos.c0000644000175000017500000000005612247437436016673 0ustar eugeneugenint main() { f(1,2); f(1,5); f(6,5); } coccinelle-1.0.0-rc19/tests/double.c0000644000175000017500000000027512247437436016154 0ustar eugeneugenstatic void BChannel_proc_xmt(struct BCState *bcs) { if (!test_bit(BC_FLG_BUSY, &bcs->Flag) && (!skb_queue_len(&bcs->squeue))) { st->l2.l2l1(st, PH_DEACTIVATE | CONFIRM, NULL); } } coccinelle-1.0.0-rc19/tests/fieldcount.cocci0000644000175000017500000000024512247437436017671 0ustar eugeneugen@r@ field list[n] fs; identifier I,x; @@ struct I { fs int x; ...}; @script:ocaml@ n << r.n; x << r.x; i << r.I; @@ Printf.printf "%s at offset %d in %s\n" x n i coccinelle-1.0.0-rc19/tests/rets.cocci0000644000175000017500000000004312247437436016506 0ustar eugeneugen@@ statement S; @@ foo(); - S + S coccinelle-1.0.0-rc19/tests/size_t.cocci0000644000175000017500000000061212247437436017030 0ustar eugeneugen@ rule1 @ identifier f, x; @@ f(...,size_t x,...) { ... } @@ expression E; type T; size_t E1; identifier rule1.f; @@ ( f(...,sizeof(E),...) | f(...,sizeof(T),...) | f(...,E1,...) | * f(...) ) @ rule2 @ identifier f, x; type T; @@ T f(...,size_t x,...); @@ expression E; type T; size_t E1; identifier rule2.f; @@ ( f(...,sizeof(E),...) | f(...,sizeof(T),...) | f(...,E1,...) | * f(...) ) coccinelle-1.0.0-rc19/tests/inclifdef.res0000644000175000017500000000013412247437436017166 0ustar eugeneugen#include #include #ifdef CONFIG #include #endif coccinelle-1.0.0-rc19/tests/tydisj.c0000644000175000017500000000006512247437436016205 0ustar eugeneugenint64_t foo() { int64_t a; int i; return i << 20; } coccinelle-1.0.0-rc19/tests/gcc_min_max.cocci0000644000175000017500000000062412247437436020002 0ustar eugeneugen// Deprecated min/max http://gcc.gnu.org/onlinedocs/gcc-4.0.1/gcc/Deprecated-Features.html // Only works if "algorithm" is allready included // This spatch is on hold until coccinelle is extended to support >?,?=,?= y; + x = max(x,y); @@ expression x,y; @@ - x >? y + max(x,y) coccinelle-1.0.0-rc19/tests/hd.cocci0000644000175000017500000000006212247437436016125 0ustar eugeneugen@@ @@ - f(int x, int y) { + f(int x){ ... } coccinelle-1.0.0-rc19/tests/bad_ptr_print.res0000644000175000017500000000013012247437436020066 0ustar eugeneugenstatic inline int tester(struct usb_endpoint_descriptor *epd) { g((struct foo *)x); } coccinelle-1.0.0-rc19/tests/iterator.cocci0000644000175000017500000000014412247437436017364 0ustar eugeneugen@@ iterator list_for_each; expression E1, E2; statement S; @@ - list_for_each(E1, E2) - S + foo();coccinelle-1.0.0-rc19/tests/wierdinit.cocci0000644000175000017500000000007712247437436017536 0ustar eugeneugen@@ typedef dev_link_t; @@ - dev_link_t + struct pcmcia_device coccinelle-1.0.0-rc19/tests/isococci.cocci0000644000175000017500000000006012247437436017323 0ustar eugeneugen@@ identifier x; @@ - if(x > 0) { return ...; }coccinelle-1.0.0-rc19/tests/multitypedef.res0000644000175000017500000000024212247437436017756 0ustar eugeneugentypedef struct HYSDN_CARD { struct work_struct irq_queue; } hysdn_card; int ergo_inithardware(hysdn_card * card) { INIT_WORK(&card->irq_queue, ergo_irq_bh); } coccinelle-1.0.0-rc19/tests/nest.res0000644000175000017500000000020712247437436016215 0ustar eugeneugenvoid info_func(int i) { foo(); while (x) { 1+hostptr->host_no+hostptr->host_no; 2+hostptr->host_no+hostptr->host_no; } } coccinelle-1.0.0-rc19/tests/ifdef5.res0000644000175000017500000000061212247437436016406 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } #ifdef CONFIG_NKERNEL #ifndef TIMER_32K_SYNCHRONIZED #define TIMER_32K_SYNCHRONIZED 0xffffffff #endif unsigned long nk_vtick_read_stamp(void) { return omap_readl(TIMER_32K_SYNCHRONIZED); } coccinelle-1.0.0-rc19/tests/incpos1.cocci0000644000175000017500000000144312247437436017112 0ustar eugeneugen@initialize:python@ first = 0 second = 0 @first_hdr@ position p; @@ #include <...>@p @script:python@ p << first_hdr.p; @@ if first == 0: print "keeping first hdr %s" % (p[0].line) first = int(p[0].line) else: print "dropping first hdr" cocci.include_match(False) @second_hdr@ position p; @@ #include "..."@p @script:python@ p << second_hdr.p; @@ if int(p[0].line) > first and first != 0: print "dropping second hdr" cocci.include_match(False) else: if second == 0: print "keeping second hdr %s because of %d" % (p[0].line,first) second = int(p[0].line) else: print "dropping second hdr" cocci.include_match(False) @done@ position second_hdr.p; @@ +#include #include "..."@p @depends on never done@ @@ +#include #include <...> coccinelle-1.0.0-rc19/tests/free_ver5.c0000644000175000017500000000010312247437436016552 0ustar eugeneugenint main () { #ifdef FOO free(foo); #else x = foo->x; #endif } coccinelle-1.0.0-rc19/tests/threea.cocci0000644000175000017500000000016412247437436017005 0ustar eugeneugen@ rule1 @ expression E; @@ f(E); //@ rule2 extends rule1 @ //@@ // //- h(E); @ rule3 extends rule1 @ @@ - q(E); coccinelle-1.0.0-rc19/tests/constrem.cocci0000644000175000017500000000006412247437436017366 0ustar eugeneugen@@ identifier d; @@ -int d; @@ @@ - int (*f)(int);coccinelle-1.0.0-rc19/tests/metastatement_if.res0000644000175000017500000000012012247437436020567 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } } coccinelle-1.0.0-rc19/tests/addif1.cocci0000644000175000017500000000014312247437436016662 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + int xxx() { + return 12; } + #endif int f(...) { ... } coccinelle-1.0.0-rc19/tests/nameless.res0000644000175000017500000000014012247437436017047 0ustar eugeneugentypedef union { int foo; } t_foo; typedef struct __COCCI__TMP__STRUCTNAME__ { int foo; } t_foo; coccinelle-1.0.0-rc19/tests/inhmet.res0000644000175000017500000000003112247437436016523 0ustar eugeneugenint main () { foo(); } coccinelle-1.0.0-rc19/tests/pb_distribute_type4.cocci0000644000175000017500000000010212247437436021511 0ustar eugeneugen@@ type T; @@ foo(...) { - T + float x; ... } coccinelle-1.0.0-rc19/tests/regexp.c0000644000175000017500000000011612247437436016166 0ustar eugeneugenint main(void) { int foo; int bar; int foobar; int barfoobar; int barfoo; } coccinelle-1.0.0-rc19/tests/param_end.cocci0000644000175000017500000000017712247437436017467 0ustar eugeneugen@@ identifier one; @@ one (... - ,int x ,...) { ... } @@ identifier one; @@ one (..., - int y, ...) { ... } coccinelle-1.0.0-rc19/tests/cards.c0000644000175000017500000000007612247437436015775 0ustar eugeneugenMODULE_PARM(io, "1-" __MODULE_STRING(MAX_CARDS) "i"); int x; coccinelle-1.0.0-rc19/tests/comadd.res0000644000175000017500000000010312247437436016466 0ustar eugeneugen// some comment // some other comment int main () { return 12; } coccinelle-1.0.0-rc19/tests/nestone.cocci0000644000175000017500000000017412247437436017211 0ustar eugeneugen@one disable all@ identifier foo; statement S; @@ foo(...) { <+... xxx(); ...+> } @two depends on one@ @@ - yyy(); coccinelle-1.0.0-rc19/tests/video.c0000644000175000017500000000203512247437436016004 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; if (cmd == VIDIOCGTUNER) { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, v, sizeof(v))) return -EFAULT; } else if (cmd == VIDIOCSTUNER) { struct video_tuner v; if (copy_from_user(&v, arg, sizeof(v))) return -EFAULT; if (v.tuner != 0) return -EINVAL; /* Only 1 tuner so no setting needed ! */ } else return -ENOIOCTLCMD; /* else if(cmd == VIDIOCSFREQ) { if (copy_from_user(typhoon->curfreq, arg, sizeof(typhoon->curfreq))) return -EFAULT; typhoon_setfreq(typhoon, typhoon->curfreq); return 0; }*/ return 0; } coccinelle-1.0.0-rc19/tests/comment_brace.c0000644000175000017500000000013512247437436017473 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ continue; return 0; } coccinelle-1.0.0-rc19/tests/endif.cocci0000644000175000017500000000005112247437436016615 0ustar eugeneugen@@ statement S; @@ x = 1; S + foo();coccinelle-1.0.0-rc19/tests/gotobreak.c0000644000175000017500000000045012247437436016652 0ustar eugeneugenstatic void sedlbauer_config(struct pcmcia_device *link) { while (1) { if ((cfg->mem.nwin > 0) || (dflt.mem.nwin > 0)) { goto next_entry; } /* If we got this far, we're cool! */ break; next_entry: CS_CHECK(GetNextTuple, pcmcia_get_next_tuple(link, &tuple)); } return; } coccinelle-1.0.0-rc19/tests/test5_ver1.c0000644000175000017500000000113012247437436016672 0ustar eugeneugen/* * If still have an edge from the startif to endif (AfterNode), * with a if-then-and-else, then rene will see this edge, * and that means that the ctl engine will see this direct path from * startif to endif as a valid execution path. So on this program, * CTL will reject the formula f(X) ... g(X) because * when we take the direct path (which should not exist I repeat), * we can't find a later g(1). */ void main() { f(1); if(1) { g(1); } else { g(1); } g(1); // if add this then the CTL even with the direct path will this time // accept, but we cheat. } coccinelle-1.0.0-rc19/tests/sizeof.c0000644000175000017500000000013612247437436016175 0ustar eugeneugenint main (int param) { int i = sizeof(3); int j = sizeof 3; int k = sizeof (int *); } coccinelle-1.0.0-rc19/tests/fns.cocci0000644000175000017500000000152512247437436016325 0ustar eugeneugen// we were using some minirules before where fn1 and fn2 were in same rule // pad: il manque un E dans check_region dans rule3 car il a 2 args // mais je sais pas si faut le propager dans request_region @ rule1 @ expression req8_reg_arg2; expression E; identifier fn1; @@ fn1(...) { ... for(...; ...; ...) { ... if (check_region(E, req8_reg_arg2)) { ... when = \( printk(...); \| dbg(...); \) continue; } ... } ... } @ rule2 depends on rule1 @ expression rule1.req8_reg_arg2; expression req8_reg_arg1; expression req8_reg_arg3; identifier fn2; @@ fn2(...) { - request_region(req8_reg_arg1, req8_reg_arg2, req8_reg_arg3); } @ rule3 depends on rule1 @ expression rule1.req8_reg_arg2; expression rule2.req8_reg_arg3; statement S; @@ - if (check_region(req8_reg_arg2)) S + if (!request_region(req8_reg_arg2, req8_reg_arg3)) S coccinelle-1.0.0-rc19/tests/const1bis.c0000644000175000017500000000006412247437436016603 0ustar eugeneugenvoid foo(int j) { const int i; int i; i++; } coccinelle-1.0.0-rc19/tests/insdef.res0000644000175000017500000000004412247437436016513 0ustar eugeneugen#define TABINFOGEN #include coccinelle-1.0.0-rc19/tests/dropbr.res0000644000175000017500000000004412247437436016533 0ustar eugeneugenint main () { if (a) foo(); } coccinelle-1.0.0-rc19/tests/const.cocci0000644000175000017500000000014712247437436016664 0ustar eugeneugen@@ @@ void foo(char *text) { - strcat(buf->data, text); + strcat_safe(buf->data, buf->len, text); } coccinelle-1.0.0-rc19/tests/ifelse.c0000644000175000017500000000055012247437436016145 0ustar eugeneugen int f(void) { if (x1) w++; else if (y1) z--; else if (z1) a--; if (x2) w++; else if (y2) z--; if (x3) { w++; } else if (y3) { z--; } if (x4) w++; else if (y4) z--; else if (z4) a--; else if (a4) a--; } function if_if(void) { if (x4) w++; if (y4) z--; dummy--; if (x5) w++; A++; if (y5) z--; } coccinelle-1.0.0-rc19/tests/test10_ver1.c0000644000175000017500000000011012247437436016743 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); //g(1); h(1); h(1); } coccinelle-1.0.0-rc19/tests/nest3.c0000644000175000017500000000013112247437436015725 0ustar eugeneugenvoid main(int i) { int i; char j;//int j; for (i = 1; i < XXX; i++) f(i); } coccinelle-1.0.0-rc19/tests/const.res0000644000175000017500000000011212247437436016365 0ustar eugeneugenvoid foo(const char *text) { strcat_safe(buf->data, buf->len, text); } coccinelle-1.0.0-rc19/tests/nameless.cocci0000644000175000017500000000010012247437436017332 0ustar eugeneugen@name_all_structs@ @@ struct + __COCCI__TMP__STRUCTNAME__ {...} coccinelle-1.0.0-rc19/tests/mem.cocci0000644000175000017500000000023212247437436016307 0ustar eugeneugen@rule1@ identifier f; @@ f(...) { <+... dev_kfree_skb_irq(...) ...+> } @@ identifier rule1.f, fld; identifier I; type T; @@ T I = { * .fld = f, }; coccinelle-1.0.0-rc19/tests/return_implicit.c0000644000175000017500000000003412247437436020104 0ustar eugeneugenvoid main(void) { foo(); } coccinelle-1.0.0-rc19/tests/toplevel_struct_modif.c0000644000175000017500000000333712247437436021320 0ustar eugeneugenstruct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; /* For a device that is "Not Ready" */ unsigned char usb_stor_sense_notready[18] = { [0] = 0x70, /* current error */ [2] = 0x02, /* not ready */ [7] = 0x0a, /* additional length */ [12] = 0x04, /* not ready */ [13] = 0x03 /* manual intervention */ }; coccinelle-1.0.0-rc19/tests/nestplus.cocci0000644000175000017500000000021312247437436017405 0ustar eugeneugen@one disable all@ identifier foo; statement S; @@ foo(...) { <+... { ... return; } ...+> } @two depends on one@ @@ - yyy(); coccinelle-1.0.0-rc19/tests/km.cocci0000644000175000017500000000024112247437436016140 0ustar eugeneugen@@ type T, T2; expression x; expression E1,E2; @@ - x = (T)kmalloc(E1,E2) + x = kzalloc(E1, E2) ... ( - memset((T2)x,0,E1); | - memset((T2)x,0,sizeof(*x)); ) coccinelle-1.0.0-rc19/tests/deref.res0000644000175000017500000000007612247437436016335 0ustar eugeneugenint main () { int **q; foo(12); xxx(12); yyy(q+12); } coccinelle-1.0.0-rc19/tests/used_after_ver1.c0000644000175000017500000000031312247437436017751 0ustar eugeneugenint my_proc_info(int i); void f1() { int x; } void f2() { int x; x.proc_info = &my_proc_info; } int my_proc_info(int i) { return i++; } int not_a_proc_info_function(int i) { return i++; } coccinelle-1.0.0-rc19/tests/substruct.res0000644000175000017500000000011312247437436017276 0ustar eugeneugenstruct a { int a; } x[2] = { { DECLARE_A(7), }, { DECLARE_A(17), }, }; coccinelle-1.0.0-rc19/tests/undef2.c0000644000175000017500000000003212247437436016054 0ustar eugeneugen#define foo 12 #undef foo coccinelle-1.0.0-rc19/tests/sizeof.res0000644000175000017500000000014312247437436016542 0ustar eugeneugenint main (int param) { int i = sizeof(int); int j = sizeof(int); int k = sizeof (int *); } coccinelle-1.0.0-rc19/tests/substruct.c0000644000175000017500000000007712247437436016740 0ustar eugeneugenstruct a { int a; } x[2] = { { .a = 7, }, { .a = 17, }, }; coccinelle-1.0.0-rc19/tests/proto_ver2.c0000644000175000017500000007113212247437436017003 0ustar eugeneugen/* * * IPACX specific routines * * Author Joerg Petersohn * Derived from hisax_isac.c, isac.c, hscx.c and others * * This software may be used and distributed according to the terms * of the GNU General Public License, incorporated herein by reference. * */ #include #include #include #include #include "hisax_if.h" #include "hisax.h" #include "isdnl1.h" #include "ipacx.h" #define DBUSY_TIMER_VALUE 80 #define TIMER3_VALUE 7000 #define MAX_DFRAME_LEN_L1 300 #define B_FIFO_SIZE 64 #define D_FIFO_SIZE 32 static spinlock_t ipacx_lock = SPIN_LOCK_UNLOCKED; // ipacx interrupt mask values #define _MASK_IMASK 0x2E // global mask #define _MASKB_IMASK 0x0B #define _MASKD_IMASK 0x03 // all on //---------------------------------------------------------- // local function declarations //---------------------------------------------------------- static void ph_command(struct IsdnCardState *cs, unsigned int command); static inline void cic_int(struct IsdnCardState *cs); static void dch_l2l1(struct PStack *st, int pr, void *arg); static void dbusy_timer_handler(struct IsdnCardState *cs); static void ipacx_new_ph(struct IsdnCardState *cs); static void dch_bh(void *data); static void dch_sched_event(struct IsdnCardState *cs, int event); static void dch_empty_fifo(struct IsdnCardState *cs, int count); static void dch_fill_fifo(struct IsdnCardState *cs); static inline void dch_int(struct IsdnCardState *cs); static void __devinit dch_setstack(struct PStack *st, struct IsdnCardState *cs); static void __devinit dch_init(struct IsdnCardState *cs); static void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_sched_event(struct BCState *bcs, int event); static void bch_empty_fifo(struct BCState *bcs, int count); static void bch_fill_fifo(struct BCState *bcs); static void bch_int(struct IsdnCardState *cs, u_char hscx); static void bch_mode(struct BCState *bcs, int mode, int bc); static void bch_close_state(struct BCState *bcs); static int bch_open_state(struct IsdnCardState *cs, struct BCState *bcs); static int bch_setstack(struct PStack *st, struct BCState *bcs); static void __devinit bch_init(struct IsdnCardState *cs, int hscx); static void __init clear_pending_ints(struct IsdnCardState *cs); //---------------------------------------------------------- // Issue Layer 1 command to chip //---------------------------------------------------------- static void ph_command(struct IsdnCardState *cs, unsigned int command) { if (cs->debug &L1_DEB_ISAC) debugl1(cs, "ph_command (%#x) in (%#x)", command, cs->dc.isac.ph_state); cs->writeisac(cs, IPACX_CIX0, (command << 4) | 0x0E); } //---------------------------------------------------------- // Transceiver interrupt handler //---------------------------------------------------------- static inline void cic_int(struct IsdnCardState *cs) { u_char event; event = cs->readisac(cs, IPACX_CIR0) >> 4; if (cs->debug &L1_DEB_ISAC) debugl1(cs, "cic_int(event=%#x)", event); cs->dc.isac.ph_state = event; dch_sched_event(cs, D_L1STATECHANGE); } //========================================================== // D channel functions //========================================================== //---------------------------------------------------------- // Command entry point //---------------------------------------------------------- static void dch_l2l1(struct PStack *st, int pr, void *arg) { struct IsdnCardState *cs = (struct IsdnCardState *) st->l1.hardware; struct sk_buff *skb = arg; u_char cda1_cr, cda2_cr; switch (pr) { case (PH_DATA |REQUEST): if (cs->debug &DEB_DLOG_HEX) LogFrame(cs, skb->data, skb->len); if (cs->debug &DEB_DLOG_VERBOSE) dlogframe(cs, skb, 0); if (cs->tx_skb) { skb_queue_tail(&cs->sq, skb); #ifdef L2FRAME_DEBUG if (cs->debug &L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA Queued", 0); #endif } else { cs->tx_skb = skb; cs->tx_cnt = 0; #ifdef L2FRAME_DEBUG if (cs->debug &L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA", 0); #endif dch_fill_fifo(cs); } break; case (PH_PULL |INDICATION): if (cs->tx_skb) { if (cs->debug & L1_DEB_WARN) debugl1(cs, " l2l1 tx_skb exist this shouldn't happen"); skb_queue_tail(&cs->sq, skb); break; } if (cs->debug & DEB_DLOG_HEX) LogFrame(cs, skb->data, skb->len); if (cs->debug & DEB_DLOG_VERBOSE) dlogframe(cs, skb, 0); cs->tx_skb = skb; cs->tx_cnt = 0; #ifdef L2FRAME_DEBUG if (cs->debug & L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA_PULLED", 0); #endif dch_fill_fifo(cs); break; case (PH_PULL | REQUEST): #ifdef L2FRAME_DEBUG if (cs->debug & L1_DEB_LAPD) debugl1(cs, "-> PH_REQUEST_PULL"); #endif if (!cs->tx_skb) { clear_bit(FLG_L1_PULL_REQ, &st->l1.Flags); st->l2.l1l2(st, PH_PULL | CONFIRM, NULL); } else set_bit(FLG_L1_PULL_REQ, &st->l1.Flags); break; case (HW_RESET | REQUEST): case (HW_ENABLE | REQUEST): ph_command(cs, IPACX_CMD_TIM); break; case (HW_INFO3 | REQUEST): ph_command(cs, IPACX_CMD_AR8); break; case (HW_TESTLOOP | REQUEST): cs->writeisac(cs, IPACX_CDA_TSDP10, 0x80); // Timeslot 0 is B1 cs->writeisac(cs, IPACX_CDA_TSDP11, 0x81); // Timeslot 0 is B1 cda1_cr = cs->readisac(cs, IPACX_CDA1_CR); cda2_cr = cs->readisac(cs, IPACX_CDA2_CR); if ((long)arg &1) { // loop B1 cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr |0x0a); } else { // B1 off cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr &~0x0a); } if ((long)arg &2) { // loop B2 cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr |0x14); } else { // B2 off cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr &~0x14); } break; case (HW_DEACTIVATE | RESPONSE): skb_queue_purge(&cs->rq); skb_queue_purge(&cs->sq); if (cs->tx_skb) { dev_kfree_skb_any(cs->tx_skb); cs->tx_skb = NULL; } if (test_and_clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) del_timer(&cs->dbusytimer); break; default: if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_l2l1 unknown %04x", pr); break; } } //---------------------------------------------------------- //---------------------------------------------------------- static void dbusy_timer_handler(struct IsdnCardState *cs) { struct PStack *st; int rbchd, stard; if (test_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) { rbchd = cs->readisac(cs, IPACX_RBCHD); stard = cs->readisac(cs, IPACX_STARD); if (cs->debug) debugl1(cs, "D-Channel Busy RBCHD %02x STARD %02x", rbchd, stard); if (!(stard &0x40)) { // D-Channel Busy set_bit(FLG_L1_DBUSY, &cs->HW_Flags); for (st = cs->stlist; st; st = st->next) { st->l2.l1l2(st, PH_PAUSE | INDICATION, NULL); // flow control on } } else { // seems we lost an interrupt; reset transceiver */ clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags); if (cs->tx_skb) { dev_kfree_skb_any(cs->tx_skb); cs->tx_cnt = 0; cs->tx_skb = NULL; } else { printk(KERN_WARNING "HiSax: ISAC D-Channel Busy no skb\n"); debugl1(cs, "D-Channel Busy no skb"); } cs->writeisac(cs, IPACX_CMDRD, 0x01); // Tx reset, generates XPR } } } //---------------------------------------------------------- // L1 state machine intermediate layer to isdnl1 module //---------------------------------------------------------- static void ipacx_new_ph(struct IsdnCardState *cs) { switch (cs->dc.isac.ph_state) { case (IPACX_IND_RES): ph_command(cs, IPACX_CMD_DI); l1_msg(cs, HW_RESET | INDICATION, NULL); break; case (IPACX_IND_DC): l1_msg(cs, HW_DEACTIVATE | CONFIRM, NULL); break; case (IPACX_IND_DR): l1_msg(cs, HW_DEACTIVATE | INDICATION, NULL); break; case (IPACX_IND_PU): l1_msg(cs, HW_POWERUP | CONFIRM, NULL); break; case (IPACX_IND_RSY): l1_msg(cs, HW_RSYNC | INDICATION, NULL); break; case (IPACX_IND_AR): l1_msg(cs, HW_INFO2 | INDICATION, NULL); break; case (IPACX_IND_AI8): l1_msg(cs, HW_INFO4_P8 | INDICATION, NULL); break; case (IPACX_IND_AI10): l1_msg(cs, HW_INFO4_P10 | INDICATION, NULL); break; default: break; } } //---------------------------------------------------------- // bottom half handler for D channel //---------------------------------------------------------- static void dch_bh(void *data) { struct IsdnCardState *cs = data; struct PStack *st; if (!cs) return; if (test_and_clear_bit(D_CLEARBUSY, &cs->event)) { if (cs->debug) debugl1(cs, "D-Channel Busy cleared"); for (st = cs->stlist; st; st = st->next) { st->l2.l1l2(st, PH_PAUSE | CONFIRM, NULL); } } if (test_and_clear_bit(D_RCVBUFREADY, &cs->event)) { DChannel_proc_rcv(cs); } if (test_and_clear_bit(D_XMTBUFREADY, &cs->event)) { DChannel_proc_xmt(cs); } if (test_and_clear_bit(D_L1STATECHANGE, &cs->event)) { ipacx_new_ph(cs); } } //---------------------------------------------------------- // proceed with bottom half handler dch_bh() //---------------------------------------------------------- static void dch_sched_event(struct IsdnCardState *cs, int event) { set_bit(event, &cs->event); schedule_work(&cs->work); } //---------------------------------------------------------- // Fill buffer from receive FIFO //---------------------------------------------------------- static void dch_empty_fifo(struct IsdnCardState *cs, int count) { unsigned long flags; u_char *ptr; if ((cs->debug &L1_DEB_ISAC) && !(cs->debug &L1_DEB_ISAC_FIFO)) debugl1(cs, "dch_empty_fifo()"); // message too large, remove if ((cs->rcvidx + count) >= MAX_DFRAME_LEN_L1) { if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_empty_fifo() incoming message too large"); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC cs->rcvidx = 0; return; } ptr = cs->rcvbuf + cs->rcvidx; cs->rcvidx += count; spin_lock_irqsave(&ipacx_lock, flags); cs->readisacfifo(cs, ptr, count); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_ISAC_FIFO) { char *t = cs->dlog; t += sprintf(t, "dch_empty_fifo() cnt %d", count); QuickHex(t, ptr, count); debugl1(cs, cs->dlog); } } //---------------------------------------------------------- // Fill transmit FIFO //---------------------------------------------------------- static void dch_fill_fifo(struct IsdnCardState *cs) { unsigned long flags; int count; u_char cmd, *ptr; if ((cs->debug &L1_DEB_ISAC) && !(cs->debug &L1_DEB_ISAC_FIFO)) debugl1(cs, "dch_fill_fifo()"); if (!cs->tx_skb) return; count = cs->tx_skb->len; if (count <= 0) return; if (count > D_FIFO_SIZE) { count = D_FIFO_SIZE; cmd = 0x08; // XTF } else { cmd = 0x0A; // XTF | XME } spin_lock_irqsave(&ipacx_lock, flags); ptr = cs->tx_skb->data; skb_pull(cs->tx_skb, count); cs->tx_cnt += count; cs->writeisacfifo(cs, ptr, count); cs->writeisac(cs, IPACX_CMDRD, cmd); // set timeout for transmission contol if (test_and_set_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) { debugl1(cs, "dch_fill_fifo dbusytimer running"); del_timer(&cs->dbusytimer); } init_timer(&cs->dbusytimer); cs->dbusytimer.expires = jiffies + ((DBUSY_TIMER_VALUE * HZ)/1000); add_timer(&cs->dbusytimer); spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_ISAC_FIFO) { char *t = cs->dlog; t += sprintf(t, "dch_fill_fifo() cnt %d", count); QuickHex(t, ptr, count); debugl1(cs, cs->dlog); } } //---------------------------------------------------------- // D channel interrupt handler //---------------------------------------------------------- static inline void dch_int(struct IsdnCardState *cs) { struct sk_buff *skb; u_char istad, rstad; unsigned long flags; int count; istad = cs->readisac(cs, IPACX_ISTAD); if (istad &0x80) { // RME rstad = cs->readisac(cs, IPACX_RSTAD); if ((rstad &0xf0) != 0xa0) { // !(VFR && !RDO && CRC && !RAB) if (!(rstad &0x80)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): invalid frame"); if ((rstad &0x40)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): RDO"); if (!(rstad &0x20)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): CRC error"); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC } else { // received frame ok count = cs->readisac(cs, IPACX_RBCLD); if (count) count--; // RSTAB is last byte count &= D_FIFO_SIZE-1; if (count == 0) count = D_FIFO_SIZE; dch_empty_fifo(cs, count); spin_lock_irqsave(&ipacx_lock, flags); if ((count = cs->rcvidx) > 0) { cs->rcvidx = 0; if (!(skb = dev_alloc_skb(count))) printk(KERN_WARNING "HiSax dch_int(): receive out of memory\n"); else { memcpy(skb_put(skb, count), cs->rcvbuf, count); skb_queue_tail(&cs->rq, skb); } } spin_unlock_irqrestore(&ipacx_lock, flags); } cs->rcvidx = 0; dch_sched_event(cs, D_RCVBUFREADY); } if (istad &0x40) { // RPF dch_empty_fifo(cs, D_FIFO_SIZE); } if (istad &0x20) { // RFO if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): RFO"); cs->writeisac(cs, IPACX_CMDRD, 0x40); //RRES } if (istad &0x10) { // XPR if (test_and_clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) del_timer(&cs->dbusytimer); if (test_and_clear_bit(FLG_L1_DBUSY, &cs->HW_Flags)) dch_sched_event(cs, D_CLEARBUSY); if (cs->tx_skb) { if (cs->tx_skb->len) { dch_fill_fifo(cs); goto afterXPR; } else { dev_kfree_skb_irq(cs->tx_skb); cs->tx_skb = NULL; cs->tx_cnt = 0; } } if ((cs->tx_skb = skb_dequeue(&cs->sq))) { cs->tx_cnt = 0; dch_fill_fifo(cs); } else { dch_sched_event(cs, D_XMTBUFREADY); } } afterXPR: if (istad &0x0C) { // XDU or XMR if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): XDU"); if (cs->tx_skb) { skb_push(cs->tx_skb, cs->tx_cnt); // retransmit cs->tx_cnt = 0; dch_fill_fifo(cs); } else { printk(KERN_WARNING "HiSax: ISAC XDU no skb\n"); debugl1(cs, "ISAC XDU no skb"); } } } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit dch_setstack(struct PStack *st, struct IsdnCardState *cs) { st->l1.l1hw = dch_l2l1; } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit dch_init(struct IsdnCardState *cs) { printk(KERN_INFO "HiSax: IPACX ISDN driver v0.1.0\n"); INIT_WORK(&cs->work, dch_bh, cs); cs->setstack_d = dch_setstack; cs->dbusytimer.function = (void *) dbusy_timer_handler; cs->dbusytimer.data = (long) cs; init_timer(&cs->dbusytimer); cs->writeisac(cs, IPACX_TR_CONF0, 0x00); // clear LDD cs->writeisac(cs, IPACX_TR_CONF2, 0x00); // enable transmitter cs->writeisac(cs, IPACX_MODED, 0xC9); // transparent mode 0, RAC, stop/go cs->writeisac(cs, IPACX_MON_CR, 0x00); // disable monitor channel } //========================================================== // B channel functions //========================================================== //---------------------------------------------------------- // Entry point for commands //---------------------------------------------------------- static void bch_l2l1(struct PStack *st, int pr, void *arg) { struct sk_buff *skb = arg; unsigned long flags; switch (pr) { case (PH_DATA | REQUEST): spin_lock_irqsave(&ipacx_lock, flags); if (st->l1.bcs->tx_skb) { skb_queue_tail(&st->l1.bcs->squeue, skb); spin_unlock_irqrestore(&ipacx_lock, flags); } else { st->l1.bcs->tx_skb = skb; set_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); st->l1.bcs->hw.hscx.count = 0; spin_unlock_irqrestore(&ipacx_lock, flags); bch_fill_fifo(st->l1.bcs); } break; case (PH_PULL | INDICATION): if (st->l1.bcs->tx_skb) { printk(KERN_WARNING "HiSax bch_l2l1(): this shouldn't happen\n"); break; } set_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); st->l1.bcs->tx_skb = skb; st->l1.bcs->hw.hscx.count = 0; bch_fill_fifo(st->l1.bcs); break; case (PH_PULL | REQUEST): if (!st->l1.bcs->tx_skb) { clear_bit(FLG_L1_PULL_REQ, &st->l1.Flags); st->l2.l1l2(st, PH_PULL | CONFIRM, NULL); } else set_bit(FLG_L1_PULL_REQ, &st->l1.Flags); break; case (PH_ACTIVATE | REQUEST): set_bit(BC_FLG_ACTIV, &st->l1.bcs->Flag); bch_mode(st->l1.bcs, st->l1.mode, st->l1.bc); l1_msg_b(st, pr, arg); break; case (PH_DEACTIVATE | REQUEST): l1_msg_b(st, pr, arg); break; case (PH_DEACTIVATE | CONFIRM): clear_bit(BC_FLG_ACTIV, &st->l1.bcs->Flag); clear_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); bch_mode(st->l1.bcs, 0, st->l1.bc); st->l2.l1l2(st, PH_DEACTIVATE | CONFIRM, NULL); break; } } //---------------------------------------------------------- // proceed with bottom half handler BChannel_bh() //---------------------------------------------------------- static void bch_sched_event(struct BCState *bcs, int event) { bcs->event |= 1 << event; schedule_work(&bcs->work); } //---------------------------------------------------------- // Read B channel fifo to receive buffer //---------------------------------------------------------- static void bch_empty_fifo(struct BCState *bcs, int count) { u_char *ptr, hscx; struct IsdnCardState *cs; unsigned long flags; int cnt; cs = bcs->cs; hscx = bcs->hw.hscx.hscx; if ((cs->debug &L1_DEB_HSCX) && !(cs->debug &L1_DEB_HSCX_FIFO)) debugl1(cs, "bch_empty_fifo()"); // message too large, remove if (bcs->hw.hscx.rcvidx + count > HSCX_BUFMAX) { if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_empty_fifo() incoming packet too large"); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC bcs->hw.hscx.rcvidx = 0; return; } // Read data uninterruptible spin_lock_irqsave(&ipacx_lock, flags); ptr = bcs->hw.hscx.rcvbuf + bcs->hw.hscx.rcvidx; cnt = count; while (cnt--) *ptr++ = cs->BC_Read_Reg(cs, hscx, IPACX_RFIFOB); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC ptr = bcs->hw.hscx.rcvbuf + bcs->hw.hscx.rcvidx; bcs->hw.hscx.rcvidx += count; spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_HSCX_FIFO) { char *t = bcs->blog; t += sprintf(t, "bch_empty_fifo() B-%d cnt %d", hscx, count); QuickHex(t, ptr, count); debugl1(cs, bcs->blog); } } //---------------------------------------------------------- // Fill buffer to transmit FIFO //---------------------------------------------------------- static void bch_fill_fifo(struct BCState *bcs) { struct IsdnCardState *cs; int more, count, cnt; u_char *ptr, *p, hscx; unsigned long flags; cs = bcs->cs; if ((cs->debug &L1_DEB_HSCX) && !(cs->debug &L1_DEB_HSCX_FIFO)) debugl1(cs, "bch_fill_fifo()"); if (!bcs->tx_skb) return; if (bcs->tx_skb->len <= 0) return; hscx = bcs->hw.hscx.hscx; more = (bcs->mode == L1_MODE_TRANS) ? 1 : 0; if (bcs->tx_skb->len > B_FIFO_SIZE) { more = 1; count = B_FIFO_SIZE; } else { count = bcs->tx_skb->len; } cnt = count; spin_lock_irqsave(&ipacx_lock, flags); p = ptr = bcs->tx_skb->data; skb_pull(bcs->tx_skb, count); bcs->tx_cnt -= count; bcs->hw.hscx.count += count; while (cnt--) cs->BC_Write_Reg(cs, hscx, IPACX_XFIFOB, *p++); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, (more ? 0x08 : 0x0a)); spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_HSCX_FIFO) { char *t = bcs->blog; t += sprintf(t, "chb_fill_fifo() B-%d cnt %d", hscx, count); QuickHex(t, ptr, count); debugl1(cs, bcs->blog); } } //---------------------------------------------------------- // B channel interrupt handler //---------------------------------------------------------- static void bch_int(struct IsdnCardState *cs, u_char hscx) { u_char istab; struct BCState *bcs; struct sk_buff *skb; int count; u_char rstab; bcs = cs->bcs + hscx; istab = cs->BC_Read_Reg(cs, hscx, IPACX_ISTAB); if (!test_bit(BC_FLG_INIT, &bcs->Flag)) return; if (istab &0x80) { // RME rstab = cs->BC_Read_Reg(cs, hscx, IPACX_RSTAB); if ((rstab &0xf0) != 0xa0) { // !(VFR && !RDO && CRC && !RAB) if (!(rstab &0x80)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: invalid frame", hscx); if ((rstab &0x40) && (bcs->mode != L1_MODE_NULL)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: RDO mode=%d", hscx, bcs->mode); if (!(rstab &0x20)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: CRC error", hscx); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC } else { // received frame ok count = cs->BC_Read_Reg(cs, hscx, IPACX_RBCLB) &(B_FIFO_SIZE-1); if (count == 0) count = B_FIFO_SIZE; bch_empty_fifo(bcs, count); if ((count = bcs->hw.hscx.rcvidx - 1) > 0) { if (cs->debug &L1_DEB_HSCX_FIFO) debugl1(cs, "bch_int Frame %d", count); if (!(skb = dev_alloc_skb(count))) printk(KERN_WARNING "HiSax bch_int(): receive frame out of memory\n"); else { memcpy(skb_put(skb, count), bcs->hw.hscx.rcvbuf, count); skb_queue_tail(&bcs->rqueue, skb); } } } bcs->hw.hscx.rcvidx = 0; bch_sched_event(bcs, B_RCVBUFREADY); } if (istab &0x40) { // RPF bch_empty_fifo(bcs, B_FIFO_SIZE); if (bcs->mode == L1_MODE_TRANS) { // queue every chunk // receive transparent audio data if (!(skb = dev_alloc_skb(B_FIFO_SIZE))) printk(KERN_WARNING "HiSax bch_int(): receive transparent out of memory\n"); else { memcpy(skb_put(skb, B_FIFO_SIZE), bcs->hw.hscx.rcvbuf, B_FIFO_SIZE); skb_queue_tail(&bcs->rqueue, skb); } bcs->hw.hscx.rcvidx = 0; bch_sched_event(bcs, B_RCVBUFREADY); } } if (istab &0x20) { // RFO if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: RFO error", hscx); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x40); // RRES } if (istab &0x10) { // XPR if (bcs->tx_skb) { if (bcs->tx_skb->len) { bch_fill_fifo(bcs); goto afterXPR; } skb_queue_tail(&bcs->cmpl_queue, bcs->tx_skb); bch_sched_event(bcs, B_CMPLREADY); bcs->hw.hscx.count = 0; } if ((bcs->tx_skb = skb_dequeue(&bcs->squeue))) { bcs->hw.hscx.count = 0; set_bit(BC_FLG_BUSY, &bcs->Flag); bch_fill_fifo(bcs); } else { clear_bit(BC_FLG_BUSY, &bcs->Flag); bch_sched_event(bcs, B_XMTBUFREADY); } } afterXPR: if (istab &0x04) { // XDU if (bcs->mode == L1_MODE_TRANS) { bch_fill_fifo(bcs); } else { if (bcs->tx_skb) { // restart transmitting the whole frame skb_push(bcs->tx_skb, bcs->hw.hscx.count); bcs->tx_cnt += bcs->hw.hscx.count; bcs->hw.hscx.count = 0; } cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x01); // XRES if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d XDU error", hscx); } } } //---------------------------------------------------------- //---------------------------------------------------------- static void bch_mode(struct BCState *bcs, int mode, int bc) { struct IsdnCardState *cs = bcs->cs; int hscx = bcs->hw.hscx.hscx; bc = bc ? 1 : 0; // in case bc is greater than 1 if (cs->debug & L1_DEB_HSCX) debugl1(cs, "mode_bch() switch B-% mode %d chan %d", hscx, mode, bc); bcs->mode = mode; bcs->channel = bc; // map controller to according timeslot if (!hscx) { cs->writeisac(cs, IPACX_BCHA_TSDP_BC1, 0x80 | bc); cs->writeisac(cs, IPACX_BCHA_CR, 0x88); } else { cs->writeisac(cs, IPACX_BCHB_TSDP_BC1, 0x80 | bc); cs->writeisac(cs, IPACX_BCHB_CR, 0x88); } switch (mode) { case (L1_MODE_NULL): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0xC0); // rec off cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x30); // std adj. cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, 0xFF); // ints off cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments break; case (L1_MODE_TRANS): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0x88); // ext transp mode cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x00); // xxx00000 cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, _MASKB_IMASK); break; case (L1_MODE_HDLC): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0xC8); // transp mode 0 cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x01); // idle=hdlc flags crc enabled cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, _MASKB_IMASK); break; } } //---------------------------------------------------------- //---------------------------------------------------------- static void bch_close_state(struct BCState *bcs) { bch_mode(bcs, 0, bcs->channel); if (test_and_clear_bit(BC_FLG_INIT, &bcs->Flag)) { if (bcs->hw.hscx.rcvbuf) { kfree(bcs->hw.hscx.rcvbuf); bcs->hw.hscx.rcvbuf = NULL; } if (bcs->blog) { kfree(bcs->blog); bcs->blog = NULL; } skb_queue_purge(&bcs->rqueue); skb_queue_purge(&bcs->squeue); if (bcs->tx_skb) { dev_kfree_skb_any(bcs->tx_skb); bcs->tx_skb = NULL; clear_bit(BC_FLG_BUSY, &bcs->Flag); } } } //---------------------------------------------------------- //---------------------------------------------------------- static int bch_open_state(struct IsdnCardState *cs, struct BCState *bcs) { if (!test_and_set_bit(BC_FLG_INIT, &bcs->Flag)) { if (!(bcs->hw.hscx.rcvbuf = kmalloc(HSCX_BUFMAX, GFP_ATOMIC))) { printk(KERN_WARNING "HiSax open_bchstate(): No memory for hscx.rcvbuf\n"); clear_bit(BC_FLG_INIT, &bcs->Flag); return (1); } if (!(bcs->blog = kmalloc(MAX_BLOG_SPACE, GFP_ATOMIC))) { printk(KERN_WARNING "HiSax open_bchstate: No memory for bcs->blog\n"); clear_bit(BC_FLG_INIT, &bcs->Flag); kfree(bcs->hw.hscx.rcvbuf); bcs->hw.hscx.rcvbuf = NULL; return (2); } skb_queue_head_init(&bcs->rqueue); skb_queue_head_init(&bcs->squeue); } bcs->tx_skb = NULL; clear_bit(BC_FLG_BUSY, &bcs->Flag); bcs->event = 0; bcs->hw.hscx.rcvidx = 0; bcs->tx_cnt = 0; return (0); } //---------------------------------------------------------- //---------------------------------------------------------- static int bch_setstack(struct PStack *st, struct BCState *bcs) { bcs->channel = st->l1.bc; if (bch_open_state(st->l1.hardware, bcs)) return (-1); st->l1.bcs = bcs; st->l1.l2l1 = bch_l2l1; setstack_manager(st); bcs->st = st; setstack_l1_B(st); return (0); } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit bch_init(struct IsdnCardState *cs, int hscx) { cs->bcs[hscx].BC_SetStack = bch_setstack; cs->bcs[hscx].BC_Close = bch_close_state; cs->bcs[hscx].hw.hscx.hscx = hscx; cs->bcs[hscx].cs = cs; bch_mode(cs->bcs + hscx, 0, hscx); } //========================================================== // Shared functions //========================================================== //---------------------------------------------------------- // Main interrupt handler //---------------------------------------------------------- void interrupt_ipacx(struct IsdnCardState *cs) { u_char ista; while ((ista = cs->readisac(cs, IPACX_ISTA))) { if (ista &0x80) bch_int(cs, 0); // B channel interrupts if (ista &0x40) bch_int(cs, 1); if (ista &0x01) dch_int(cs); // D channel if (ista &0x10) cic_int(cs); // Layer 1 state } } //---------------------------------------------------------- // Clears chip interrupt status //---------------------------------------------------------- static void __init clear_pending_ints(struct IsdnCardState *cs) { int ista; // all interrupts off cs->writeisac(cs, IPACX_MASK, 0xff); cs->writeisac(cs, IPACX_MASKD, 0xff); cs->BC_Write_Reg(cs, 0, IPACX_MASKB, 0xff); cs->BC_Write_Reg(cs, 1, IPACX_MASKB, 0xff); ista = cs->readisac(cs, IPACX_ISTA); if (ista &0x80) cs->BC_Read_Reg(cs, 0, IPACX_ISTAB); if (ista &0x40) cs->BC_Read_Reg(cs, 1, IPACX_ISTAB); if (ista &0x10) cs->readisac(cs, IPACX_CIR0); if (ista &0x01) cs->readisac(cs, IPACX_ISTAD); } //---------------------------------------------------------- // Does chip configuration work // Work to do depends on bit mask in part //---------------------------------------------------------- void __init init_ipacx(struct IsdnCardState *cs, int part) { if (part &1) { // initialise chip clear_pending_ints(cs); bch_init(cs, 0); bch_init(cs, 1); dch_init(cs); } if (part &2) { // reenable all interrupts and start chip cs->BC_Write_Reg(cs, 0, IPACX_MASKB, _MASKB_IMASK); cs->BC_Write_Reg(cs, 1, IPACX_MASKB, _MASKB_IMASK); cs->writeisac(cs, IPACX_MASKD, _MASKD_IMASK); cs->writeisac(cs, IPACX_MASK, _MASK_IMASK); // global mask register // reset HDLC Transmitters/receivers cs->writeisac(cs, IPACX_CMDRD, 0x41); cs->BC_Write_Reg(cs, 0, IPACX_CMDRB, 0x41); cs->BC_Write_Reg(cs, 1, IPACX_CMDRB, 0x41); ph_command(cs, IPACX_CMD_RES); } } //----------------- end of file ----------------------- coccinelle-1.0.0-rc19/tests/bigrepl.res0000644000175000017500000000070212247437436016670 0ustar eugeneugenint main () { one(argument1(nested, argument), argument2(nested, argument), call(to, a, very, complicated, function, with, many, args), argument3(nested, argument)); one(argument1(nested, argument), argument2(nested, argument), call(to, a, very, complicated, function, with, many, args), a(b)); one(argument1(nested, argument), argument2(nested, argument), call(to, a, very, complicated, function, with, many, args)); } coccinelle-1.0.0-rc19/tests/incpos1.res0000644000175000017500000000012112247437436016613 0ustar eugeneugen#include #include "two" #include #include "four" #include coccinelle-1.0.0-rc19/tests/stm3.res0000644000175000017500000000005112247437436016127 0ustar eugeneugenint main(int x) { f(); g(); g(); } coccinelle-1.0.0-rc19/tests/type_infer.c0000644000175000017500000000020112247437436017033 0ustar eugeneugenint __init snd_pmac_awacs_init(struct snd_pmac *chip) { struct awacs_amp *amp = kmalloc(sizeof(*amp)); memset(sizeof(*amp)); } coccinelle-1.0.0-rc19/tests/braces.res0000644000175000017500000000023612247437436016505 0ustar eugeneugen#define main foo(); int main() { foo(); } int main() { if (x) foo(); } int main() { while (x) foo(); } int main() { if (x) foo(); else foo(); } coccinelle-1.0.0-rc19/tests/hd.h0000644000175000017500000000002512247437436015273 0ustar eugeneugenint f(int x, int y); coccinelle-1.0.0-rc19/tests/retest.c0000644000175000017500000000007112247437436016202 0ustar eugeneugenint main () { foo(); if (x) return 3; bar(); } coccinelle-1.0.0-rc19/tests/badzero.res0000644000175000017500000000021012247437436016664 0ustar eugeneugenint main () { int *x; int *y; int z; if (y - x == 0) return; if ((y - x) == 0) return; if (27) return; if (27) return; } coccinelle-1.0.0-rc19/tests/badwhen.res0000644000175000017500000000013212247437436016651 0ustar eugeneugenint main () { f(); if (foo()) return; g(); } int second() { if (xfoo()) return; } coccinelle-1.0.0-rc19/tests/justremove.res0000644000175000017500000000005412247437436017447 0ustar eugeneugenint main () { foo(); foo(); foo(); } coccinelle-1.0.0-rc19/tests/define_param.res0000644000175000017500000000042112247437436017654 0ustar eugeneugenstatic int atari_proc_infos(unsigned char *nvram, char *buffer, int *len, off_t *begin, off_t offset, int size) { for (i = ARRAY_SIZE(boot_prefs) - 1; i >= 0; --i) { if (nvram[1] == boot_prefs[i].val) { PRINT_PROC("%s\n", boot_prefs[i].name); break; } } } coccinelle-1.0.0-rc19/tests/array_init.c0000644000175000017500000000012612247437436017036 0ustar eugeneugenstatic int term[MAX_ECARDS] = { 1, 1, 1, 1, 1, 1, 1, 1 }; MODULE_PARM(term, "1-8i"); coccinelle-1.0.0-rc19/tests/longlongint.c0000644000175000017500000000021412247437436017225 0ustar eugeneugenint main() { unsigned int x; int y; unsigned long long int a; long long int b; unsigned long long m; long long n; return 0; } coccinelle-1.0.0-rc19/tests/decl_split.c0000644000175000017500000000004712247437436017021 0ustar eugeneugenint func(int i) { int x, y; } coccinelle-1.0.0-rc19/tests/test3.c0000644000175000017500000000012012247437436015731 0ustar eugeneugenvoid main() { /* a comment */ f(3); if(1) g(1); else g(2); } coccinelle-1.0.0-rc19/tests/ifdefmeta3.cocci0000644000175000017500000000005712247437436017545 0ustar eugeneugen@@ statement S; @@ f(); - S + xxx(); g(); coccinelle-1.0.0-rc19/tests/enum.c0000644000175000017500000000032012247437436015635 0ustar eugeneugentypedef enum { } another_test; typedef enum { xxx #ifdef FOO ,bar #endif } another_test2; typedef enum { xxx } this_one_works; static reg_errcode_t regex_compile () { unsigned char *pending_exact = 0; } coccinelle-1.0.0-rc19/tests/badtypedef.c0000644000175000017500000000016412247437436017006 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { struct foo *a; foo_t *b; foo_t *c; xxx(a); yyy(b); } coccinelle-1.0.0-rc19/tests/edots.c0000644000175000017500000000012112247437436016006 0ustar eugeneugenvoid main(int i) { foo[45]; bar[45+v.field]; // f(foo[45] + bar[45]); } coccinelle-1.0.0-rc19/tests/incdir2.c0000644000175000017500000000001112247437436016220 0ustar eugeneugenchar *x; coccinelle-1.0.0-rc19/tests/posiso.cocci0000644000175000017500000000023212247437436017045 0ustar eugeneugen@x@ position p1,p2; expression E; statement S1, S2; @@ if@p1 (E ==@p2 NULL) S1 else S2 @@ position x.p1; statement S1, S2; @@ - if@p1 (...) S1 else S2 coccinelle-1.0.0-rc19/tests/iterprint.c0000644000175000017500000000014112247437436016712 0ustar eugeneugenint main () { for(bit = 0; bit < size; bit++) { if (test_bit(bit, bitmap)) x = 12; } } coccinelle-1.0.0-rc19/tests/notest.res0000644000175000017500000000011012247437436016551 0ustar eugeneugenint main() { struct foo *x; x = FN(); if (12) return; return; } coccinelle-1.0.0-rc19/tests/y2.c0000644000175000017500000000043112247437436015226 0ustar eugeneugenstatic void asuscom_interrupt_ipac(int intno, void *dev_id, struct pt_regs *regs) { if (!cs) { printk(KERN_WARNING "ISDNLink: Spurious interrupt!\n"); return; } Start_IPAC: debugl1(cs, "IPAC ISTA %02X", ista); if ((ista & 0x3f) && icnt) { icnt--; goto Start_IPAC; } } coccinelle-1.0.0-rc19/tests/declinv.c0000644000175000017500000000005712247437436016324 0ustar eugeneugenint main () { int a ; int b, c ; } coccinelle-1.0.0-rc19/tests/fortype.res0000644000175000017500000000010012247437436016724 0ustar eugeneugenint main () { for (char * p = 0; y!=10; y++) return y; } coccinelle-1.0.0-rc19/tests/paren1.cocci0000644000175000017500000000001712247437436016720 0ustar eugeneugen@@ @@ - x && y coccinelle-1.0.0-rc19/tests/retval2.res0000644000175000017500000000072412247437436016627 0ustar eugeneugenint getlen(int *input, size_t maxlen, int delim, size_t *result) { size_t i; for (i = 0; i < maxlen; ++i) { if (input[i] == delim) { if (result != NULL) { *result = i; } return 0; } } return -1; } int newname(int *input, size_t maxlen, int delim, size_t *result) { size_t i; for (i = 0; i < maxlen; ++i) { if (input[i] == delim) { if (result != NULL) { *result = i; } return 0; } } } coccinelle-1.0.0-rc19/tests/array_init.res0000644000175000017500000000007312247437436017406 0ustar eugeneugenstatic int term[MAX_ECARDS] = { 1, 1, 1, 1, 1, 1, 1, 1 }; coccinelle-1.0.0-rc19/tests/initializer.res0000644000175000017500000000011712247437436017567 0ustar eugeneugenstruct SHT var = { .f1 = toto1, .foo = 12, .foo2 = 12, .f3 = toto3, }; coccinelle-1.0.0-rc19/tests/metastatement2.cocci0000644000175000017500000000003612247437436020470 0ustar eugeneugen@@ statement S; @@ f(); - S coccinelle-1.0.0-rc19/tests/include.c0000644000175000017500000000017412247437436016323 0ustar eugeneugen #include #include #include #include void main(int i) { i++; } coccinelle-1.0.0-rc19/tests/array_init.cocci0000644000175000017500000000024612247437436017677 0ustar eugeneugen@ rule3 @ identifier I; type T; expression E; @@ T I[E]; @@ identifier rule3.I; expression str; type rule3.T; declarer name MODULE_PARM; @@ - MODULE_PARM(I,str); coccinelle-1.0.0-rc19/tests/defe.cocci0000644000175000017500000000006312247437436016436 0ustar eugeneugen@@ identifier id; expression E; @@ * #define id E coccinelle-1.0.0-rc19/tests/decl2.c0000644000175000017500000000014512247437436015667 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { if (x) { return 0; } else { return 0; } } coccinelle-1.0.0-rc19/tests/format.c0000644000175000017500000000016312247437436016166 0ustar eugeneugenint main () { printf("one %d two\n", 1); printf("one %d two %d three\n", 1, 2); printf("one two three\n"); } coccinelle-1.0.0-rc19/tests/branchparen.res0000644000175000017500000000013012247437436017522 0ustar eugeneugenint main () { if (x) { foo(); xxx(); } else { foo(); xxx(); } } coccinelle-1.0.0-rc19/tests/ifdef1.cocci0000644000175000017500000000014712247437436016674 0ustar eugeneugen@ Exemple1@ @@ #include + #ifdef CONFIG_NKERNEL + #include + #endif coccinelle-1.0.0-rc19/tests/bigrepl.cocci0000644000175000017500000000011412247437436017154 0ustar eugeneugen@@ @@ - foo() + call(to, a, very, complicated, function, with, many, args) coccinelle-1.0.0-rc19/tests/branchparen.c0000644000175000017500000000006612247437436017163 0ustar eugeneugenint main () { if (x) xxx(); else xxx(); } coccinelle-1.0.0-rc19/tests/addif2.res0000644000175000017500000000021312247437436016372 0ustar eugeneugen#ifdef FOO int /*foo*/ xxx; #endif static int foo() { return 12; } #ifdef FOO int /*foo*/ xxx; #endif static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/comments.res0000644000175000017500000000020612247437436017070 0ustar eugeneugen int main() { // Calls foo() foo(); return 0; } /** Some info about @foo() @return void */ void foo() { /* Do nothing */ } coccinelle-1.0.0-rc19/tests/zero.cocci0000644000175000017500000000005512247437436016513 0ustar eugeneugen@@ expression E1, E2; @@ - memset(E1,0,E2); coccinelle-1.0.0-rc19/tests/strangeorder.c0000644000175000017500000000043612247437436017400 0ustar eugeneugenstruct i2c_client * i2c_new_device(struct i2c_adapter *adap, struct i2c_board_info const *info) { struct i2c_client *client; client = kzalloc(sizeof *client, GFP_KERNEL); if (!client) return NULL; client->adapter = adap; if (status < 0) { client = NULL; } return client; } coccinelle-1.0.0-rc19/tests/fix_flow_need.res0000644000175000017500000000011312247437436020050 0ustar eugeneugenvoid main(int i) { foobar(); if(1) { foo(); } foobar(); } coccinelle-1.0.0-rc19/tests/test11_ver1.c0000644000175000017500000000007012247437436016751 0ustar eugeneugenvoid main(int i) { f(1); g(1); //g(1); h(1); } coccinelle-1.0.0-rc19/tests/memory.res0000644000175000017500000000016512247437436016557 0ustar eugeneugen#define BAD_MAGIC(q,m) 0 int __queue_add(Queue_t *queue, Scsi_Cmnd *SCpnt, int head) { BUG_ON (BAD_MAGIC(1,12)); } coccinelle-1.0.0-rc19/tests/multivars.cocci0000644000175000017500000000004712247437436017563 0ustar eugeneugen@@ expression X; @@ - f(X,X); + h(X); coccinelle-1.0.0-rc19/tests/addif.res0000644000175000017500000000045512247437436016320 0ustar eugeneugen#ifdef FOO /* some comment */ int xxx() { /* a comment by itself */ return 12; /* another comment */ } #endif static int foo() { return 12; } #ifdef FOO /* some comment */ int xxx() { /* a comment by itself */ return 12; /* another comment */ } #endif static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/pb_distribute_type4.c0000644000175000017500000000016112247437436020660 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.0-rc19/tests/ifdef5.c0000644000175000017500000000031212247437436016034 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/com.c0000644000175000017500000000012712247437436015454 0ustar eugeneugenint main() { foo(); /* a comment */ foo(); /* a comment */ foo(); bar(); } coccinelle-1.0.0-rc19/tests/undef.c0000644000175000017500000000020712247437436015776 0ustar eugeneugen#define foo 12 #undef foo #define foo 12 int main () { #undef foo return; } int main () { #define foo 12 return; } #undef foo coccinelle-1.0.0-rc19/tests/julia7.res0000644000175000017500000000011012247437436016430 0ustar eugeneugenint main(int x) { foo(); if (x) { after(); return 0;} after(); } coccinelle-1.0.0-rc19/tests/remstruct.res0000644000175000017500000000012712247437436017275 0ustar eugeneugenint hello ( String input ) { String input = input.lowercase(); printf(input); } coccinelle-1.0.0-rc19/tests/y.cocci0000644000175000017500000000020012247437436015774 0ustar eugeneugen@ rule1 @ expression E; @@ + xxx(E); foo(E); @@ expression F; @@ xxx(F); @@ expression rule1.E; @@ foo(E); + yyy(E); coccinelle-1.0.0-rc19/tests/julia7.cocci0000644000175000017500000000025712247437436016733 0ustar eugeneugen// foobar(x) comes out to the right of foo(x) // if bar is alone in a branch, as in julia7.c, the if ends up with no branch @@ @@ foo(); ... ?- bar(); after(); coccinelle-1.0.0-rc19/tests/minstruct.c0000644000175000017500000000016512247437436016730 0ustar eugeneugenstatic struct i2c_client client_template = { .name = "(unset)", .id = -1, .driver = &i2c_driver_videotext }; coccinelle-1.0.0-rc19/tests/reserved.res0000644000175000017500000000006312247437436017063 0ustar eugeneugenint main() { f(1,2); f(2,3,2); f(3,4,3,3); } coccinelle-1.0.0-rc19/tests/pragmatest.cocci0000644000175000017500000000033112247437436017700 0ustar eugeneugen@@ expression e; identifier i; @@ -#define i e @r@ identifier fn; @@ - #pragma inline (fn) @@ identifier r.fn; type T; @@ T fn(...) + __attribute__((always_inline)) ; @@ identifier r.fn; @@ - #pragma abc fn defcoccinelle-1.0.0-rc19/tests/gilles-question.cocci0000644000175000017500000000003512247437436020656 0ustar eugeneugen@@ @@ f(0); ... - g(0); coccinelle-1.0.0-rc19/tests/comadd.c0000644000175000017500000000003512247437436016123 0ustar eugeneugenint main () { return 12; } coccinelle-1.0.0-rc19/tests/parameters_dots.res0000644000175000017500000000003612247437436020440 0ustar eugeneugenvoid main(int i) { g(3); } coccinelle-1.0.0-rc19/tests/decmeta.cocci0000644000175000017500000000037312247437436017141 0ustar eugeneugen@@ idexpression decimal(TEN,FIVE) x; @@ - x + 10 @@ idexpression decimal(10,5) x; @@ - x + 20 @r@ constant n,p; idexpression decimal(n,p) x; @@ - x + p @@ constant r.n; @@ -6 +n @@ @@ - decimal(10,5) + int @@ @@ - decimal(TEN,FIVE) + int * coccinelle-1.0.0-rc19/tests/longconst.res0000644000175000017500000000074212247437436017256 0ustar eugeneugenlong function1() { long a; int b; a = f(1l, "long"); a = f(1u, "unsigned"); a = f(65536l, "long"); a = f(65536u, "unsigned"); a = f(65536, "int"); a = f(4294967296, "int"); a = f(65535, "int"); a = f(4294967295, "int"); a = f(0x7fffffff, "int"); a = f(0x1fl, "long"); a = f(0x1fu, "unsigned"); a = f(0x1FL, "long"); a = f(0x1FU, "unsigned"); return a; } coccinelle-1.0.0-rc19/tests/whitespace.c0000644000175000017500000000005412247437436017031 0ustar eugeneugenint main () { foo(sizeof (struct xxx)); } coccinelle-1.0.0-rc19/tests/test1.c0000644000175000017500000000017012247437436015734 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { // h(3); h(3); } else { h(4); } } coccinelle-1.0.0-rc19/tests/format.cocci0000644000175000017500000000003512247437436017022 0ustar eugeneugen@@ @@ - "...%d..." + "blah" coccinelle-1.0.0-rc19/tests/localid.res0000644000175000017500000000007312247437436016654 0ustar eugeneugenint c; int main () { int a; f(a+1); h(b); g(c); } coccinelle-1.0.0-rc19/tests/devlink.res0000644000175000017500000000042712247437436016704 0ustar eugeneugenstatic void cm4000_release(struct pcmcia_device *link); int main () { memset(&dev->atr_csum,0, sizeof(struct pcmcia_device) - sizeof(dev_node)); } int xmain () { struct pcmcia_device x; memset(&dev->atr_csum,0, sizeof(struct pcmcia_device) - sizeof(dev_node)); } coccinelle-1.0.0-rc19/tests/sgrep.cocci0000644000175000017500000000006712247437436016657 0ustar eugeneugen@@ @@ - f(); ... g(); @@ @@ x(); ... - y(); coccinelle-1.0.0-rc19/tests/multidecl.cocci0000644000175000017500000000046412247437436017522 0ustar eugeneugen// test with -cocci_vs_c_3 -use_ref @ rule1 @ identifier driver; identifier attach, detach; @@ struct pcmcia_driver driver = { .remove = detach, }; @@ identifier link; identifier rule1.detach; @@ detach(struct pcmcia_device *link) { ... if (link->state & DEV_CONFIG) { ... } ... } coccinelle-1.0.0-rc19/tests/const1bis.res0000644000175000017500000000006012247437436017146 0ustar eugeneugenvoid foo(int j) { float i; int i; i++; } coccinelle-1.0.0-rc19/tests/sizeof_julia.cocci0000644000175000017500000000012712247437436020217 0ustar eugeneugen@@ identifier arg; identifier v; @@ - copy_from_user(&v,arg,sizeof(v)) + foo() coccinelle-1.0.0-rc19/tests/if2.cocci0000644000175000017500000000013312247437436016211 0ustar eugeneugen@@ expression E; @@ - for(...;...;...) { xxx(2); <... - xxx(E); ...> - } coccinelle-1.0.0-rc19/tests/free.cocci0000644000175000017500000000123712247437436016460 0ustar eugeneugen@a@ identifier x; expression E; expression f; identifier fld; type T; @@ ( free(x); | kfree(x); | kfree_skb(x); | dev_kfree_skb(x); | dev_kfree_skb_anx(x); ) ... WHEN != x = E WHEN != \(T x;\| T x = E;\) f(...,x,...) @@ identifier x; expression E; type T; @@ ( free(x); | kfree(x); | kfree_skb(x); | dev_kfree_skb(x); | dev_kfree_skb_anx(x); ) ... WHEN != x = E WHEN != T x; WHEN != T x = E; *x @@ identifier x; expression E; identifier fld; type T; @@ ( free(x); | kfree(x); | kfree_skb(x); | dev_kfree_skb(x); | dev_kfree_skb_anx(x); ) ... WHEN != x = E WHEN != T x; WHEN != T x = E; x->fld coccinelle-1.0.0-rc19/tests/macro_int16.cocci0000644000175000017500000000007612247437436017661 0ustar eugeneugen@testint16@ int E1, E2, E3; @@ - E1 = E2 + E3; +E1 = E2 - E3; coccinelle-1.0.0-rc19/tests/topdec_ver1.c0000644000175000017500000000017712247437436017116 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ static struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/foura.c0000644000175000017500000000005012247437436016005 0ustar eugeneugenint main () { f(1); h(2); i(2); } coccinelle-1.0.0-rc19/tests/include.cocci0000644000175000017500000000004512247437436017156 0ustar eugeneugen@@ @@ -#include coccinelle-1.0.0-rc19/tests/join.c0000644000175000017500000000012412247437436015632 0ustar eugeneugenint main(int i) { f(0); if(1) { g(2); } else { g(3); } h(4); } coccinelle-1.0.0-rc19/tests/nstruct.cocci0000644000175000017500000000014512247437436017236 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, + .dev = { .name = E, }, }; coccinelle-1.0.0-rc19/tests/incl.cocci0000644000175000017500000000015012247437436016455 0ustar eugeneugen@@ @@ + #include "before.h" #include @@ @@ #include + #include "after.h" coccinelle-1.0.0-rc19/tests/return.cocci0000644000175000017500000000037612247437436017061 0ustar eugeneugen// not needed with 'return implicit' feature // @@ // statement S; // @@ // // foo(...) { // ... // ( // + before_return(); // return; // | // S // + before_return(); // ) // } @@ statement S; @@ foo(...) { ... + before_return(); return; } coccinelle-1.0.0-rc19/tests/return.res0000644000175000017500000000024212247437436016562 0ustar eugeneugenvoid foo(int y) { int x; if (x) { aaa(); bbb(); before_return(); return; } if (x) { aaa(); bbb(); before_return(); return; } ccc(); before_return(); } coccinelle-1.0.0-rc19/tests/ifdef6a.res0000644000175000017500000000037312247437436016554 0ustar eugeneugen#include #ifdef CONFIG_NKERNEL #define foo(x) f(x) #endif #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/pb_cfg.c0000644000175000017500000000012212247437436016111 0ustar eugeneugenvoid main(int i) { f(1); goto return_0; f(1); label1: f(2); return; } coccinelle-1.0.0-rc19/tests/bigin.cocci0000644000175000017500000000002712247437436016623 0ustar eugeneugen@@ @@ +bar(); foo(); coccinelle-1.0.0-rc19/tests/incompatible_value.cocci0000644000175000017500000000016312247437436021376 0ustar eugeneugen@ r1 @ expression E; identifier fn; @@ fn(...) { <... f(E) ...> } @@ expression r1.E; @@ - g(E) + h(E) coccinelle-1.0.0-rc19/tests/opt.res0000644000175000017500000000002112247437436016040 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/stm7.res0000644000175000017500000000005712247437436016141 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/inline.c0000644000175000017500000000004312247437436016151 0ustar eugeneugeninline void foo(int x) { return; } coccinelle-1.0.0-rc19/tests/edots.res0000644000175000017500000000010112247437436016353 0ustar eugeneugenvoid main(int i) { foo; bar; // f(foo[45] + bar[45]); } coccinelle-1.0.0-rc19/tests/rptr.c0000644000175000017500000000011312247437436015660 0ustar eugeneugenint foo(struct resource *r) { if (r == NULL) return 0; return 1; } coccinelle-1.0.0-rc19/tests/notest.c0000644000175000017500000000011012247437436016202 0ustar eugeneugenint main() { struct foo *x; x = FN(); if (!x) return; return; } coccinelle-1.0.0-rc19/tests/a_and_e.c0000644000175000017500000000012612247437436016243 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(3,4); // return 1; } coccinelle-1.0.0-rc19/tests/cast.c0000644000175000017500000000005712247437436015632 0ustar eugeneugenint main () { ((struct xxx *)E)->foo = 12; } coccinelle-1.0.0-rc19/tests/memory.cocci0000644000175000017500000000006612247437436017046 0ustar eugeneugen@@ expression E; @@ - if (E) { BUG(); } + BUG_ON(E); coccinelle-1.0.0-rc19/tests/format.res0000644000175000017500000000013212247437436016531 0ustar eugeneugenint main () { printf("blah", 1); printf("blah", 1, 2); printf("one two three\n"); } coccinelle-1.0.0-rc19/tests/string.c0000644000175000017500000000004412247437436016202 0ustar eugeneugenMODULE_PARM(suppress_pollack, "x"); coccinelle-1.0.0-rc19/tests/request_irq_sgrep.cocci0000644000175000017500000000327212247437436021303 0ustar eugeneugen// sgrep // Case 1: search for irq functions where interrupt.h is not used // these might be ok as is, because some definitions of request_irq still // have the pt_regs parameter in the signature @ rule1 @ @@ #include @ rule2 depends on !rule1 @ expression irq; identifier handler; expression irqflags; expression devname; expression dev_id; @@ request_irq(irq, handler, irqflags, devname, dev_id) @@ identifier rule2.handler, irq, dev, regs; @@ * handler(int irq, void *dev, struct pt_regs *regs) { ... } // ---------------------------------------------------------------------- // Case 2: the function is not static. This only works when there is no // static handler function in the file, but fortunately this is the case // (we have detected this by actually doing the transformation, which makes // the second rule no longer match; unfortunately there is no disjunction // at the function level) @ rule3 depends on rule1 @ expression irq; identifier handler; expression irqflags; expression devname; expression dev_id; @@ request_irq(irq, handler, irqflags, devname, dev_id) @ rule4 @ typedef irqreturn_t; identifier rule3.handler, irq, dev, regs; @@ static irqreturn_t handler(int irq, void *dev, struct pt_regs *regs) { ... } @ rule5 depends on !rule4 @ identifier rule3.handler, irq, dev, regs; @@ * handler(int irq, void *dev, struct pt_regs *regs) { ... } // ---------------------------------------------------------------------- // Case 3: the code contains a reference to the regs parameter @@ identifier rule3.handler, irq, dev, regs; int E; @@ handler(int irq, void *dev, struct pt_regs *regs) { <... ( handle_irq(E,regs) | * regs ) ...> } coccinelle-1.0.0-rc19/tests/switchdecl.c0000644000175000017500000000020412247437436017023 0ustar eugeneugenvoid f(void) { switch (2) { int x; int x; case 2: x=y; break; case 4: j++; break; } } coccinelle-1.0.0-rc19/tests/nestone.c0000644000175000017500000000006212247437436016347 0ustar eugeneugenint foo() { if (x) { xxx(); return;} yyy(); } coccinelle-1.0.0-rc19/tests/inner2.cocci0000644000175000017500000000015512247437436016732 0ustar eugeneugen@@ identifier ty,x; expression a; initializer list is; @@ struct ty x = {is, - .i = a, + foo(a), ...}; coccinelle-1.0.0-rc19/tests/dec.cocci0000644000175000017500000000006212247437436016265 0ustar eugeneugen@@ @@ f(int x) { + int z; int y; return x; } coccinelle-1.0.0-rc19/tests/dbg.res0000644000175000017500000000023612247437436016002 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { struct resource *pr, *r = &dev->resource[idx]; if (pr) DBG("PCI"); else pr = NULL; } coccinelle-1.0.0-rc19/tests/ifend.res0000644000175000017500000000014612247437436016333 0ustar eugeneugen#ifdef VORTEX_DEBUG static int vortex_debug = VORTEX_DEBUG; #else static int vortex_debug = 1; #endif coccinelle-1.0.0-rc19/tests/twoproto.c0000644000175000017500000000037112247437436016574 0ustar eugeneugenstatic void tc574_config(dev_link_t *link); static int tc574_attach(struct pcmcia_device *p_dev) { dev_link_t *link = dev_to_instance(p_dev); } static void tc574_detach(struct pcmcia_device *p_dev) { dev_link_t *link = dev_to_instance(p_dev); } coccinelle-1.0.0-rc19/tests/if.c0000644000175000017500000000040112247437436015267 0ustar eugeneugenint main () { f(x); g(x); } int main1 () { f(x); if (x == NULL) { g(x); } } int main1 () { f(x); while (x == NULL) { if (q == 3) { g(x); } } x = 6; } int main2 () { f(x); if (x == NULL || y == 2) { g(x); } } coccinelle-1.0.0-rc19/tests/ac.c0000644000175000017500000000070212247437436015260 0ustar eugeneugenstatic Scsi_Host_Template acornscsi_template = { .module = THIS_MODULE, .proc_info = acornscsi_proc_info, .name = "AcornSCSI", .info = acornscsi_info, .queuecommand = acornscsi_queuecmd, #warning fixme .abort = acornscsi_abort, .reset = acornscsi_reset, .can_queue = 16, .this_id = 7, .sg_tablesize = SG_ALL, .cmd_per_lun = 2, .unchecked_isa_dma = 0, .use_clustering = DISABLE_CLUSTERING, .proc_name = "acornscsi", }; coccinelle-1.0.0-rc19/tests/constx.c0000644000175000017500000000014112247437436016210 0ustar eugeneugenint main() { foo(12); foo(x); foo(CONSTANT); foo('a'); foo("string"); foo(1.0001); } coccinelle-1.0.0-rc19/tests/ifdef4.c0000644000175000017500000000031212247437436016033 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/spacing.cocci0000644000175000017500000000031712247437436017161 0ustar eugeneugen@@ @@ typedef int *foo; +void *bar(int *baz) +{ + return baz; +} @@ identifier f,x; @@ f(int x) { ... } +void *bar(int *baz) +{ + return baz; +} @@ @@ two(); +if (y) { + test(); +} coccinelle-1.0.0-rc19/tests/bugon.c0000644000175000017500000000011612247437436016006 0ustar eugeneugenstatic void b44_tx(struct b44 *bp) { if (unlikely(skb == NULL)) BUG(); } coccinelle-1.0.0-rc19/tests/twomatch.cocci0000644000175000017500000000016012247437436017357 0ustar eugeneugen@r@ expression a,b,c; @@ ( foo(a,c); | bar(b,c); ) @@ expression r.a,r.b,r.c; @@ - xxx(\(a\|b\),c); + yyy(); coccinelle-1.0.0-rc19/tests/hex.c0000644000175000017500000000003212247437436015455 0ustar eugeneugenint main() { f(0x00); } coccinelle-1.0.0-rc19/tests/bad_subsumption.c0000644000175000017500000000165312247437436020101 0ustar eugeneugenstatic int __devinit snd_vx222_create(struct snd_card *card, struct pci_dev *pci, struct snd_vx_hardware *hw, struct snd_vx222 **rchip) { struct vx_core *chip; struct snd_vx222 *vx; static struct snd_device_ops ops = { .dev_free = snd_vx222_dev_free, }; chip = snd_vx_create(card, hw, vx_ops, sizeof(struct snd_vx222) - sizeof(struct vx_core)); if (! chip) { pci_disable_device(pci); return -ENOMEM; } vx = (struct snd_vx222 *)chip; vx->pci = pci; if ((err = pci_request_regions(pci, CARD_NAME)) < 0) { snd_vx222_free(chip); return 0; } for (i = 0; i < 2; i++) vx->port[i] = pci_resource_start(pci, i + 1); if (request_irq(pci->irq, snd_vx_irq_handler, IRQF_SHARED, CARD_NAME, chip)) { snd_vx222_free(chip); return -EBUSY; } chip->irq = pci->irq; if ((err = snd_device_new(card, SNDRV_DEV_LOWLEVEL, chip, &ops)) < 0) { snd_vx222_free(chip); return 0; } return 0; } coccinelle-1.0.0-rc19/tests/multidec.c0000644000175000017500000000007512247437436016506 0ustar eugeneugenint main () { int x = 3,z; int x = 12; int x = 12,y; } coccinelle-1.0.0-rc19/tests/minusall.c0000644000175000017500000000006512247437436016523 0ustar eugeneugenstatic int f () { int x = 12; int y; return x + y; } coccinelle-1.0.0-rc19/tests/cst.c0000644000175000017500000000014612247437436015470 0ustar eugeneugenint main(int x) { emu10k1_t *emu = snd_magic_cast(1, 2, return -ENXIO); int z = 12; return y; } coccinelle-1.0.0-rc19/tests/topdec.cocci0000644000175000017500000000013112247437436017005 0ustar eugeneugen@@ identifier I; @@ + static const struct ethtool_ops I; - static struct ethtool_ops I; coccinelle-1.0.0-rc19/tests/typeof.res0000644000175000017500000000006112247437436016550 0ustar eugeneugenint main() { int x; f(sizeof(struct foo)); } coccinelle-1.0.0-rc19/tests/threea.res0000644000175000017500000000003012247437436016506 0ustar eugeneugenint main() { f(12); } coccinelle-1.0.0-rc19/tests/longlongint.res0000644000175000017500000000003312247437436017573 0ustar eugeneugenint main() { return 0; } coccinelle-1.0.0-rc19/tests/expopt3_ver1.res0000644000175000017500000000026212247437436017604 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner *v; //&v.field; f(&v->field1, &v->field2, &v->field3, &v->field4); } coccinelle-1.0.0-rc19/tests/test1.res0000644000175000017500000000016412247437436016306 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { h(1, 3, 2); } else { h(1, 4, 2); } } coccinelle-1.0.0-rc19/tests/decl1.cocci0000644000175000017500000000016412247437436016525 0ustar eugeneugen@@ statement S; identifier ioctl; @@ ioctl(int cmd, void *arg) { ... int x; + foo(); S ... } coccinelle-1.0.0-rc19/tests/desc.c0000644000175000017500000000015312247437436015613 0ustar eugeneugenMODULE_PARM_DESC(devices, "number of dsp devices allocated by the driver"); module_param(devices, int, 0); coccinelle-1.0.0-rc19/tests/test_unsigned_meta.cocci0000644000175000017500000000036212247437436021416 0ustar eugeneugen@@ type T; @@ - unsigned T x; @@ type T; @@ - signed T y; @r@ type T; @@ unsigned T q; + T r; + unsigned T s1; + signed T s2; @@ type r.T; @@ - T m; @@ @@ + signed int x; + char new_x; @@ @@ + unsigned int y; + char new_y; coccinelle-1.0.0-rc19/tests/ifdef5.cocci0000644000175000017500000000036712247437436016704 0ustar eugeneugen@ Exemple5 @ @@ init_IRQ(...) {...} + #ifdef CONFIG_NKERNEL + #ifndef TIMER_32K_SYNCHRONIZED + #define TIMER_32K_SYNCHRONIZED 0xffffffff + #endif + unsigned long nk_vtick_read_stamp(void) + { + return omap_readl(TIMER_32K_SYNCHRONIZED); + } coccinelle-1.0.0-rc19/tests/arraysz.res0000644000175000017500000000053612247437436016744 0ustar eugeneugentypedef struct signature { const char *sig; /* String to look for */ unsigned long ofs; /* offset from BIOS base address */ unsigned len; /* length of string */ } Signature; static const Signature signatures[] = { {"SSTBIOS", 0x0000d, 7} /* "SSTBIOS" @ offset 0x0000d */ }; #define NUM_SIGNATURES ARRAY_SIZE(signatures) coccinelle-1.0.0-rc19/tests/badtypedef.cocci0000644000175000017500000000021412247437436017640 0ustar eugeneugen// need the merge_val facility for typedef and struct equivalence @@ type T; T E, E1; @@ - xxx(E); + aaa(E); ... - yyy(E1); + bbb(E1); coccinelle-1.0.0-rc19/tests/labels_metastatement_ver1.c0000644000175000017500000000004412247437436022026 0ustar eugeneugenint foo(int i) { if(1) x = 3; } coccinelle-1.0.0-rc19/tests/doundo.res0000644000175000017500000000014212247437436016532 0ustar eugeneugens8 *noevent; int main() { const s8 (*queue_priority_mapping)[2]; s8 *noevent; new_foo(); } coccinelle-1.0.0-rc19/tests/labels_metastatement_ver1.res0000644000175000017500000000010312247437436022371 0ustar eugeneugenint foo(int i) { if(1) { x = 3; foo(); } foo(); } coccinelle-1.0.0-rc19/tests/sizestar.c0000644000175000017500000000030412247437436016537 0ustar eugeneugenint main () { max = num_var_ranges; if (fcount == NULL) { fcount = kzalloc(max * sizeof *fcount, GFP_KERNEL); if (!fcount) return -ENOMEM; FILE_FCOUNT(file) = fcount; } } coccinelle-1.0.0-rc19/tests/fp.res0000644000175000017500000000004012247437436015644 0ustar eugeneugenint main(int (*x)(int,int)) { } coccinelle-1.0.0-rc19/tests/define_exp.cocci0000644000175000017500000000010412247437436017635 0ustar eugeneugen@@ @@ ( - SA_INTERRUPT + IRQF_DISABLED | - SA_SHIRQ + IRQF_SHARED ) coccinelle-1.0.0-rc19/tests/overshoot.c0000644000175000017500000000010112247437436016716 0ustar eugeneugenint main () { a(); s(); d(); f(); b(); b(); q(); } coccinelle-1.0.0-rc19/tests/rcu3_ver1.c0000644000175000017500000000067712247437436016521 0ustar eugeneugenint cryptocop_free_session(cryptocop_session_id sid) { struct list_head *node, *tmp; for (i = 0; i < cryptocop_prio_no_prios; i++){ if (!list_empty(&(cryptocop_job_queues[i].jobs))){ list_for_each_safe(f(node), _Y(tmp), &(cryptocop_job_queues[i].jobs)) { pj = list_entry(_Y(node), struct cryptocop_prio_job, _Y(node)); if (pj->oper->sid == sid) { list_move_tail(_Y(node), &remove_list); } } } } } coccinelle-1.0.0-rc19/tests/decl_space.res0000644000175000017500000000005312247437436017325 0ustar eugeneugenint main () { int *x = g; int x = g; } coccinelle-1.0.0-rc19/tests/dec.res0000644000175000017500000000006612247437436016002 0ustar eugeneugenint f(int x) { int z; static int y; return x; } coccinelle-1.0.0-rc19/tests/decl.res0000644000175000017500000000010212247437436016145 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { foo(); return 0; } coccinelle-1.0.0-rc19/tests/stm4.cocci0000644000175000017500000000004612247437436016423 0ustar eugeneugen@@ statement S; @@ f(); S + g(); coccinelle-1.0.0-rc19/tests/test5_ver1.res0000644000175000017500000000113312247437436017244 0ustar eugeneugen/* * If still have an edge from the startif to endif (AfterNode), * with a if-then-and-else, then rene will see this edge, * and that means that the ctl engine will see this direct path from * startif to endif as a valid execution path. So on this program, * CTL will reject the formula f(X) ... g(X) because * when we take the direct path (which should not exist I repeat), * we can't find a later g(1). */ void main() { f(1); if(1) { h(1); } else { h(1); } g(1); // if add this then the CTL even with the direct path will this time // accept, but we cheat. } coccinelle-1.0.0-rc19/tests/twomatch.c0000644000175000017500000000005212247437436016521 0ustar eugeneugenint main() { bar(12,1); xxx(12,1); } coccinelle-1.0.0-rc19/tests/multichars.c0000644000175000017500000000007512247437436017053 0ustar eugeneugenint main () { f('XYZ',ab); f('X\nY',ab); f('\n',ab); } coccinelle-1.0.0-rc19/tests/vpos.res0000644000175000017500000000006512247437436016235 0ustar eugeneugenint main() { f(2); if (x) { } else { } } coccinelle-1.0.0-rc19/tests/proto.c0000644000175000017500000000045512247437436016045 0ustar eugeneugenstatic void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_sched_event(struct BCState *bcs, int event); static void bch_empty_fifo(struct BCState *bcs, int count); static void bch_sched_event(struct BCState *bcs, int event) { bcs->event |= 1 << event; schedule_work(&bcs->work); } coccinelle-1.0.0-rc19/tests/bad_kfree.c0000644000175000017500000000046012247437436016600 0ustar eugeneugenint main () { for (i = 0; i < IVTV_VBI_FRAMES; i++) { a = itv[i]; kfree(itv[i]); } print("foo",itv[i]); print("foo",itv[i]); a = itv[i]; itv[i]=12; a = itv[i]; } int bad () { kfree(itv[i]); print("foo",itv[i]); print("foo",itv[i]); a = itv[i]; itv[i]=12; a = itv[i]; } coccinelle-1.0.0-rc19/tests/zero.res0000644000175000017500000000002012247437436016214 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/stat.res0000644000175000017500000000000012247437436016206 0ustar eugeneugencoccinelle-1.0.0-rc19/tests/rule19a.c0000644000175000017500000000067112247437436016164 0ustar eugeneugenstatic void gazel_interrupt_ipac(int intno, void *dev_id, struct pt_regs *regs) { struct IsdnCardState *cs = dev_id; u_char ista, val; int count = 0; if (!cs) { printk(KERN_WARNING "Gazel: Spurious interrupt!\n"); return; } do { if (ista & 0x10) { val = 0x01; isac_interrupt(cs, val); } } while ((ista & 0x3f) && (count < MAXCOUNT)); WriteISAC(cs, IPAC_MASK - 0x80, 0xFF); WriteISAC(cs, IPAC_MASK - 0x80, 0xC0); } coccinelle-1.0.0-rc19/tests/cards.cocci0000644000175000017500000000012612247437436016627 0ustar eugeneugen@@ identifier I; expression str; declarer name MODULE_PARM; @@ - MODULE_PARM(I,str); coccinelle-1.0.0-rc19/tests/bad_typedef.res0000644000175000017500000000035612247437436017517 0ustar eugeneugentypedef struct { struct semaphore lock; } scsi_changer; int main1 (scsi_changer *x) { foo(x->new_lock); } struct scsi_changer_two { struct semaphore lock; }; int main2 (struct scsi_changer_two *x) { foo(x->new_lock); } coccinelle-1.0.0-rc19/tests/nl.cocci0000644000175000017500000000001712247437436016143 0ustar eugeneugen@@ @@ - x + y coccinelle-1.0.0-rc19/tests/stm10_ver1.res0000644000175000017500000000010412247437436017141 0ustar eugeneugenint main(int x) { f(); { replace(); replace();} h(); g(); } coccinelle-1.0.0-rc19/tests/declinv.res0000644000175000017500000000005212247437436016666 0ustar eugeneugenint main () { int b, c ; int a; } coccinelle-1.0.0-rc19/tests/of.c0000644000175000017500000000046412247437436015306 0ustar eugeneugenstatic struct iommu_table *iommu_table_find(struct iommu_table * tbl) { for (node = NULL; (node = of_find_all_nodes(node)); ) { if (x) return it; } } static struct iommu_table *iommu_table_find(struct iommu_table * tbl) { for (node = NULL; (node = something(node)); ) { if (x) return it; } } coccinelle-1.0.0-rc19/tests/param1_ver1.c0000644000175000017500000000004212247437436017010 0ustar eugeneugenvoid foo(int x,int y) { return; } coccinelle-1.0.0-rc19/tests/ab.res0000644000175000017500000000006112247437436015624 0ustar eugeneugenint main () { foo = 5; b = 12; xxx = 12; } coccinelle-1.0.0-rc19/tests/argument.c0000644000175000017500000000006412247437436016520 0ustar eugeneugenvoid main(int i){ f(1,2,3); h(1,2); h(); } coccinelle-1.0.0-rc19/tests/b1.cocci0000644000175000017500000000007712247437436016042 0ustar eugeneugen@@ @@ while(...) { <... foo(); + bar(); break; ...> } coccinelle-1.0.0-rc19/tests/p9.c0000644000175000017500000000004712247437436015227 0ustar eugeneugenint f(int, int, int x) { return x; } coccinelle-1.0.0-rc19/tests/ppos.c0000644000175000017500000000053612247437436015663 0ustar eugeneugenstruct vma_to_fileoffset_map *create_vma_map(const struct spu *aSpu, unsigned long spu_elf_start) { for (i = 0; i < n_ovlys; i++) { map = vma_map_add(map, ovly.vma, ovly.size, ovly.offset, ovly_buf_table_sym + (ovly.buf-1) * 4, i+1); if (!map) { map = NULL; goto fail; } } goto out; fail: map = NULL; out: return map; } coccinelle-1.0.0-rc19/tests/varargs.cocci0000644000175000017500000000007112247437436017177 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.0-rc19/tests/void.c0000644000175000017500000000012612247437436015636 0ustar eugeneugenint xbar(void) { return; } // this is some info about bar int bar(void) { return; } coccinelle-1.0.0-rc19/tests/join.cocci0000644000175000017500000000017612247437436016477 0ustar eugeneugen@@ expression X, Y, Z; @@ f(X); ... g(Y); ... - h(Z); + h(1); // si c'est '+ h(X,Y,Z)' alors la il y'a probleme par contre coccinelle-1.0.0-rc19/tests/bad_noputm10000644000175000017500000001276112247437436016675 0ustar eugeneugendiff -u -p -b a/arch/sparc64/kernel/isa.c b/arch/sparc64/kernel/isa.c OK send --- a/arch/sparc64/kernel/isa.c 2007-08-12 13:27:06.000000000 +0200 +++ b/arch/sparc64/kernel/isa.c 2007-11-18 18:32:16.000000000 +0100 @@ -155,6 +155,7 @@ void __init isa_init(void) isa_br = kzalloc(sizeof(*isa_br), GFP_KERNEL); if (!isa_br) { printk(KERN_DEBUG "isa: cannot allocate sparc_isa_bridge"); + pci_dev_put(pdev); return; } @@ -168,6 +169,7 @@ void __init isa_init(void) printk(KERN_DEBUG "isa: device registration error for %s!\n", dp->path_component_name); kfree(isa_br); + pci_dev_put(pdev); return; } diff -u -p -b a/drivers/char/agp/amd64-agp.c b/drivers/char/agp/amd64-agp.c --- a/drivers/char/agp/amd64-agp.c 2007-11-01 10:30:39.000000000 +0100 +++ b/drivers/char/agp/amd64-agp.c 2007-11-18 18:32:36.000000000 +0100 NOT SURE @@ -771,6 +771,7 @@ int __init agp_amd64_init(void) /* Only one bridge supported right now */ if (agp_amd64_probe(dev, NULL) == 0) { err = 0; + pci_dev_put(dev); break; } } diff -u -p -b a/drivers/char/applicom.c b/drivers/char/applicom.c --- a/drivers/char/applicom.c 2006-11-30 19:04:20.000000000 +0100 +++ b/drivers/char/applicom.c 2007-11-18 18:32:39.000000000 +0100 @@ -204,7 +204,9 @@ static int __init applicom_init(void) continue; if (pci_enable_device(dev)) - return -EIO; + { + pci_dev_put(dev); + return -EIO;} RamIO = ioremap(dev->resource[0].start, LEN_RAM_IO); @@ -213,6 +215,7 @@ static int __init applicom_init(void) "space at 0x%llx\n", (unsigned long long)dev->resource[0].start); pci_disable_device(dev); + pci_dev_put(dev); return -EIO; } diff -u -p -b a/drivers/macintosh/via-pmu.c b/drivers/macintosh/via-pmu.c --- a/drivers/macintosh/via-pmu.c 2007-10-22 11:25:10.000000000 +0200 +++ b/drivers/macintosh/via-pmu.c 2007-11-18 18:33:24.000000000 +0100 OK sent @@ -1897,7 +1897,9 @@ pbook_pci_restore(void) pci_write_config_dword(pd, 4, ps->config[1]); #else if (npci-- == 0) - return; + { + pci_dev_put(pd); + return;} ps++; if (ps->command == 0) continue; diff -u -p -b a/drivers/mmc/host/ricoh_mmc.c b/drivers/mmc/host/ricoh_mmc.c --- a/drivers/mmc/host/ricoh_mmc.c 2007-11-18 16:56:19.000000000 +0100 +++ b/drivers/mmc/host/ricoh_mmc.c 2007-11-18 18:33:44.000000000 +0100 @@ -68,6 +68,7 @@ static int __devinit ricoh_mmc_probe(str if (disable & 0x02) { printk(KERN_INFO DRIVER_NAME ": Controller already disabled. Nothing to do.\n"); + pci_dev_put(fw_dev); return -ENODEV; } @@ -81,6 +82,7 @@ static int __devinit ricoh_mmc_probe(str printk(KERN_INFO DRIVER_NAME ": Controller is now disabled.\n"); + pci_dev_put(fw_dev); break; } } diff -u -p -b a/drivers/net/s2io.c b/drivers/net/s2io.c --- a/drivers/net/s2io.c 2007-11-15 15:09:36.000000000 +0100 +++ b/drivers/net/s2io.c 2007-11-18 18:34:15.000000000 +0100 BIZARRE submitted @@ -983,6 +983,7 @@ static int s2io_on_nec_bridge(struct pci if (tdev->vendor == NEC_VENID && tdev->device == NEC_DEVID) { if (tdev->bus == s2io_pdev->bus->parent) pci_dev_put(tdev); + pci_dev_put(tdev); return 1; } } diff -u -p -b a/drivers/pci/pci-sysfs.c b/drivers/pci/pci-sysfs.c OK sent --- a/drivers/pci/pci-sysfs.c 2007-07-20 17:45:56.000000000 +0200 +++ b/drivers/pci/pci-sysfs.c 2007-11-18 18:34:41.000000000 +0100 @@ -703,7 +703,9 @@ static int __init pci_sysfs_init(void) for_each_pci_dev(pdev) { retval = pci_create_sysfs_dev_files(pdev); if (retval) - return retval; + { + pci_dev_put(pdev); + return retval;} } return 0; diff -u -p -b a/drivers/pnp/resource.c b/drivers/pnp/resource.c OK sent --- a/drivers/pnp/resource.c 2007-10-22 11:25:20.000000000 +0200 +++ b/drivers/pnp/resource.c 2007-11-18 18:34:46.000000000 +0100 @@ -368,7 +368,9 @@ int pnp_check_irq(struct pnp_dev *dev, i struct pci_dev *pci = NULL; for_each_pci_dev(pci) { if (pci->irq == *irq) - return 0; + { + pci_dev_put(pci); + return 0;} } } #endif diff -u -p -b a/drivers/scsi/dpt_i2o.c b/drivers/scsi/dpt_i2o.c --- a/drivers/scsi/dpt_i2o.c 2007-10-22 11:25:23.000000000 +0200 +++ b/drivers/scsi/dpt_i2o.c 2007-11-18 18:36:30.000000000 +0100 NOT SURE code is written in an inconsistent manner, such that adpt_install_hba might do a put on pDev, or might not @@ -189,6 +189,7 @@ static int adpt_detect(void) if(adpt_install_hba(pDev) ){ PERROR("Could not Init an I2O RAID device\n"); PERROR("Will not try to detect others.\n"); + pci_dev_put(pDev); return hba_count-1; } pci_dev_get(pDev); diff -u -p -b a/drivers/watchdog/iTCO_wdt.c b/drivers/watchdog/iTCO_wdt.c NO. iTCO_wdt_init does put. --- a/drivers/watchdog/iTCO_wdt.c 2007-11-08 08:00:52.000000000 +0100 +++ b/drivers/watchdog/iTCO_wdt.c 2007-11-18 18:37:09.000000000 +0100 @@ -740,6 +740,7 @@ static int __devinit iTCO_wdt_probe(stru if (ent) { if (!(iTCO_wdt_init(pdev, ent, dev))) { found++; + pci_dev_put(pdev); break; } } diff -u -p -b a/sound/core/memalloc.c b/sound/core/memalloc.c OK sent --- a/sound/core/memalloc.c 2007-10-22 11:25:51.000000000 +0200 +++ b/sound/core/memalloc.c 2007-11-18 18:38:21.000000000 +0100 @@ -568,6 +568,7 @@ static ssize_t snd_mem_proc_write(struct if (pci_set_dma_mask(pci, mask) < 0 || pci_set_consistent_dma_mask(pci, mask) < 0) { printk(KERN_ERR "snd-page-alloc: cannot set DMA mask %lx for pci %04x:%04x\n", mask, vendor, device); + pci_dev_put(pci); return count; } } coccinelle-1.0.0-rc19/tests/metastatement_if.cocci0000644000175000017500000000006012247437436021061 0ustar eugeneugen @@ expression E1; statement S; @@ - if(E1) - Scoccinelle-1.0.0-rc19/tests/array_size.c0000644000175000017500000000014112247437436017042 0ustar eugeneugen#define MAX_SETUP_STRINGS (sizeof(setup_strings) / sizeof(char *)) #define SETUP_BUFFER_SIZE 200 coccinelle-1.0.0-rc19/tests/define_param.c0000644000175000017500000000047512247437436017316 0ustar eugeneugen#define fieldsize(a) (sizeof(a)/sizeof(*a)) static int atari_proc_infos(unsigned char *nvram, char *buffer, int *len, off_t *begin, off_t offset, int size) { for (i = fieldsize(boot_prefs) - 1; i >= 0; --i) { if (nvram[1] == boot_prefs[i].val) { PRINT_PROC("%s\n", boot_prefs[i].name); break; } } } coccinelle-1.0.0-rc19/tests/tdnl.c0000644000175000017500000000014712247437436015641 0ustar eugeneugenvoid main() { unknown_tyepdef_1 td1; td1.attr = (unknown_typedef_2) td2.attr; foo(); } coccinelle-1.0.0-rc19/tests/type.res0000644000175000017500000000004512247437436016225 0ustar eugeneugenint foo() { int *x; return 0; } coccinelle-1.0.0-rc19/tests/ifields.res0000644000175000017500000000040212247437436016660 0ustar eugeneugen typedef struct tag_obj { int x; int y; IFace IFace_iface; int a; } Tobj; static struct IFaceImpl obj = { 1, 2, { &x, 4, }, 3 }; static struct IFaceImpl obj1 = { 1, 2, 6, &x, 3 }; coccinelle-1.0.0-rc19/tests/minusdots.c0000644000175000017500000000013512247437436016722 0ustar eugeneugenvoid main(int i) { if (!hostptr) { if (hostptr) { return -ESRCH; } } } coccinelle-1.0.0-rc19/tests/substruct.cocci0000644000175000017500000000006412247437436017572 0ustar eugeneugen@@ expression E; @@ { - .a = E, + DECLARE_A(E), } coccinelle-1.0.0-rc19/tests/same_expr.c0000644000175000017500000000005112247437436016655 0ustar eugeneugenvoid main(int i) { f(1,1); f(1,2); } coccinelle-1.0.0-rc19/tests/test11.c0000644000175000017500000000012112247437436016011 0ustar eugeneugenvoid main(int i) { f(1); g(1); g(1); // if comment then simpler h(1); } coccinelle-1.0.0-rc19/tests/inline.cocci0000644000175000017500000000003412247437436017007 0ustar eugeneugen@@ @@ - foo(int x) { ... } coccinelle-1.0.0-rc19/tests/bugloop.c0000644000175000017500000000064612247437436016353 0ustar eugeneugen/* this doesn't work, because on the paths where we don't find refrigerator, we expect to reach Exit without first going through current->flags & PF_FREEZE, but of course any path that goes around the loop does precisely that */ static int stir_transmit_thread(void *arg) { while (x) { /* if suspending, then power off and wait */ if (unlikely(current->flags & PF_FREEZE)) { refrigerator(PF_FREEZE); } } } coccinelle-1.0.0-rc19/tests/break.res0000644000175000017500000000064312247437436016334 0ustar eugeneugenint main () { while (1) { x = 12; do { x = 15; if (x > 1 ) { foo(); break; } } while (a == 3); if (x > 1 ) { foo(); bar(); break; } if (x > 1 ) { foo(); bar(); break; } } } int mainx () { while (1) { x = 12; do { x = 15; if (x > 1 ) { xxx(); continue; } } while (a == 3); if (x > 1 ) { xxx(); break; } if (x > 1 ) { xxx(); bar(); continue; } } } coccinelle-1.0.0-rc19/tests/check_order2.cocci0000644000175000017500000000015412247437436020066 0ustar eugeneugen@s@ expression E; @@ g(E); @r@ expression s.E, E1; @@ f(E,E1); @script:python@ E1 << r.E1; @@ print E1 coccinelle-1.0.0-rc19/tests/getc.cocci0000644000175000017500000000022112247437436016451 0ustar eugeneugen@@ typedef VOID; typedef LPVOID; typedef PVOID; {void *, VOID *, LPVOID, PVOID} ppv; identifier QI =~ "_QueryInterface$"; @@ - QI(..., ppv) + 12 coccinelle-1.0.0-rc19/tests/ifbr.c0000644000175000017500000000004512247437436015617 0ustar eugeneugenint main () { if (x) return; } coccinelle-1.0.0-rc19/tests/fieldsmin.c0000644000175000017500000000006212247437436016646 0ustar eugeneugenstruct foo x = { .a = 1, .b = 2, .c = 3, }; coccinelle-1.0.0-rc19/tests/ab.cocci0000644000175000017500000000001712247437436016114 0ustar eugeneugen@@ @@ - a + b coccinelle-1.0.0-rc19/tests/exitp.res0000644000175000017500000000006612247437436016400 0ustar eugeneugenint main () { g(a1); g(a2); g(done); g(a4); } coccinelle-1.0.0-rc19/tests/pdbgg.c0000644000175000017500000000773212247437436015772 0ustar eugeneugen/* regression if remove the definintion of PDBGG in standard.h: Great: a test file now works: /home/pad/linux/arch/mips/alchemy/common/au1xxx_irqmap.c PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/arch/powerpc/boot/ps3.c Error : bad = 11, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/i2c/busses/i2c-ibm_iic.c Error : bad = 52, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/media/video/et61x251/et61x251_core.c Error : bad = 197, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/media/video/sn9c102/sn9c102_core.c Error : bad = 247, timeout = false Great: a test file now works: /home/pad/linux/drivers/media/video/w9968cf.c PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/media/video/zc0301/zc0301_core.c Error : bad = 96, timeout = false Great: a test file now works: /home/pad/linux/drivers/mtd/devices/docprobe.c Great: a test file now works: /home/pad/linux/drivers/mtd/nand/diskonchip.c PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/net/ibm_newemac/core.c Error : bad = 14, timeout = false Great: a test file now works: /home/pad/linux/drivers/scsi/in2000.c Great: a test file now works: /home/pad/linux/drivers/scsi/scsi_lib.c Great: a test file now works: /home/pad/linux/drivers/scsi/wd33c93.c PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/usb/gadget/composite.c Error : bad = 173, timeout = false Semipb: still error but not same error : /home/pad/linux/drivers/usb/gadget/omap_udc.c Old error: bad = 1, timeout = fals New error: bad = 115, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/usb/gadget/printer.c Error : bad = 168, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/usb/musb/cppi_dma.c Error : bad = 20, timeout = false Semipb: still error but not same error : /home/pad/linux/drivers/usb/musb/musb_core.c Old error: bad = 2, timeout = fals New error: bad = 315, timeout = false PBBBBBBBB: a test file does not work anymore!!! : /home/pad/linux/drivers/usb/musb/musb_gadget.c Error : bad = 104, timeout = false Great: a test file now works: /home/pad/linux/kernel/auditfilter.c Great: a test file now works: /home/pad/linux/sound/soc/sh/hac.c Great: a test file now works: /home/pad/linux/sound/soc/sh/ssi.c cp /home/pad/linux/arch/mips/alchemy/common/au1xxx_irqmap.c /home/pad/linux/arch/powerpc/boot/ps3.c /home/pad/linux/drivers/i2c/busses/i2c-ibm_iic.c /home/pad/linux/drivers/media/video/et61x251/et61x251_core.c /home/pad/linux/drivers/media/video/sn9c102/sn9c102_core.c /home/pad/linux/drivers/media/video/w9968cf.c /home/pad/linux/drivers/media/video/zc0301/zc0301_core.c /home/pad/linux/drivers/mtd/devices/docprobe.c /home/pad/linux/drivers/mtd/nand/diskonchip.c /home/pad/linux/drivers/net/ibm_newemac/core.c /home/pad/linux/drivers/scsi/in2000.c /home/pad/linux/drivers/scsi/scsi_lib.c /home/pad/linux/drivers/scsi/wd33c93.c /home/pad/linux/drivers/usb/gadget/composite.c /home/pad/linux/drivers/usb/gadget/omap_udc.c /home/pad/linux/drivers/usb/gadget/printer.c /home/pad/linux/drivers/usb/musb/cppi_dma.c /home/pad/linux/drivers/usb/musb/musb_core.c /home/pad/linux/drivers/usb/musb/musb_gadget.c /home/pad/linux/kernel/auditfilter.c /home/pad/linux/sound/soc/sh/hac.c /home/pad/linux/sound/soc/sh/ssi.c */ int main() { PDBGG("this is a test %d\n",x); } int main() { PDBGG("this is a test %d\n",x) } int main() { PDBGG(static unsigned int prev_mask = 0); } int main() { PDBGG("Isochrnous frame: length %u, #%u i", len, i) /* NOTE: It is probably correct to assume that SOF and EOF headers do not occur between two consecutive packets, but who knows..Whatever is the truth, this assumption doesn't introduce bugs. */ redo: sof = sn9c102_find_sof_header(cam, pos, len); } coccinelle-1.0.0-rc19/tests/expopt3.cocci0000644000175000017500000000020312247437436017131 0ustar eugeneugen@@ identifier v,fld; @@ - struct video_tuner v; + struct video_tuner *v; <... ( - v.fld + v->fld | - v + *v ) ...>coccinelle-1.0.0-rc19/tests/format2.res0000644000175000017500000000004712247437436016620 0ustar eugeneugenint main () { foo("blah %x blah"); } coccinelle-1.0.0-rc19/tests/assign.cocci0000644000175000017500000000005612247437436017021 0ustar eugeneugen@@ expression E; @@ x = - E + E + 25 coccinelle-1.0.0-rc19/tests/badwhen.cocci0000644000175000017500000000005212247437436017141 0ustar eugeneugen@@ @@ -f(); ... when != false foo() -g();coccinelle-1.0.0-rc19/tests/spl.cocci0000644000175000017500000000062512247437436016335 0ustar eugeneugen// this illustrates how when strict is not so effective. if the comment is // removed, only the first return gets its spin_unlock, because the pattern // is not found under the then of the first if in the C code. it is not // good enough that there is a matching pattern around the then @@ expression l; @@ spin_lock(l); ... when any // when strict if (...) { + spin_unlock(l); return ...; } coccinelle-1.0.0-rc19/tests/empty.iso0000644000175000017500000000000012247437436016372 0ustar eugeneugencoccinelle-1.0.0-rc19/tests/labels_metastatement.res0000644000175000017500000000031212247437436021436 0ustar eugeneugenint foo(int i) { if(1) {{ x = 3; foo(); z = 4; foo(); } foo(); } // we dont want that it add both foo on the } and on the endif // (note: but need correct endif accrochage) foo(); } coccinelle-1.0.0-rc19/tests/parse_field.c0000644000175000017500000000013412247437436017151 0ustar eugeneugenvoid blk_queue_prep_rq(struct request_queue *q, prep_rq_fn *pfn) { q->prep_rq_fn = pfn; } coccinelle-1.0.0-rc19/tests/retval.res0000644000175000017500000000024612247437436016544 0ustar eugeneugenint main () { if (retval1) { foo(); return 3; } return 6; } int second () { if (retval1) { foo(); goto out; } out: return 6; } coccinelle-1.0.0-rc19/tests/type_annotated_fields.c0000644000175000017500000000152612247437436021246 0ustar eugeneugentypedef struct bluecard_info_t { dev_link_t link; dev_node_t node; struct hci_dev *hdev; spinlock_t lock; /* For serializing operations */ struct timer_list timer; /* For LED control */ struct sk_buff_head txq; unsigned long tx_state; unsigned long rx_state; unsigned long rx_count; struct sk_buff *rx_skb; unsigned char ctrl_reg; unsigned long hw_state; /* Status of the hardware and LED control */ } bluecard_info_t; static int bluecard_hci_send_frame(struct sk_buff *skb) { bluecard_info_t *info; struct hci_dev *hdev = (struct hci_dev *)(skb->dev); skb->pkt_type; hdev->stat.cmd_tx++; } static void bluecard_receive(bluecard_info_t *info, unsigned int offset) { unsigned char buf[31]; int i, len; bluecard_info_t info2; info->rx_skb->pkt_type = buf[i]; info2.tx_state; } coccinelle-1.0.0-rc19/tests/bad_typedef.c0000644000175000017500000000034612247437436017147 0ustar eugeneugentypedef struct { struct semaphore lock; } scsi_changer; int main1 (scsi_changer *x) { foo(x->lock); } struct scsi_changer_two { struct semaphore lock; }; int main2 (struct scsi_changer_two *x) { foo(x->lock); } coccinelle-1.0.0-rc19/tests/serio.c0000644000175000017500000000024112247437436016014 0ustar eugeneugen#include #include #include static void serio_init_port(struct serio *serio) { init_MUTEX(&serio->drv_sem); } coccinelle-1.0.0-rc19/tests/delete_function.res0000644000175000017500000000007212247437436020413 0ustar eugeneugenint first () { return 0; } int last () { return 0; } coccinelle-1.0.0-rc19/tests/badwhen.c0000644000175000017500000000015012247437436016302 0ustar eugeneugenint main () { f(); if (foo()) return; g(); } int second() { f(); if (xfoo()) return; g(); } coccinelle-1.0.0-rc19/tests/spaces.res0000644000175000017500000000003612247437436016522 0ustar eugeneugenint main () { foo(x + y); } coccinelle-1.0.0-rc19/tests/cst_null.res0000644000175000017500000000154512247437436017075 0ustar eugeneugenvoid* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kzalloc(size,GFP_KERNEL); if (vb != NULL) { videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } void* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kzalloc(size,GFP_KERNEL); if (vb) { videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } void* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kzalloc(size,GFP_KERNEL); if (NULL != vb) { videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } coccinelle-1.0.0-rc19/tests/multi_func.cocci0000644000175000017500000000011612247437436017677 0ustar eugeneugen@@ @@ fn1(int i) { - foo_lock(); ... } fn2(int i) { - foo_unlock(); } coccinelle-1.0.0-rc19/tests/disjid.cocci0000644000175000017500000000010712247437436017000 0ustar eugeneugen@@ @@ \(foo\|bar\)(int \(x\|y\), int z) { - return 0; + return 1; } coccinelle-1.0.0-rc19/tests/three_types.res0000644000175000017500000000030212247437436017573 0ustar eugeneugentypedef struct _drm_via_blitq { struct work_struct wq; } drm_via_blitq_t; void via_init_dmablit(drm_device_t *dev) { drm_via_blitq_t *blitq; INIT_WORK(&blitq->wq, via_dmablit_workqueue); } coccinelle-1.0.0-rc19/tests/exitp.cocci0000644000175000017500000000021612247437436016664 0ustar eugeneugen@r@ identifier x; @@ -f(x); +g(x); @script:python@ x << r.x; @@ if ("%s" % x) == "done": cocci.exit() @@ identifier x; @@ g(x + ,y ); coccinelle-1.0.0-rc19/tests/retmac.c0000644000175000017500000000070212247437436016150 0ustar eugeneugen#define I830FALLBACK(s, arg...) \ do { \ if (I830PTR(pScrn)->fallback_debug) { \ xf86DrvMsg(pScrn->scrnIndex, X_INFO, \ "EXA fallback: " s "\n", ##arg); \ } \ return FALSE; \ } while(0) int main () { I830FALLBACK(a,b); } coccinelle-1.0.0-rc19/tests/pragmatest1.cocci0000644000175000017500000000003112247437436017756 0ustar eugeneugen@@ @@ - #pragma xxx ... coccinelle-1.0.0-rc19/tests/metahex.cocci0000644000175000017500000000004412247437436017165 0ustar eugeneugen@@ expression E; @@ - f(E); - g(E);coccinelle-1.0.0-rc19/tests/optional_qualifier.c0000644000175000017500000000002412247437436020560 0ustar eugeneugenint a; const int b; coccinelle-1.0.0-rc19/tests/multitype.cocci0000644000175000017500000000013612247437436017570 0ustar eugeneugen@ rule1 @ type T; T *E; identifier fld; @@ f(E->fld) @@ rule1.T *E; @@ - g(E) + g(E, NULL) coccinelle-1.0.0-rc19/tests/kmc.res0000644000175000017500000000034612247437436016022 0ustar eugeneugenint dmabounce_register_dev(struct device *dev, unsigned long small_buffer_size, unsigned long large_buffer_size) { if (large_buffer_size) { if (ret) goto err_destroy; } return 0; err_destroy: kfreea(device_info); } coccinelle-1.0.0-rc19/tests/mini_null_ref.c0000644000175000017500000000065012247437436017521 0ustar eugeneugenstatic int __devinit w90p910_keypad_probe(struct platform_device *pdev) { const struct w90p910_keypad_platform_data *pdata = pdev->dev.platform_data; const struct matrix_keymap_data *keymap_data = pdata->keymap_data; if (!pdata) { dev_err(&pdev->dev, "no platform data defined\n"); return -EINVAL; } return; } coccinelle-1.0.0-rc19/tests/mult.cocci0000644000175000017500000000015012247437436016511 0ustar eugeneugen@ rule1 @ expression E; @@ - xxx(E); - yyy(); + bar(); @ rule2 extends rule1 @ @@ - goo(E); + har(); coccinelle-1.0.0-rc19/tests/ifdef6.res0000644000175000017500000000037312247437436016413 0ustar eugeneugen#include #include #ifdef CONFIG_NKERNEL #define foo(x) f(x) #endif #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/longint.cocci0000644000175000017500000000014012247437436017201 0ustar eugeneugen@ rule2 @ identifier I; expression E; @@ MODULE_PARM(I, E); @@ identifier rule2.I; @@ int I; coccinelle-1.0.0-rc19/tests/cr.cocci0000644000175000017500000000030512247437436016136 0ustar eugeneugen@@ identifier x; expression E1, E2, E3; @@ - x = request_region(E1,E2,E3); <... - if (...) { - ... when != release_region(E1,E2); - return ...; - } ...> ?- release_region(E1,E2); coccinelle-1.0.0-rc19/tests/format2.c0000644000175000017500000000011012247437436016240 0ustar eugeneugenint main () { foo("blah %x blah"); foo("blah %1x blah %2x blah"); } coccinelle-1.0.0-rc19/tests/inner.c0000644000175000017500000000004012247437436016003 0ustar eugeneugenstruct ty x[] = { { a, }}; coccinelle-1.0.0-rc19/tests/const_array.res0000644000175000017500000000105112247437436017566 0ustar eugeneugenstatic const char *r128_family[] __devinitdata = { "AGP", "PCI", }; static const char *r128_family1[] = { "AGP", "PCI", }; static char *r128_family2[] = { "AGP", "PCI", }; static struct foo *r128_family3[] = { "AGP", "PCI", }; static const struct foo *r128_family4[] = { "AGP", "PCI", }; int main () { ent->driver_data = ARRAY_SIZE(r128_family); ent->driver_data = ARRAY_SIZE(r128_family1); ent->driver_data = ARRAY_SIZE(r128_family2); ent->driver_data = ARRAY_SIZE(r128_family3); ent->driver_data = ARRAY_SIZE(r128_family4); } coccinelle-1.0.0-rc19/tests/multr.cocci0000644000175000017500000000012312247437436016673 0ustar eugeneugen@ rule1 @ expression x; @@ foo(x); @@ expression rule1.x; @@ xxx(); + foo(x); coccinelle-1.0.0-rc19/tests/pragmatest.res0000644000175000017500000000022512247437436017413 0ustar eugeneugenint two () { return 12; } int one () __attribute__((always_inline)) ; int one () { return 12; } int three () { return 12; } #pragma abc ddd def coccinelle-1.0.0-rc19/tests/ifend.c0000644000175000017500000000020112247437436015754 0ustar eugeneugen#ifdef VORTEX_DEBUG static int vortex_debug = VORTEX_DEBUG; #else static int vortex_debug = 1; #endif #include coccinelle-1.0.0-rc19/tests/proto2.c0000644000175000017500000000045512247437436016127 0ustar eugeneugenstatic void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_sched_event(struct BCState *bcs, int event); static void bch_empty_fifo(struct BCState *bcs, int count); static void bch_sched_event(struct BCState *bcs, int event) { bcs->event |= 1 << event; schedule_work(&bcs->work); } coccinelle-1.0.0-rc19/tests/nestseq.res0000644000175000017500000000006212247437436016725 0ustar eugeneugenint main () { f(); g(12); h(); xxx(12); } coccinelle-1.0.0-rc19/tests/list_test.c0000644000175000017500000000343712247437436016717 0ustar eugeneugenint main () { f(a); g(a,b); h(x,a,y,b,z); h(a,y,b,z); h(x,a,b,z); h(x,a,y,b); h(a,b,z); h(x,a,b); h(a,b); } int f(int a) { return; } int g(int a,int b) { return; } int h(int x, int a, int y, int b, int z) { return; } int h(int a, int y, int b, int z) { return; } int h(int x, int a, int b, int z) { return; } int h(int x, int a, int y, int b) { return; } int h(int a, int b, int z) { return; } int h(int x, int a, int b) { return; } int h(int a, int b) { return; } int f[] = { a }; int g[] = { a, b }; int h[] = { x, a, y, b, z }; int h[] = { a, y, b, z, }; int h[] = { x, a, b, z }; int h[] = { x, a, y, b, }; int h[] = { a, b, z }; int h[] = { x, a, b, }; int h[] = { a, b }; int i[] = { x, a, y, b, z }; int i[] = { a, y, b, z, }; int i[] = { x, a, b, z }; int i[] = { x, a, y, b, }; int i[] = { a, b, z }; int i[] = { x, a, b, }; int i[] = { a, b }; struct f { int a; }; struct g { int a; int b; }; struct h { int x; int a; int y; int b; int z; }; struct h { int a; int y; int b; int z; }; struct h { int x; int a; int b; int z; }; struct h { int x; int a; int y; int b; }; struct h { int a; int b; int z; }; struct h { int x; int a; int b; }; struct h { int a; int b; }; enum f { a }; enum g { a, b }; enum h { x, a, y, b, z, }; enum h { a, y, b, z }; enum h { x, a, b, z, }; enum h { x, a, y, b }; enum h { a, b, z, }; enum h { x, a, b }; enum h { a, b, }; enum i { x, a, y, b, z, }; enum i { a, y, b, z }; enum i { x, a, b, z, }; enum i { x, a, y, b, }; enum i { a, b, z, }; enum i { x, a, b, }; enum i { a, b, }; #define f(a) 3 #define g(a,b) 3 #define h(x,a,y,b,z) 3 #define h(a,y,b,z) 3 #define h(x,a,b,z) 3 #define h(x,a,y,b) 3 #define h(a,b,z) 3 #define h(x,a,b) 3 #define h(a,b) 3 coccinelle-1.0.0-rc19/tests/keep_comma.cocci0000644000175000017500000000003112247437436017626 0ustar eugeneugen@@ @@ - foo(); + xxx(); coccinelle-1.0.0-rc19/tests/ifdef2.cocci0000644000175000017500000000023612247437436016674 0ustar eugeneugen@ Exemple2 @ @@ #include + #ifdef CONFIG_NKERNEL + #include + #include + unsigned long maxsize = 0; + #endif coccinelle-1.0.0-rc19/tests/longint.c0000644000175000017500000000016012247437436016345 0ustar eugeneugen MODULE_PARM(cm206_base, "i"); /* base */ static void do_cm206_request(request_queue_t * q) { long int i; } coccinelle-1.0.0-rc19/tests/b2.cocci0000644000175000017500000000011012247437436016027 0ustar eugeneugen@@ @@ if(...) { <... foo(); + bar(); brk(); ...> } else aaa(); coccinelle-1.0.0-rc19/tests/expopt.cocci0000644000175000017500000000007512247437436017055 0ustar eugeneugen@@ expression E; @@ f(E); ... ( - *E + E | - E + *E ) coccinelle-1.0.0-rc19/tests/ip2.res0000644000175000017500000000041112247437436015733 0ustar eugeneugenvoid GetInfoDestTV(short sNoFo) { if(sNoFo == 1) { trace("ifelel"); printf("one"); } else if(sNoFo == 2) { trace("ifelel"); printf("two"); } else if(sNoFo == 2) { trace("ifelel"); printf("three"); } else printf("other"); } coccinelle-1.0.0-rc19/tests/pragmatest1.c0000644000175000017500000000005112247437436017122 0ustar eugeneugen#pragma xxx a b c #pragma xxx (a, b, c) coccinelle-1.0.0-rc19/tests/proto.cocci0000644000175000017500000000022712247437436016700 0ustar eugeneugen@r@ identifier fn2; identifier bcs, ev; @@ - fn2(struct BCState *bcs, int ev) { - ... - bcs->event |= 1 << ev; - schedule_work(&bcs->work); - } coccinelle-1.0.0-rc19/tests/metaline.cocci0000644000175000017500000000045612247437436017337 0ustar eugeneugen@r@ expression E; statement S; @@ f(3 +@E@S 4); @@ expression r.E; @@ - g(E) + h(E) @@ expression x; statement r.S; @@ - if + while (x) S @s@ expression E; position p; @@ -m(3 +@E@p 3); @@ expression s.E; @@ - g(E) + q(E) @a@ declaration d; @@ -int x@d; @@ declaration a.d; @@ int y; +d coccinelle-1.0.0-rc19/tests/cr.c0000644000175000017500000000051312247437436015301 0ustar eugeneugenint main() { int x; x = request_region(a,b,c); if (!x) { foo(); } if (x) { foo(); return 1; } if (x) { foo(); release_region(a,b); return 2; } if (x) { foo(); release_region(a,b); return 3; } release_region(a,b); if (!y) { foo(); } if (y) { foo(); return 1; } if (y) { foo(); release_region(a,b); return 1; } } coccinelle-1.0.0-rc19/tests/sizeof.cocci0000644000175000017500000000011212247437436017025 0ustar eugeneugen@@ expression X; //type X; @@ //- sizeof(...) - sizeof(X) + sizeof(int) coccinelle-1.0.0-rc19/tests/orexp.c0000644000175000017500000000003512247437436016031 0ustar eugeneugenint main() { bar(12+12); } coccinelle-1.0.0-rc19/tests/test3.cocci0000644000175000017500000000011312247437436016571 0ustar eugeneugen@@ expression X,Y; @@ f(X); ... - g(Y); + h(X, Y); //error words = [f]coccinelle-1.0.0-rc19/tests/line_before_last.c0000644000175000017500000000015312247437436020171 0ustar eugeneugenint main () { foo(); xxx(); } int main () { xxx(); foo(); } int main () { xxx(); foo(); } coccinelle-1.0.0-rc19/tests/badpos.res0000644000175000017500000000021612247437436016514 0ustar eugeneugenstatic irqreturn_t elmc_interrupt(int irq, void *dev_id, struct pt_regs *reg_ptr) { printk(KERN_ERR "foo", (int) -(xxx->orig_eax + 2)); } coccinelle-1.0.0-rc19/tests/delp.res0000644000175000017500000000004212247437436016165 0ustar eugeneugenint main () { return foo; } coccinelle-1.0.0-rc19/tests/addtoo.cocci0000644000175000017500000000005212247437436017003 0ustar eugeneugen@@ statement S; @@ + bar(); - S foo(); coccinelle-1.0.0-rc19/tests/parameters_dots.c0000644000175000017500000000006712247437436020075 0ustar eugeneugenvoid main(int i) { f(1); g(3); f(1,2); f(); } coccinelle-1.0.0-rc19/tests/inherited.res0000644000175000017500000000010512247437436017214 0ustar eugeneugenvoid main(int i) { g(1); //f(2); h(2); h2(2); bar(1); } coccinelle-1.0.0-rc19/tests/post.res0000644000175000017500000000010712247437436016230 0ustar eugeneugenint main() { f(4, 3, 5); f(4, 3, 5); h(4, 3, 5); h(4, 3, 5); } coccinelle-1.0.0-rc19/tests/sp.res0000644000175000017500000000011112247437436015660 0ustar eugeneugenstruct name { unsigned long gcr; struct pci_dev *pci; }; coccinelle-1.0.0-rc19/tests/test10.c0000644000175000017500000000014512247437436016016 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); g(1); // if comment then should work h(1); h(1); } coccinelle-1.0.0-rc19/tests/multitype.c0000644000175000017500000000012512247437436016730 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { foo_t * x; f(x->a); g(x); } coccinelle-1.0.0-rc19/tests/befS.cocci0000644000175000017500000000004112247437436016406 0ustar eugeneugen@@ statement S; @@ + foo(); S coccinelle-1.0.0-rc19/tests/constructor.res0000644000175000017500000000024012247437436017626 0ustar eugeneugenint main () { changed_imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask); } coccinelle-1.0.0-rc19/tests/overshoot.cocci0000644000175000017500000000023412247437436017563 0ustar eugeneugen@aaa@ identifier f; @@ a(); <... -ff(); +g(); ...> b(); @bbb@ identifier f; @@ a(); <... -f(); +g(); ...> b(); @xxx@ identifier f; @@ a(); ... -b(); coccinelle-1.0.0-rc19/tests/minusdots.cocci0000644000175000017500000000015112247437436017556 0ustar eugeneugen@@ identifier ptr; //statement S; @@ // body could be S instead of { ... } - if (!ptr) - { - ... - } coccinelle-1.0.0-rc19/tests/unl.res0000644000175000017500000000021112247437436016035 0ustar eugeneugenint main () { if (unlikely(new_pe == NULL)) { return NULL; } } int main () { if (unlikely(new_pe == NULL)) return NULL; } coccinelle-1.0.0-rc19/tests/stm1.c0000644000175000017500000000005712247437436015564 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/isotest.res0000644000175000017500000000006712247437436016742 0ustar eugeneugenvoid main(int i) { char j; // = 1; j++; } coccinelle-1.0.0-rc19/tests/initializer.cocci0000644000175000017500000000016312247437436020057 0ustar eugeneugen@@ identifier name1, name2; @@ struct SHT var = { .f1 = name1, - .f2 = name2, + .foo = 12, + .foo2 = 12, }; coccinelle-1.0.0-rc19/tests/test10.res0000644000175000017500000000014512247437436016365 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); g(1); // if comment then should work h(1); h(1); } coccinelle-1.0.0-rc19/tests/ty1.res0000644000175000017500000000003412247437436015757 0ustar eugeneugenint fn(int y) { char x; } coccinelle-1.0.0-rc19/tests/pb_params_iso.res0000644000175000017500000000024512247437436020064 0ustar eugeneugen int f(bool a, int i, char j, bool b) { i++; } int f(int i, char j, bool b) { i++; } int f(bool a, int i, char j) { i++; } int f(int i, char j) { i++; } coccinelle-1.0.0-rc19/tests/str_init.cocci0000644000175000017500000000006312247437436017366 0ustar eugeneugen@@ @@ struct foo x = { - ..., .xxx= 12, - ... }; coccinelle-1.0.0-rc19/tests/double_switch.cocci0000644000175000017500000000006112247437436020364 0ustar eugeneugen@s@ expression E; position p; @@ - E@p < 0 + 12 coccinelle-1.0.0-rc19/tests/bugloop.cocci0000644000175000017500000000024712247437436017206 0ustar eugeneugen@@ expression current; @@ - current->flags & PF_FREEZE + freezing(current) ... ?- refrigerator(PF_FREEZE) + refrigerator() ... ? current->flags & PF_FREEZE coccinelle-1.0.0-rc19/tests/test9_ver1.c0000644000175000017500000000026012247437436016701 0ustar eugeneugenvoid main(int foo) { f(1); f(1); // if uncoment then problems g(2); if(1) { h(3); } else { h(4); } // if uncomment then problems { i++; } } coccinelle-1.0.0-rc19/tests/fun.cocci0000644000175000017500000000006112247437436016321 0ustar eugeneugen@@ @@ +struct a{int a;}; f(int x) { return x; } coccinelle-1.0.0-rc19/tests/bad_iso_example.res0000644000175000017500000000004112247437436020353 0ustar eugeneugenint main() { if (x) return; } coccinelle-1.0.0-rc19/tests/regexp3.c0000644000175000017500000000021512247437436016251 0ustar eugeneugen int main(void) { char *t0 = "FOO"; char *t1 = "BAR"; char *t2 = "FOOBAR"; char *t3 = "BARFOOBAR"; char *t4 = "BARFOO"; char *s0 = "%s"; } coccinelle-1.0.0-rc19/tests/multidec.cocci0000644000175000017500000000005112247437436017336 0ustar eugeneugen@@ type T; identifier x; @@ - T x = 12; coccinelle-1.0.0-rc19/tests/threea.c0000644000175000017500000000004112247437436016141 0ustar eugeneugenint main() { f(12); q(12); } coccinelle-1.0.0-rc19/tests/dc_close.res0000644000175000017500000000034112247437436017016 0ustar eugeneugenvoid __init initicc(struct IsdnCardState *cs) { int val, eval; INIT_WORK(&cs->work, icc_bh, cs); cs->setstack_d = setstack_icc; cs->DC_Send_Data = d_fill_fifo; cs->DC_Close = DC_Close_icc; cs->dc.icc.mon_rx = NULL; } coccinelle-1.0.0-rc19/tests/bitfield.cocci0000644000175000017500000000020312247437436017311 0ustar eugeneugen@@ @@ struct dvb_frontend { ... - struct dvb_frontend_ops* ops; + struct dvb_frontend_ops ops; ... }; coccinelle-1.0.0-rc19/tests/a_and_e.res0000644000175000017500000000012612247437436016612 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(3,4); // return 1; } coccinelle-1.0.0-rc19/tests/nest2.cocci0000644000175000017500000000014112247437436016563 0ustar eugeneugen@@ identifier func; @@ int func(int i) { <... a(); ...> - a(); + b(); <... a(); ...> }coccinelle-1.0.0-rc19/tests/metaruleelem.cocci0000644000175000017500000000005112247437436020211 0ustar eugeneugen@@ statement S; @@ f(); - S + foo();S coccinelle-1.0.0-rc19/tests/str_init.res0000644000175000017500000000004012247437436017072 0ustar eugeneugenstruct foo x = { .xxx= 12, }; coccinelle-1.0.0-rc19/tests/minenum1.c0000644000175000017500000000003212247437436016422 0ustar eugeneugenenum h { x, a, z, q, b }; coccinelle-1.0.0-rc19/tests/toplevel_struct.c0000644000175000017500000000363512247437436020143 0ustar eugeneugenstruct SHT usb_stor_host_template = { /* basic userland interface stuff */ .name = "usb-storage", .proc_name = "usb-storage", .proc_info2 = usb_storage_proc_info2, .proc_info = usb_storage_proc_info, .proc_dir = NULL, .info = usb_storage_info, .ioctl = NULL, /* old-style detect and release */ .detect = NULL, .release = NULL, /* command interface -- queued only */ .command = NULL, .queuecommand = usb_storage_queuecommand, /* error and abort handlers */ .eh_abort_handler = usb_storage_command_abort, .eh_device_reset_handler = usb_storage_device_reset, .eh_bus_reset_handler = usb_storage_bus_reset, .eh_host_reset_handler = NULL, .eh_strategy_handler = NULL, /* queue commands only, only one command per LUN */ .can_queue = 1, .cmd_per_lun = 1, /* unknown initiator id */ .this_id = -1, /* no limit on commands */ .max_sectors = 0, /* pre- and post- device scan functions */ .slave_alloc = NULL, .slave_configure = NULL, .slave_destroy = NULL, /* lots of sg segments can be handled */ .sg_tablesize = SG_ALL, /* use 32-bit address space for DMA */ .unchecked_isa_dma = FALSE, .highmem_io = FALSE, /* merge commands... this seems to help performance, but * periodically someone should test to see which setting is more * optimal. */ .use_clustering = TRUE, /* emulated HBA */ .emulated = TRUE, /* sorry, no BIOS to help us */ .bios_param = NULL, /* module management */ .module = THIS_MODULE }; /* For a device that is "Not Ready" */ unsigned char usb_stor_sense_notready[18] = { [0] = 0x70, /* current error */ [2] = 0x02, /* not ready */ [7] = 0x0a, /* additional length */ [12] = 0x04, /* not ready */ [13] = 0x03 /* manual intervention */ }; void usb_storage_proc_info(int i) { f(1); } void usb_storage_proc_info2(int i) { f(27); } void not_usb_storage_proc_info(int i) { f(1); } coccinelle-1.0.0-rc19/tests/typedef.c0000644000175000017500000000052512247437436016340 0ustar eugeneugentypedef struct bluecard_info_t { dev_link_t link; } foo; static void should_work(u_long arg) { foo *info = (struct bluecard_info_t *)arg; unsigned int iobase = info->link.io.BasePort1; } static void does_work(u_long arg) { struct bluecard_info_t *info = (struct bluecard_info_t *)arg; unsigned int iobase = info->link.io.BasePort1; } coccinelle-1.0.0-rc19/tests/pb_tag_symbols.res0000644000175000017500000000012412247437436020246 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { } coccinelle-1.0.0-rc19/tests/ktype.c0000644000175000017500000000027712247437436016040 0ustar eugeneugentypedef struct r1_private_data_s conf_t; static int run(mddev_t *mddev) { conf_t *conf; conf = kmalloc(sizeof(conf_t), GFP_KERNEL); if (!conf) return; memset(conf, 0, sizeof(*conf)); } coccinelle-1.0.0-rc19/tests/p9.res0000644000175000017500000000005512247437436015575 0ustar eugeneugenint f(int v2, int v3, int x) { return x; } coccinelle-1.0.0-rc19/tests/pb_distribute_type3.c0000644000175000017500000000016112247437436020657 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.0-rc19/tests/struct_metavar.res0000644000175000017500000000025712247437436020314 0ustar eugeneugenstruct foo { int x; struct bar first; int y; struct xxx second; int z; }; int main() { struct foo *a; struct notfoo *b; f(b->first); f(b->second); } coccinelle-1.0.0-rc19/tests/fieldcount.c0000644000175000017500000000015212247437436017030 0ustar eugeneugenstruct foo { int a; #define FOO 12 #define BAR 20 int b; #ifdef FOO int c; #else int d; #endif }; coccinelle-1.0.0-rc19/tests/hex2.c0000644000175000017500000000004012247437436015536 0ustar eugeneugenint main() { f(4294967295); } coccinelle-1.0.0-rc19/tests/sw.res0000644000175000017500000000000112247437436015665 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/a_and_e_ver1.c0000644000175000017500000000012612247437436017200 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(2,2); // return 1; } coccinelle-1.0.0-rc19/tests/kmc.c0000644000175000017500000000036112247437436015450 0ustar eugeneugenint dmabounce_register_dev(struct device *dev, unsigned long small_buffer_size, unsigned long large_buffer_size) { if (large_buffer_size) { if (ret) goto err_destroy; } return 0; err_destroy: kfreea(device_info); return 1; } coccinelle-1.0.0-rc19/tests/minusdots.res0000644000175000017500000000003112247437436017264 0ustar eugeneugenvoid main(int i) { } coccinelle-1.0.0-rc19/tests/fields.c0000644000175000017500000000006512247437436016145 0ustar eugeneugenstruct foo x = { .xa = 1, .xb = 2, .xc = 3, }; coccinelle-1.0.0-rc19/tests/badaw.cocci0000644000175000017500000000042012247437436016606 0ustar eugeneugen@loc@ identifier f; position pl; @@ f@pl(...) @probe forall@ identifier E; identifier f,g; int ret; statement S; position loc.pl; @@ E = f@pl(...); ... when any ( g(...,E,...); | return ret; ) @exists@ identifier probe.f, probe.g; @@ f(...) ... g(...)coccinelle-1.0.0-rc19/tests/print_return.res0000644000175000017500000000007312247437436020000 0ustar eugeneugenint config(struct pcmcia_device *link) { return bar(); } coccinelle-1.0.0-rc19/tests/video3.c0000644000175000017500000000203112247437436016063 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; if (cmd == VIDIOCGTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, v, sizeof(v))) return -EFAULT; } else if (cmd == VIDIOCSTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v))) return -EFAULT; if (v.tuner != 0) return -EINVAL; /* Only 1 tuner so no setting needed ! */ } else return -ENOIOCTLCMD; /* else if(cmd == VIDIOCSFREQ) { if (copy_from_user(typhoon->curfreq, arg, sizeof(typhoon->curfreq))) return -EFAULT; typhoon_setfreq(typhoon, typhoon->curfreq); return 0; }*/ return 0; } coccinelle-1.0.0-rc19/tests/switchdecl.res0000644000175000017500000000020012247437436017366 0ustar eugeneugenvoid f(void) { switch (2) { int x; int x; case 2: break; case 4: j++; break; } } coccinelle-1.0.0-rc19/tests/video4.c0000644000175000017500000000021612247437436016067 0ustar eugeneugenint main() { int v; m(); f(1); x(); v.x = 12; v.y = 21; g(1); f(2); x(); v.xafter = 12; v.yafter = 21; g(2); n(); } coccinelle-1.0.0-rc19/tests/array.c0000644000175000017500000000022712247437436016015 0ustar eugeneugen#include void main(int i) { float x[] = { 0.1, 0.2, 0.3}; int y; y = sizeof(x) / sizeof(float); printf ("size array = %d\n", y); } coccinelle-1.0.0-rc19/tests/type_iso.c0000644000175000017500000000035112247437436016530 0ustar eugeneugen struct SHT ops1; struct SHT2 notops1; void main(int i) { ops1.proc_info =1; notops1.proc_info =1; } typedef struct SHT SHT_t; SHT_t ops2; SHT2_t notops2; void main(int i) { ops2.proc_info =1; notops2.proc_info =1; } coccinelle-1.0.0-rc19/tests/distribute.res0000644000175000017500000000005412247437436017422 0ustar eugeneugenint main(int i) { f(g(1) * 0 * g(2)); } coccinelle-1.0.0-rc19/tests/test_unsigned_meta.res0000644000175000017500000000023612247437436021127 0ustar eugeneugenint main () { signed int x; char new_x; unsigned int y; char new_y; unsigned char q; char r; unsigned char s1; signed char s2; return 0; } coccinelle-1.0.0-rc19/tests/sis.cocci0000644000175000017500000000021412247437436016327 0ustar eugeneugen@@ declarer name DECLARE_MUTEX; declarer name DEFINE_MUTEX; identifier I; //fresh identifier I1; @@ - DECLARE_MUTEX(I); + DEFINE_MUTEX(I); coccinelle-1.0.0-rc19/tests/fp.cocci0000644000175000017500000000010312247437436016133 0ustar eugeneugen@@ identifier f,g; @@ f(int (*g)(int,int)) { ... - g(); ... } coccinelle-1.0.0-rc19/tests/sw.c0000644000175000017500000000005512247437436015327 0ustar eugeneugenint f() { switch (x) { case FOO: return; } } coccinelle-1.0.0-rc19/tests/proto2.res0000644000175000017500000000040312247437436016467 0ustar eugeneugenstatic void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_sched_event(int event); static void bch_empty_fifo(struct BCState *bcs, int count); static void bch_sched_event(int event) { bcs->event |= 1 << event; schedule_work(&bcs->work); } coccinelle-1.0.0-rc19/tests/constructor.c0000644000175000017500000000016412247437436017264 0ustar eugeneugenint main () { imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask); } coccinelle-1.0.0-rc19/tests/typedef3.c0000644000175000017500000000037312247437436016424 0ustar eugeneugentypedef struct bluecard_info_t { dev_link_t link; } foo; static void should_work(foo *info) { unsigned int iobase = info->link.io.BasePort1; } static void does_work(struct bluecard_info_t *info) { unsigned int iobase = info->link.io.BasePort1; } coccinelle-1.0.0-rc19/tests/shared_brace.res0000644000175000017500000000014012247437436017642 0ustar eugeneugen int __init ixj_init(void) { if ((probe = ixj_probe_pci(&cnt)) < 0) { return probe; } } coccinelle-1.0.0-rc19/tests/addif1.c0000644000175000017500000000010512247437436016022 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/attradd.res0000644000175000017500000000013412247437436016666 0ustar eugeneugenint main () { char __attribute__((aligned(1))) f; } // some comment // some other comment coccinelle-1.0.0-rc19/tests/defe.c0000644000175000017500000000001412247437436015574 0ustar eugeneugen#define x 3 coccinelle-1.0.0-rc19/tests/incl.res0000644000175000017500000000023612247437436016173 0ustar eugeneugen#include "before.h" #include #include #include #include "after.h" #ifdef FOO #include #endif FOO coccinelle-1.0.0-rc19/tests/test6.res0000644000175000017500000000043712247437436016316 0ustar eugeneugenint i; void main() { /* a comment */ f(4, "foo") + f(5, "foo"); //f(f(3)); // if uncomment, should have the warning "already minused token" if(f(1, "foo")) f(1, "foo"); else f(2, "foo"); if(1) g(1); else g(2); } void mainbis() { f(10, "foo"); } coccinelle-1.0.0-rc19/tests/yloop.c0000644000175000017500000000026512247437436016043 0ustar eugeneugenstatic int arxescsi_proc_info(char *buffer) { host = scsi_host_hn_get(hostno); if (!host) return 0; list_for_each_entry(scd, &host->my_devices, siblings) { } return pos; } coccinelle-1.0.0-rc19/tests/y2.res0000644000175000017500000000031012247437436015571 0ustar eugeneugenstatic void asuscom_interrupt_ipac(int intno, void *dev_id, struct pt_regs *regs) { Start_IPAC: debugl1(cs, "IPAC ISTA %02X", ista); if ((ista & 0x3f) && icnt) { icnt--; goto Start_IPAC; } } coccinelle-1.0.0-rc19/tests/ws2.cocci0000644000175000017500000000007312247437436016247 0ustar eugeneugen@@ statement S; fresh identifier A; @@ - if (foo()) S + S coccinelle-1.0.0-rc19/tests/SCORE_expected.sexp0000644000175000017500000003530212247437554020173 0ustar eugeneugen:tt\*threea.res@@@+include.res@)deref.res@@)break.res@@@@@@@4line_before_last.res@,iterator.res@@+arraysz.res@@@*format.res -INCORRECT:diff token: "one %d two\n" VS "blah" File "tests/format.c", line 2, column 9, charpos = 23 around = '"one %d two\n"', whole content = printf("one %d two\n", 1); File "tests/format.res", line 2, column 9, charpos = 23 around = '"blah"', whole content = printf("blah", 1); diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int main () { - printf("one %d two\n", 1); - printf("one %d two %d three\n", 1, 2); + printf("blah", 1); + printf("blah", 1, 2); printf("one two three\n"); } @-doublepos.res@@(cr1a.res@'spl.res@5metastatement_for.res@@,addfield.res@@@+format2.res OPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/format2ac0454.cmxs") @2type_annotated.res@@&ty.res@-positionc.res@)ptrar.res@@+metahex.res VINCORRECT:diff token: f VS } File "tests/metahex.c", line 2, column 2, charpos = 15 around = 'f', whole content = f(3); File "tests/metahex.res", line 2, column 0, charpos = 13 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,4 +1,2 @@ int main() { - f(3); - g(0x03); } @@@7pb_distribute_type4.res@)exitp.res &PROBLEM exn = Failure("no python") (fnty.res@@+varargs.res@*test_s.res@(loop.res@@@;initializer_many_fields.res@(rptr.res@@@(hil1.res@+minenum.res@@-remstruct.res@@@(cptr.res@*ifdef2.res@@*expopt.res@@+nestone.res@@@-video1bis.res@-iterprint.res@@.badtypedef.res@/branchparen.res@2addbeforeafter.res@@*return.res@@@+addelse.res@@0double_lines.res@@2minusdots_ver1.res@@@)test6.res@+typedef.res@@1comment_brace.res@@)test1.res@+localid.res@@)bigin.res@@@*addif2.res@@/gcc_min_max.res@@0expopt3_ver1.res@@*braces.res@@@(getc.res@@(stmt.res@@@+retval2.res@@-list_test.res@0metaruleelem.res@@@@@@-wierdinit.res Xseems incorrect, but only because of code that was not parsablediff token: dev_link_t VS struct File "tests/wierdinit.c", line 4, column 1, charpos = 27 around = 'dev_link_t', whole content = dev_link_t *link; File "tests/wierdinit.res", line 4, column 1, charpos = 27 around = 'struct', whole content = struct pcmcia_device *link; 1pb_params_iso.res@@+devlink.res@@-ifdefmeta.res@/longlongint.res@@,ty_tyexp.res@@'unl.res@@(anon.res@@@'ty1.res@-inclifdef.res@@@)ktype.res@/topdec_ver1.res@(void.res@@0strangeorder.res@+expopt2.res@,argument.res@@(pmac.res@.proto_ver1.res@@*test12.res@@&p9.res INCORRECT:diff token: v0 VS v2 File , line 1, column 10, charpos = 10 around = 'v0', whole content = int f(int v0, int v1, int x) { File "tests/p9.res", line 1, column 10, charpos = 10 around = 'v2', whole content = int f(int v2, int v3, int x) { diff (result(<) vs expected_result(>)) = @@ -1,3 +1,3 @@ -int f(int v0, int v1, int x) { +int f(int v2, int v3, int x) { return x; } @@-starprint.res@(delp.res@@(stm8.res@@@(stm3.res@@,twomatch.res@@@@.define_exp.res@3gilles-question.res@@(dbg1.res INCORRECT:diff token: E VS ( File , line 5, column 2, charpos = 75 around = 'E', whole content = E = NULL;("PCI"); File "tests/dbg1.res", line 4, column 5, charpos = 72 around = '(', whole content = DBG("PCI"); diff (result(<) vs expected_result(>)) = @@ -1,6 +1,6 @@ static inline void alloc_resource(struct pci_dev *dev, int idx) { - DBG - E = NULL;("PCI"); + DBG("PCI"); + E = NULL; } @-gotobreak.res@@@)const.res@'ws2.res@*signed.res@@@*dropbr.res@@,nameless.res@@(tern.res@@.justremove.res@*badexp.res@'com.res@3return_implicit.res@@@@@)type1.res@@)proto.res@@,comments.res@1disjexpr_ver1.res@@,multidec.res@'opt.res@@@@@0const_adding.res@*retval.res@@/constructor.res@@@2typedef_double.res@+condexp.res@@.array_init.res@8labels_metastatement.res@(rets.res@@@'dec.res@3toplevel_struct.res@@@*ifdef3.res@@-type_ver1.res@@(zero.res@@+declinv.res DPROBLEM exn = Unix.Unix_error(20, "stat", "tests/declinv.cocci") @@*addtoo.res@2struct_metavar.res@@(four.res@@-null_type.res@@@,cst_null.res@,cs_check.res@@@@)test7.res@,constrem.res@@@)test2.res@-multitype.res@@(defe.res@@(cast.res@,cast_iso.res@@&fp.res@(post.res@@@0expopt3_ver2.res@@@@@@/remove_call.res@1bad_ptr_print.res@@@'ip2.res@@@'csw.res@@(nest.res@@@@1scope_problem.res INCORRECT:diff token: } VS a File , line 4, column 2, charpos = 42 around = '}', whole content = } File "tests/scope_problem.res", line 4, column 4, charpos = 44 around = 'a', whole content = a = 2; diff (result(<) vs expected_result(>)) = @@ -1,7 +1,6 @@ void main(int i) { if(1) { int a; + a = 2; } - - } )endif.res@@'lid.res@@&of.res@@(decl.res@6optional_qualifier.res@@+spacing.res@@@@.ifdefmeta1.res@@/topdec_ver2.res@@+expopt3.res@*strid2.res@@*doundo.res@.proto_ver2.res@@@/macro_int16.res@@1mini_null_ref.res@@6incompatible_value.res@@+compare.res@@@0a_and_e_ver1.res@(stm4.res@@@*jloop1.res PROBLEM exn = Failure("minus: parse error: \n = File \"tests/jloop1.cocci\", line 10, column 3, charpos = 129\n around = '...>', whole content = ...>\n") @/protoassert.res@@+fn_todo.res@@@@@-same_expr.res@(ifbr.res@@@@.decl_split.res jINCORRECT:diff token: int VS } File "tests/decl_split.c", line 2, column 8, charpos = 27 around = 'int', whole content = int x, y; File "tests/decl_split.res", line 2, column 0, charpos = 19 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,3 +1,2 @@ int func(int i) { - int x, y; } *inhmet.res@/multi_func1.res PROBLEM exn = Failure("minus: parse error: \n = File \"tests/multi_func1.cocci\", line 12, column 2, charpos = 102\n around = 'fn2', whole content = fn2(...) {\n") @*inline.res@+ifields.res@@@@@@'kmc.res@)ifadd.res@@+julia10.res@@1disjexpr_ver2.res@@*sizeof.res@@*incdir.res INCORRECT:diff token: x VS 12 File "tests/incdir.c", line 4, column 6, charpos = 46 around = 'x', whole content = foo(x); File "tests/incdir.res", line 4, column 6, charpos = 46 around = '12', whole content = foo(12); diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ #include "sub/incdir2.c" int main () { - foo(x); + foo(12); } @)cards.res@(bug1.res@@.decl_space.res@@)stm10.res@/test10_ver1.res@@@.multichars.res@@@@-minusdots.res@*comadd.res@@)exitc.res MPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/exitc439450.cmxs") @@&sp.res@*ifdef4.res@+expnest.res@@'ifd.res@(type.res@*incpos.res &PROBLEM exn = Failure("no python") -type_ver2.res INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int foo() { - int[10] *x; + int *x[10]; return 0; } @*switch.res@@)debug.res@@*regexp.res@@@*protox.res@@&hd.res@-multivars.res@*addaft.res@@+deftodo.res@@*double.res@@+dowhile.res@,isococci.res@@@)test8.res@)fnptr.res@@@)test3.res@@)bugon.res@0doubleswitch.res@@+badwhen.res@@@+nestseq.res@@@@*static.res@@.array_size.res@'inc.res@@1fix_flow_need.res@@.end_commas.res@@.distribute.res@@@@)foura.res@@.param_ver1.res@@'exp.res@@@1match_no_meta.res@@@*proto2.res@+isotest.res@@@@.stm10_ver1.res@)addif.res@@+headers.res@@.ifdefmeta2.res@@*inhpos.res@@(noty.res@@@4metastatement_if.res@,isotest2.res@@-overshoot.res@&na.res@'tup.res@@@@*posiso.res@@@+constty.res@(stm5.res@@@0useless_cast.res@@0param_to_exp.res IPROBLEM exn = Unix.Unix_error(20, "stat", "tests/param_to_exp.cocci") @*topdec.res@@0multitypedef.res@@,disjexpr.res@-decl_star.res@@+badzero.res@@+kmalloc.res@*fields.res@@-dropparam.res@@(rcu3.res@0print_return.res@'not.res@@-longconst.res@&kr.res@@&ab.res@@&km.res@@-structfoo.res@/multiremove.res@@'max.res@)ifend.res@@,longlong.res@@%a.res@.neststruct.res@@@)edots.res@+incpos1.res &PROBLEM exn = Failure("no python") @@6pb_distribute_type.res INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -10,6 +10,6 @@ } int foo() { - int[45] *x; + int (*x)[45]; return 0; } @1double_switch.res@@*disjid.res@'fun.res@@&b1.res@+sizeptr.res@*nocast.res@@@7pb_distribute_type2.res /INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int foo() { - int* x; + int *x; return 0; } @@ -10,6 +10,6 @@ } int foo() { - int x[45]*; + int (*x)[45]; return 0; } @(rem1.res@4pb_parsing_macro.res@&ip.res@@(tyex.res@@+fortype.res@@@&if.res@@*ifdef5.res@@@@,reserved.res@@@)serio.res INCORRECT:diff token: init_MUTEX VS mutex_init File "tests/serio.c", line 7, column 1, charpos = 130 around = 'init_MUTEX', whole content = init_MUTEX(&serio->drv_sem); File "tests/serio.res", line 7, column 1, charpos = 130 around = 'mutex_init', whole content = mutex_init(&serio->new_lock); diff (result(<) vs expected_result(>)) = @@ -4,5 +4,5 @@ static void serio_init_port(struct serio *serio) { - init_MUTEX(&serio->drv_sem); + mutex_init(&serio->new_lock); } @'arg.res@,dc_close.res@*memory.res@@(enum.res@6test_unsigned_meta.res@+smallfn.res@@-substruct.res@(vpos.res@@/three_types.res@@@.edots_ver1.res@-const1bis.res@@)test9.res@*typeof.res@@.pragmatest.res@@)test4.res@@@@@,retmacro.res@4optional_storage.res@@@-find_long.res@-param_end.res@*symbol.res@'dbg.res INCORRECT:diff token: else VS ( File , line 8, column 2, charpos = 133 around = 'else', whole content = else pr = NULL;("PCI"); File "tests/dbg.res", line 7, column 5, charpos = 130 around = '(', whole content = DBG("PCI"); diff (result(<) vs expected_result(>)) = @@ -4,6 +4,6 @@ struct resource *pr, *r = &dev->resource[idx]; if (pr) - DBG - else pr = NULL;("PCI"); + DBG("PCI"); + else pr = NULL; } @@,twoproto.res@)param.res@@@.switchdecl.res@0sizeof_julia.res@@@*string.res@@@.formatlist.res@+bigrepl.res@6const_implicit_iso.res@@*julia7.res@@'cst.res@.match_init.res@)decl2.res@@.whitespace.res@@@@)macro.res@@(ifzz.res@/const_array.res@@1double_assign.res@@(incl.res@@@.ifdefmeta3.res@'ben.res@@&nl.res@@@@@)local.res@/pragmatest1.res@+regexp2.res@@*test10.res@)strid.res@@-inherited.res@@)orexp.res@@,typedef3.res rINCORRECT:diff token: link VS p_dev File , line 7, column 29, charpos = 137 around = 'link', whole content = unsigned int iobase = info->link.io.BasePort1; File "tests/typedef3.res", line 7, column 29, charpos = 137 around = 'p_dev', whole content = unsigned int iobase = info->p_dev->io.BasePort1; diff (result(<) vs expected_result(>)) = @@ -4,7 +4,7 @@ static void should_work(foo *info) { - unsigned int iobase = info->link.io.BasePort1; + unsigned int iobase = info->p_dev->io.BasePort1; } static void does_work(struct bluecard_info_t *info) *badpos.res PROBLEM exn = Failure("rule starting on line 1: already tagged token:\nC code context\nFile \"tests/badpos.c\", line 5, column 30, charpos = 139\n around = 'reg_ptr', whole content = \t (int) -(((struct pt_regs *) reg_ptr)->orig_eax + 2));") @(stm6.res@@@(stm1.res &PROBLEM exn = Failure("no python") @@@+partial.res@)extra.res MPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/extra831591.cmxs") @&ar.res@+arparam.res@@@)empty.res@+oneline.res@@/test11_ver1.res@@+attradd.res@@2inherited_ver1.res@'eb1.res@@&y2.res@@-addbefore.res@@@2struct_typedef.res@'hex.res@*xfield.res@@)dropf.res@@2comment_brace2.res@)ifzer.res@@@3replace_typedef.res@*notest.res@@/initializer.res@*retest.res@@3bad_iso_example.res INCORRECT:diff token: ( VS x File "tests/bad_iso_example.c", line 2, column 6, charpos = 19 around = '(', whole content = if ((x = 3)) return; File "tests/bad_iso_example.res", line 2, column 6, charpos = 19 around = 'x', whole content = if (x) return; diff (result(<) vs expected_result(>)) = @@ -1,4 +1,4 @@ int main() { - if ((x = 3)) return; + if (x) return; } @@.keep_comma.res@@&b2.res@)minfn.res@@@0define_param.res@7pb_distribute_type3.res ?PROBLEM exn = Failure("line 7: index 53 53 already used\n") (tdnl.res@/bad_typedef.res@*lvalue.res@@(rem2.res@@@@'a3d.res@&td.res@&sw.res@3delete_function.res@@,oddifdef.res INCORRECT:diff token: #else VS x File , line 10, column 0, charpos = 114 around = '#else ', whole content = #else File "tests/oddifdef.res", line 10, column 2, charpos = 116 around = 'x', whole content = x = 0; diff (result(<) vs expected_result(>)) = @@ -7,8 +7,9 @@ a = 5; #ifdef FOO + x = 0; #else - + x = 0; #endif } @@ -21,8 +22,9 @@ a = 3; #ifdef FOO + x = 0; #else - + x = 0; #endif } @@ -35,7 +37,8 @@ #endif #ifdef FOO + x = 0; #else - + x = 0; #endif } @6toplevel_macrostmt.res@)fnret.res@*ifdef6.res@*struct.res@2wierd_argument.res@@,bitfield.res@@*ifdef1.res@.test5_ver1.res@@@@-minstruct.res@-bad_kfree.res@@-null_bool.res $INCORRECT:diff token: ) VS != File , line 2, column 8, charpos = 22 around = ')', whole content = if (12) return; File "tests/null_bool.res", line 2, column 9, charpos = 23 around = '!=', whole content = if (12 != NULL) return; diff (result(<) vs expected_result(>)) = @@ -1,6 +1,6 @@ int main () { - if (12) return; - if (a && 12 && b) return; + if (12 != NULL) return; + if (a && 12 != NULL && b) return; if (12) return; if (a && 12 && b) return; x = x + 20; @+bugloop.res@@@,str_init.res@'top.res@'fsh.res@2pb_tag_symbols.res@@@@@(skip.res@@)test5.res@@+ifdef6a.res@@)test0.res@(befS.res@@=labels_metastatement_ver1.res@@3parameters_dots.res@@*spaces.res@*addif1.res@@*constx.res@@@@@,sizestar.res@@@@,after_if.res@@0shared_brace.res@@@@@@2metastatement2.res@@@'sis.res@@+a_and_e.res@-fieldsmin.res@@@@.ifdefmeta4.res GPROBLEM exn = Unix.Unix_error(20, "stat", "tests/ifdefmeta4.cocci") @,metaline.res@@@@-multiplus.res@@*insdef.res@+regexp3.res@@*test11.res@@@@,minenum1.res@@(stm7.res &PROBLEM exn = Failure("no python") @*tydisj.res@@(stm2.res@@coccinelle-1.0.0-rc19/tests/sis.c0000644000175000017500000000026212247437436015474 0ustar eugeneugenDECLARE_MUTEX(disconnect_sem); /*int foo() { return; }*/ // if uncomment, and erase newline, then have Line ID EOF and // some patterns in parsing_hacks don't apply anymore :( coccinelle-1.0.0-rc19/tests/sizeof_julia.c0000644000175000017500000000017312247437436017362 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { copy_from_user(&v, arg, sizeof(v)); } coccinelle-1.0.0-rc19/tests/loop.cocci0000644000175000017500000000003312247437436016501 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.0-rc19/tests/com.cocci0000644000175000017500000000002012247437436016302 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/decl_star.res0000644000175000017500000000005712247437436017207 0ustar eugeneugenint main () { int *y; int y; return x; } coccinelle-1.0.0-rc19/tests/xfield.res0000644000175000017500000000010512247437436016514 0ustar eugeneugenint x; /* int y; struct foo { FOO(a,b,c); FOO(a1,b1,c1); }; */ coccinelle-1.0.0-rc19/tests/parsing_pad.c0000644000175000017500000000026412247437436017167 0ustar eugeneugen#ifdef SIGALRM #if defined(__STDC__) || defined(sgi) || defined(_AIX) #define SIGRETTYPE void* #else #define SIGRETTYPE int* #endif SIGRETTYPE foo(void) { void x; int x$y; } coccinelle-1.0.0-rc19/tests/wierd_argument.cocci0000644000175000017500000000007312247437436020550 0ustar eugeneugen@@ expression B; type T; @@ - snd_magic_cast(T,B,...) + B coccinelle-1.0.0-rc19/tests/inhmet.c0000644000175000017500000000003512247437436016160 0ustar eugeneugenint main () { x->s = 12; } coccinelle-1.0.0-rc19/tests/struct_typedef.c0000644000175000017500000000035212247437436017742 0ustar eugeneugentypedef struct dvb_frontend { struct dvb_frontend_ops* ops; } xx_t; typedef struct { u8 RESET :1; u8 IDLE :1; u8 STOP :1; u8 HIRQ0 :1; u8 HIRQ1 :1; u8 na0 :1; u8 HABAV :1; u8 na1 :1; } bcm3510_register_value; coccinelle-1.0.0-rc19/tests/macro.cocci0000644000175000017500000000007112247437436016633 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.0-rc19/tests/tern.cocci0000644000175000017500000000005712247437436016506 0ustar eugeneugen@@ expression E; @@ - return (E); + return E; coccinelle-1.0.0-rc19/tests/braces.c0000644000175000017500000000025012247437436016132 0ustar eugeneugen#define main { foo(); } int main() { foo(); } int main() { if (x) { foo(); } } int main() { while (x) { foo(); } } int main() { if (x) { foo(); } else { foo(); } } coccinelle-1.0.0-rc19/tests/param1.cocci0000644000175000017500000000004112247437436016710 0ustar eugeneugen@@ @@ - foo(int x, ...) { ... } coccinelle-1.0.0-rc19/tests/metastatement.cocci0000644000175000017500000000024512247437436020410 0ustar eugeneugen// dumb example. does not work well because S is also match // on the compounds, so it try to erase multiple times the same node. @@ statement S; @@ - S + S f(1); coccinelle-1.0.0-rc19/tests/struct_metavar.cocci0000644000175000017500000000030612247437436020576 0ustar eugeneugen@ rule1 @ type T; identifier X, Y; @@ T { ... struct bar X; ... struct xxx Y; ... }; @@ rule1.T *a; identifier rule1.X; @@ - f(a->X); @@ rule1.T *a; identifier rule1.Y; @@ - f(a->Y); coccinelle-1.0.0-rc19/tests/wierd_argument.res0000644000175000017500000000027112247437436020261 0ustar eugeneugenstatic void ewx_i2c_setlines(snd_i2c_bus_t *bus, int clk, int data) { ice1712_t *ice = bus->private_data; ice1712_t *ice = bus->private_data; unsigned char tmp = 0; tmp++; } coccinelle-1.0.0-rc19/tests/noty.cocci0000644000175000017500000000007512247437436016527 0ustar eugeneugen@@ statement S; expression *x; @@ if (NULL == x) S + g(); coccinelle-1.0.0-rc19/tests/optional_storage.cocci0000644000175000017500000000013412247437436021103 0ustar eugeneugen@ disable optional_storage @ identifier func; @@ - int + static int func(...) { ... } coccinelle-1.0.0-rc19/tests/stm6.cocci0000644000175000017500000000004612247437436016425 0ustar eugeneugen@@ statement S; @@ + h(); S g(); coccinelle-1.0.0-rc19/tests/ifdefmeta2.c0000644000175000017500000000014512247437436016704 0ustar eugeneugenint main() { buf = alloca(3 +5 +2 ); } coccinelle-1.0.0-rc19/tests/match_no_meta.c0000644000175000017500000000006412247437436017474 0ustar eugeneugenvoid main(int i) { foo(1); bar(2); bar(3); } coccinelle-1.0.0-rc19/tests/bad_kfree.cocci0000644000175000017500000000063112247437436017436 0ustar eugeneugen@print@ constant char [] c; expression E1; position p; identifier f; @@ f(...,c,...,E1@p,...) @free@ expression E; position p1; @@ kfree@p1(E) @r exists@ expression free.E, subE<=free.E, E2; iterator iter; statement S; position free.p1,p2!=print.p; @@ kfree@p1(E) ... ( iter(subE,...) S // no use | subE = E2 // no use | subE++ // no use | subE-- // no use | &subE // no use | - E@p2 // bad use + NULL ) coccinelle-1.0.0-rc19/tests/stm10.cocci0000644000175000017500000000004612247437436016500 0ustar eugeneugen@@ statement S; @@ f(); S + h(); coccinelle-1.0.0-rc19/tests/tests_firehose/0000755000175000017500000000000012247437436017560 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/tests_firehose/vm_fh.result0000644000175000017500000000066312247437436022124 0ustar eugeneugen alloc=kmalloc coccinelle-1.0.0-rc19/tests/tests_firehose/vm.c0000644000175000017500000000006712247437436020351 0ustar eugeneugenint main () { x = kmalloc(); r = 15; kfree(x); } coccinelle-1.0.0-rc19/tests/tests_firehose/vm_fh.cocci0000644000175000017500000000050212247437436021656 0ustar eugeneugen// Options: -D alloc=kmalloc -D free=kfree @r@ identifier virtual.alloc, virtual.free; expression x; position p1,p2; @@ x = alloc@p1(...); ... free@p2(x); @script:python@ p1 << r.p1; p2 << r.p2; alloc << virtual.alloc; @@ coccilib.xml_firehose.import_firehose() coccilib.xml_firehose.print_issue(p1, ("alloc="+alloc)); coccinelle-1.0.0-rc19/tests/test1_ver1.c0000644000175000017500000000024412247437436016673 0ustar eugeneugenvoid main(int foo) { f(1); f(1); // if uncoment then problems g(2); g(2);// if uncomment then problems if(1) { h(3); } else { h(4); } } coccinelle-1.0.0-rc19/tests/optional_qualifier.cocci0000644000175000017500000000011312247437436021415 0ustar eugeneugen@ disable optional_qualifier @ identifier x; @@ - int + const int x; coccinelle-1.0.0-rc19/tests/ifdef1.res0000644000175000017500000000040012247437436016375 0ustar eugeneugen#include #include #ifdef CONFIG_NKERNEL #include #endif #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/ifdef6.c0000644000175000017500000000031212247437436016035 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/b1.res0000644000175000017500000000020212247437436015541 0ustar eugeneugenint main () { while (1) { if (x > 1 ) { foo(); bar(); break; } } while (1) if (x > 1 ) { foo(); bar(); break; } } coccinelle-1.0.0-rc19/tests/dropf.cocci0000644000175000017500000000004612247437436016646 0ustar eugeneugen@@ expression E; @@ - f(E) + f(E + 3)coccinelle-1.0.0-rc19/tests/strid.res0000644000175000017500000000006312247437436016371 0ustar eugeneugenint main () { struct foo *a; print(f(a,12)); } coccinelle-1.0.0-rc19/tests/dowhile.c0000644000175000017500000000006712247437436016334 0ustar eugeneugenint main() { do { f(); } while (0); g(); } coccinelle-1.0.0-rc19/tests/addelse.res0000644000175000017500000000002012247437436016636 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/test11_ver1.res0000644000175000017500000000007312247437436017323 0ustar eugeneugenvoid main(int i) { f(1); g(1); //g(1); h(1, 1); } coccinelle-1.0.0-rc19/tests/typeur.h0000644000175000017500000000001012247437436016222 0ustar eugeneugenint x; coccinelle-1.0.0-rc19/tests/dep.cocci0000644000175000017500000000014112247437436016300 0ustar eugeneugen@ rule1 @ @@ - foo(); @ rule2 @ @@ - bar(); @ rule3 depends on rule1 && rule2 @ @@ - xxx(); coccinelle-1.0.0-rc19/tests/typeof.c0000644000175000017500000000011312247437436016177 0ustar eugeneugenint main() { int x; f(x); f(sizeof(struct foo)); f(sizeof(int)); } coccinelle-1.0.0-rc19/tests/scripting/0000755000175000017500000000000012247437436016534 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/scripting/array/0000755000175000017500000000000012247437436017652 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/scripting/array/script4.cocci0000644000175000017500000000051612247437436022246 0ustar eugeneugen@ rule1 @ type T; identifier I; expression C; expression E; position p1, p2, p3, p4; @@ T I@p2[C@p3]; <... I[E@p4] ...> @ script:python @ x_mv << rule1.C; xp << rule1.p3; y_mv << rule1.E; yp << rule1.p4; @@ x = cocci.combine(x_mv, xp) y = cocci.combine(y_mv, yp) cocci.register_match(True, [(x, 'Array match'), (y, 'Array use')]) coccinelle-1.0.0-rc19/tests/scripting/array/script4.c0000644000175000017500000000041012247437436021401 0ustar eugeneugen#include const int qqq = 20; void foo() { int z[10]; z[2] = 34; } int main() { int buf[qqq], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script1.c0000644000175000017500000000013412247437436020263 0ustar eugeneugenint main() { int buf[20]; int i; for (i = 0; i <= 20; ++i) buf[i] = i; f(); } coccinelle-1.0.0-rc19/tests/scripting/script6.c0000644000175000017500000000033612247437436020274 0ustar eugeneugenvoid foo() { int z[10]; z[2] = 34; } int main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script7.c0000644000175000017500000000013212247437436020267 0ustar eugeneugenint main() { int x; f(2); if (2 == 2) { x = 7; } g(2); q(x); h(); } coccinelle-1.0.0-rc19/tests/scripting/script8.cocci0000644000175000017500000000020012247437436021122 0ustar eugeneugen@ rule1 @ expression C; position p1; @@ *C@p1 @ script:python @ x << rule1.C; xloc << rule1.p1; @@ print "%s[%s]" % (x,xloc) coccinelle-1.0.0-rc19/tests/scripting/script4.cocci0000644000175000017500000000042312247437436021125 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; position p1, p2, p3, p4; @@ T I@p2[C@p3]; <... I[E@p4] ...> @ script:python @ x << rule1.p3; y << rule1.p4; @@ print "%s:%s:%s:%s" % (x.location.file, x.location.line, x.location.column, x) print "%s[%s]" % (x,y) coccinelle-1.0.0-rc19/tests/scripting/script6.cocci0000644000175000017500000000016512247437436021132 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... *I[E] ...> @ rule2 @ type rule1.T; @@ * T coccinelle-1.0.0-rc19/tests/scripting/script4.c0000644000175000017500000000033612247437436020272 0ustar eugeneugenvoid foo() { int z[10]; z[2] = 34; } int main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script3.cocci0000644000175000017500000000024212247437436021123 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... -I[E] +I[E] ...> @ script:python @ @@ print "Hello" @ rule2 @ constant rule1.C; @@ - C coccinelle-1.0.0-rc19/tests/scripting/script5.cocci0000644000175000017500000000040612247437436021127 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... -I[E] +I[E] ...> @ script:python @ t << rule1.T; i << rule1.I; x << rule1.C; y << rule1.E; @@ print t, i, "[", x, "]; ", i, "[", y, "];" #print "Hello" @ rule2 @ constant rule1.C; @@ - C coccinelle-1.0.0-rc19/tests/scripting/script2.cocci0000644000175000017500000000017712247437436021131 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... -I[E] +I[E] ...> @ script:python @ @@ print "Hello" coccinelle-1.0.0-rc19/tests/scripting/script3.c0000644000175000017500000000033612247437436020271 0ustar eugeneugenvoid foo() { int z[10]; z[2] = 34; } int main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script5.c0000644000175000017500000000033612247437436020273 0ustar eugeneugenvoid foo() { int z[10]; z[2] = 34; } int main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script8.c0000644000175000017500000000033612247437436020276 0ustar eugeneugenvoid foo() { int z[10]; z[2] = 34; } int main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script1.cocci0000644000175000017500000000017212247437436021123 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... -I[E] ...> @ script:python @ @@ print "Hello" coccinelle-1.0.0-rc19/tests/scripting/script2.c0000644000175000017500000000026312247437436020267 0ustar eugeneugenint main() { int buf[20], foo[30]; int i; for (i = 0; i <= 20; ++i) { buf[i] = i; foo[i] = i; } for (i = 0; i <= 20; ++i) printf("%d: %d\n", i, buf[i]); } coccinelle-1.0.0-rc19/tests/scripting/script7.cocci0000644000175000017500000000014612247437436021132 0ustar eugeneugen@ rule1 @ expression E; @@ f(E); ... g(E); ... -h() +h(E); @ script:python @ x << rule1.E; @@ print x coccinelle-1.0.0-rc19/tests/longlong.c0000644000175000017500000000007112247437436016513 0ustar eugeneugenlong long a; int main () { long long b; return 0; } coccinelle-1.0.0-rc19/tests/addbeforeafter.cocci0000644000175000017500000000007012247437436020466 0ustar eugeneugen@@ statement S; @@ if (...) { + foo(); S + bar(); }coccinelle-1.0.0-rc19/tests/double_assign.res0000644000175000017500000000010212247437436020054 0ustar eugeneugenint main() { x = 12; x = x + 1; } int badmain() { x = 1; } coccinelle-1.0.0-rc19/tests/addif1.res0000644000175000017500000000024112247437436016372 0ustar eugeneugen#ifdef FOO int xxx() { return 12; } #endif static int foo() { return 12; } #ifdef FOO int xxx() { return 12; } #endif static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/ali.cocci0000644000175000017500000000124512247437436016303 0ustar eugeneugen@ rule1 @ fresh identifier agp_driver_struct; function fn; identifier ent,dev; @@ + static struct agp_driver agp_driver_struct = { + .owner = THIS_MODULE, + }; fn (struct pci_dev *dev, struct pci_device_id *ent) { ... ( - agp_register_driver(dev); + agp_driver_struct.dev = dev; + agp_register_driver(&agp_driver_struct); | if (...) { // a non-error pathm, but looks like an error path ... - agp_register_driver(dev); + agp_driver_struct.dev = dev; + agp_register_driver(&agp_driver_struct); ... return 0; } ) ... } @ rule2 extends rule1 @ @@ - agp_unregister_driver(); + agp_unregister_driver(&agp_driver_struct); coccinelle-1.0.0-rc19/tests/multiplus.cocci0000644000175000017500000000041112247437436017566 0ustar eugeneugen// shows that there is a problem with \+ @@ identifier fn1, fld1; identifier data, device; type T; expression delay; @@ fn1 ( - void *data + struct work_struct *work ) { <+... schedule_delayed_work(&device->fld1,delay); ...+> } coccinelle-1.0.0-rc19/tests/sizeptr.res0000644000175000017500000000026612247437436016751 0ustar eugeneugenint main () { int *x; int *y; size_t a; ssize_t b; ptrdiff_t c; foo(ASIZE(sizeof ANINT(*x)),ASIZE(a)); foo(ANINT(*x),ASSIZE(b)); foo(APTRDIFF(x - y),APTRDIFF(c)); } coccinelle-1.0.0-rc19/tests/gcc_min_max.c0000644000175000017500000000010512247437436017136 0ustar eugeneugenint main() { int a, b; a ? b; a >?= b; } coccinelle-1.0.0-rc19/tests/makes_a_loop.cocci0000644000175000017500000000070712247437436020171 0ustar eugeneugen// if the translation of ... doesn't search for the closing brace // then the for loop in makes_a_loop.c causes an infinite loop in the CTL // of length the number of nodes in the for loop // the problem is the witnesses, one witness derived from the break in the // for loop enters and then leaves and then reenters and then releaves // the set of witnesses @r@ identifier I; identifier retval; expression E1, E2; @@ if (retval) { - foo(); - ... } coccinelle-1.0.0-rc19/tests/cast.res0000644000175000017500000000002012247437436016167 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/undef2.cocci0000644000175000017500000000003012247437436016710 0ustar eugeneugen@@ @@ - #define foo 12 coccinelle-1.0.0-rc19/tests/include/0000755000175000017500000000000012247437436016155 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/include/linux/0000755000175000017500000000000012247437436017314 5ustar eugeneugencoccinelle-1.0.0-rc19/tests/include/linux/serio.h.res0000644000175000017500000000010112247437436021366 0ustar eugeneugenstruct serio { struct mutex new_lock; /* mutex for mixer */ }; coccinelle-1.0.0-rc19/tests/include/linux/serio.h0000644000175000017500000000010412247437436020601 0ustar eugeneugenstruct serio { struct semaphore drv_sem; /* mutex for mixer */ }; coccinelle-1.0.0-rc19/tests/dropparam.c0000644000175000017500000000021012247437436016654 0ustar eugeneugenint f(char *x, int y, char* z) { return; } int g(char *x, int y, char* z) { return; } void main(void) { g("toto", 3, "tata"); } coccinelle-1.0.0-rc19/tests/test6.c0000644000175000017500000000036512247437436015747 0ustar eugeneugenint i; void main() { /* a comment */ f(4) + f(5); //f(f(3)); // if uncomment, should have the warning "already minused token" if(f(1)) f(1); else f(2); if(1) g(1); else g(2); } void mainbis() { f(10); } coccinelle-1.0.0-rc19/tests/inhpos.cocci0000644000175000017500000000023712247437436017036 0ustar eugeneugen// the point of this example is that if p doesn't get bound, then p1 can // be anything @a@ position p; @@ f@p(...) @@ position p1 != a.p; @@ - g@p1(...); coccinelle-1.0.0-rc19/tests/expnest.c0000644000175000017500000000011512247437436016361 0ustar eugeneugenint main() { x = 3 + 4; x = f() + 15; x = 15 + g(); x = f() + g(); } coccinelle-1.0.0-rc19/tests/ip.res0000644000175000017500000000037512247437436015662 0ustar eugeneugenvoid GetInfoDestTV(short sNoFo) { if(sNoFo == 1) printf("one"); else { trace("ifelel"); if(sNoFo == 2) printf("two"); else { trace("ifelel"); if(sNoFo == 2) printf("three"); else { trace("ifelel"); printf("other"); }}} } coccinelle-1.0.0-rc19/tests/formatlist.cocci0000644000175000017500000000014412247437436017717 0ustar eugeneugen@@ format list[4] d; @@ - "xyz %@d@" + "blah" @@ format list[2] d; @@ - "xyz %@d@ abc" + "blah2" coccinelle-1.0.0-rc19/tests/ws2.res0000644000175000017500000000005312247437436015756 0ustar eugeneugenint main() { goto err; err: return; } coccinelle-1.0.0-rc19/tests/not.c0000644000175000017500000000015312247437436015475 0ustar eugeneugenint main() { int x; this(12,x); this(foo,x); bar(12,x); foo(12,x); this(12,x); this(12,x); } coccinelle-1.0.0-rc19/tests/rem1.res0000644000175000017500000000004212247437436016105 0ustar eugeneugenint main () { xxx(); yyy(); } coccinelle-1.0.0-rc19/tests/test12.c0000644000175000017500000000006512247437436016021 0ustar eugeneugenvoid main(int foo) { f(1); foo(); g(2); } coccinelle-1.0.0-rc19/tests/hex2.cocci0000644000175000017500000000002712247437436016401 0ustar eugeneugen@@ @@ - f(0xFFFFFFFF); coccinelle-1.0.0-rc19/tests/spacing.res0000644000175000017500000000026412247437436016673 0ustar eugeneugentypedef int *foo; void *bar(int *baz) { return baz; } int f(int x) { one(); if (x) { two(); if (y) { test(); } } } void *bar(int *baz) { return baz; } coccinelle-1.0.0-rc19/tests/bad_subsumption.cocci0000644000175000017500000000223612247437436020735 0ustar eugeneugen@loc exists@ type T; identifier E; identifier f != {kmalloc,kcalloc,kzalloc}; position pl; @@ T *E; ... when any E = f@pl(...) @probe forall@ identifier E; expression E1,E2; identifier loc.f,g; int ret; statement S; position loc.pl; @@ ( E = f@pl(...); ... when != E if (<+... E == NULL ...+>) S | if (<+...(E = f@pl(...)) == NULL...+>) S ) ... when strict when any when != E2 = E when != E = E2 ( E1 = E; | E = E1;// this could seem bad: the value is being overwritten before being // saved, but in bd_claim_by_kobject in fs/block_dev, the value is // first passed to a function that saves it. anyway, we will see if // this leads to false positives. | g(...,E,...); | return; | return ret; ) // might be a different function than the one matched above @exists@ identifier E; identifier loc.f, probe.g,x; expression E1; position loc.pl; int ret; @@ E = f@pl(...) ... when strict when any when != E1 = E if (...) { ... when any when != E1 = E when != g(...,E,...) g(E + ,"detected allocator",f,g ); ... when != E ( return; | return ret; ) } coccinelle-1.0.0-rc19/tests/incpos1.c0000644000175000017500000000010012247437436016241 0ustar eugeneugen#include "two" #include #include "four" #include coccinelle-1.0.0-rc19/tests/endif.c0000644000175000017500000000035412247437436015765 0ustar eugeneugenvoid f(int i) { x = 1; if(1) x = 3; x = 1; while(1) x = 3; x = 1; do x = 3; while(1); x = 1; for(1;1;1) x = 3; x = 1; for(1;1;1) { x = 3; } // switch(1) { // case 0: x = 3; // default: x = 3; // } } coccinelle-1.0.0-rc19/tests/assign.c0000644000175000017500000000005512247437436016162 0ustar eugeneugenint main(int x) { int x = 100; x = 45; } coccinelle-1.0.0-rc19/tests/ifdef6a.cocci0000644000175000017500000000014212247437436017035 0ustar eugeneugen@ Exemple6@ @@ + #ifdef CONFIG_NKERNEL + #define foo(x) f(x) + #endif #include coccinelle-1.0.0-rc19/tests/type.c0000644000175000017500000000004412247437436015655 0ustar eugeneugenint foo() { int x; return 0; } coccinelle-1.0.0-rc19/tests/exitc.cocci0000644000175000017500000000021212247437436016643 0ustar eugeneugen@r@ identifier x; @@ -f(x); +g(x); @script:ocaml@ x << r.x; @@ if x = "done" then Coccilib.exit() @@ identifier x; @@ g(x + ,y ); coccinelle-1.0.0-rc19/tests/labels_metastatement.cocci0000644000175000017500000000004112247437436021724 0ustar eugeneugen@@ statement S; @@ S + foo(); coccinelle-1.0.0-rc19/tests/vpos.c0000644000175000017500000000011312247437436015660 0ustar eugeneugenint main() { f(2); if (x) { g(1,1); } else { g(1,2); } } coccinelle-1.0.0-rc19/tests/expopt3.c0000644000175000017500000000023612247437436016301 0ustar eugeneugenstatic int pcm20_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct video_tuner v; pcm20_getflags(pcm20, &v.flags, &v.xxx, &v.signal); } coccinelle-1.0.0-rc19/tests/if.res0000644000175000017500000000057712247437436015654 0ustar eugeneugenint main () { before(); f(x); after(); before(); g(x); after(); } int main1 () { before(); f(x); if (x == NULL) { before(); g(x); } } int main1 () { before(); f(x); while (x == NULL) { if (q == 3) { before(); g(x); } } x = 6; } int main2 () { before(); f(x); if (x == NULL || y == 2) { before(); g(x); } } coccinelle-1.0.0-rc19/tests/kmalloc.res0000644000175000017500000000027412247437436016672 0ustar eugeneugenint main() { struct bar *y; struct foo *x = kzalloc(sizeof(struct foo),GPF_KERNEL); if (!x) return -ENOMEM; y = kzalloc(sizeof(struct bar),GPF_KERNEL); if (!y) return -ENOMEM; } coccinelle-1.0.0-rc19/tests/ip.cocci0000644000175000017500000000010712247437436016142 0ustar eugeneugen@@ statement s1, s2; @@ if(...) s1 else +{trace("ifelel"); s2 +} coccinelle-1.0.0-rc19/tests/insdef.cocci0000644000175000017500000000005412247437436017003 0ustar eugeneugen@@ @@ #define TABINFOGEN +#include coccinelle-1.0.0-rc19/tests/stm2.res0000644000175000017500000000004212247437436016126 0ustar eugeneugenint main(int x) { f(); g(); } coccinelle-1.0.0-rc19/tests/km.c0000644000175000017500000000020612247437436015303 0ustar eugeneugenint main() { int *data = kmalloc(element->string.length + 1, GFP_KERNEL); foo(); memset(data, 0, element->string.length + 1); } coccinelle-1.0.0-rc19/tests/typedef3.cocci0000644000175000017500000000037412247437436017263 0ustar eugeneugen@ rule1 @ type T; identifier link; @@ T { ... - dev_link_t link; + struct pcmcia_device *p_dev; ... } @ rule2 extends rule1 @ //T *s; identifier fld; identifier fn; identifier s; @@ fn(...,T *s,...) { <... - s->link.fld + s->p_dev->fld ...> } coccinelle-1.0.0-rc19/tests/fortype.cocci0000644000175000017500000000013112247437436017217 0ustar eugeneugen@@ @@ - x + y @@ identifier x; statement S; @@ for ( - int x + char *p ; ...; ...) Scoccinelle-1.0.0-rc19/tests/proto_ver2.res0000644000175000017500000007037212247437436017357 0ustar eugeneugen/* * * IPACX specific routines * * Author Joerg Petersohn * Derived from hisax_isac.c, isac.c, hscx.c and others * * This software may be used and distributed according to the terms * of the GNU General Public License, incorporated herein by reference. * */ #include #include #include #include #include "hisax_if.h" #include "hisax.h" #include "isdnl1.h" #include "ipacx.h" #define DBUSY_TIMER_VALUE 80 #define TIMER3_VALUE 7000 #define MAX_DFRAME_LEN_L1 300 #define B_FIFO_SIZE 64 #define D_FIFO_SIZE 32 static spinlock_t ipacx_lock = SPIN_LOCK_UNLOCKED; // ipacx interrupt mask values #define _MASK_IMASK 0x2E // global mask #define _MASKB_IMASK 0x0B #define _MASKD_IMASK 0x03 // all on //---------------------------------------------------------- // local function declarations //---------------------------------------------------------- static void ph_command(struct IsdnCardState *cs, unsigned int command); static inline void cic_int(struct IsdnCardState *cs); static void dch_l2l1(struct PStack *st, int pr, void *arg); static void dbusy_timer_handler(struct IsdnCardState *cs); static void ipacx_new_ph(struct IsdnCardState *cs); static void dch_bh(void *data); static void dch_sched_event(struct IsdnCardState *cs, int event); static void dch_empty_fifo(struct IsdnCardState *cs, int count); static void dch_fill_fifo(struct IsdnCardState *cs); static inline void dch_int(struct IsdnCardState *cs); static void __devinit dch_setstack(struct PStack *st, struct IsdnCardState *cs); static void __devinit dch_init(struct IsdnCardState *cs); static void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_empty_fifo(struct BCState *bcs, int count); static void bch_fill_fifo(struct BCState *bcs); static void bch_int(struct IsdnCardState *cs, u_char hscx); static void bch_mode(struct BCState *bcs, int mode, int bc); static void bch_close_state(struct BCState *bcs); static int bch_open_state(struct IsdnCardState *cs, struct BCState *bcs); static int bch_setstack(struct PStack *st, struct BCState *bcs); static void __devinit bch_init(struct IsdnCardState *cs, int hscx); static void __init clear_pending_ints(struct IsdnCardState *cs); //---------------------------------------------------------- // Issue Layer 1 command to chip //---------------------------------------------------------- static void ph_command(struct IsdnCardState *cs, unsigned int command) { if (cs->debug &L1_DEB_ISAC) debugl1(cs, "ph_command (%#x) in (%#x)", command, cs->dc.isac.ph_state); cs->writeisac(cs, IPACX_CIX0, (command << 4) | 0x0E); } //---------------------------------------------------------- // Transceiver interrupt handler //---------------------------------------------------------- static inline void cic_int(struct IsdnCardState *cs) { u_char event; event = cs->readisac(cs, IPACX_CIR0) >> 4; if (cs->debug &L1_DEB_ISAC) debugl1(cs, "cic_int(event=%#x)", event); cs->dc.isac.ph_state = event; dch_sched_event(cs, D_L1STATECHANGE); } //========================================================== // D channel functions //========================================================== //---------------------------------------------------------- // Command entry point //---------------------------------------------------------- static void dch_l2l1(struct PStack *st, int pr, void *arg) { struct IsdnCardState *cs = (struct IsdnCardState *) st->l1.hardware; struct sk_buff *skb = arg; u_char cda1_cr, cda2_cr; switch (pr) { case (PH_DATA |REQUEST): if (cs->debug &DEB_DLOG_HEX) LogFrame(cs, skb->data, skb->len); if (cs->debug &DEB_DLOG_VERBOSE) dlogframe(cs, skb, 0); if (cs->tx_skb) { skb_queue_tail(&cs->sq, skb); #ifdef L2FRAME_DEBUG if (cs->debug &L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA Queued", 0); #endif } else { cs->tx_skb = skb; cs->tx_cnt = 0; #ifdef L2FRAME_DEBUG if (cs->debug &L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA", 0); #endif dch_fill_fifo(cs); } break; case (PH_PULL |INDICATION): if (cs->tx_skb) { if (cs->debug & L1_DEB_WARN) debugl1(cs, " l2l1 tx_skb exist this shouldn't happen"); skb_queue_tail(&cs->sq, skb); break; } if (cs->debug & DEB_DLOG_HEX) LogFrame(cs, skb->data, skb->len); if (cs->debug & DEB_DLOG_VERBOSE) dlogframe(cs, skb, 0); cs->tx_skb = skb; cs->tx_cnt = 0; #ifdef L2FRAME_DEBUG if (cs->debug & L1_DEB_LAPD) Logl2Frame(cs, skb, "PH_DATA_PULLED", 0); #endif dch_fill_fifo(cs); break; case (PH_PULL | REQUEST): #ifdef L2FRAME_DEBUG if (cs->debug & L1_DEB_LAPD) debugl1(cs, "-> PH_REQUEST_PULL"); #endif if (!cs->tx_skb) { clear_bit(FLG_L1_PULL_REQ, &st->l1.Flags); st->l2.l1l2(st, PH_PULL | CONFIRM, NULL); } else set_bit(FLG_L1_PULL_REQ, &st->l1.Flags); break; case (HW_RESET | REQUEST): case (HW_ENABLE | REQUEST): ph_command(cs, IPACX_CMD_TIM); break; case (HW_INFO3 | REQUEST): ph_command(cs, IPACX_CMD_AR8); break; case (HW_TESTLOOP | REQUEST): cs->writeisac(cs, IPACX_CDA_TSDP10, 0x80); // Timeslot 0 is B1 cs->writeisac(cs, IPACX_CDA_TSDP11, 0x81); // Timeslot 0 is B1 cda1_cr = cs->readisac(cs, IPACX_CDA1_CR); cda2_cr = cs->readisac(cs, IPACX_CDA2_CR); if ((long)arg &1) { // loop B1 cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr |0x0a); } else { // B1 off cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr &~0x0a); } if ((long)arg &2) { // loop B2 cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr |0x14); } else { // B2 off cs->writeisac(cs, IPACX_CDA1_CR, cda1_cr &~0x14); } break; case (HW_DEACTIVATE | RESPONSE): skb_queue_purge(&cs->rq); skb_queue_purge(&cs->sq); if (cs->tx_skb) { dev_kfree_skb_any(cs->tx_skb); cs->tx_skb = NULL; } if (test_and_clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) del_timer(&cs->dbusytimer); break; default: if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_l2l1 unknown %04x", pr); break; } } //---------------------------------------------------------- //---------------------------------------------------------- static void dbusy_timer_handler(struct IsdnCardState *cs) { struct PStack *st; int rbchd, stard; if (test_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) { rbchd = cs->readisac(cs, IPACX_RBCHD); stard = cs->readisac(cs, IPACX_STARD); if (cs->debug) debugl1(cs, "D-Channel Busy RBCHD %02x STARD %02x", rbchd, stard); if (!(stard &0x40)) { // D-Channel Busy set_bit(FLG_L1_DBUSY, &cs->HW_Flags); for (st = cs->stlist; st; st = st->next) { st->l2.l1l2(st, PH_PAUSE | INDICATION, NULL); // flow control on } } else { // seems we lost an interrupt; reset transceiver */ clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags); if (cs->tx_skb) { dev_kfree_skb_any(cs->tx_skb); cs->tx_cnt = 0; cs->tx_skb = NULL; } else { printk(KERN_WARNING "HiSax: ISAC D-Channel Busy no skb\n"); debugl1(cs, "D-Channel Busy no skb"); } cs->writeisac(cs, IPACX_CMDRD, 0x01); // Tx reset, generates XPR } } } //---------------------------------------------------------- // L1 state machine intermediate layer to isdnl1 module //---------------------------------------------------------- static void ipacx_new_ph(struct IsdnCardState *cs) { switch (cs->dc.isac.ph_state) { case (IPACX_IND_RES): ph_command(cs, IPACX_CMD_DI); l1_msg(cs, HW_RESET | INDICATION, NULL); break; case (IPACX_IND_DC): l1_msg(cs, HW_DEACTIVATE | CONFIRM, NULL); break; case (IPACX_IND_DR): l1_msg(cs, HW_DEACTIVATE | INDICATION, NULL); break; case (IPACX_IND_PU): l1_msg(cs, HW_POWERUP | CONFIRM, NULL); break; case (IPACX_IND_RSY): l1_msg(cs, HW_RSYNC | INDICATION, NULL); break; case (IPACX_IND_AR): l1_msg(cs, HW_INFO2 | INDICATION, NULL); break; case (IPACX_IND_AI8): l1_msg(cs, HW_INFO4_P8 | INDICATION, NULL); break; case (IPACX_IND_AI10): l1_msg(cs, HW_INFO4_P10 | INDICATION, NULL); break; default: break; } } //---------------------------------------------------------- // bottom half handler for D channel //---------------------------------------------------------- static void dch_bh(void *data) { struct IsdnCardState *cs = data; struct PStack *st; if (!cs) return; if (test_and_clear_bit(D_CLEARBUSY, &cs->event)) { if (cs->debug) debugl1(cs, "D-Channel Busy cleared"); for (st = cs->stlist; st; st = st->next) { st->l2.l1l2(st, PH_PAUSE | CONFIRM, NULL); } } if (test_and_clear_bit(D_RCVBUFREADY, &cs->event)) { DChannel_proc_rcv(cs); } if (test_and_clear_bit(D_XMTBUFREADY, &cs->event)) { DChannel_proc_xmt(cs); } if (test_and_clear_bit(D_L1STATECHANGE, &cs->event)) { ipacx_new_ph(cs); } } //---------------------------------------------------------- // proceed with bottom half handler dch_bh() //---------------------------------------------------------- static void dch_sched_event(struct IsdnCardState *cs, int event) { set_bit(event, &cs->event); schedule_work(&cs->work); } //---------------------------------------------------------- // Fill buffer from receive FIFO //---------------------------------------------------------- static void dch_empty_fifo(struct IsdnCardState *cs, int count) { unsigned long flags; u_char *ptr; if ((cs->debug &L1_DEB_ISAC) && !(cs->debug &L1_DEB_ISAC_FIFO)) debugl1(cs, "dch_empty_fifo()"); // message too large, remove if ((cs->rcvidx + count) >= MAX_DFRAME_LEN_L1) { if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_empty_fifo() incoming message too large"); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC cs->rcvidx = 0; return; } ptr = cs->rcvbuf + cs->rcvidx; cs->rcvidx += count; spin_lock_irqsave(&ipacx_lock, flags); cs->readisacfifo(cs, ptr, count); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_ISAC_FIFO) { char *t = cs->dlog; t += sprintf(t, "dch_empty_fifo() cnt %d", count); QuickHex(t, ptr, count); debugl1(cs, cs->dlog); } } //---------------------------------------------------------- // Fill transmit FIFO //---------------------------------------------------------- static void dch_fill_fifo(struct IsdnCardState *cs) { unsigned long flags; int count; u_char cmd, *ptr; if ((cs->debug &L1_DEB_ISAC) && !(cs->debug &L1_DEB_ISAC_FIFO)) debugl1(cs, "dch_fill_fifo()"); if (!cs->tx_skb) return; count = cs->tx_skb->len; if (count <= 0) return; if (count > D_FIFO_SIZE) { count = D_FIFO_SIZE; cmd = 0x08; // XTF } else { cmd = 0x0A; // XTF | XME } spin_lock_irqsave(&ipacx_lock, flags); ptr = cs->tx_skb->data; skb_pull(cs->tx_skb, count); cs->tx_cnt += count; cs->writeisacfifo(cs, ptr, count); cs->writeisac(cs, IPACX_CMDRD, cmd); // set timeout for transmission contol if (test_and_set_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) { debugl1(cs, "dch_fill_fifo dbusytimer running"); del_timer(&cs->dbusytimer); } init_timer(&cs->dbusytimer); cs->dbusytimer.expires = jiffies + ((DBUSY_TIMER_VALUE * HZ)/1000); add_timer(&cs->dbusytimer); spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_ISAC_FIFO) { char *t = cs->dlog; t += sprintf(t, "dch_fill_fifo() cnt %d", count); QuickHex(t, ptr, count); debugl1(cs, cs->dlog); } } //---------------------------------------------------------- // D channel interrupt handler //---------------------------------------------------------- static inline void dch_int(struct IsdnCardState *cs) { struct sk_buff *skb; u_char istad, rstad; unsigned long flags; int count; istad = cs->readisac(cs, IPACX_ISTAD); if (istad &0x80) { // RME rstad = cs->readisac(cs, IPACX_RSTAD); if ((rstad &0xf0) != 0xa0) { // !(VFR && !RDO && CRC && !RAB) if (!(rstad &0x80)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): invalid frame"); if ((rstad &0x40)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): RDO"); if (!(rstad &0x20)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): CRC error"); cs->writeisac(cs, IPACX_CMDRD, 0x80); // RMC } else { // received frame ok count = cs->readisac(cs, IPACX_RBCLD); if (count) count--; // RSTAB is last byte count &= D_FIFO_SIZE-1; if (count == 0) count = D_FIFO_SIZE; dch_empty_fifo(cs, count); spin_lock_irqsave(&ipacx_lock, flags); if ((count = cs->rcvidx) > 0) { cs->rcvidx = 0; if (!(skb = dev_alloc_skb(count))) printk(KERN_WARNING "HiSax dch_int(): receive out of memory\n"); else { memcpy(skb_put(skb, count), cs->rcvbuf, count); skb_queue_tail(&cs->rq, skb); } } spin_unlock_irqrestore(&ipacx_lock, flags); } cs->rcvidx = 0; dch_sched_event(cs, D_RCVBUFREADY); } if (istad &0x40) { // RPF dch_empty_fifo(cs, D_FIFO_SIZE); } if (istad &0x20) { // RFO if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): RFO"); cs->writeisac(cs, IPACX_CMDRD, 0x40); //RRES } if (istad &0x10) { // XPR if (test_and_clear_bit(FLG_DBUSY_TIMER, &cs->HW_Flags)) del_timer(&cs->dbusytimer); if (test_and_clear_bit(FLG_L1_DBUSY, &cs->HW_Flags)) dch_sched_event(cs, D_CLEARBUSY); if (cs->tx_skb) { if (cs->tx_skb->len) { dch_fill_fifo(cs); goto afterXPR; } else { dev_kfree_skb_irq(cs->tx_skb); cs->tx_skb = NULL; cs->tx_cnt = 0; } } if ((cs->tx_skb = skb_dequeue(&cs->sq))) { cs->tx_cnt = 0; dch_fill_fifo(cs); } else { dch_sched_event(cs, D_XMTBUFREADY); } } afterXPR: if (istad &0x0C) { // XDU or XMR if (cs->debug &L1_DEB_WARN) debugl1(cs, "dch_int(): XDU"); if (cs->tx_skb) { skb_push(cs->tx_skb, cs->tx_cnt); // retransmit cs->tx_cnt = 0; dch_fill_fifo(cs); } else { printk(KERN_WARNING "HiSax: ISAC XDU no skb\n"); debugl1(cs, "ISAC XDU no skb"); } } } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit dch_setstack(struct PStack *st, struct IsdnCardState *cs) { st->l1.l1hw = dch_l2l1; } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit dch_init(struct IsdnCardState *cs) { printk(KERN_INFO "HiSax: IPACX ISDN driver v0.1.0\n"); INIT_WORK(&cs->work, dch_bh, cs); cs->setstack_d = dch_setstack; cs->dbusytimer.function = (void *) dbusy_timer_handler; cs->dbusytimer.data = (long) cs; init_timer(&cs->dbusytimer); cs->writeisac(cs, IPACX_TR_CONF0, 0x00); // clear LDD cs->writeisac(cs, IPACX_TR_CONF2, 0x00); // enable transmitter cs->writeisac(cs, IPACX_MODED, 0xC9); // transparent mode 0, RAC, stop/go cs->writeisac(cs, IPACX_MON_CR, 0x00); // disable monitor channel } //========================================================== // B channel functions //========================================================== //---------------------------------------------------------- // Entry point for commands //---------------------------------------------------------- static void bch_l2l1(struct PStack *st, int pr, void *arg) { struct sk_buff *skb = arg; unsigned long flags; switch (pr) { case (PH_DATA | REQUEST): spin_lock_irqsave(&ipacx_lock, flags); if (st->l1.bcs->tx_skb) { skb_queue_tail(&st->l1.bcs->squeue, skb); spin_unlock_irqrestore(&ipacx_lock, flags); } else { st->l1.bcs->tx_skb = skb; set_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); st->l1.bcs->hw.hscx.count = 0; spin_unlock_irqrestore(&ipacx_lock, flags); bch_fill_fifo(st->l1.bcs); } break; case (PH_PULL | INDICATION): if (st->l1.bcs->tx_skb) { printk(KERN_WARNING "HiSax bch_l2l1(): this shouldn't happen\n"); break; } set_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); st->l1.bcs->tx_skb = skb; st->l1.bcs->hw.hscx.count = 0; bch_fill_fifo(st->l1.bcs); break; case (PH_PULL | REQUEST): if (!st->l1.bcs->tx_skb) { clear_bit(FLG_L1_PULL_REQ, &st->l1.Flags); st->l2.l1l2(st, PH_PULL | CONFIRM, NULL); } else set_bit(FLG_L1_PULL_REQ, &st->l1.Flags); break; case (PH_ACTIVATE | REQUEST): set_bit(BC_FLG_ACTIV, &st->l1.bcs->Flag); bch_mode(st->l1.bcs, st->l1.mode, st->l1.bc); l1_msg_b(st, pr, arg); break; case (PH_DEACTIVATE | REQUEST): l1_msg_b(st, pr, arg); break; case (PH_DEACTIVATE | CONFIRM): clear_bit(BC_FLG_ACTIV, &st->l1.bcs->Flag); clear_bit(BC_FLG_BUSY, &st->l1.bcs->Flag); bch_mode(st->l1.bcs, 0, st->l1.bc); st->l2.l1l2(st, PH_DEACTIVATE | CONFIRM, NULL); break; } } //---------------------------------------------------------- // Read B channel fifo to receive buffer //---------------------------------------------------------- static void bch_empty_fifo(struct BCState *bcs, int count) { u_char *ptr, hscx; struct IsdnCardState *cs; unsigned long flags; int cnt; cs = bcs->cs; hscx = bcs->hw.hscx.hscx; if ((cs->debug &L1_DEB_HSCX) && !(cs->debug &L1_DEB_HSCX_FIFO)) debugl1(cs, "bch_empty_fifo()"); // message too large, remove if (bcs->hw.hscx.rcvidx + count > HSCX_BUFMAX) { if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_empty_fifo() incoming packet too large"); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC bcs->hw.hscx.rcvidx = 0; return; } // Read data uninterruptible spin_lock_irqsave(&ipacx_lock, flags); ptr = bcs->hw.hscx.rcvbuf + bcs->hw.hscx.rcvidx; cnt = count; while (cnt--) *ptr++ = cs->BC_Read_Reg(cs, hscx, IPACX_RFIFOB); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC ptr = bcs->hw.hscx.rcvbuf + bcs->hw.hscx.rcvidx; bcs->hw.hscx.rcvidx += count; spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_HSCX_FIFO) { char *t = bcs->blog; t += sprintf(t, "bch_empty_fifo() B-%d cnt %d", hscx, count); QuickHex(t, ptr, count); debugl1(cs, bcs->blog); } } //---------------------------------------------------------- // Fill buffer to transmit FIFO //---------------------------------------------------------- static void bch_fill_fifo(struct BCState *bcs) { struct IsdnCardState *cs; int more, count, cnt; u_char *ptr, *p, hscx; unsigned long flags; cs = bcs->cs; if ((cs->debug &L1_DEB_HSCX) && !(cs->debug &L1_DEB_HSCX_FIFO)) debugl1(cs, "bch_fill_fifo()"); if (!bcs->tx_skb) return; if (bcs->tx_skb->len <= 0) return; hscx = bcs->hw.hscx.hscx; more = (bcs->mode == L1_MODE_TRANS) ? 1 : 0; if (bcs->tx_skb->len > B_FIFO_SIZE) { more = 1; count = B_FIFO_SIZE; } else { count = bcs->tx_skb->len; } cnt = count; spin_lock_irqsave(&ipacx_lock, flags); p = ptr = bcs->tx_skb->data; skb_pull(bcs->tx_skb, count); bcs->tx_cnt -= count; bcs->hw.hscx.count += count; while (cnt--) cs->BC_Write_Reg(cs, hscx, IPACX_XFIFOB, *p++); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, (more ? 0x08 : 0x0a)); spin_unlock_irqrestore(&ipacx_lock, flags); if (cs->debug &L1_DEB_HSCX_FIFO) { char *t = bcs->blog; t += sprintf(t, "chb_fill_fifo() B-%d cnt %d", hscx, count); QuickHex(t, ptr, count); debugl1(cs, bcs->blog); } } //---------------------------------------------------------- // B channel interrupt handler //---------------------------------------------------------- static void bch_int(struct IsdnCardState *cs, u_char hscx) { u_char istab; struct BCState *bcs; struct sk_buff *skb; int count; u_char rstab; bcs = cs->bcs + hscx; istab = cs->BC_Read_Reg(cs, hscx, IPACX_ISTAB); if (!test_bit(BC_FLG_INIT, &bcs->Flag)) return; if (istab &0x80) { // RME rstab = cs->BC_Read_Reg(cs, hscx, IPACX_RSTAB); if ((rstab &0xf0) != 0xa0) { // !(VFR && !RDO && CRC && !RAB) if (!(rstab &0x80)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: invalid frame", hscx); if ((rstab &0x40) && (bcs->mode != L1_MODE_NULL)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: RDO mode=%d", hscx, bcs->mode); if (!(rstab &0x20)) if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: CRC error", hscx); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x80); // RMC } else { // received frame ok count = cs->BC_Read_Reg(cs, hscx, IPACX_RBCLB) &(B_FIFO_SIZE-1); if (count == 0) count = B_FIFO_SIZE; bch_empty_fifo(bcs, count); if ((count = bcs->hw.hscx.rcvidx - 1) > 0) { if (cs->debug &L1_DEB_HSCX_FIFO) debugl1(cs, "bch_int Frame %d", count); if (!(skb = dev_alloc_skb(count))) printk(KERN_WARNING "HiSax bch_int(): receive frame out of memory\n"); else { memcpy(skb_put(skb, count), bcs->hw.hscx.rcvbuf, count); skb_queue_tail(&bcs->rqueue, skb); } } } bcs->hw.hscx.rcvidx = 0; bch_sched_event(bcs, B_RCVBUFREADY); } if (istab &0x40) { // RPF bch_empty_fifo(bcs, B_FIFO_SIZE); if (bcs->mode == L1_MODE_TRANS) { // queue every chunk // receive transparent audio data if (!(skb = dev_alloc_skb(B_FIFO_SIZE))) printk(KERN_WARNING "HiSax bch_int(): receive transparent out of memory\n"); else { memcpy(skb_put(skb, B_FIFO_SIZE), bcs->hw.hscx.rcvbuf, B_FIFO_SIZE); skb_queue_tail(&bcs->rqueue, skb); } bcs->hw.hscx.rcvidx = 0; bch_sched_event(bcs, B_RCVBUFREADY); } } if (istab &0x20) { // RFO if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d: RFO error", hscx); cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x40); // RRES } if (istab &0x10) { // XPR if (bcs->tx_skb) { if (bcs->tx_skb->len) { bch_fill_fifo(bcs); goto afterXPR; } skb_queue_tail(&bcs->cmpl_queue, bcs->tx_skb); bch_sched_event(bcs, B_CMPLREADY); bcs->hw.hscx.count = 0; } if ((bcs->tx_skb = skb_dequeue(&bcs->squeue))) { bcs->hw.hscx.count = 0; set_bit(BC_FLG_BUSY, &bcs->Flag); bch_fill_fifo(bcs); } else { clear_bit(BC_FLG_BUSY, &bcs->Flag); bch_sched_event(bcs, B_XMTBUFREADY); } } afterXPR: if (istab &0x04) { // XDU if (bcs->mode == L1_MODE_TRANS) { bch_fill_fifo(bcs); } else { if (bcs->tx_skb) { // restart transmitting the whole frame skb_push(bcs->tx_skb, bcs->hw.hscx.count); bcs->tx_cnt += bcs->hw.hscx.count; bcs->hw.hscx.count = 0; } cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x01); // XRES if (cs->debug &L1_DEB_WARN) debugl1(cs, "bch_int() B-%d XDU error", hscx); } } } //---------------------------------------------------------- //---------------------------------------------------------- static void bch_mode(struct BCState *bcs, int mode, int bc) { struct IsdnCardState *cs = bcs->cs; int hscx = bcs->hw.hscx.hscx; bc = bc ? 1 : 0; // in case bc is greater than 1 if (cs->debug & L1_DEB_HSCX) debugl1(cs, "mode_bch() switch B-% mode %d chan %d", hscx, mode, bc); bcs->mode = mode; bcs->channel = bc; // map controller to according timeslot if (!hscx) { cs->writeisac(cs, IPACX_BCHA_TSDP_BC1, 0x80 | bc); cs->writeisac(cs, IPACX_BCHA_CR, 0x88); } else { cs->writeisac(cs, IPACX_BCHB_TSDP_BC1, 0x80 | bc); cs->writeisac(cs, IPACX_BCHB_CR, 0x88); } switch (mode) { case (L1_MODE_NULL): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0xC0); // rec off cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x30); // std adj. cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, 0xFF); // ints off cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments break; case (L1_MODE_TRANS): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0x88); // ext transp mode cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x00); // xxx00000 cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, _MASKB_IMASK); break; case (L1_MODE_HDLC): cs->BC_Write_Reg(cs, hscx, IPACX_MODEB, 0xC8); // transp mode 0 cs->BC_Write_Reg(cs, hscx, IPACX_EXMB, 0x01); // idle=hdlc flags crc enabled cs->BC_Write_Reg(cs, hscx, IPACX_CMDRB, 0x41); // validate adjustments cs->BC_Write_Reg(cs, hscx, IPACX_MASKB, _MASKB_IMASK); break; } } //---------------------------------------------------------- //---------------------------------------------------------- static void bch_close_state(struct BCState *bcs) { bch_mode(bcs, 0, bcs->channel); if (test_and_clear_bit(BC_FLG_INIT, &bcs->Flag)) { if (bcs->hw.hscx.rcvbuf) { kfree(bcs->hw.hscx.rcvbuf); bcs->hw.hscx.rcvbuf = NULL; } if (bcs->blog) { kfree(bcs->blog); bcs->blog = NULL; } skb_queue_purge(&bcs->rqueue); skb_queue_purge(&bcs->squeue); if (bcs->tx_skb) { dev_kfree_skb_any(bcs->tx_skb); bcs->tx_skb = NULL; clear_bit(BC_FLG_BUSY, &bcs->Flag); } } } //---------------------------------------------------------- //---------------------------------------------------------- static int bch_open_state(struct IsdnCardState *cs, struct BCState *bcs) { if (!test_and_set_bit(BC_FLG_INIT, &bcs->Flag)) { if (!(bcs->hw.hscx.rcvbuf = kmalloc(HSCX_BUFMAX, GFP_ATOMIC))) { printk(KERN_WARNING "HiSax open_bchstate(): No memory for hscx.rcvbuf\n"); clear_bit(BC_FLG_INIT, &bcs->Flag); return (1); } if (!(bcs->blog = kmalloc(MAX_BLOG_SPACE, GFP_ATOMIC))) { printk(KERN_WARNING "HiSax open_bchstate: No memory for bcs->blog\n"); clear_bit(BC_FLG_INIT, &bcs->Flag); kfree(bcs->hw.hscx.rcvbuf); bcs->hw.hscx.rcvbuf = NULL; return (2); } skb_queue_head_init(&bcs->rqueue); skb_queue_head_init(&bcs->squeue); } bcs->tx_skb = NULL; clear_bit(BC_FLG_BUSY, &bcs->Flag); bcs->event = 0; bcs->hw.hscx.rcvidx = 0; bcs->tx_cnt = 0; return (0); } //---------------------------------------------------------- //---------------------------------------------------------- static int bch_setstack(struct PStack *st, struct BCState *bcs) { bcs->channel = st->l1.bc; if (bch_open_state(st->l1.hardware, bcs)) return (-1); st->l1.bcs = bcs; st->l1.l2l1 = bch_l2l1; setstack_manager(st); bcs->st = st; setstack_l1_B(st); return (0); } //---------------------------------------------------------- //---------------------------------------------------------- static void __devinit bch_init(struct IsdnCardState *cs, int hscx) { cs->bcs[hscx].BC_SetStack = bch_setstack; cs->bcs[hscx].BC_Close = bch_close_state; cs->bcs[hscx].hw.hscx.hscx = hscx; cs->bcs[hscx].cs = cs; bch_mode(cs->bcs + hscx, 0, hscx); } //========================================================== // Shared functions //========================================================== //---------------------------------------------------------- // Main interrupt handler //---------------------------------------------------------- void interrupt_ipacx(struct IsdnCardState *cs) { u_char ista; while ((ista = cs->readisac(cs, IPACX_ISTA))) { if (ista &0x80) bch_int(cs, 0); // B channel interrupts if (ista &0x40) bch_int(cs, 1); if (ista &0x01) dch_int(cs); // D channel if (ista &0x10) cic_int(cs); // Layer 1 state } } //---------------------------------------------------------- // Clears chip interrupt status //---------------------------------------------------------- static void __init clear_pending_ints(struct IsdnCardState *cs) { int ista; // all interrupts off cs->writeisac(cs, IPACX_MASK, 0xff); cs->writeisac(cs, IPACX_MASKD, 0xff); cs->BC_Write_Reg(cs, 0, IPACX_MASKB, 0xff); cs->BC_Write_Reg(cs, 1, IPACX_MASKB, 0xff); ista = cs->readisac(cs, IPACX_ISTA); if (ista &0x80) cs->BC_Read_Reg(cs, 0, IPACX_ISTAB); if (ista &0x40) cs->BC_Read_Reg(cs, 1, IPACX_ISTAB); if (ista &0x10) cs->readisac(cs, IPACX_CIR0); if (ista &0x01) cs->readisac(cs, IPACX_ISTAD); } //---------------------------------------------------------- // Does chip configuration work // Work to do depends on bit mask in part //---------------------------------------------------------- void __init init_ipacx(struct IsdnCardState *cs, int part) { if (part &1) { // initialise chip clear_pending_ints(cs); bch_init(cs, 0); bch_init(cs, 1); dch_init(cs); } if (part &2) { // reenable all interrupts and start chip cs->BC_Write_Reg(cs, 0, IPACX_MASKB, _MASKB_IMASK); cs->BC_Write_Reg(cs, 1, IPACX_MASKB, _MASKB_IMASK); cs->writeisac(cs, IPACX_MASKD, _MASKD_IMASK); cs->writeisac(cs, IPACX_MASK, _MASK_IMASK); // global mask register // reset HDLC Transmitters/receivers cs->writeisac(cs, IPACX_CMDRD, 0x41); cs->BC_Write_Reg(cs, 0, IPACX_CMDRB, 0x41); cs->BC_Write_Reg(cs, 1, IPACX_CMDRB, 0x41); ph_command(cs, IPACX_CMD_RES); } } //----------------- end of file ----------------------- coccinelle-1.0.0-rc19/tests/disjexpr_ver2.c0000644000175000017500000000005312247437436017462 0ustar eugeneugenint main (int i) { f(v.fld, v.fld2, v); } coccinelle-1.0.0-rc19/tests/scope_problem.res0000644000175000017500000000007112247437436020074 0ustar eugeneugenvoid main(int i) { if(1) { int a; a = 2; } } coccinelle-1.0.0-rc19/tests/pb_params_iso.cocci0000644000175000017500000000116512247437436020355 0ustar eugeneugen// soluce ? // - add isomorphism: // func(..., P, ...) => func(P) , => func(P,...), => func(...,P) ? // but propagate well the modifiers ? // but then how specify that we really want match function // that have parameters before ? use a P metavariable. // - allow func (... int i ...) in parsing_cocci/ @@ identifier func; @@ // pad: this one does not work because the last comma is tagged // and so I force it to be present. // func(..., // - int i, // + int i, char j, // ...) { // ... // } func(..., - int i + int i, char j ,...) { ... } coccinelle-1.0.0-rc19/tests/sp.cocci0000644000175000017500000000010212247437436016147 0ustar eugeneugen@ rule0 @ type T; @@ - typedef struct + name { ... } - T ; coccinelle-1.0.0-rc19/tests/cr1a.res0000644000175000017500000000106212247437436016072 0ustar eugeneugenint __init probe_base_port(int base) { int b = 0x300, e = 0x370; /* this is the range of start addresses */ volatile int fool, i; if (base) b = e = base; for (base = b; base <= e; base += 0x10) { if (!request_region(base,0x10,req_reg_arg3)) continue; for (i = 0; i < 3; i++) fool = inw(base + 2); /* empty possibly uart_receive_buffer */ if ((inw(base + 6) & 0xffef) != 0x0001 || /* line_status */ (inw(base) & 0xad00) != 0) { release_region(base,0x10); continue; } return (base); release_region(base,0x10); } return 0; } coccinelle-1.0.0-rc19/tests/oddifdef.res0000644000175000017500000000072312247437436017013 0ustar eugeneugenvoid one () { if (errno != ENOENT #ifdef ENOTDIR && errno != ENOTDIR #endif ) a = 5; #ifdef FOO x = 0; #else x = 0; #endif } void two() { #ifdef ENOTTY if (errno == ENOTTY) is_a_tty=0; else #endif a = 3; #ifdef FOO x = 0; #else x = 0; #endif } void three() { if (x) a = 3; #ifndef OPENSSL_NO_SSL2 else if (strcmp(*argv,"-ssl2") == 0) meth=SSLv2_client_method(); #endif #ifdef FOO x = 0; #else x = 0; #endif } coccinelle-1.0.0-rc19/tests/td.c0000644000175000017500000000012712247437436015305 0ustar eugeneugenstruct foo {int a;}; typedef struct blah {int a;} name; typedef struct {int a;} xxx; coccinelle-1.0.0-rc19/tests/print_return.c0000644000175000017500000000010012247437436017420 0ustar eugeneugenint config(struct pcmcia_device *link) { bar(); return 0; } coccinelle-1.0.0-rc19/tests/replace_typedef.c0000644000175000017500000000017512247437436020034 0ustar eugeneugentypedef struct foo { int x; } foo_t; typedef int int_t; int main() { foo_t x; int_t y; x.x = 12; return x.x + y; } coccinelle-1.0.0-rc19/tests/cst_null.c0000644000175000017500000000170012247437436016517 0ustar eugeneugenvoid* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kmalloc(size,GFP_KERNEL); if (vb != NULL) { memset(vb,0,size); videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } void* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kmalloc(size,GFP_KERNEL); if (vb) { memset(vb,0,size); videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } void* videobuf_alloc(unsigned int size) { struct videobuf_buffer *vb; vb = kmalloc(size,GFP_KERNEL); if (NULL != vb) { memset(vb,0,size); videobuf_dma_init(&vb->dma); init_waitqueue_head(&vb->done); vb->magic = MAGIC_BUFFER; } return vb; } coccinelle-1.0.0-rc19/tests/fortype.c0000644000175000017500000000007512247437436016370 0ustar eugeneugenint main () { for (int x = 0; x!=10; x++) return x; } coccinelle-1.0.0-rc19/tests/mf.cocci0000644000175000017500000000025212247437436016135 0ustar eugeneugen@ rule1 @ identifier fn1, fn2; expression A, B; @@ fn1(...) { foo(A); } fn2(...) { fn1(); - bar(B); + xxx(A); } @ rule2 extends rule1 @ @@ fn1(...) { - foo(A); } coccinelle-1.0.0-rc19/tests/tdnl.cocci0000644000175000017500000000001512247437436016471 0ustar eugeneugen@@ @@ -foo();coccinelle-1.0.0-rc19/tests/stm4.res0000644000175000017500000000006612247437436016136 0ustar eugeneugenint main(int x) { f(); replace(); g(); g(); } coccinelle-1.0.0-rc19/tests/free.c0000644000175000017500000000300712247437436015617 0ustar eugeneugenstatic int del_from_chain(struct ip_fw *volatile*chainptr, struct ip_fw *frwl) { struct ip_fw *ftmp,*ltmp; unsigned short tport1,tport2,tmpnum; char matches,was_found; unsigned long flags; save_flags(flags); cli(); ftmp=*chainptr; if ( ftmp == NULL ) { #ifdef DEBUG_IP_FIREWALL printk("ip_fw_ctl: chain is empty\n"); #endif restore_flags(flags); return( EINVAL ); } ltmp=NULL; was_found=0; while( !was_found && ftmp != NULL ) { matches=1; if (ftmp->fw_src.s_addr!=frwl->fw_src.s_addr || ftmp->fw_dst.s_addr!=frwl->fw_dst.s_addr || ftmp->fw_smsk.s_addr!=frwl->fw_smsk.s_addr || ftmp->fw_dmsk.s_addr!=frwl->fw_dmsk.s_addr || ftmp->fw_via.s_addr!=frwl->fw_via.s_addr || ftmp->fw_flg!=frwl->fw_flg) matches=0; tport1=ftmp->fw_nsp+ftmp->fw_ndp; tport2=frwl->fw_nsp+frwl->fw_ndp; if (tport1!=tport2) matches=0; else if (tport1!=0) { for (tmpnum=0;tmpnum < tport1 && tmpnum < IP_FW_MAX_PORTS;tmpnum++) if (ftmp->fw_pts[tmpnum]!=frwl->fw_pts[tmpnum]) matches=0; } if (strncmp(ftmp->fw_vianame, frwl->fw_vianame, IFNAMSIZ)) matches=0; if(matches) { was_found=1; if (ltmp) { ltmp->fw_next=ftmp->fw_next; kfree(ftmp); ftmp=ltmp->fw_next; } else { *chainptr=ftmp->fw_next; kfree(ftmp); ftmp=*chainptr; } } else { ltmp = ftmp; ftmp = ftmp->fw_next; } } restore_flags(flags); if (was_found) return 0; else return(EINVAL); } coccinelle-1.0.0-rc19/tests/metaline.res0000644000175000017500000000014712247437436017045 0ustar eugeneugenint main () { static int y; static int x; while (12) f(4+3); h(4 + 3); q(3 + 3); r(3+4); } coccinelle-1.0.0-rc19/tests/mf.c0000644000175000017500000000013012247437436015272 0ustar eugeneugenint fn1() { foo(12); } int fn2() { fn1(); bar(10); } int fn1bis() { foo(7); } coccinelle-1.0.0-rc19/tests/undef.cocci0000644000175000017500000000004012247437436016627 0ustar eugeneugen@@ identifier x; @@ - #undef x coccinelle-1.0.0-rc19/tests/bugon.cocci0000644000175000017500000000012012247437436016637 0ustar eugeneugen@disable unlikely@ expression E; @@ - if (unlikely(E)) { BUG(); } + BUG_ON(E); coccinelle-1.0.0-rc19/tests/test4.c0000644000175000017500000000011112247437436015732 0ustar eugeneugenvoid main() { f(1,2,3); h(1); if(1) g(1); else g(1); } coccinelle-1.0.0-rc19/tests/ty_tyexp.res0000644000175000017500000000014012247437436017125 0ustar eugeneugenvoid main(double z) { float x; float y; } float main(float z) { } float main2(float z); coccinelle-1.0.0-rc19/tests/ifdef1.c0000644000175000017500000000031212247437436016030 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/posnpb.c0000644000175000017500000000011112247437436016170 0ustar eugeneugenint main() { x = FN(); if (y) x->a = 12; else x->b = 15; } coccinelle-1.0.0-rc19/tests/ifdef4.res0000644000175000017500000000040512247437436016405 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { #ifdef CONFIG_NKERNEL if (irq < IRQ_LIMIT) #endif *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/stmt.c0000644000175000017500000000003612247437436015664 0ustar eugeneugenint f() { int x; xxx(); } coccinelle-1.0.0-rc19/tests/expnest.cocci0000644000175000017500000000007512247437436017224 0ustar eugeneugen@expression@ @@ <+... f() ...+> - + + - <+... g() ...+> coccinelle-1.0.0-rc19/tests/minfn.c0000644000175000017500000000030612247437436016004 0ustar eugeneugenint main () { return first; } int f () { return second; } int f () { return second; } int main () { return third; } #define x 3 #define x 3 #define x 3 #define x 3 int main () { return fifth; } coccinelle-1.0.0-rc19/tests/orexp.cocci0000644000175000017500000000007112247437436016667 0ustar eugeneugen@@ expression E, F; @@ ( - foo(E) + 4 | - bar(F) + 4 )coccinelle-1.0.0-rc19/tests/regexp3.res0000644000175000017500000000134212247437436016622 0ustar eugeneugen int main(void) { char *t0 = "FOO"; char * t0_equals_cst_that_begins_by_FOO; char * t0_equals_cst_that_ends_by_FOO; char * t0_equals_cst_that_contains_FOO; char * t0_is_constant; char *t1 = "BAR"; char * t1_equals_cst_that_doesn_t_contain_FOO; char * t1_is_constant; char *t2 = "FOOBAR"; char * t2_equals_cst_that_begins_by_FOO; char * t2_equals_cst_that_contains_FOO; char * t2_is_constant; char *t3 = "BARFOOBAR"; char * t3_equals_cst_that_contains_FOO; char * t3_is_constant; char *t4 = "BARFOO"; char * t4_equals_cst_that_ends_by_FOO; char * t4_equals_cst_that_contains_FOO; char * t4_is_constant; char *s0 = "%s"; char * s0_is_a_format_for_at_least_a_string; char * s0_equals_cst_that_doesn_t_contain_FOO; char * s0_is_constant; } coccinelle-1.0.0-rc19/tests/disjid.c0000644000175000017500000000027112247437436016144 0ustar eugeneugenint foo (int x, int z) { return 0; } int foo (int y, int z) { return 0; } int bar (int x, int z) { return 0; } int bar (int y, int z) { return 0; } int xxx (int y, int z) { return 0; } coccinelle-1.0.0-rc19/tests/useless_cast.c0000644000175000017500000000056012247437436017374 0ustar eugeneugen // from: http://kernelnewbies.org/KernelJanitors/Todo struct device { struct netdev_private *priv; struct netdev_private2 *priv2; }; struct device *dev; struct netdev_private *np = (struct netdev_private *) dev->priv; struct netdev_private *np2 = (struct netdev_private *) dev->priv2; struct netdev_private *np3 = (struct netdev_private *) dev; coccinelle-1.0.0-rc19/tests/typedef3.res0000644000175000017500000000041312247437436016766 0ustar eugeneugentypedef struct bluecard_info_t { struct pcmcia_device *p_dev; } foo; static void should_work(foo *info) { unsigned int iobase = info->p_dev->io.BasePort1; } static void does_work(struct bluecard_info_t *info) { unsigned int iobase = info->p_dev->io.BasePort1; } coccinelle-1.0.0-rc19/tests/bitfield.res0000644000175000017500000000033412247437436017027 0ustar eugeneugenstruct dvb_frontend { struct dvb_frontend_ops ops; }; typedef struct { u8 RESET :1; u8 IDLE :1; u8 STOP :1; u8 HIRQ0 :1; u8 HIRQ1 :1; u8 na0 :1; u8 HABAV :1; u8 na1 :1; } bcm3510_register_value; coccinelle-1.0.0-rc19/tests/symbol.res0000644000175000017500000000005112247437436016546 0ustar eugeneugenint main() { int f = 0; return f; } coccinelle-1.0.0-rc19/tests/rem1.c0000644000175000017500000000006612247437436015544 0ustar eugeneugenint main () { xxx(); if (x) { foo(); } yyy(); } coccinelle-1.0.0-rc19/tests/expopt2.res0000644000175000017500000000005012247437436016641 0ustar eugeneugenvoid main(int i) { f(v, g(w.aa)); } coccinelle-1.0.0-rc19/tests/fp.c0000644000175000017500000000004712247437436015304 0ustar eugeneugenint main(int (*x)(int,int)) { x(); } coccinelle-1.0.0-rc19/tests/after_if.c0000644000175000017500000000020312247437436016450 0ustar eugeneugen#ifdef ELMC_MULTICAST static void set_multicast_list(struct net_device *dev); #endif static struct ethtool_ops netdev_ethtool_ops; coccinelle-1.0.0-rc19/tests/file.h0000644000175000017500000000003112247437436015614 0ustar eugeneugen int xmain () { f(); } coccinelle-1.0.0-rc19/tests/multidec.res0000644000175000017500000000005712247437436017055 0ustar eugeneugenint main () { int x = 3,z; int x = 12,y; } coccinelle-1.0.0-rc19/tests/stm5.cocci0000644000175000017500000000005512247437436016424 0ustar eugeneugen@@ statement S; @@ f(); + h(); S + g(); coccinelle-1.0.0-rc19/tests/voyager.cocci0000644000175000017500000000042412247437436017210 0ustar eugeneugen// spatch -test voyager -sgrep2 @ r4 @ type T, T2; expression x; expression E1,E2,E; @@ - x = (T)kmalloc(E1,E2) ... when != x = E - memset((T2)x,0,E1); @ r18 @ type T, T2; type T1; T1 *x; expression E1,E2; @@ - x = (T)kmalloc(E1,E2) ... - memset((T2)x,0,sizeof(T1)); coccinelle-1.0.0-rc19/tests/julia7.c0000644000175000017500000000012712247437436016071 0ustar eugeneugenint main(int x) { foo(); if (x) {bar(); after(); return 0;} bar(); after(); } coccinelle-1.0.0-rc19/tests/multiplus.res0000644000175000017500000000065512247437436017311 0ustar eugeneugenstatic void xm_link_timer(struct work_struct *work) { struct net_device *dev = arg; struct skge_port *skge = netdev_priv(arg); struct skge_hw *hw = skge->hw; int port = skge->port; if (!netif_running(dev)) return; if (netif_carrier_ok(dev)) { xm_read16(hw, port, XM_ISRC); if (!(xm_read16(hw, port, XM_ISRC) & XM_IS_INP_ASS)) goto nochange; } nochange: schedule_delayed_work(&skge->link_thread, LINK_HZ); } coccinelle-1.0.0-rc19/tests/localid.c0000644000175000017500000000010312247437436016277 0ustar eugeneugenint c; int main () { int a; f(a); f(a+1); f(b); f(c); } coccinelle-1.0.0-rc19/tests/ifzz.cocci0000644000175000017500000000002312247437436016511 0ustar eugeneugen@@ @@ -int +size_t coccinelle-1.0.0-rc19/tests/disjexpr_ver1.c0000644000175000017500000000004012247437436017455 0ustar eugeneugenint main (int i) { f(v.fld); } coccinelle-1.0.0-rc19/tests/tup.res0000644000175000017500000000032412247437436016054 0ustar eugeneugenstatic int cm206_block_ioctl(struct inode *inode, struct file *file, unsigned cmd, unsigned long arg) { return xxx(); } static struct block_device_operations cm206_bdops = { .ioctl = cm206_block_ioctl }; coccinelle-1.0.0-rc19/tests/minenum.cocci0000644000175000017500000000007512247437436017206 0ustar eugeneugen@@ @@ enum h { ..., - a, - z, + qq, ..., b, ... }; coccinelle-1.0.0-rc19/tests/type_annotated.res0000644000175000017500000000024212247437436020261 0ustar eugeneugenvoid f1(int z) { struct foo i; struct foo2 j; int k; j+i.newfoo+j.foo; } void f2(struct foo i) { struct foo2 j; int k; j+i.newfoo+j.foo; } coccinelle-1.0.0-rc19/tests/remove_call.res0000644000175000017500000000002012247437436017525 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/comment_brace.cocci0000644000175000017500000000005512247437436020332 0ustar eugeneugen@@ @@ + release_region(); continue; coccinelle-1.0.0-rc19/tests/com.res0000644000175000017500000000010212247437436016014 0ustar eugeneugenint main() { /* a comment */ /* a comment */ bar(); } coccinelle-1.0.0-rc19/tests/delete_function.cocci0000644000175000017500000000005012247437436020676 0ustar eugeneugen@@ @@ -foo() { - a(); - a(); - a(); -} coccinelle-1.0.0-rc19/tests/gcc_min_max.res0000644000175000017500000000012712247437436017511 0ustar eugeneugenint main() { int a, b; min(a, b); a = min(a, b); max(a, b); a = max(a, b); } coccinelle-1.0.0-rc19/tests/dropparam.cocci0000644000175000017500000000047312247437436017525 0ustar eugeneugen@ rule1 disable add_signed @ parameter list[n] P; identifier x; @@ f (P,int x,...) { ... } @ rule3 disable add_signed @ expression list[rule1.n] Es; expression E; identifier x; @@ g (Es, - E, ...) @ rule2 disable add_signed @ parameter list[rule1.n] P; identifier x; @@ g (P, - int x, ...) { ... } coccinelle-1.0.0-rc19/tests/getc.c0000644000175000017500000000016112247437436015616 0ustar eugeneugenint IFoo_QueryInterface(int *iface, long *riid, void **ppv) { return IBar_QueryInterface(iface, riid, *ppv); } coccinelle-1.0.0-rc19/tests/test9.cocci0000644000175000017500000000023312247437436016602 0ustar eugeneugen@@ identifier func; // work with local function ? with function ? expression X,Y; @@ func(...) { ... f(X); ... - h(Y); + h(X, Y); ... } coccinelle-1.0.0-rc19/tests/debug.res0000644000175000017500000000007012247437436016330 0ustar eugeneugenstatic int __init init_3c574_cs(void) { return 0; } coccinelle-1.0.0-rc19/tests/not_converted.c0000644000175000017500000000062512247437436017552 0ustar eugeneugen// -ifdef_to_if doesn't convert this ifdef ssize_t __net_Write( vlc_object_t *p_this, int fd, const v_socket_t *p_vs, const uint8_t *p_data, size_t i_data ) { if (p_vs != NULL) val = p_vs->pf_send (p_vs->p_sys, p_data, i_data); else #ifdef WIN32 val = send (fd, p_data, i_data, 0); #else val = write (fd, p_data, i_data); #endif } coccinelle-1.0.0-rc19/tests/switch_case.cocci0000644000175000017500000000023312247437436020026 0ustar eugeneugen@@ @@ - switch(1) { + switch(2) { case CASE1: case1(); case3(); //case4(); //break; case CASE2: case2(); break; } coccinelle-1.0.0-rc19/tests/distribute.cocci0000644000175000017500000000007012247437436017707 0ustar eugeneugen@@ expression E; @@ f( + g(1) * - E + 0 + * g(2) ) coccinelle-1.0.0-rc19/tests/spl.c0000644000175000017500000000034312247437436015474 0ustar eugeneugenint main() { spin_lock(&isp116x->lock); /* take idle endpoints out of the schedule */ if (!list_empty(&ep->hep->urb_list)) { return; } /* async deschedule */ if (!list_empty(&ep->schedule)) { return; } } coccinelle-1.0.0-rc19/tests/allbound.cocci0000644000175000017500000000014512247437436017334 0ustar eugeneugen@ rule1 @ expression E, E1; @@ ( foo(E1) | bar(E) ) @ rule2 extends rule1 @ @@ - xxx(E1) + yyy(E) coccinelle-1.0.0-rc19/tests/multidecl.c0000644000175000017500000000036212247437436016661 0ustar eugeneugenstatic void elsa_cs_detach(struct pcmcia_device *link) { } /* elsa_cs_detach */ static void elsa_cs_config(struct pcmcia_device *link) { int i, j, last_fn; } static struct pcmcia_driver elsa_cs_driver = { .detach = elsa_cs_detach }; coccinelle-1.0.0-rc19/tests/cs_check.cocci0000644000175000017500000000013512247437436017275 0ustar eugeneugen@@ expression E1; @@ - pcmcia_get_first_tuple(handle,E1) + pcmcia_get_first_tuple(link, E1) coccinelle-1.0.0-rc19/tests/stm10.c0000644000175000017500000000011212247437436015634 0ustar eugeneugenint main(int x) { f(); if (x) replace(); g(); if (x) replace(); } coccinelle-1.0.0-rc19/tests/test0.cocci0000644000175000017500000000001712247437436016571 0ustar eugeneugen@@ @@ - f(1); coccinelle-1.0.0-rc19/tests/type_infer.cocci0000644000175000017500000000022512247437436017677 0ustar eugeneugen@ disable all @ expression *xx; @@ - foo(xx); @ disable all @ type T1; identifier x; expression E1; @@ - T1 x = kmalloc(E1); ... - memset(E1); coccinelle-1.0.0-rc19/tests/test10_ver1.res0000644000175000017500000000011312247437436017315 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); //g(1); h(1, 1); h(1); } coccinelle-1.0.0-rc19/tests/iterator.c0000644000175000017500000000041012247437436016522 0ustar eugeneugenvoid pcibios_report_status(u_int status_mask, int warn) { struct list_head *l; list_for_each(l, &pci_root_buses) { struct pci_bus *bus = pci_bus_b(l); pcibios_bus_report_status(bus, status_mask, warn); } } coccinelle-1.0.0-rc19/tests/fsh.c0000644000175000017500000000003712247437436015456 0ustar eugeneugenint main () { f(c); g(); } coccinelle-1.0.0-rc19/tests/ty_tyexp.cocci0000644000175000017500000000002512247437436017416 0ustar eugeneugen@@ @@ - int + float coccinelle-1.0.0-rc19/tests/delp.c0000644000175000017500000000004412247437436015620 0ustar eugeneugenint main () { return (foo); } coccinelle-1.0.0-rc19/tests/check_order1.c0000644000175000017500000000010612247437436017224 0ustar eugeneugenint main () { f(one); f(two); f(three); f(four); f(five); } coccinelle-1.0.0-rc19/tests/null_type.res0000644000175000017500000000007212247437436017257 0ustar eugeneugenint main(int i) { int *x; g(f(x)); g(f(NULL)); } coccinelle-1.0.0-rc19/tests/sis.res0000644000175000017500000000006712247437436016046 0ustar eugeneugenDEFINE_MUTEX(disconnect_sem); //int foo() { return; } coccinelle-1.0.0-rc19/tests/cs_check.c0000644000175000017500000000043312247437436016440 0ustar eugeneugen#define CS_CHECK(fn, ret) \ do { last_fn = (fn); if ((last_ret = (ret)) != 0) goto cs_failed; } while (0) static void nsp_cs_config(dev_link_t *link) { client_handle_t handle = link->handle; CS_CHECK(GetFirstTuple, pcmcia_get_first_tuple(handle, &tuple)); cs_failed: return; } coccinelle-1.0.0-rc19/tests/constrem.c0000644000175000017500000000006712247437436016533 0ustar eugeneugenstatic const int a; static const int (*f)(const int); coccinelle-1.0.0-rc19/tests/hil1.res0000644000175000017500000000021612247437436016101 0ustar eugeneugen#define FUNC(funct, funct_arg, zero_rc, neg_rc, pos_rc) \ { HILSE_FUNC, { func: &funct }, funct_arg, zero_rc }, int main () { return 5; } coccinelle-1.0.0-rc19/tests/local.c0000644000175000017500000000004412247437436015766 0ustar eugeneugenint f(int xx, int yy) { return 0; } coccinelle-1.0.0-rc19/tests/my.h0000644000175000017500000000066512247437436015337 0ustar eugeneugen#define DBG_OFFSCREEN(a) #define I830FALLBACK(s, arg...) \ do { \ if (I830PTR(pScrn)->fallback_debug) { \ xf86DrvMsg(pScrn->scrnIndex, X_INFO, \ "EXA fallback: " s "\n", ##arg); \ } \ return FALSE; \ } while(0) coccinelle-1.0.0-rc19/tests/formatlist.res0000644000175000017500000000035212247437436017431 0ustar eugeneugenint main () { foo("xyz %d abc"); foo("blah2"); foo("mno %d %d abc"); foo("mno %d abc %d %d abc %d"); foo("blah"); foo("blah"); foo("xyz %d abc %d %d abc %d %d abc %d"); foo("xyz %d abc %d %d abc"); foo("xyz abc"); } coccinelle-1.0.0-rc19/tests/find_long.c0000644000175000017500000000014512247437436016635 0ustar eugeneugenlong function() { long a; int b; a + b; b + a; return a; } coccinelle-1.0.0-rc19/tests/static.res0000644000175000017500000000005512247437436016534 0ustar eugeneugenstatic inline int i8042_read_data(void) { } coccinelle-1.0.0-rc19/tests/define_chip_t.cocci0000644000175000017500000000013512247437436020313 0ustar eugeneugen@ rule1 @ type T; @@ - #define chip_t T @@ typedef chip_t; type rule1.T; @@ - chip_t + T coccinelle-1.0.0-rc19/tests/mini_null_ref.res0000644000175000017500000000067712247437436020101 0ustar eugeneugenstatic int __devinit w90p910_keypad_probe(struct platform_device *pdev) { const struct w90p910_keypad_platform_data *pdata = pdev->dev.platform_data; const struct matrix_keymap_data * keymap_data; if (!pdata) { dev_err(&pdev->dev, "no platform data defined\n"); return -EINVAL; } keymap_data = pdata->keymap_data; return; } coccinelle-1.0.0-rc19/tests/exitp.c0000644000175000017500000000006612247437436016031 0ustar eugeneugenint main () { f(a1); f(a2); f(done); f(a4); } coccinelle-1.0.0-rc19/tests/metastatement.c0000644000175000017500000000005512247437436017551 0ustar eugeneugenvoid main(int i) { g(1); g(2); f(1); } coccinelle-1.0.0-rc19/tests/param.cocci0000644000175000017500000000003212247437436016627 0ustar eugeneugen@@ @@ - foo(...) { ... } coccinelle-1.0.0-rc19/tests/decl.c0000644000175000017500000000007112247437436015603 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { return 0; } coccinelle-1.0.0-rc19/tests/multi_func1.c0000644000175000017500000000024412247437436017124 0ustar eugeneugenint f1() { foo(12); } int f2() { bar(12); } int f3() { bar(7); } int f4() { foo(12); } int f5() { bar(12); } int main() { f1(); f2(); f3(); } coccinelle-1.0.0-rc19/tests/rets.c0000644000175000017500000000004612247437436015653 0ustar eugeneugenint main () { foo(); return 12; } coccinelle-1.0.0-rc19/tests/incompatible_value.res0000644000175000017500000000010412247437436021102 0ustar eugeneugenint main() { f(1); f(2); } int main() { g(1); g(2); } coccinelle-1.0.0-rc19/tests/metaruleelem.c0000644000175000017500000000007712247437436017363 0ustar eugeneugenint main(int x) { f(); if(1) { replace(); } g(); } coccinelle-1.0.0-rc19/tests/zero.c0000644000175000017500000000037012247437436015655 0ustar eugeneugenint main () { memset(command, 0, sizeof(struct sbp2_command_info)); memset(command, 0x00, sizeof(struct sbp2_command_info)); memset(command, 0x0, sizeof(struct sbp2_command_info)); memset(command, '\0', sizeof(struct sbp2_command_info)); } coccinelle-1.0.0-rc19/tests/oneline.res0000644000175000017500000000003612247437436016675 0ustar eugeneugenint main () { g(); g(); } coccinelle-1.0.0-rc19/tests/tydisj.res0000644000175000017500000000007412247437436016554 0ustar eugeneugenint64_t foo() { int64_t a; int i; xxx(); return i << 20; } coccinelle-1.0.0-rc19/tests/ifbr.res0000644000175000017500000000004512247437436016166 0ustar eugeneugenint main () { if (x) return; } coccinelle-1.0.0-rc19/tests/disjexpr.res0000644000175000017500000000005612247437436017076 0ustar eugeneugenint main (int i) { f(v->fld, *v, v->fld2); } coccinelle-1.0.0-rc19/tests/ar.res0000644000175000017500000000016712247437436015653 0ustar eugeneugenstruct bar { struct foo *a; struct foo b[27]; }; int main() { struct foo *x; struct bar *y; struct foo z[15]; } coccinelle-1.0.0-rc19/tests/send_pci20000644000175000017500000000223112247437436016321 0ustar eugeneugenSend to: thomas@winischhofer.net, linux-kernel@vger.kernel.org, kernel-janitors@vger.kernel.org Subject: [PATCH 2/2]: drivers/video: remove unnecessary pci_dev_put --------------------------------------- From: Julia Lawall pci_get_class implicitly does a pci_dev_put on its second argument, so pci_dev_put is only needed if there is a break out of the loop. The semantic match detecting this problem is as follows: // @@ expression dev; expression E; @@ * pci_dev_put(dev) ... when != dev = E ( * pci_get_device(...,dev) | * pci_get_device_reverse(...,dev) | * pci_get_subsys(...,dev) | * pci_get_class(...,dev) ) // Signed-off-by: Julia Lawall --- diff -up a/drivers/video/sis/sis_main.c b/drivers/video/sis/sis_main.c --- a/drivers/video/sis/sis_main.c 2007-11-15 07:33:31.000000000 +0100 +++ b/drivers/video/sis/sis_main.c 2007-11-15 07:38:48.000000000 +0100 @@ -4620,9 +4620,9 @@ sisfb_find_host_bridge(struct sis_video_ while((pdev = pci_get_class(PCI_CLASS_BRIDGE_HOST, pdev))) { temp = pdev->vendor; - pci_dev_put(pdev); if(temp == pcivendor) { ret = 1; + pci_dev_put(pdev); break; } } coccinelle-1.0.0-rc19/tests/test11.res0000644000175000017500000000012112247437436016360 0ustar eugeneugenvoid main(int i) { f(1); g(1); g(1); // if comment then simpler h(1); } coccinelle-1.0.0-rc19/tests/const_array.c0000644000175000017500000000115412247437436017223 0ustar eugeneugenstatic const char *r128_family[] __devinitdata = { "AGP", "PCI", }; static const char *r128_family1[] = { "AGP", "PCI", }; static char *r128_family2[] = { "AGP", "PCI", }; static struct foo *r128_family3[] = { "AGP", "PCI", }; static const struct foo *r128_family4[] = { "AGP", "PCI", }; int main () { ent->driver_data = sizeof(r128_family)/sizeof(char *); ent->driver_data = sizeof(r128_family1)/sizeof(char *); ent->driver_data = sizeof(r128_family2)/sizeof(char *); ent->driver_data = sizeof(r128_family3)/sizeof(struct foo *); ent->driver_data = sizeof(r128_family4)/sizeof(struct foo *); } coccinelle-1.0.0-rc19/tests/include.res0000644000175000017500000000010612247437436016665 0ustar eugeneugen #include #include void main(int i) { i++; } coccinelle-1.0.0-rc19/tests/ktype.res0000644000175000017500000000023512247437436016401 0ustar eugeneugentypedef struct r1_private_data_s conf_t; static int run(mddev_t *mddev) { conf_t *conf; conf = kzalloc(sizeof(conf_t), GFP_KERNEL); if (!conf) return; } coccinelle-1.0.0-rc19/tests/debug.cocci0000644000175000017500000000010112247437436016612 0ustar eugeneugen@@ identifier init; @@ init(...) { - DEBUG(...); ... } coccinelle-1.0.0-rc19/tests/partial.c0000644000175000017500000000017312247437436016333 0ustar eugeneugen#define CS_THIS_MODULE THIS_MODULE, #define CS_OWNER owner: void cs46xx_null(struct pci_dev *pcidev) { return PAGE_SIZE; } coccinelle-1.0.0-rc19/tests/ifields.c0000644000175000017500000000036012247437436016314 0ustar eugeneugen typedef struct tag_obj { int x; int y; const IFaceVtbl *lpVtbl; int a; } Tobj; static struct IFaceImpl obj = { 1, 2, &x, 3 }; static struct IFaceImpl obj1 = { 1, 2, 6, &x, 3 }; coccinelle-1.0.0-rc19/tests/starprint.c0000644000175000017500000000011212247437436016716 0ustar eugeneugentypedef int *LPINT; int foo(LPINT x, LPINT *y) { return *x == **y; } coccinelle-1.0.0-rc19/tests/addaft.cocci0000644000175000017500000000005212247437436016754 0ustar eugeneugen@@ statement S; @@ foo(); - S + bar(); coccinelle-1.0.0-rc19/tests/metastatement2.res0000644000175000017500000000004412247437436020200 0ustar eugeneugenvoid main(int i) { f(); g(); } coccinelle-1.0.0-rc19/tests/constty.res0000644000175000017500000000010612247437436016745 0ustar eugeneugenint main () { const int x; int y; f(y,int); f(x,const int); } coccinelle-1.0.0-rc19/tests/eb1.c0000644000175000017500000000011012247437436015335 0ustar eugeneugenint func() { int c; Packet p1,p2; int y; a = 3; return x+y; } coccinelle-1.0.0-rc19/tests/nestseq.cocci0000644000175000017500000000007112247437436017214 0ustar eugeneugen@@ expression E; @@ f(); <... g(E) ...> h(); + xxx(E); coccinelle-1.0.0-rc19/tests/gotobreak.res0000644000175000017500000000045212247437436017223 0ustar eugeneugenstatic void sedlbauer_config(struct pcmcia_device *link) { while (1) { if ((cfg->mem.nwin > 0) || (dflt.mem.nwin > 0)) { goto next_entry; } /* If we got this far, we're cool! */ break; next_entry: CS_CHECK(GetNextTuple, pcmcia_get_next_tuple(link, &tuple)); } return 0; } coccinelle-1.0.0-rc19/tests/skip.cocci0000644000175000017500000000013312247437436016477 0ustar eugeneugen@ rule1 @ expression E; @@ f(E) @@ @@ - g(); + h(); @@ expression rule1.E; @@ - f(E); coccinelle-1.0.0-rc19/tests/multivars.res0000644000175000017500000000005212247437436017270 0ustar eugeneugenvoid main(int i) { h(1+2+v.field1); } coccinelle-1.0.0-rc19/tests/strangeorder.cocci0000644000175000017500000000013012247437436020225 0ustar eugeneugen@@ expression *E; identifier f; statement S1; @@ if (E == NULL) +{ + E = NULL; S1 +} coccinelle-1.0.0-rc19/tests/test2.res0000644000175000017500000000010312247437436016300 0ustar eugeneugenvoid main() { f(1,2,3); if(1) h(1); else h(1); } coccinelle-1.0.0-rc19/tests/inner.cocci0000644000175000017500000000017112247437436016646 0ustar eugeneugen@@ identifier ty,x; expression a; initializer list is; @@ struct ty x[] = {..., {is, - a + .i = foo(a) ,...}, ...}; coccinelle-1.0.0-rc19/tests/pb_params_iso.c0000644000175000017500000000020612247437436017512 0ustar eugeneugen int f(bool a, int i, bool b) { i++; } int f(int i, bool b) { i++; } int f(bool a, int i) { i++; } int f(int i) { i++; } coccinelle-1.0.0-rc19/tests/tadb.c0000644000175000017500000000017412247437436015612 0ustar eugeneugenstatic int adbhid_kbd_event() { } static void adbhid_input_register() { adbhid[id]->input.event = adbhid_kbd_event; } coccinelle-1.0.0-rc19/tests/not.res0000644000175000017500000000013412247437436016043 0ustar eugeneugenint main() { int x; f(20); this(foo,x); bar(12,x); foo(12,x); f(20); f(20); } coccinelle-1.0.0-rc19/tests/void.res0000644000175000017500000000021412247437436016203 0ustar eugeneugenint xbar(void) { return; } int foo(void) { return; } // this is some info about bar int bar(void) { return; } int foo(void) { return; } coccinelle-1.0.0-rc19/tests/protox.cocci0000644000175000017500000000070312247437436017067 0ustar eugeneugen// before handling "depends on", when julia was generating // from this rule the rule to modify the corresponding prototype, // this rule was applied whatever happend an in particular // this SP will not match the .c because return x <> return 12 // but its prototype will still be modified :( // with "depends on" the prototype is changed only if the // function is matched and transformed. @@ @@ - f(int x) + f(int x, int y) { return x; } coccinelle-1.0.0-rc19/tests/stm5.c0000644000175000017500000000005712247437436015570 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/y.c0000644000175000017500000000004512247437436015145 0ustar eugeneugenint main() { foo(12); bar(80); } coccinelle-1.0.0-rc19/tests/test_s.res0000644000175000017500000000067112247437436016552 0ustar eugeneugenint main () { if (x-one) { one(); } if (12) { one(); two(); } if (x-three) { one(); two(); three(); } if (12) { while (x) { one(); } while (x) { one(); two(); } } if (one) { while (x) { one(); } } if (three) { while (x) { one(); } while (x) { one(); two(); } while (x) { one(); two(); } } } coccinelle-1.0.0-rc19/tests/skip.c0000644000175000017500000000004712247437436015645 0ustar eugeneugenint main () { f(1); f(2); g(); } coccinelle-1.0.0-rc19/tests/param_to_exp.res0000644000175000017500000000006512247437436017724 0ustar eugeneugenint main (int x, int y) { foo(x, y); return 0; } coccinelle-1.0.0-rc19/tests/typeur.c0000644000175000017500000000007212247437436016225 0ustar eugeneugen#include "typeur.h" int main () { int y; f(x + y); } coccinelle-1.0.0-rc19/tests/param_ver1.res0000644000175000017500000000000212247437436017272 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/csw.res0000644000175000017500000000007512247437436016043 0ustar eugeneugenint main() { switch (x) { case MID: mid(); break; } } coccinelle-1.0.0-rc19/tests/badpos.cocci0000644000175000017500000000010612247437436017001 0ustar eugeneugen@@ struct pt_regs *regs; expression E; expression f; @@ - regs + xxx coccinelle-1.0.0-rc19/tests/bug1.res0000644000175000017500000000022712247437436016104 0ustar eugeneugenstatic int typhoon_ioctl(struct inode *i, struct file *f, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; return 0; } coccinelle-1.0.0-rc19/tests/posmult.cocci0000644000175000017500000000071012247437436017235 0ustar eugeneugen// shows the expressive power added by positions // normally, we find one root and then explore its children. // here the root is in some sense the if, and we want to see if it can // be reached from two contexts @n@ position p; expression E; statement S,S1; @@ E = NULL ... when != E = ALLOC(...) if@p (\(E\|!E\)) S else S1 @@ expression E, E1; statement S,S1; position p1 != n.p; @@ * E = ALLOC(...) ... when != E = E1 * if@p1 (\(E\|!E\)) S else S1 coccinelle-1.0.0-rc19/tests/null_type.c0000644000175000017500000000006412247437436016711 0ustar eugeneugenint main(int i) { int *x; g(x); g(NULL); } coccinelle-1.0.0-rc19/tests/match_init.res0000644000175000017500000000021512247437436017362 0ustar eugeneugenint probably_works () { int a = 12; f(x); } int does_it_work () { int y, a = 12; f(x); } int should_work () { a = 12; f(x); } coccinelle-1.0.0-rc19/tests/befS.c0000644000175000017500000000022012247437436015547 0ustar eugeneugenint main () { xxx(); if(y) { rrr(); } } int main () { xxx(); if(y) rrr(); } int d() {} int main2 () { yyy(); xxx(); } coccinelle-1.0.0-rc19/tests/remstruct.cocci0000644000175000017500000000017412247437436017566 0ustar eugeneugen@@ @@ - static struct irqchip mpuio_irq_chip = { - ... - }; @@ @@ - static struct irqchip xxx = { - .a = 12, - ... - }; coccinelle-1.0.0-rc19/tests/toplevel_struct.cocci0000644000175000017500000000124312247437436020772 0ustar eugeneugen@ rule1 @ identifier proc_info_func, proc_info_func2; @@ struct SHT usb_stor_host_template = { .proc_info = proc_info_func, .proc_info2 = proc_info_func2, + .foo = 12, }; //@@ //identifier proc_info_func, proc_info_func2; //@@ // //struct SHT xxx = { // .proc_info2 = proc_info_func2, //+ .proc_info = proc_info_func, //+ .foo = 12 //}; //@@ //identifier proc_info_func, proc_info_func2; //@@ // //struct SHT yyy = { //+ .proc_info2 = proc_info_func2, //+ .proc_info = proc_info_func, //+ .foo = 12 //}; @ rule2 extends rule1 @ @@ proc_info_func(...) { - f(1); + g(1); } @ rule3 extends rule1 @ @@ proc_info_func2(...) { - f(27); + g(27); }coccinelle-1.0.0-rc19/tests/stmt.res0000644000175000017500000000004712247437436016235 0ustar eugeneugenint f() { int x; foo(); xxx(); } coccinelle-1.0.0-rc19/tests/dbg1.c0000644000175000017500000000012312247437436015507 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { DBG("PCI"); } coccinelle-1.0.0-rc19/tests/andparen.c0000644000175000017500000000006012247437436016462 0ustar eugeneugenint main() { if (foo() && (x < 12)) return; } coccinelle-1.0.0-rc19/tests/spaces.cocci0000644000175000017500000000004712247437436017013 0ustar eugeneugen@@ expression E; @@ - foo(E) + foo(E) coccinelle-1.0.0-rc19/tests/testprint.c0000644000175000017500000000017012247437436016730 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { // h(3); h(3); } else { h(4); } } coccinelle-1.0.0-rc19/tests/match_no_meta.cocci0000644000175000017500000000011212247437436020324 0ustar eugeneugen@ rule1 @ @@ foo(1); bar(2); @ rule2 depends on rule1 @ @@ - bar(3);coccinelle-1.0.0-rc19/tests/cs_check.res0000644000175000017500000000043112247437436017005 0ustar eugeneugen#define CS_CHECK(fn, ret) \ do { last_fn = (fn); if ((last_ret = (ret)) != 0) goto cs_failed; } while (0) static void nsp_cs_config(dev_link_t *link) { client_handle_t handle = link->handle; CS_CHECK(GetFirstTuple, pcmcia_get_first_tuple(link, &tuple)); cs_failed: return; } coccinelle-1.0.0-rc19/tests/twomatch.res0000644000175000017500000000004612247437436017073 0ustar eugeneugenint main() { bar(12,1); yyy(); } coccinelle-1.0.0-rc19/tests/minusdots_ver1.c0000644000175000017500000000006712247437436017663 0ustar eugeneugenvoid main(int i) { if (!hostptr) { i++; } } coccinelle-1.0.0-rc19/tests/double_assign.c0000644000175000017500000000011412247437436017510 0ustar eugeneugenint main() { x = 12; x = x + 1; } int badmain() { x = 12; x = 1; } coccinelle-1.0.0-rc19/tests/disjid.res0000644000175000017500000000027112247437436016513 0ustar eugeneugenint foo (int x, int z) { return 1; } int foo (int y, int z) { return 1; } int bar (int x, int z) { return 1; } int bar (int y, int z) { return 1; } int xxx (int y, int z) { return 0; } coccinelle-1.0.0-rc19/tests/toplevel_macrostmt.cocci0000644000175000017500000000017612247437436021463 0ustar eugeneugen@@ expression x,y; declarer name MODULE_PARM; declarer name module_param; @@ - MODULE_PARM(x,y); + module_param(x, int, y); coccinelle-1.0.0-rc19/tests/ifdef6.cocci0000644000175000017500000000014212247437436016674 0ustar eugeneugen@ Exemple6@ @@ #include + #ifdef CONFIG_NKERNEL + #define foo(x) f(x) + #endif coccinelle-1.0.0-rc19/tests/proto2.cocci0000644000175000017500000000024212247437436016757 0ustar eugeneugen@@ identifier fn2; identifier bcs, ev; @@ - fn2(struct BCState *bcs, int ev) { + fn2(int ev) { ... bcs->event |= 1 << ev; schedule_work(&bcs->work); } coccinelle-1.0.0-rc19/tests/pb_parsing_macro.res0000644000175000017500000000012212247437436020545 0ustar eugeneugen#define FOO_METH_TEST(a) prefix_##a void FOO_METH_TEST(foo)(int x){ malloc(x); } coccinelle-1.0.0-rc19/tests/switch.c0000644000175000017500000000011412247437436016173 0ustar eugeneugenint main () { switch (x) { default: break; case X: f(); } } coccinelle-1.0.0-rc19/tests/ldecl.cocci0000644000175000017500000000007312247437436016617 0ustar eugeneugen@test@ int E1, E2; int E3; @@ E3 = - E1 + E2 + E1 - E2 coccinelle-1.0.0-rc19/tests/strid.cocci0000644000175000017500000000005712247437436016663 0ustar eugeneugen@r@ identifier x; struct x *a; @@ -a +f(a,12) coccinelle-1.0.0-rc19/tests/ifdefmeta.cocci0000644000175000017500000000010612247437436017455 0ustar eugeneugen@@ expression E; @@ -alloca(E) +malloc(E) ... -alloca(E) +malloc(E) coccinelle-1.0.0-rc19/tests/multi_inc1.h0000644000175000017500000000003012247437436016740 0ustar eugeneugen#include "multi_inc2.h" coccinelle-1.0.0-rc19/tests/arg.c0000644000175000017500000000012012247437436015440 0ustar eugeneugenint main () { foo(bar()); foo(1,bar()); foo(bar(),2); foo(1,bar(),2); } coccinelle-1.0.0-rc19/tests/ifdef4.cocci0000644000175000017500000000021512247437436016673 0ustar eugeneugen@ Exemple4 @ @@ init_IRQ(...) { <... + #ifdef CONFIG_NKERNEL + if(irq < IRQ_LIMIT) + #endif *desc = irq_desc; ...> } coccinelle-1.0.0-rc19/tests/optional_storage.res0000644000175000017500000000011412247437436020612 0ustar eugeneugenstatic int foo1(void) { } static int foo2(void) { } float foo2(void) { } coccinelle-1.0.0-rc19/tests/arparam.res0000644000175000017500000000014512247437436016670 0ustar eugeneugeng(int q[1024]) { return 12; } int main(int q[1024]) { return 12; } int fn(int q[]) { return 12; } coccinelle-1.0.0-rc19/tests/test11.cocci0000644000175000017500000000007512247437436016657 0ustar eugeneugen@@ expression X; @@ f(X) ... g(X) ... - h(X) + h(X, X) coccinelle-1.0.0-rc19/tests/decl1.c0000644000175000017500000000011312247437436015661 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { int x; int y; return 0; } coccinelle-1.0.0-rc19/tests/decl.cocci0000644000175000017500000000017012247437436016441 0ustar eugeneugen// pb: foo doesn't get added @@ statement S; identifier ioctl; @@ ioctl(int cmd, void *arg) { + foo(); ... } coccinelle-1.0.0-rc19/tests/expopt2.c0000644000175000017500000000004512247437436016276 0ustar eugeneugenvoid main(int i) { f(v, w.aa); } coccinelle-1.0.0-rc19/tests/pci_noputm.cocci0000644000175000017500000000335112247437436017713 0ustar eugeneugen@@ type T; identifier d; expression e; @@ T *d; ... while ((d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(..., d)) != NULL) {... when != pci_dev_put(d) when != e = d ( return d; | + pci_dev_put(d); ? return ...; ) ...} @@ identifier d; type T; expression e, e1; @@ T *d; ... while ((d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(..., d)) != NULL) {... when != pci_dev_put(d) when != e = d + pci_dev_put(d); ? break; ...} ... when != pci_dev_put(d) when != e1 = d when != return d; @@ identifier d; type T; expression e; iterator name for_each_pci_dev; @@ T *d; ... for_each_pci_dev(d) {... when != pci_dev_put(d) when != e = d ( return d; | + pci_dev_put(d); ? return ...; ) ...} @@ identifier d; type T; expression e, e1; @@ T *d; ... for_each_pci_dev(d) {... when != pci_dev_put(d) when != e = d + pci_dev_put(d); ? break; ...} ... when != pci_dev_put(d) when != e1 = d when != return d; @@ type T; identifier d; expression e; @@ T *d; ... for (d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(...); d != NULL; d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(...,d)) {... when != pci_dev_put(d) when != e = d ( return d; | + pci_dev_put(d); ? return ...; ) ...} @@ identifier d; type T; expression e, e1; @@ T *d; ... for (d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(...); d != NULL; d = \(pci_get_device\|pci_get_device_reverse\|pci_get_subsys\|pci_get_class\)(...,d)) {... when != pci_dev_put(d) when != e = d + pci_dev_put(d); ? break; ...} ... when != pci_dev_put(d) when != e1 = d when != return d; coccinelle-1.0.0-rc19/tests/stm6.res0000644000175000017500000000006612247437436016140 0ustar eugeneugenint main(int x) { f(); h(); replace(); g(); } coccinelle-1.0.0-rc19/tests/constructor.cocci0000644000175000017500000000132512247437436020122 0ustar eugeneugen@@ expression Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask; @@ -imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask) +platform_device_register_full(&((struct platform_device_info){ .name = Ename, .id = Eid, .res = Eres, .num_res = Enum_res, .data = Edata, .size_data = Esize_data, .dma_mask = Edma_mask, })) @@ expression Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask; @@ -platform_device_register_full(&((struct platform_device_info){ .name = Ename, .id = Eid, .res = Eres, .num_res = Enum_res, .data = Edata, .size_data = Esize_data, .dma_mask = Edma_mask, })) +changed_imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask) coccinelle-1.0.0-rc19/tests/nl.c0000644000175000017500000000005512247437436015307 0ustar eugeneugenint main() { if (x) return; x = x + 1; } coccinelle-1.0.0-rc19/tests/ws2.c0000644000175000017500000000007212247437436015410 0ustar eugeneugenint main() { if (foo()) goto err; err: return; } coccinelle-1.0.0-rc19/tests/notest.cocci0000644000175000017500000000011212247437436017042 0ustar eugeneugen@n2@ expression x; @@ x = FN(...) ... when strict when any - !x + 12 coccinelle-1.0.0-rc19/tests/test8.res0000644000175000017500000000011612247437436016312 0ustar eugeneugenvoid main(char i, int foo) { float k; float j; { j++; } } coccinelle-1.0.0-rc19/tests/pmac.c0000644000175000017500000000037112247437436015617 0ustar eugeneugen#ifdef CONFIG_PPC_HAS_FEATURE_CALLS #include #else #include #endif #define chip_t pmac_t static int snd_pmac_register_sleep_notifier(pmac_t *chip); static int snd_pmac_unregister_sleep_notifier(pmac_t *chip); coccinelle-1.0.0-rc19/tests/sp.c0000644000175000017500000000012112247437436015312 0ustar eugeneugentypedef struct { unsigned long gcr; struct pci_dev *pci; } snd_card_als4000_t; coccinelle-1.0.0-rc19/tests/spacing.c0000644000175000017500000000010712247437436016320 0ustar eugeneugentypedef int *foo; int f(int x) { one(); if (x) { two(); } } coccinelle-1.0.0-rc19/tests/retval.c0000644000175000017500000000040412247437436016171 0ustar eugeneugenint main () { if (retval1) { if (retval2 != -ENODEV) { foo(); return 3; } bar(); } return 6; } int second () { if (retval1) { if (retval2 != -ENODEV) { foo(); goto out; } bar(); } out: return 6; } coccinelle-1.0.0-rc19/tests/comment_brace.res0000644000175000017500000000016612247437436020046 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ { release_region(); continue; } return 0; } coccinelle-1.0.0-rc19/tests/ifdefmeta1.cocci0000644000175000017500000000004712247437436017542 0ustar eugeneugen@@ expression E,E1; @@ -E1=alloca(E); coccinelle-1.0.0-rc19/tests/video1.c0000644000175000017500000000203012247437436016060 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { struct typhoon_device *typhoon = dev->priv; if (cmd == VIDIOCGTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v)) != 0) return -EFAULT; if (v.tuner) /* Only 1 tuner */ return -EINVAL; v.rangelow = 875 * 1600; v.rangehigh = 1080 * 1600; v.flags = VIDEO_TUNER_LOW; v.mode = VIDEO_MODE_AUTO; v.signal = 0xFFFF; /* We can't get the signal strength */ strcpy(v.name, "FM"); if (copy_to_user(arg, v, sizeof(v))) return -EFAULT; } else if (cmd == VIDIOCSTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v))) return -EFAULT; if (v.tuner != 0) return -EINVAL; /* Only 1 tuner so no setting needed ! */ } else return -ENOIOCTLCMD; /*else if(cmd == VIDIOCSFREQ) { if (copy_from_user(typhoon->curfreq, arg, sizeof(typhoon->curfreq))) return -EFAULT; typhoon_setfreq(typhoon, typhoon->curfreq); return 0; }*/ return 0; } coccinelle-1.0.0-rc19/tests/bad_define_parse.cocci0000644000175000017500000000002312247437436020761 0ustar eugeneugen@@ @@ - f() + g() coccinelle-1.0.0-rc19/tests/soc.c0000644000175000017500000000025612247437436015465 0ustar eugeneugen#define soc_printk printk ("soc%d: ", s->soc_no); printk static inline void soc_init(struct sbus_dev *sdev, int no) { soc_printk ("Cannot order irq %d to go\n", irq); } coccinelle-1.0.0-rc19/tests/indecl.c0000644000175000017500000000014412247437436016133 0ustar eugeneugenint x; int y = 0; int main () { int xx; int yy = 0; } struct yyy { int xxx; int yyy; }; coccinelle-1.0.0-rc19/tests/incompatible_value.c0000644000175000017500000000010412247437436020533 0ustar eugeneugenint main() { f(1); f(2); } int main() { g(1); g(2); } coccinelle-1.0.0-rc19/tests/end_commas.res0000644000175000017500000000017012247437436017350 0ustar eugeneugenstatic struct i2c_client client_template = { .driver = &i2c_driver_adv7175, .dev = { .name = "adv7175_client", }, }; coccinelle-1.0.0-rc19/tests/inhmet.cocci0000644000175000017500000000016012247437436017015 0ustar eugeneugen@r@ metavariable a,b; expression x; @@ x->a = b @@ metavariable r.a,r.b; expression x; @@ - x->a = b + foo() coccinelle-1.0.0-rc19/tests/fns.c0000644000175000017500000000037012247437436015464 0ustar eugeneugenint __init probe_base_port(int base) { for (base = b; base <= e; base += 0x10) { if (check_region(base, 0x10)) continue; return (base); } return 0; } int __init cm206_init(void) { request_region(cm206_base, 0x10, "cm206"); } coccinelle-1.0.0-rc19/tests/stm3.c0000644000175000017500000000005712247437436015566 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/insdef.c0000644000175000017500000000002312247437436016141 0ustar eugeneugen#define TABINFOGEN coccinelle-1.0.0-rc19/tests/andparen.cocci0000644000175000017500000000032312247437436017322 0ustar eugeneugen// gives already tagged token, because E can bind in two different ways // so both substitutions are returned. @@ expression E; statement S; @@ if ( ( - foo() && (E) + E | - foo() && E + E ) ) S coccinelle-1.0.0-rc19/tests/deftodo.c0000644000175000017500000000041312247437436016320 0ustar eugeneugen#define UNIT_TYPE int /* * cpu_alloc area immediately follows the percpu area that is allocated for * each processor. */ #define cpu_alloc_start ((int *)__per_cpu_end) void __init cpu_alloc_init(void) { cpu_alloc_start = alloc_bootmem(nr_units * UNIT_SIZE); } coccinelle-1.0.0-rc19/tests/cr1.cocci0000644000175000017500000000052212247437436016220 0ustar eugeneugen@@ expression E, req_reg_arg2; identifier probe; @@ probe(...) { ... for(...; ...; ...) { ... + if (!request_region(E, req_reg_arg2, req_reg_arg3)) - if (check_region(E, req_reg_arg2)) { continue; } <... + release_region(E, req_reg_arg2); continue; ...> + release_region(E, req_reg_arg2); } ... } coccinelle-1.0.0-rc19/tests/break.cocci0000644000175000017500000000020112247437436016611 0ustar eugeneugen@@ @@ while(...) { <... foo(); + bar(); break; ...> } @@ @@ while(...) { <... xxx(); + bar(); continue; ...> }coccinelle-1.0.0-rc19/tests/axnet.c0000644000175000017500000000045112247437436016015 0ustar eugeneugenstatic void axnet_config(struct pcmcia_device *link) { if (last_ret != CS_SUCCESS) { cs_error(link, RequestIO, last_ret); goto failed; } return; cs_failed: cs_error(link, last_fn, last_ret); failed: axnet_release(link); link->state &= ~DEV_CONFIG_PENDING; return; } coccinelle-1.0.0-rc19/tests/bad_define.cocci0000644000175000017500000000033512247437436017575 0ustar eugeneugen@@ expression E; identifier y; constant c; identifier x,fld; expression f; @@ ( #define x (E) | #define x y | #define x c | #define x f(...) | #define x sizeof(...) | #define x E.fld | #define x E->fld | - #define x E ) coccinelle-1.0.0-rc19/tests/kmc.cocci0000644000175000017500000000016512247437436016310 0ustar eugeneugen@r@ identifier E; statement S; expression x1; int ret; @@ if (...) { ... when != kfree(E) - return ret; } coccinelle-1.0.0-rc19/tests/pb_distribute_type2.cocci0000644000175000017500000000007212247437436021515 0ustar eugeneugen@@ type T; @@ foo(...) { T + * x; ... } coccinelle-1.0.0-rc19/tests/assert.c0000644000175000017500000000051712247437436016202 0ustar eugeneugenxfs_dir2_data_free_t * xfs_dir2_data_freefind( xfs_dir2_data_t *d, /* data block */ xfs_dir2_data_unused_t *dup) /* data unused entry */ { if (off < be16_to_cpu(dfp->offset)) ASSERT(off + be16_to_cpu(dup->length) <= be16_to_cpu(dfp->offset)); else ASSERT(be16_to_cpu(dfp->offset) + be16_to_cpu(dfp->length) <= off); } coccinelle-1.0.0-rc19/tests/badpos.c0000644000175000017500000000024712247437436016151 0ustar eugeneugenstatic irqreturn_t elmc_interrupt(int irq, void *dev_id, struct pt_regs *reg_ptr) { printk(KERN_ERR "foo", (int) -(((struct pt_regs *) reg_ptr)->orig_eax + 2)); } coccinelle-1.0.0-rc19/tests/oneline.cocci0000644000175000017500000000002512247437436017162 0ustar eugeneugen@@ @@ - f(); + g(); coccinelle-1.0.0-rc19/tests/metastatement_for.cocci0000644000175000017500000000007712247437436021261 0ustar eugeneugen @@ expression E1,E2,E3; statement S; @@ - for(E1; E2; E3) - Scoccinelle-1.0.0-rc19/tests/addif2.cocci0000644000175000017500000000012512247437436016663 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + int/*foo*/ xxx; + #endif int f(...) { ... } coccinelle-1.0.0-rc19/tests/constx.res0000644000175000017500000000022512247437436016562 0ustar eugeneugenint main() { foobar(12, 12); foo(x); foobar(CONSTANT, CONSTANT); foobar('a', 'a'); foobar("string", "string"); foobar(1.0001, 1.0001); } coccinelle-1.0.0-rc19/tests/used_after.cocci0000644000175000017500000000030512247437436017653 0ustar eugeneugen@ rule1 @ identifier x; //local function func; identifier func; @@ x.proc_info = &func; @@ // type T; identifier rule1.func; @@ - int func(int i) { + int func(int i, char j) { ... } coccinelle-1.0.0-rc19/tests/ty.c0000644000175000017500000000005512247437436015332 0ustar eugeneugenint main () { struct foo x; return 12; } coccinelle-1.0.0-rc19/tests/ptrar.c0000644000175000017500000000015512247437436016027 0ustar eugeneugenint main () { struct foo *x; struct foo y[12]; *y = 4; *x = 2; a = sizeof x; b = sizeof "foo"; } coccinelle-1.0.0-rc19/tests/used_after.c0000644000175000017500000000017212247437436017017 0ustar eugeneugenint my_proc_info(int i); void f() { int x; x.proc_info = &my_proc_info; } int my_proc_info(int i) { return i++; } coccinelle-1.0.0-rc19/tests/fnty.c0000644000175000017500000000021412247437436015653 0ustar eugeneugenstruct allfns { int (*x) (int); int (*y) (int); }; struct somefns { int (*x) (int); int y; }; struct nofns { int x; int y; }; coccinelle-1.0.0-rc19/tests/allbound.c0000644000175000017500000000004612247437436016476 0ustar eugeneugenint main () { foo(27); xxx(27); } coccinelle-1.0.0-rc19/tests/dec.c0000644000175000017500000000005512247437436015431 0ustar eugeneugenint f(int x) { static int y; return x; } coccinelle-1.0.0-rc19/tests/test7.res0000644000175000017500000000016612247437436016316 0ustar eugeneugenvoid main() { if(1) { f(1, "foo"); f(1, "bar"); } f(3, "foo"); f(3, "bar"); /* nice comment */ } coccinelle-1.0.0-rc19/tests/signed.cocci0000644000175000017500000000010412247437436017000 0ustar eugeneugen@@ @@ - signed x; + signed y; @@ @@ - unsigned a; + unsigned b; coccinelle-1.0.0-rc19/tests/ifbr.cocci0000644000175000017500000000021012247437436016447 0ustar eugeneugen@@ expression test; expression E; @@ if (test) { ... ( + pci_dev_put(); return; | + pci_dev_put(); return ret; ) } coccinelle-1.0.0-rc19/tests/isotest.cocci0000644000175000017500000000003712247437436017226 0ustar eugeneugen@@ identifier id; @@ - int id;coccinelle-1.0.0-rc19/tests/disjexpr_ver1.res0000644000175000017500000000004112247437436020025 0ustar eugeneugenint main (int i) { f(v->fld); } coccinelle-1.0.0-rc19/tests/topdec_ver1.res0000644000175000017500000000020512247437436017455 0ustar eugeneugen#ifdef TUN_DEBUG static int debug; #endif /* Network device part of the driver */ static const struct ethtool_ops tun_ethtool_ops; coccinelle-1.0.0-rc19/tests/dectest.cocci0000644000175000017500000000015012247437436017163 0ustar eugeneugen@@ expression e1,e2; @@ decimal( -e1 +e2 , -e2 +e1 ) @@ expression e1,e2; @@ - decimal(e1) + char coccinelle-1.0.0-rc19/tests/multiremove.c0000644000175000017500000000026512247437436017251 0ustar eugeneugenint main () { if (x) { xyz1(); } if (x) { foo(); abc(); } if (x) { xyz2(); } if (x) { bar(); abc(); } if (x) { xyz3(); } if (x) { foo(); abc(); bar(); bar(); foo(); } } coccinelle-1.0.0-rc19/tests/y2.cocci0000644000175000017500000000016712247437436016072 0ustar eugeneugen@@ //local function interrupt; identifier interrupt, cs; @@ interrupt(...) { ... - if (!cs) { ... return; } ... } coccinelle-1.0.0-rc19/tests/test6_ver1.c0000644000175000017500000000036312247437436016702 0ustar eugeneugenint i; void main() { /* a comment */ f(4) + f(5); f(f(3)); // if uncomment, should have the warning "already minused token" if(f(1)) f(1); else f(2); if(1) g(1); else g(2); } void mainbis() { f(10); } coccinelle-1.0.0-rc19/tests/proto.res0000644000175000017500000000017112247437436016407 0ustar eugeneugenstatic void bch_l2l1(struct PStack *st, int pr, void *arg); static void bch_empty_fifo(struct BCState *bcs, int count); coccinelle-1.0.0-rc19/tests/comment_brace2.cocci0000644000175000017500000000005512247437436020414 0ustar eugeneugen@@ @@ + release_region(); continue; coccinelle-1.0.0-rc19/tests/longconst.c0000644000175000017500000000061112247437436016702 0ustar eugeneugenlong function1() { long a; int b; a = 1l << b; a = 1u << b; a = 65536l << b; a = 65536u << b; a = 65536 << b; a = 4294967296 << b; a = 65535 << b; a = 4294967295 << b; a = 0x7fffffff << b; a = 0x1fl << b; a = 0x1fu << b; a = 0x1FL << b; a = 0x1FU << b; return a; } coccinelle-1.0.0-rc19/tests/isotest.c0000644000175000017500000000007612247437436016373 0ustar eugeneugenvoid main(int i) { char j; int i; // = 1; j++; } coccinelle-1.0.0-rc19/tests/ben.cocci0000644000175000017500000000045012247437436016277 0ustar eugeneugen@@ function get_type; identifier this_info, this_type; typedef GType, GTypeInfo; initialiser E ; @@ + static GType this_type = 0; + static const GTypeInfo this_info = E; GType get_type () { - static GType this_type = 0; if (...) { - static const GTypeInfo this_info = E ; ... } ... } coccinelle-1.0.0-rc19/tests/bug1.cocci0000644000175000017500000000030312247437436016366 0ustar eugeneugen@r@ identifier ioctlfn; identifier dev, cmd, arg; @@ ioctlfn( - struct video_device *dev, + struct inode *i, struct file *f, unsigned int cmd, void *arg) { ... } coccinelle-1.0.0-rc19/tests/shared_brace.cocci0000644000175000017500000000011612247437436020134 0ustar eugeneugen@@ type T; identifier x; statement S; @@ - if (pci_present()) { ... - } coccinelle-1.0.0-rc19/tests/inherited.cocci0000644000175000017500000000025312247437436017507 0ustar eugeneugen@ rule1 @ expression X; @@ ( f(X); | g(1); ) @@ expression rule1.X; @@ - h(X); + hh(X); @@ expression rule1.X; @@ - h2(X); + hh22(X); @@ @@ - foo(1); + bar(1); coccinelle-1.0.0-rc19/tests/multi_func1.cocci0000644000175000017500000000145512247437436017767 0ustar eugeneugen@@ identifier fn1, fn2, fn3; expression A; @@ fn1(...) { - foo(A); //+ bidon(A, fn1); } fn2(...) { - bar(A); //+ bidon(A, fn1, fn2); } fn3(...) { //+ bidon(A, fn1, fn2); fn1(...); fn2(...); // bug need: ... (partial match didn't help that much) ... } //@@ //@@ //- bidon(...); // @@ // @@ // ( // - fn1(A,1) // | // - fn2(A,1) // ) // @@ // identifier fn1; // expression A; // @@ // fn1(...) { // foo(A); // } // // @@ // identifier fn2; // @@ // // fn2(...) { // bar(A); // } // // // @@ // identifier fn3; // //identifier fn1, fn2; // @@ // // fn3(...) { // fn1(...); // fn2(...); // ... // } // // @@ // //expression A; // @@ // fn1(...) { // - foo(A); // } // // @@ // @@ // // fn2(...) { // - bar(A); // } coccinelle-1.0.0-rc19/tests/na.c0000644000175000017500000000020312247437436015267 0ustar eugeneugen#define FOO 10 void foo() { int i; if (!i & FOO) return; !i & -FOO; !i & !FOO; !i & 100; !i & -100; !i & !100; } coccinelle-1.0.0-rc19/tests/multi_inc.cocci0000644000175000017500000000002612247437436017515 0ustar eugeneugen@@ int E; @@ - f(E); coccinelle-1.0.0-rc19/tests/test5.c0000644000175000017500000000113312247437436015740 0ustar eugeneugen/* * If still have an edge from the startif to endif (AfterNode), * with a if-then-and-else, then rene will see this edge, * and that means that the ctl engine will see this direct path from * startif to endif as a valid execution path. So on this program, * CTL will reject the formula f(X) ... g(X) because * when we take the direct path (which should not exist I repeat), * we can't find a later g(1). */ void main() { f(1); if(1) { g(1); } else { g(1); } // g(1); // if add this then the CTL even with the direct path will this time // accept, but we cheat. } coccinelle-1.0.0-rc19/tests/dowhile.res0000644000175000017500000000004712247437436016701 0ustar eugeneugenint main() { do { } while (0); } coccinelle-1.0.0-rc19/tests/overshoot.res0000644000175000017500000000006412247437436017275 0ustar eugeneugenint main () { a(); g();g();g(); b(); q(); } coccinelle-1.0.0-rc19/tests/pb_parsing_macro.cocci0000644000175000017500000000005512247437436021041 0ustar eugeneugen@@ expression E; @@ -alloca(E) +malloc(E) coccinelle-1.0.0-rc19/tests/iterator.res0000644000175000017500000000016112247437436017074 0ustar eugeneugenvoid pcibios_report_status(u_int status_mask, int warn) { struct list_head *l; foo(); } coccinelle-1.0.0-rc19/tests/pragmatest.c0000644000175000017500000000030312247437436017041 0ustar eugeneugenint two () { return 12; } #define foo 12 #pragma inline(one) int one (); int one () { return 12; } int three () { return 12; } #pragma abc one def #pragma abc ddd def #pragma abc one def coccinelle-1.0.0-rc19/tests/dep.c0000644000175000017500000000003112247437436015440 0ustar eugeneugenint main () { xxx(); } coccinelle-1.0.0-rc19/tests/line_before_last.res0000644000175000017500000000011712247437436020540 0ustar eugeneugenint main () { xxx(); } int main () { xxx(); } int main () { xxx(); } coccinelle-1.0.0-rc19/tests/td.res0000644000175000017500000000012712247437436015654 0ustar eugeneugenstruct foo {int b;}; typedef struct blah {int b;} name; typedef struct {int b;} xxx; coccinelle-1.0.0-rc19/tests/ifdefmeta1.res0000644000175000017500000000001712247437436017250 0ustar eugeneugenint main() { } coccinelle-1.0.0-rc19/tests/param_end.c0000644000175000017500000000045112247437436016624 0ustar eugeneugenint one (int x) { return; } int two (int a, int x, int b) { return; } int three (int x, int a) { return; } int four (int a, int x) { return; } int yone (int y) { return; } int ytwo (int a, int y, int b) { return; } int ythree (int y, int a) { return; } int yfour (int a, int y) { return; } coccinelle-1.0.0-rc19/tests/comments.cocci0000644000175000017500000000023712247437436017363 0ustar eugeneugen@@ @@ int main() { ... + // Calls foo() + foo(); return 0; } +/** + Some info about @foo() + @return void +*/ +void foo() { + /* Do nothing */ +} coccinelle-1.0.0-rc19/tests/replace_typedef.cocci0000644000175000017500000000026312247437436020670 0ustar eugeneugen@ rule1 @ type T1, T2; @@ typedef T1 { ... } T2; @@ type rule1.T1, rule1.T2; @@ - T2 + T1 @ rule2 @ type T1, T2; @@ typedef T1 T2; @@ type rule2.T1, rule2.T2; @@ - T2 + T1 coccinelle-1.0.0-rc19/tests/varargs.c0000644000175000017500000000014312247437436016341 0ustar eugeneugen static void fas216_log_command(FAS216_Info *info, int level, Scsi_Cmnd *SCpnt, char *fmt, ...) {} coccinelle-1.0.0-rc19/tests/isotest2.c0000644000175000017500000000007212247437436016451 0ustar eugeneugenvoid main(int i) { char j; int i = 1; j++; } coccinelle-1.0.0-rc19/tests/stm7.cocci0000644000175000017500000000010712247437436016424 0ustar eugeneugen// seems to loop! @@ statement S; @@ f(); S @script:python@ @@ coccinelle-1.0.0-rc19/tests/optional_storage.c0000644000175000017500000000010512247437436020243 0ustar eugeneugenint foo1(void) { } static int foo2(void) { } float foo2(void) { } coccinelle-1.0.0-rc19/tests/a.cocci0000644000175000017500000000013012247437436015746 0ustar eugeneugen@@ expression a; @@ -f(a); ... -g(a); @@ idexpression int a; @@ -h(a); ... -r(a); coccinelle-1.0.0-rc19/tests/empty.res0000644000175000017500000000025112247437436016401 0ustar eugeneugenstatic int vlsi_hard_start_xmit(struct sk_buff *skb, struct net_device *ndev) { pci_restore_state(pdev); if (ring_first(idev->tx_ring) == NULL) { } else ; } coccinelle-1.0.0-rc19/tests/spl.res0000644000175000017500000000056012247437436016044 0ustar eugeneugenint main() { spin_lock(&isp116x->lock); /* take idle endpoints out of the schedule */ if (!list_empty(&ep->hep->urb_list)) { spin_unlock(&isp116x->lock); return; } /* async deschedule */ if (!list_empty(&ep->schedule)) { spin_unlock(&isp116x->lock); return; } } coccinelle-1.0.0-rc19/tests/after_if.cocci0000644000175000017500000000013112247437436017306 0ustar eugeneugen@@ identifier I; @@ + static const struct ethtool_ops I; - static struct ethtool_ops I; coccinelle-1.0.0-rc19/tests/symbol.c0000644000175000017500000000006312247437436016202 0ustar eugeneugenint main() { int f = 0; f = 3; return f; } coccinelle-1.0.0-rc19/tests/array_size.cocci0000644000175000017500000000013612247437436017704 0ustar eugeneugen@ rule1 using "empty.iso" @ expression E; type T; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/tests/whitespace.res0000644000175000017500000000005712247437436017403 0ustar eugeneugenint main () { foo(sizeof (struct xxx),12); } coccinelle-1.0.0-rc19/tests/keep_comma.res0000644000175000017500000000013012247437436017337 0ustar eugeneugenint main () { xxx(); snd_assert(!atomic_read(&substream->runtime->mmap_count), ); } coccinelle-1.0.0-rc19/tests/nest.c0000644000175000017500000000013112247437436015642 0ustar eugeneugenvoid info_func(int i) { foo(); while (x) { 1+hostno+xxx; 2+hostno+xxx; } } coccinelle-1.0.0-rc19/tests/protoassert.c0000644000175000017500000000014512247437436017263 0ustar eugeneugenstatic unsigned mii_rd(ioaddr_t ioaddr, u_char phyaddr, u_char phyreg); int init(void) { foo(); } coccinelle-1.0.0-rc19/tests/type_ver1.c0000644000175000017500000000005312247437436016612 0ustar eugeneugenint foo() { struct foo x; return 0; } coccinelle-1.0.0-rc19/tests/bad_iso_example.cocci0000644000175000017500000000026712247437436020654 0ustar eugeneugen@r@ expression E,E1; statement S1,S2; @@ + E = E1; if ( - !(E = E1) + E ) S1 else S2 @@ expression E,E1; statement S1,S2; @@ + E = E1; if ( - E = E1 + E ) S1 else S2 coccinelle-1.0.0-rc19/tests/yellow.c0000644000175000017500000000530012247437436016207 0ustar eugeneugen// search for "paren missing" static void yellowfin_init_ring(struct net_device *dev) { struct yellowfin_private *yp = netdev_priv(dev); int i; yp->tx_full = 0; yp->cur_rx = yp->cur_tx = 0; yp->dirty_tx = 0; yp->rx_buf_sz = (dev->mtu <= 1500 ? PKT_BUF_SZ : dev->mtu + 32); for (i = 0; i < RX_RING_SIZE; i++) { yp->rx_ring[i].dbdma_cmd = cpu_to_le32(CMD_RX_BUF | INTR_ALWAYS | yp->rx_buf_sz); yp->rx_ring[i].branch_addr = cpu_to_le32(yp->rx_ring_dma + ((i+1)%RX_RING_SIZE)*sizeof(struct yellowfin_desc)); } for (i = 0; i < RX_RING_SIZE; i++) { struct sk_buff *skb = dev_alloc_skb(yp->rx_buf_sz); yp->rx_skbuff[i] = skb; if (skb == NULL) break; skb->dev = dev; /* Mark as being used by this device. */ skb_reserve(skb, 2); /* 16 byte align the IP header. */ yp->rx_ring[i].addr = cpu_to_le32(pci_map_single(yp->pci_dev, skb->data, yp->rx_buf_sz, PCI_DMA_FROMDEVICE)); } yp->rx_ring[i-1].dbdma_cmd = cpu_to_le32(CMD_STOP); yp->dirty_rx = (unsigned int)(i - RX_RING_SIZE); #define NO_TXSTATS #ifdef NO_TXSTATS /* In this mode the Tx ring needs only a single descriptor. */ for (i = 0; i < TX_RING_SIZE; i++) { yp->tx_skbuff[i] = NULL; yp->tx_ring[i].dbdma_cmd = cpu_to_le32(CMD_STOP); yp->tx_ring[i].branch_addr = cpu_to_le32(yp->tx_ring_dma + ((i+1)%TX_RING_SIZE)*sizeof(struct yellowfin_desc)); } /* Wrap ring */ yp->tx_ring[--i].dbdma_cmd = cpu_to_le32(CMD_STOP | BRANCH_ALWAYS); #else { int j; /* Tx ring needs a pair of descriptors, the second for the status. */ for (i = 0; i < TX_RING_SIZE; i++) { j = 2*i; yp->tx_skbuff[i] = 0; /* Branch on Tx error. */ yp->tx_ring[j].dbdma_cmd = cpu_to_le32(CMD_STOP); yp->tx_ring[j].branch_addr = cpu_to_le32(yp->tx_ring_dma + (j+1)*sizeof(struct yellowfin_desc);//paren missing j++; if (yp->flags & FullTxStatus) { yp->tx_ring[j].dbdma_cmd = cpu_to_le32(CMD_TXSTATUS | sizeof(*yp->tx_status)); yp->tx_ring[j].request_cnt = sizeof(*yp->tx_status); yp->tx_ring[j].addr = cpu_to_le32(yp->tx_status_dma + i*sizeof(struct tx_status_words);//paren missing } else { /* Symbios chips write only tx_errs word. */ yp->tx_ring[j].dbdma_cmd = cpu_to_le32(CMD_TXSTATUS | INTR_ALWAYS | 2); yp->tx_ring[j].request_cnt = 2; /* Om pade ummmmm... */ yp->tx_ring[j].addr = cpu_to_le32(yp->tx_status_dma + i*sizeof(struct tx_status_words) + &(yp->tx_status[0].tx_errs) - &(yp->tx_status[0])); } yp->tx_ring[j].branch_addr = cpu_to_le32(yp->tx_ring_dma + ((j+1)%(2*TX_RING_SIZE))*sizeof(struct yellowfin_desc)); } /* Wrap ring */ yp->tx_ring[++j].dbdma_cmd |= cpu_to_le32(BRANCH_ALWAYS | INTR_ALWAYS); } #endif yp->tx_tail_desc = &yp->tx_status[0]; return; } int foo () { return; } coccinelle-1.0.0-rc19/tests/stm8.c0000644000175000017500000000005712247437436015573 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/cr1.c0000644000175000017500000000076412247437436015372 0ustar eugeneugenint __init probe_base_port(int base) { int b = 0x300, e = 0x370; /* this is the range of start addresses */ volatile int fool, i; if (base) b = e = base; for (base = b; base <= e; base += 0x10) { if (check_region(base, 0x10)) continue; for (i = 0; i < 3; i++) fool = inw(base + 2); /* empty possibly uart_receive_buffer */ if ((inw(base + 6) & 0xffef) != 0x0001 || /* line_status */ (inw(base) & 0xad00) != 0) /* data status */ continue; return (base); } return 0; } coccinelle-1.0.0-rc19/tests/justremove.cocci0000644000175000017500000000004112247437436017732 0ustar eugeneugen@@ statement S; @@ - S foo(); coccinelle-1.0.0-rc19/tests/four.c0000644000175000017500000000005012247437436015644 0ustar eugeneugenint main () { f(1); h(2); i(2); } coccinelle-1.0.0-rc19/tests/multiremove.res0000644000175000017500000000011712247437436017614 0ustar eugeneugenint main () { if (x) { xyz1(); } if (x) { xyz2(); } if (x) { xyz3(); } } coccinelle-1.0.0-rc19/tests/toplevel_struct_modif.cocci0000644000175000017500000000032012247437436022143 0ustar eugeneugen@@ identifier proc_info_func, usb_stor_host_template; @@ struct SHT usb_stor_host_template = { .name = "usb-storage", .proc_name = "usb-storage", - .proc_info = proc_info_func, .ioctl = NULL, }; coccinelle-1.0.0-rc19/tests/compare.cocci0000644000175000017500000000007112247437436017160 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.0-rc19/tests/bad_assign.cocci0000644000175000017500000000264112247437436017631 0ustar eugeneugen@@ expression x; expression E; constant c; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - c == (x = E) + x == c ) S1 else S2 @@ expression x; expression E; constant c; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - (x = E) == c + x == c ) S1 else S2 @@ expression x; expression E; constant c; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - c != (x = E) + x != c ) S1 else S2 @@ expression x; expression E; constant c; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - (x = E) != c + x != c ) S1 else S2 @@ expression x; expression E, E1; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - E1 == (x = E) + E1 == x ) S1 else S2 @@ expression x; expression E, E1; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - (x = E) == E1 + x == E1 ) S1 else S2 @@ expression x; expression E,E1; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - E1 != (x = E) + E1 != x ) S1 else S2 @@ expression x; expression E,E1; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - (x = E) != E1 + x != E1 ) S1 else S2 @@ expression x; expression E; statement S1, S2; @@ + x = E; + NOTHING_XXX; if ( - x = E + x ) S1 else S2 @@ expression x; expression E; statement S1, S2; @@ + x = E; + NOTHING_XXX; if (! - (x = E) + x ) S1 else S2 @@ @@ - NOTHING_XXX; coccinelle-1.0.0-rc19/tests/retmacro.c0000644000175000017500000000156112247437436016515 0ustar eugeneugen#define REG_PATTERN_TEST(R, M, W) \ { \ for (pat = 0; pat < sizeof(test)/sizeof(test[0]); pat++) { \ if (value != (test[pat] & W & M)) { \ return 1; \ } \ } \ } #define REG_PATTERN_TEST2(R, M, W) \ { \ for (pat = 0; pat < sizeof(test)/sizeof(test[0]); pat++) { \ if (value != (test[pat] & W & M)) { \ } \ } \ } coccinelle-1.0.0-rc19/tests/multitype.res0000644000175000017500000000013212247437436017275 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { foo_t * x; f(x->a); g(x,NULL); } coccinelle-1.0.0-rc19/tests/wierdinit.res0000644000175000017500000000022212247437436017237 0ustar eugeneugen static int cmm_ioctl() { struct pcmcia_device *link; char *ioctl_names[CM_IOC_MAXNR + 1] = { [_IOC_NR(CM_IOSDBGLVL)] "CM4000_DBGLVL", }; } coccinelle-1.0.0-rc19/tests/break.c0000644000175000017500000000061612247437436015765 0ustar eugeneugenint main () { while (1) { x = 12; do { x = 15; if (x > 1 ) { foo(); break; } } while (a == 3); if (x > 1 ) { foo(); break; } if (x > 1 ) { foo(); break; } } } int mainx () { while (1) { x = 12; do { x = 15; if (x > 1 ) { xxx(); continue; } } while (a == 3); if (x > 1 ) { xxx(); break; } if (x > 1 ) { xxx(); continue; } } } coccinelle-1.0.0-rc19/tests/addbeforeafter.c0000644000175000017500000000011112247437436017624 0ustar eugeneugenint main () { if (x) { goto out; } after(); out: return 0; } coccinelle-1.0.0-rc19/tests/kr.cocci0000644000175000017500000000002012247437436016140 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/regexp2.res0000644000175000017500000000104012247437436016614 0ustar eugeneugen int main(void) { int t0 = FOO; int t0_equals_cst_that_begins_by_FOO; int t0_equals_cst_that_ends_by_FOO; int t0_equals_cst_that_contains_FOO; int t0_is_constant; int t1 = BAR; int t1_equals_cst_that_doesn_t_contain_FOO; int t1_is_constant; int t2 = FOOBAR; int t2_equals_cst_that_begins_by_FOO; int t2_equals_cst_that_contains_FOO; int t2_is_constant; int t3 = BARFOOBAR; int t3_equals_cst_that_contains_FOO; int t3_is_constant; int t4 = BARFOO; int t4_equals_cst_that_ends_by_FOO; int t4_equals_cst_that_contains_FOO; int t4_is_constant; } coccinelle-1.0.0-rc19/tests/fix_flow_need.c0000644000175000017500000000012412247437436017503 0ustar eugeneugenvoid main(int i) { foobar(); if(1) { foo(); } bar(); foobar(); } coccinelle-1.0.0-rc19/tests/cast_iso.cocci0000644000175000017500000000020612247437436017336 0ustar eugeneugen@@ expression B; type T; @@ - snd_magic_cast(T, (void*) B ,...) + (T *)B @@ expression B; type T; @@ - snd_magic_cast(T,B,...) + B coccinelle-1.0.0-rc19/tests/isococci.c0000644000175000017500000000005312247437436016467 0ustar eugeneugen void f(int i) { if(x > 0) return x; } coccinelle-1.0.0-rc19/tests/void.cocci0000644000175000017500000000013312247437436016472 0ustar eugeneugen@@ @@ + int foo(void) { return; } int bar(void) { return; } + int foo(void) { return; } coccinelle-1.0.0-rc19/tests/optional_qualifier.res0000644000175000017500000000003212247437436021126 0ustar eugeneugenconst int a; const int b; coccinelle-1.0.0-rc19/tests/ifzz.c0000644000175000017500000000013512247437436015657 0ustar eugeneugenif 0 char c; #endif int foo(void) { int i = 1; #if 0 TRACE("\n"); #endif return i; } coccinelle-1.0.0-rc19/tests/argument.res0000644000175000017500000000004312247437436017064 0ustar eugeneugenvoid main(int i){ g(3,2,1); } coccinelle-1.0.0-rc19/tests/double_switch.res0000644000175000017500000000070412247437436020101 0ustar eugeneugen static NTSTATUS get_line_control(int fd, SERIAL_LINE_CONTROL* slc) { #ifdef CMSPAR switch (port.c_cflag & (PARENB | PARODD | CMSPAR)) #else switch (port.c_cflag & (PARENB | PARODD)) #endif { case 0: slc->Parity = NOPARITY; break; case PARENB: slc->Parity = EVENPARITY; break; case PARENB|PARODD: slc->Parity = ODDPARITY; break; } return STATUS_SUCCESS; } coccinelle-1.0.0-rc19/tests/minenum1.res0000644000175000017500000000003012247437436016767 0ustar eugeneugenenum h { x, qq, q, b }; coccinelle-1.0.0-rc19/tests/incpos.res0000644000175000017500000000014012247437436016533 0ustar eugeneugen#include #include #include "two" #include #include "four" #include coccinelle-1.0.0-rc19/tests/sizeptr.cocci0000644000175000017500000000021012247437436017225 0ustar eugeneugen@@ size_t x; @@ - x + ASIZE(x) @@ ssize_t x; @@ - x + ASSIZE(x) @@ ptrdiff_t x; @@ - x + APTRDIFF(x) @@ int x; @@ - x + ANINT(x) coccinelle-1.0.0-rc19/tests/minenum.res0000644000175000017500000000003012247437436016706 0ustar eugeneugenenum h { x, qq, q, b }; coccinelle-1.0.0-rc19/tests/video1bis.c0000644000175000017500000000034012247437436016560 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { if (cmd == VIDIOCGTUNER) { struct video_tuner v; if (copy_from_user(v, arg, sizeof(v)) != 0) ret(-EFAULT); else {} } } coccinelle-1.0.0-rc19/tests/expopt4.c0000644000175000017500000000010112247437436016271 0ustar eugeneugenvoid xxx(void) { xxx(1); } void main(void) { f((int) 1); } coccinelle-1.0.0-rc19/tests/request_irq.cocci0000644000175000017500000000224512247437436020102 0ustar eugeneugen@ rule1 @ @@ #include // -------------------------------------------------------------- // do some cleaup first. // we should specify that these rules only apply to files in the directory // arch/v850/kernel @@ int E; struct pt_regs *regs; @@ ( - handle_irq(E,regs) + handle_irq(E) | - __do_IRQ(E,regs) + __do_IRQ(E) ) @@ identifier irq, regs; @@ unsigned int - handle_irq (int irq, struct pt_regs *regs) + handle_irq (int irq) { ... when != regs } // -------------------------------------------------------------- // now the real transformation @ rule2 depends on rule1 @ expression irq; identifier handler; expression irqflags; expression devname; expression dev_id; @@ request_irq(irq, handler, irqflags, devname, dev_id) @@ typedef irqreturn_t; identifier rule2.handler, irq, dev, regs; @@ static irqreturn_t - handler(int irq, void *dev, struct pt_regs *regs) + handler(int irq, void *dev) { ... when != regs } @@ identifier rule2.handler; expression E1, E2; @@ handler(E1,E2 - ,NULL ) @@ identifier rule2.handler; expression E1, E2, E3; @@ handler(E1,E2, - E3 + NEED_TO_CHECK_THIS_USE_OF(E3) ) coccinelle-1.0.0-rc19/tests/double_assign.cocci0000644000175000017500000000035312247437436020353 0ustar eugeneugen@s@ identifier i; position p0; @@ i =@p0 ...; @r exists@ identifier s.i; position s.p0,p; @@ i =@p0 ...; ... i =@p <+... i ...+>; @x@ identifier s.i; position s.p0; position p != r.p; @@ - i =@p0 ...; ... when strict i =@p ...; coccinelle-1.0.0-rc19/tests/neststruct.c0000644000175000017500000000036612247437436017121 0ustar eugeneugenstruct usb_hub { union { struct usb_hub_status hub; struct usb_port_status port; } *status; /* buffer for status reports */ }; static int hub_configure(struct usb_hub *hub) { hub->status = kmalloc(sizeof(*hub->status), GFP_KERNEL); } coccinelle-1.0.0-rc19/tests/inhpos.c0000644000175000017500000000003012247437436016167 0ustar eugeneugenint main () { g(3); } coccinelle-1.0.0-rc19/tests/ifdefmeta.c0000644000175000017500000000152112247437436016621 0ustar eugeneugenint main() { buf = alloca(3 #ifdef PLATFORM_A // platform a stuff +5 +50 #endif #ifdef PLATFORM_B /* platform b stuff */ +2 #endif ); buf = alloca(3 #ifdef PLATFORM_A // platform a stuff +5 +50 #endif #ifdef PLATFORM_B /* platform b stuff */ +2 #endif ); } int other() { buf = alloca(3 #ifdef PLATFORM_A // platform a stuff +5 #endif #ifdef PLATFORM_B /* platform b stuff */ +2 #endif ); buf = alloca(3 +5 +2 ); } int third() { buf = alloca(3+5+2); buf = alloca(3 +5 +2 ); } coccinelle-1.0.0-rc19/tests/arraysz.c0000644000175000017500000000055612247437436016377 0ustar eugeneugentypedef struct signature { const char *sig; /* String to look for */ unsigned long ofs; /* offset from BIOS base address */ unsigned len; /* length of string */ } Signature; static const Signature signatures[] = { {"SSTBIOS", 0x0000d, 7} /* "SSTBIOS" @ offset 0x0000d */ }; #define NUM_SIGNATURES (sizeof(signatures)/sizeof(Signature)) coccinelle-1.0.0-rc19/tests/match_const.cocci0000644000175000017500000000005312247437436020034 0ustar eugeneugen@r@ type T; identifier I; @@ - const T I; coccinelle-1.0.0-rc19/tests/pragmatest1.res0000644000175000017500000000000212247437436017465 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/detect_alloc.cocci0000644000175000017500000000013712247437436020157 0ustar eugeneugen@@ type T; identifier f; T *x; @@ * T *f(...) { ... x = kmalloc(...); ... return x; } coccinelle-1.0.0-rc19/tests/post.cocci0000644000175000017500000000017612247437436016525 0ustar eugeneugen@x@ position p; identifier f; expression E; @@ f(3,E@p,...) @@ position x.p; identifier g; expression E; @@ - g(3,E@p,...);coccinelle-1.0.0-rc19/tests/ifdefmeta3.res0000644000175000017500000000004712247437436017255 0ustar eugeneugenint main () { f(); xxx(); g(); } coccinelle-1.0.0-rc19/tests/pb_parsing_macro.c0000644000175000017500000000012212247437436020176 0ustar eugeneugen#define FOO_METH_TEST(a) prefix_##a void FOO_METH_TEST(foo)(int x){ alloca(x); } coccinelle-1.0.0-rc19/tests/cst.cocci0000644000175000017500000000030612247437436016324 0ustar eugeneugen// we cant say snd_magic_cast(E1, E2, E3) because E3 // is not an expression. it is an action, which is not even exactly // a statement. @@ expression E1, E2; @@ - snd_magic_cast(E1, E2, ...) + 4 coccinelle-1.0.0-rc19/tests/dectest.c0000644000175000017500000000163312247437436016334 0ustar eugeneugen#define DECIMCALC1_MAX 18 #define DECIMCALC1_PRE 6 typedef decimal(DECIMCALC1_MAX,DECIMCALC1_PRE) DECIMCALC1; short RchNUNENJInd(short *, decimal(15), decimal(15)*, short); int main () { decimal(18,6) dMontPrelPropHO; decimal(7,4) dTauxPrelHO; decimal(1,0) WS_MDDRA; DECIMCALC1 d_mt_manque = D_ZERO; pstDataOut->stEDIT_RPAY[s_idx_edit_rpay].d_rap_net_res_paya = (DECIMCALC1)pstDataOPG->stRPAY[s_idx_rpay_tmp].d_rap_net_res_paya; decimal(15,6) dSeuilOPA = 0; decimal(18,6) dOMC_JEBP_ORG[4]; int TraiterTYRP(decimal(18,6)); //decimal(7,4) TraiterTaux(decimal(9,8) dTaux) static decimal(10, 8) hvdTXPRL; pAggOpar->DMtJec = (decimal(15,0))(0); HTRPTOJX.JEOPX = (decimal(18,6))(bet->amoWag) / 100.0d ; HTRPTFAR.MASSPAR=((decimal(13,2))(pool)) / 100; decimal(13,7) *taux; if (lRC == OK) *taux = ((decimal(13,7)*)contenu)[numDevise]; if (lRC == OK) *taux = ((decimal(7)*)contenu)[numDevise]; } coccinelle-1.0.0-rc19/tests/match_init.c0000644000175000017500000000021212247437436017010 0ustar eugeneugenint probably_works () { int x = 3; f(x); } int does_it_work () { int y, x = 3; f(x); } int should_work () { x = 3; f(x); } coccinelle-1.0.0-rc19/tests/constty.c0000644000175000017500000000012212247437436016374 0ustar eugeneugenint main () { const int x; int y; f(x,int); f(y,int); f(x,const int); } coccinelle-1.0.0-rc19/tests/constx.cocci0000644000175000017500000000005612247437436017053 0ustar eugeneugen@@ constant X; @@ - foo(X); + foobar(X, X); coccinelle-1.0.0-rc19/tests/tern.c0000644000175000017500000000007612247437436015651 0ustar eugeneugenint main () { return (wc >= 0 && wc <= 0x7f ? wc : 0x7f); } coccinelle-1.0.0-rc19/tests/inline.res0000644000175000017500000000000212247437436016513 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/pb_tag_symbols.c0000644000175000017500000000022312247437436017677 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { if (copy_from_user(v,arg) != 0) return -EFAULT; else {} } coccinelle-1.0.0-rc19/tests/cst.res0000644000175000017500000000010412247437436016031 0ustar eugeneugenint main(int x) { emu10k1_t *emu = 4; int z = 12; return y; } coccinelle-1.0.0-rc19/tests/typedef.cocci0000644000175000017500000000027512247437436017200 0ustar eugeneugen@ rule1 @ type T; identifier link; @@ T { ... - dev_link_t link; + struct pcmcia_device *p_dev; ... }; @ rule2 extends rule1 @ T *s; identifier fld; @@ - s->link.fld + s->p_dev->fld coccinelle-1.0.0-rc19/tests/metastatement_for.c0000644000175000017500000000016512247437436020421 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } if (i == 0) { printf("%d", i); } } coccinelle-1.0.0-rc19/tests/str_init.c0000644000175000017500000000012012247437436016522 0ustar eugeneugenstruct foo x = { .aaa = 5, .rrr = 1, .xxx= 12, .bbb = 2, .ccc = 4, }; coccinelle-1.0.0-rc19/tests/test0.res0000644000175000017500000000004312247437436016301 0ustar eugeneugenint main(int i) { f(2); } coccinelle-1.0.0-rc19/tests/protoassert.cocci0000644000175000017500000000017212247437436020121 0ustar eugeneugen@@ @@ + static struct pcmcia_driver ZZZ_driver = { + .owner = THIS_MODULE, + }; int init (...) { - foo(); } coccinelle-1.0.0-rc19/tests/compare.c0000644000175000017500000000075412247437436016332 0ustar eugeneugenstruct aic7xxx_host { struct aic7xxx_cmd_queue { Scsi_Cmnd *head; Scsi_Cmnd *tail; } completeq; unsigned char msg_buf[13]; /* The message for the target */ unsigned char msg_type; #define MSG_TYPE_NONE 0x00 #define MSG_TYPE_INITIATOR_MSGOUT 0x01 #define MSG_TYPE_INITIATOR_MSGIN 0x02 unsigned char msg_len; /* Length of message */ unsigned char msg_index; /* Index into msg_buf array */ }; coccinelle-1.0.0-rc19/tests/static.c0000644000175000017500000000010312247437436016157 0ustar eugeneugenstatic inline int i8042_read_data(void) { return jazz_kh->data; } coccinelle-1.0.0-rc19/tests/addelse.c0000644000175000017500000000005112247437436016273 0ustar eugeneugenint main () { if (x == 12) return 6; } coccinelle-1.0.0-rc19/tests/isotest2.res0000644000175000017500000000005512247437436017021 0ustar eugeneugenvoid main(int i) { char j; j++; } coccinelle-1.0.0-rc19/tests/initializer_many_fields.c0000644000175000017500000000003512247437436021571 0ustar eugeneugen struct foo x = { .a = 12 }; coccinelle-1.0.0-rc19/tests/struct_metavar.c0000644000175000017500000000033012247437436017735 0ustar eugeneugenstruct foo { int x; struct bar first; int y; struct xxx second; int z; }; int main() { struct foo *a; struct notfoo *b; f(a->first); f(a->second); f(a->second); f(b->first); f(b->second); } coccinelle-1.0.0-rc19/tests/const_array.cocci0000644000175000017500000000020112247437436020051 0ustar eugeneugen@@ type T; T[] E; @@ - sizeof(E)/sizeof(T) + ARRAY_SIZE(E) @@ type T; const T*[] E; @@ - sizeof(E)/sizeof(T*) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/tests/bad_define_parse.c0000644000175000017500000000042512247437436020131 0ustar eugeneugen/* I830 Video support */ #define NEED_REPLIES /* ? */ //#define EXTENSION_PROC_ARGS void * #include "file.h" /* required */ #include /* required */ int main () { f(); __releases(x) } coccinelle-1.0.0-rc19/tests/tup.c0000644000175000017500000000037012247437436015506 0ustar eugeneugenstatic int cm206_block_ioctl(struct inode *inode, struct file *file, unsigned cmd, unsigned long arg) { return cdrom_ioctl(&cm206_info, inode, cmd, arg); } static struct block_device_operations cm206_bdops = { .ioctl = cm206_block_ioctl }; coccinelle-1.0.0-rc19/tests/ifdef3.cocci0000644000175000017500000000036412247437436016677 0ustar eugeneugen@ Exemple3 @ @@ #include + #ifdef CONFIG_NKERNEL + #include + #define CONFIG_NKERNEL_NO_SHARED_IRQ // use local (native) mask/unmask + #undef CONFIG_NKERNEL_DEBUG_IRQ + #endif + static inline void nop(void) { int i; } coccinelle-1.0.0-rc19/tests/retval2.c0000644000175000017500000000072312247437436016257 0ustar eugeneugenint getlen(int *input, size_t maxlen, int delim, size_t *result) { size_t i; for (i = 0; i < maxlen; ++i) { if (input[i] == delim) { if (result != NULL) { *result = i; } return 0; } } return -1; } int getlen(int *input, size_t maxlen, int delim, size_t *result) { size_t i; for (i = 0; i < maxlen; ++i) { if (input[i] == delim) { if (result != NULL) { *result = i; } return 0; } } } coccinelle-1.0.0-rc19/tests/addaft.c0000644000175000017500000000023012247437436016114 0ustar eugeneugenint main () { foo(); if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); } coccinelle-1.0.0-rc19/tests/ifdef6a.c0000644000175000017500000000031212247437436016176 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/eb1.res0000644000175000017500000000033612247437436015716 0ustar eugeneugenint func() { int c; Packet * p1 = SCMalloc(SIZE_OF_PACKET),* p2 = SCMalloc(SIZE_OF_PACKET); int y; if (p1 == NULL) return 0; if (p2 == NULL) return 0; a = 3; SCFree(p1); SCFree(p2); return x+y; } coccinelle-1.0.0-rc19/tests/initializer.c0000644000175000017500000000010312247437436017213 0ustar eugeneugenstruct SHT var = { .f1 = toto1, .f2 = toto2, .f3 = toto3, }; coccinelle-1.0.0-rc19/tests/type1.res0000644000175000017500000000004512247437436016306 0ustar eugeneugenint foo() { int *x; return 0; } coccinelle-1.0.0-rc19/tests/oddifdef.cocci0000644000175000017500000000003712247437436017300 0ustar eugeneugen@@ @@ - x = 0; ... - x = 0; coccinelle-1.0.0-rc19/tests/ifdefmeta2.res0000644000175000017500000000001712247437436017251 0ustar eugeneugenint main() { } coccinelle-1.0.0-rc19/tests/hil1.c0000644000175000017500000000021712247437436015533 0ustar eugeneugen#define FUNC(funct, funct_arg, zero_rc, neg_rc, pos_rc) \ { HILSE_FUNC, { func: &funct }, funct_arg, zero_rc }, int main () { return 12; } coccinelle-1.0.0-rc19/tests/stm10.res0000644000175000017500000000012112247437436016203 0ustar eugeneugenint main(int x) { f(); if (x) replace(); h(); g(); if (x) replace(); } coccinelle-1.0.0-rc19/tests/test4.res0000644000175000017500000000010112247437436016300 0ustar eugeneugenvoid main() { f(1,2,3); if(1) g(1); else g(1); } coccinelle-1.0.0-rc19/tests/dbg.c0000644000175000017500000000021512247437436015430 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { struct resource *pr, *r = &dev->resource[idx]; if (pr) DBG("PCI"); } coccinelle-1.0.0-rc19/tests/metaruleelem.res0000644000175000017500000000011112247437436017717 0ustar eugeneugenint main(int x) { f(); foo(); if(1) { replace(); } g(); } coccinelle-1.0.0-rc19/tests/isococci.res0000644000175000017500000000002512247437436017035 0ustar eugeneugen void f(int i) { } coccinelle-1.0.0-rc19/tests/fsh.cocci0000644000175000017500000000012712247437436016314 0ustar eugeneugen@r@ identifier x; @@ f(x); @@ fresh identifier a = "foo-" ## r.x; @@ - g(); + g(a); coccinelle-1.0.0-rc19/tests/test9.res0000644000175000017500000000026612247437436016321 0ustar eugeneugenvoid main(int foo) { f(1); // f(1); // if uncoment then problems g(2); if(1) { h(1, 3); } else { h(1, 4); } // if uncomment then problems { i++; } } coccinelle-1.0.0-rc19/tests/jloop1.c0000644000175000017500000000055612247437436016110 0ustar eugeneugenvoid cpu_idle(void) { local_fiq_enable(); /* endless idle loop with no priority at all */ while (1) { int idle = pm_idle; if (!idle) idle = default_idle; preempt_disable(); leds_event(led_idle_start); while (!need_resched()) idle(); leds_event(led_idle_end); preempt_enable(); schedule(); } } coccinelle-1.0.0-rc19/tests/doublepos.res0000644000175000017500000000004412247437436017237 0ustar eugeneugenint main() { f(1,5); f(6,5); } coccinelle-1.0.0-rc19/tests/neststruct.res0000644000175000017500000000036612247437436017470 0ustar eugeneugenstruct usb_hub { union { struct usb_hub_status hub; struct usb_port_status port; } *status; /* buffer for status reports */ }; static int hub_configure(struct usb_hub *hub) { hub->status = kzalloc(sizeof(*hub->status), GFP_KERNEL); } coccinelle-1.0.0-rc19/tests/lvalue.c0000644000175000017500000000004712247437436016167 0ustar eugeneugenint main() { x = x + 1; *x = 12; } coccinelle-1.0.0-rc19/tests/fix_flow_need.cocci0000644000175000017500000000005712247437436020346 0ustar eugeneugen@@ @@ ... if(1) { foo(); } - bar(); ... coccinelle-1.0.0-rc19/tests/labels_metastatement3.cocci0000644000175000017500000000004012247437436022006 0ustar eugeneugen@@ statement S; @@ + foo(); Scoccinelle-1.0.0-rc19/tests/fnptr.c0000644000175000017500000000056312247437436016033 0ustar eugeneugenstatic irqreturn_t sci_tx_interrupt(int irq, void *ptr, struct pt_regs *regs) { } static int sci_request_irq(struct sci_port *port) { int i; irqreturn_t (*handlers[4])(int irq, void *ptr, struct pt_regs *regs) = { sci_er_interrupt, sci_rx_interrupt, sci_tx_interrupt, sci_br_interrupt, }; request_irq(port->irqs[0], sci_mpxed_interrupt, SA_INTERRUPT); } coccinelle-1.0.0-rc19/tests/metastatement_if.c0000644000175000017500000000016512247437436020231 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } if (i == 0) { printf("%d", i); } } coccinelle-1.0.0-rc19/tests/comment_brace2.c0000644000175000017500000000013712247437436017557 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ continue; return 0; } coccinelle-1.0.0-rc19/tests/decl_ver1.c0000644000175000017500000000043312247437436016542 0ustar eugeneugenstatic int volconvert(int level) { level>>=14; /* Map 16bits down to 2 bit */ level&=3; /* convert to card-friendly values */ switch (level) { case 0: return 0; case 1: return 1; case 2: return 4; case 3: return 5; } return 0; /* Quieten gcc */ } coccinelle-1.0.0-rc19/tests/badtypedef.res0000644000175000017500000000016412247437436017355 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { struct foo *a; foo_t *b; foo_t *c; aaa(a); bbb(b); } coccinelle-1.0.0-rc19/tests/test3.res0000644000175000017500000000012612247437436016306 0ustar eugeneugenvoid main() { /* a comment */ f(3); if(1) h(3, 1); else h(3, 2); } coccinelle-1.0.0-rc19/tests/multi_func1_ver2.c0000644000175000017500000000004112247437436020055 0ustar eugeneugenint main() { foo(); bar(); } coccinelle-1.0.0-rc19/tests/incdir.res0000644000175000017500000000006512247437436016516 0ustar eugeneugen#include "sub/incdir2.c" int main () { foo(12); } coccinelle-1.0.0-rc19/tests/top.res0000644000175000017500000000003112247437436016041 0ustar eugeneugenmodule_param(I, int, 0); coccinelle-1.0.0-rc19/tests/ty1.c0000644000175000017500000000005512247437436015413 0ustar eugeneugenint fn(int y) { char x; foo(int,char); } coccinelle-1.0.0-rc19/tests/test5.cocci0000644000175000017500000000006112247437436016575 0ustar eugeneugen@@ expression X; @@ f(X); ... - g(X); + h(X); coccinelle-1.0.0-rc19/tests/bug1.c0000644000175000017500000000021712247437436015534 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd,void *arg) { struct typhoon_device *typhoon = dev->priv; return 0; } coccinelle-1.0.0-rc19/tests/expopt2.cocci0000644000175000017500000000014312247437436017133 0ustar eugeneugen@@ identifier v,w; identifier fld; @@ f(v, ( - v.fld + v->fld | - w.aa + g(w.aa) ) ) coccinelle-1.0.0-rc19/tests/SCORE_expected_orig.sexp0000644000175000017500000003530212247437554021213 0ustar eugeneugen:tt\*threea.res@@@+include.res@)deref.res@@)break.res@@@@@@@4line_before_last.res@,iterator.res@@+arraysz.res@@@*format.res -INCORRECT:diff token: "one %d two\n" VS "blah" File "tests/format.c", line 2, column 9, charpos = 23 around = '"one %d two\n"', whole content = printf("one %d two\n", 1); File "tests/format.res", line 2, column 9, charpos = 23 around = '"blah"', whole content = printf("blah", 1); diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int main () { - printf("one %d two\n", 1); - printf("one %d two %d three\n", 1, 2); + printf("blah", 1); + printf("blah", 1, 2); printf("one two three\n"); } @-doublepos.res@@(cr1a.res@'spl.res@5metastatement_for.res@@,addfield.res@@@+format2.res OPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/format2ac0454.cmxs") @2type_annotated.res@@&ty.res@-positionc.res@)ptrar.res@@+metahex.res VINCORRECT:diff token: f VS } File "tests/metahex.c", line 2, column 2, charpos = 15 around = 'f', whole content = f(3); File "tests/metahex.res", line 2, column 0, charpos = 13 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,4 +1,2 @@ int main() { - f(3); - g(0x03); } @@@7pb_distribute_type4.res@)exitp.res &PROBLEM exn = Failure("no python") (fnty.res@@+varargs.res@*test_s.res@(loop.res@@@;initializer_many_fields.res@(rptr.res@@@(hil1.res@+minenum.res@@-remstruct.res@@@(cptr.res@*ifdef2.res@@*expopt.res@@+nestone.res@@@-video1bis.res@-iterprint.res@@.badtypedef.res@/branchparen.res@2addbeforeafter.res@@*return.res@@@+addelse.res@@0double_lines.res@@2minusdots_ver1.res@@@)test6.res@+typedef.res@@1comment_brace.res@@)test1.res@+localid.res@@)bigin.res@@@*addif2.res@@/gcc_min_max.res@@0expopt3_ver1.res@@*braces.res@@@(getc.res@@(stmt.res@@@+retval2.res@@-list_test.res@0metaruleelem.res@@@@@@-wierdinit.res Xseems incorrect, but only because of code that was not parsablediff token: dev_link_t VS struct File "tests/wierdinit.c", line 4, column 1, charpos = 27 around = 'dev_link_t', whole content = dev_link_t *link; File "tests/wierdinit.res", line 4, column 1, charpos = 27 around = 'struct', whole content = struct pcmcia_device *link; 1pb_params_iso.res@@+devlink.res@@-ifdefmeta.res@/longlongint.res@@,ty_tyexp.res@@'unl.res@@(anon.res@@@'ty1.res@-inclifdef.res@@@)ktype.res@/topdec_ver1.res@(void.res@@0strangeorder.res@+expopt2.res@,argument.res@@(pmac.res@.proto_ver1.res@@*test12.res@@&p9.res INCORRECT:diff token: v0 VS v2 File , line 1, column 10, charpos = 10 around = 'v0', whole content = int f(int v0, int v1, int x) { File "tests/p9.res", line 1, column 10, charpos = 10 around = 'v2', whole content = int f(int v2, int v3, int x) { diff (result(<) vs expected_result(>)) = @@ -1,3 +1,3 @@ -int f(int v0, int v1, int x) { +int f(int v2, int v3, int x) { return x; } @@-starprint.res@(delp.res@@(stm8.res@@@(stm3.res@@,twomatch.res@@@@.define_exp.res@3gilles-question.res@@(dbg1.res INCORRECT:diff token: E VS ( File , line 5, column 2, charpos = 75 around = 'E', whole content = E = NULL;("PCI"); File "tests/dbg1.res", line 4, column 5, charpos = 72 around = '(', whole content = DBG("PCI"); diff (result(<) vs expected_result(>)) = @@ -1,6 +1,6 @@ static inline void alloc_resource(struct pci_dev *dev, int idx) { - DBG - E = NULL;("PCI"); + DBG("PCI"); + E = NULL; } @-gotobreak.res@@@)const.res@'ws2.res@*signed.res@@@*dropbr.res@@,nameless.res@@(tern.res@@.justremove.res@*badexp.res@'com.res@3return_implicit.res@@@@@)type1.res@@)proto.res@@,comments.res@1disjexpr_ver1.res@@,multidec.res@'opt.res@@@@@0const_adding.res@*retval.res@@/constructor.res@@@2typedef_double.res@+condexp.res@@.array_init.res@8labels_metastatement.res@(rets.res@@@'dec.res@3toplevel_struct.res@@@*ifdef3.res@@-type_ver1.res@@(zero.res@@+declinv.res DPROBLEM exn = Unix.Unix_error(20, "stat", "tests/declinv.cocci") @@*addtoo.res@2struct_metavar.res@@(four.res@@-null_type.res@@@,cst_null.res@,cs_check.res@@@@)test7.res@,constrem.res@@@)test2.res@-multitype.res@@(defe.res@@(cast.res@,cast_iso.res@@&fp.res@(post.res@@@0expopt3_ver2.res@@@@@@/remove_call.res@1bad_ptr_print.res@@@'ip2.res@@@'csw.res@@(nest.res@@@@1scope_problem.res INCORRECT:diff token: } VS a File , line 4, column 2, charpos = 42 around = '}', whole content = } File "tests/scope_problem.res", line 4, column 4, charpos = 44 around = 'a', whole content = a = 2; diff (result(<) vs expected_result(>)) = @@ -1,7 +1,6 @@ void main(int i) { if(1) { int a; + a = 2; } - - } )endif.res@@'lid.res@@&of.res@@(decl.res@6optional_qualifier.res@@+spacing.res@@@@.ifdefmeta1.res@@/topdec_ver2.res@@+expopt3.res@*strid2.res@@*doundo.res@.proto_ver2.res@@@/macro_int16.res@@1mini_null_ref.res@@6incompatible_value.res@@+compare.res@@@0a_and_e_ver1.res@(stm4.res@@@*jloop1.res PROBLEM exn = Failure("minus: parse error: \n = File \"tests/jloop1.cocci\", line 10, column 3, charpos = 129\n around = '...>', whole content = ...>\n") @/protoassert.res@@+fn_todo.res@@@@@-same_expr.res@(ifbr.res@@@@.decl_split.res jINCORRECT:diff token: int VS } File "tests/decl_split.c", line 2, column 8, charpos = 27 around = 'int', whole content = int x, y; File "tests/decl_split.res", line 2, column 0, charpos = 19 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,3 +1,2 @@ int func(int i) { - int x, y; } *inhmet.res@/multi_func1.res PROBLEM exn = Failure("minus: parse error: \n = File \"tests/multi_func1.cocci\", line 12, column 2, charpos = 102\n around = 'fn2', whole content = fn2(...) {\n") @*inline.res@+ifields.res@@@@@@'kmc.res@)ifadd.res@@+julia10.res@@1disjexpr_ver2.res@@*sizeof.res@@*incdir.res INCORRECT:diff token: x VS 12 File "tests/incdir.c", line 4, column 6, charpos = 46 around = 'x', whole content = foo(x); File "tests/incdir.res", line 4, column 6, charpos = 46 around = '12', whole content = foo(12); diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ #include "sub/incdir2.c" int main () { - foo(x); + foo(12); } @)cards.res@(bug1.res@@.decl_space.res@@)stm10.res@/test10_ver1.res@@@.multichars.res@@@@-minusdots.res@*comadd.res@@)exitc.res MPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/exitc439450.cmxs") @@&sp.res@*ifdef4.res@+expnest.res@@'ifd.res@(type.res@*incpos.res &PROBLEM exn = Failure("no python") -type_ver2.res INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int foo() { - int[10] *x; + int *x[10]; return 0; } @*switch.res@@)debug.res@@*regexp.res@@@*protox.res@@&hd.res@-multivars.res@*addaft.res@@+deftodo.res@@*double.res@@+dowhile.res@,isococci.res@@@)test8.res@)fnptr.res@@@)test3.res@@)bugon.res@0doubleswitch.res@@+badwhen.res@@@+nestseq.res@@@@*static.res@@.array_size.res@'inc.res@@1fix_flow_need.res@@.end_commas.res@@.distribute.res@@@@)foura.res@@.param_ver1.res@@'exp.res@@@1match_no_meta.res@@@*proto2.res@+isotest.res@@@@.stm10_ver1.res@)addif.res@@+headers.res@@.ifdefmeta2.res@@*inhpos.res@@(noty.res@@@4metastatement_if.res@,isotest2.res@@-overshoot.res@&na.res@'tup.res@@@@*posiso.res@@@+constty.res@(stm5.res@@@0useless_cast.res@@0param_to_exp.res IPROBLEM exn = Unix.Unix_error(20, "stat", "tests/param_to_exp.cocci") @*topdec.res@@0multitypedef.res@@,disjexpr.res@-decl_star.res@@+badzero.res@@+kmalloc.res@*fields.res@@-dropparam.res@@(rcu3.res@0print_return.res@'not.res@@-longconst.res@&kr.res@@&ab.res@@&km.res@@-structfoo.res@/multiremove.res@@'max.res@)ifend.res@@,longlong.res@@%a.res@.neststruct.res@@@)edots.res@+incpos1.res &PROBLEM exn = Failure("no python") @@6pb_distribute_type.res INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -10,6 +10,6 @@ } int foo() { - int[45] *x; + int (*x)[45]; return 0; } @1double_switch.res@@*disjid.res@'fun.res@@&b1.res@+sizeptr.res@*nocast.res@@@7pb_distribute_type2.res /INCORRECT:PB parsing only in generated-file diff (result(<) vs expected_result(>)) = @@ -1,5 +1,5 @@ int foo() { - int* x; + int *x; return 0; } @@ -10,6 +10,6 @@ } int foo() { - int x[45]*; + int (*x)[45]; return 0; } @(rem1.res@4pb_parsing_macro.res@&ip.res@@(tyex.res@@+fortype.res@@@&if.res@@*ifdef5.res@@@@,reserved.res@@@)serio.res INCORRECT:diff token: init_MUTEX VS mutex_init File "tests/serio.c", line 7, column 1, charpos = 130 around = 'init_MUTEX', whole content = init_MUTEX(&serio->drv_sem); File "tests/serio.res", line 7, column 1, charpos = 130 around = 'mutex_init', whole content = mutex_init(&serio->new_lock); diff (result(<) vs expected_result(>)) = @@ -4,5 +4,5 @@ static void serio_init_port(struct serio *serio) { - init_MUTEX(&serio->drv_sem); + mutex_init(&serio->new_lock); } @'arg.res@,dc_close.res@*memory.res@@(enum.res@6test_unsigned_meta.res@+smallfn.res@@-substruct.res@(vpos.res@@/three_types.res@@@.edots_ver1.res@-const1bis.res@@)test9.res@*typeof.res@@.pragmatest.res@@)test4.res@@@@@,retmacro.res@4optional_storage.res@@@-find_long.res@-param_end.res@*symbol.res@'dbg.res INCORRECT:diff token: else VS ( File , line 8, column 2, charpos = 133 around = 'else', whole content = else pr = NULL;("PCI"); File "tests/dbg.res", line 7, column 5, charpos = 130 around = '(', whole content = DBG("PCI"); diff (result(<) vs expected_result(>)) = @@ -4,6 +4,6 @@ struct resource *pr, *r = &dev->resource[idx]; if (pr) - DBG - else pr = NULL;("PCI"); + DBG("PCI"); + else pr = NULL; } @@,twoproto.res@)param.res@@@.switchdecl.res@0sizeof_julia.res@@@*string.res@@@.formatlist.res@+bigrepl.res@6const_implicit_iso.res@@*julia7.res@@'cst.res@.match_init.res@)decl2.res@@.whitespace.res@@@@)macro.res@@(ifzz.res@/const_array.res@@1double_assign.res@@(incl.res@@@.ifdefmeta3.res@'ben.res@@&nl.res@@@@@)local.res@/pragmatest1.res@+regexp2.res@@*test10.res@)strid.res@@-inherited.res@@)orexp.res@@,typedef3.res rINCORRECT:diff token: link VS p_dev File , line 7, column 29, charpos = 137 around = 'link', whole content = unsigned int iobase = info->link.io.BasePort1; File "tests/typedef3.res", line 7, column 29, charpos = 137 around = 'p_dev', whole content = unsigned int iobase = info->p_dev->io.BasePort1; diff (result(<) vs expected_result(>)) = @@ -4,7 +4,7 @@ static void should_work(foo *info) { - unsigned int iobase = info->link.io.BasePort1; + unsigned int iobase = info->p_dev->io.BasePort1; } static void does_work(struct bluecard_info_t *info) *badpos.res PROBLEM exn = Failure("rule starting on line 1: already tagged token:\nC code context\nFile \"tests/badpos.c\", line 5, column 30, charpos = 139\n around = 'reg_ptr', whole content = \t (int) -(((struct pt_regs *) reg_ptr)->orig_eax + 2));") @(stm6.res@@@(stm1.res &PROBLEM exn = Failure("no python") @@@+partial.res@)extra.res MPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/extra831591.cmxs") @&ar.res@+arparam.res@@@)empty.res@+oneline.res@@/test11_ver1.res@@+attradd.res@@2inherited_ver1.res@'eb1.res@@&y2.res@@-addbefore.res@@@2struct_typedef.res@'hex.res@*xfield.res@@)dropf.res@@2comment_brace2.res@)ifzer.res@@@3replace_typedef.res@*notest.res@@/initializer.res@*retest.res@@3bad_iso_example.res INCORRECT:diff token: ( VS x File "tests/bad_iso_example.c", line 2, column 6, charpos = 19 around = '(', whole content = if ((x = 3)) return; File "tests/bad_iso_example.res", line 2, column 6, charpos = 19 around = 'x', whole content = if (x) return; diff (result(<) vs expected_result(>)) = @@ -1,4 +1,4 @@ int main() { - if ((x = 3)) return; + if (x) return; } @@.keep_comma.res@@&b2.res@)minfn.res@@@0define_param.res@7pb_distribute_type3.res ?PROBLEM exn = Failure("line 7: index 53 53 already used\n") (tdnl.res@/bad_typedef.res@*lvalue.res@@(rem2.res@@@@'a3d.res@&td.res@&sw.res@3delete_function.res@@,oddifdef.res INCORRECT:diff token: #else VS x File , line 10, column 0, charpos = 114 around = '#else ', whole content = #else File "tests/oddifdef.res", line 10, column 2, charpos = 116 around = 'x', whole content = x = 0; diff (result(<) vs expected_result(>)) = @@ -7,8 +7,9 @@ a = 5; #ifdef FOO + x = 0; #else - + x = 0; #endif } @@ -21,8 +22,9 @@ a = 3; #ifdef FOO + x = 0; #else - + x = 0; #endif } @@ -35,7 +37,8 @@ #endif #ifdef FOO + x = 0; #else - + x = 0; #endif } @6toplevel_macrostmt.res@)fnret.res@*ifdef6.res@*struct.res@2wierd_argument.res@@,bitfield.res@@*ifdef1.res@.test5_ver1.res@@@@-minstruct.res@-bad_kfree.res@@-null_bool.res $INCORRECT:diff token: ) VS != File , line 2, column 8, charpos = 22 around = ')', whole content = if (12) return; File "tests/null_bool.res", line 2, column 9, charpos = 23 around = '!=', whole content = if (12 != NULL) return; diff (result(<) vs expected_result(>)) = @@ -1,6 +1,6 @@ int main () { - if (12) return; - if (a && 12 && b) return; + if (12 != NULL) return; + if (a && 12 != NULL && b) return; if (12) return; if (a && 12 && b) return; x = x + 20; @+bugloop.res@@@,str_init.res@'top.res@'fsh.res@2pb_tag_symbols.res@@@@@(skip.res@@)test5.res@@+ifdef6a.res@@)test0.res@(befS.res@@=labels_metastatement_ver1.res@@3parameters_dots.res@@*spaces.res@*addif1.res@@*constx.res@@@@@,sizestar.res@@@@,after_if.res@@0shared_brace.res@@@@@@2metastatement2.res@@@'sis.res@@+a_and_e.res@-fieldsmin.res@@@@.ifdefmeta4.res GPROBLEM exn = Unix.Unix_error(20, "stat", "tests/ifdefmeta4.cocci") @,metaline.res@@@@-multiplus.res@@*insdef.res@+regexp3.res@@*test11.res@@@@,minenum1.res@@(stm7.res &PROBLEM exn = Failure("no python") @*tydisj.res@@(stm2.res@@coccinelle-1.0.0-rc19/tests/delp.cocci0000644000175000017500000000005012247437436016453 0ustar eugeneugen@@ expression E; @@ return - ( E - ) ; coccinelle-1.0.0-rc19/tests/a.res0000644000175000017500000000011012247437436015455 0ustar eugeneugenint main () { int a; f(a); h(a); { int a; g(a); r(a); } } coccinelle-1.0.0-rc19/tests/ifdef2.c0000644000175000017500000000031212247437436016031 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/stm7.c0000644000175000017500000000005712247437436015572 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/decl_space.cocci0000644000175000017500000000012512247437436017614 0ustar eugeneugen@@ type T; @@ - T *x = y; + T *x = g; @@ type T; @@ - T x = y; + T x = g; coccinelle-1.0.0-rc19/tests/stm8.cocci0000644000175000017500000000004712247437436016430 0ustar eugeneugen@@ statement S; @@ f(); - S + g();S coccinelle-1.0.0-rc19/tests/posiso.c0000644000175000017500000000027412247437436016215 0ustar eugeneugenint main () { int *x; if (x == NULL) x = a; else x = b; if (!x) x = a; else x = b; if (x == a) x = a; else x = b; if (x == NULL) x = a; if (!x) x = a; if (x == a) x = a; } coccinelle-1.0.0-rc19/tests/inherited_ver1.c0000644000175000017500000000010512247437436017602 0ustar eugeneugenvoid main(int i) { //g(1); f(2); h(2); h2(2); foo(1); } coccinelle-1.0.0-rc19/tests/ret.cocci0000644000175000017500000000013512247437436016325 0ustar eugeneugen@@ expression E; identifier x; @@ f(...) { + spin_lock(); ... + spin_unlock(); }coccinelle-1.0.0-rc19/tests/rptr.cocci0000644000175000017500000000005412247437436016522 0ustar eugeneugen@@ expression *r; statement S; @@ -if(!r) S coccinelle-1.0.0-rc19/tests/oneline.c0000644000175000017500000000003612247437436016326 0ustar eugeneugenint main () { f(); f(); } coccinelle-1.0.0-rc19/tests/empty.cocci0000644000175000017500000000070612247437436016675 0ustar eugeneugen//---------------------------------------------------------------------- // Rule 82 //---------------------------------------------------------------------- //---------------------------------------------------------------------- @@ expression E1, E2; @@ - pci_save_state(E1,E2) + pci_save_state(E1) //---------------------------------------------------------------------- @@ expression E1, E2; @@ - pci_restore_state(E1,E2) + pci_restore_state(E1) coccinelle-1.0.0-rc19/tests/addif.c0000644000175000017500000000010512247437436015741 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.0-rc19/tests/fnptr.res0000644000175000017500000000055412247437436016402 0ustar eugeneugenstatic irqreturn_t sci_tx_interrupt(int irq, void *ptr, struct pt_regs *regs) { } static int sci_request_irq(struct sci_port *port) { int i; irqreturn_t (*handlers[4])(int irq, void *ptr, struct pt_regs *regs) = { sci_er_interrupt, sci_rx_interrupt, sci_tx_interrupt, sci_br_interrupt, }; request_irq(port->irqs[0], sci_mpxed_interrupt, foo()); } coccinelle-1.0.0-rc19/tests/badaw.c0000644000175000017500000000137712247437436015764 0ustar eugeneugenstatic int __cpuinit cpuup_prepare(long cpu) { struct kmem_list3 *l3 = NULL; list_for_each_entry(cachep, &cache_chain, next) { if (!cachep->nodelists[node]) { l3 = kmalloc_node(memsize, GFP_KERNEL, node); if (!l3) return 0; kmem_list3_init(l3); l3->next_reap = jiffies + REAPTIMEOUT_LIST3 + ((unsigned long)cachep) % REAPTIMEOUT_LIST3; cachep->nodelists[node] = l3; } } list_for_each_entry(cachep, &cache_chain, next) { struct array_cache *shared = NULL; if (cachep->shared) { shared = alloc_arraycache(node, cachep->shared * cachep->batchcount, 0xbaadf00d); if (!shared) return 0; } if (use_alien_caches) { if (!alien) { kfree(shared); goto bad; } } kfree(shared); } bad: return -ENOMEM; } coccinelle-1.0.0-rc19/tests/const_implicit_iso.c0000644000175000017500000000005112247437436020564 0ustar eugeneugenvoid main(double y) { const int x; } coccinelle-1.0.0-rc19/tests/metahex.c0000644000175000017500000000004212247437436016325 0ustar eugeneugenint main() { f(3); g(0x03); } coccinelle-1.0.0-rc19/tests/typedef_double.res0000644000175000017500000000021212247437436020232 0ustar eugeneugentypedef struct stlpcibrd { unsigned short vendid; unsigned short devid; int brdtype; } stlpcibrd_t; int main () { sema_init(x); } coccinelle-1.0.0-rc19/tests/ifzer.res0000644000175000017500000000035612247437436016370 0ustar eugeneugenint main() { #if 0 /* Accessing floppy->pc is not valid here, the previous pc may be gone and have lived on another thread's stack; that stack may have become unmapped meanwhile (CONFIG_DEBUG_PAGEALLOC). */ #endif } coccinelle-1.0.0-rc19/tests/macro.res0000644000175000017500000000031212247437436016342 0ustar eugeneugen#define SC_FCMND(fcmnd) ((struct scsi_cmnd *)((long)fcmnd - (long)&(((struct scsi_cmnd *)0)->SCp))) int main() { return ((struct scsi_cmnd *)((long)fcmnd - (long)&(((struct scsi_cmnd *)0)->SCp))); } coccinelle-1.0.0-rc19/tests/proto_ver1.res0000644000175000017500000000015312247437436017344 0ustar eugeneugenvoid bch_l2l1(struct PStack *st, int pr, void *arg); void bch_empty_fifo(struct BCState *bcs, int count); coccinelle-1.0.0-rc19/tests/a3d.cocci0000644000175000017500000000015112247437436016200 0ustar eugeneugen@@ struct input_dev E; @@ - E.idbus + E.id.bustype @@ struct gameport E; @@ - E.idbus + E.id.bustype coccinelle-1.0.0-rc19/tests/positionc.cocci0000644000175000017500000000110112247437436017534 0ustar eugeneugen@x disable all@ position p; expression E; expression A; statement S1, S2; @@ if@p (foo(E,A)) S1 else S2 // here the incoming environment is p = 1,2 E = 6 and p = 3 E = 7 @disable all@ position p1 != x.p; expression x.E; expression B; statement S1, S2; @@ - if@p1 (foo(E,B)) S1 else S2 @y disable all@ position p; expression E; expression A; statement S1, S2; @@ if@p (bar(E,A)) S1 else S2 // here the incoming environment is p = 4,5 E = 6 and p = 6 E = 7 @disable all@ position p1 != y.p; expression y.E; expression C; statement S1, S2; @@ - if@p1 (bar(C,E)) S1 else S2 coccinelle-1.0.0-rc19/tests/xloop.cocci0000644000175000017500000000003312247437436016671 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.0-rc19/tests/iterprint.res0000644000175000017500000000010212247437436017256 0ustar eugeneugenint main () { for_each_set_bit(bit, bitmap, size) x = 12; } coccinelle-1.0.0-rc19/tests/three.c0000644000175000017500000000065112247437436016007 0ustar eugeneugenint ide_event(event_t event, int priority, event_callback_args_t *args) { dev_link_t *link = args->client_data; DEBUG(1, "ide_event(0x%06x)\n", event); } /* ide_event */ /*====================================================================*/ static int init_ide_cs(void) { register_pccard_driver(&ide_attach); return 0; } static void exit_ide_cs(void) { unregister_pccard_driver(&dev_info); } coccinelle-1.0.0-rc19/tests/condexp.res0000644000175000017500000000043112247437436016703 0ustar eugeneugenint main(int argc, char *argv[]) { // ... dpy = XOpenDisplay (displayname); if (!dpy) { fprintf (stderr, "%s: unable to open display \"%s\"\n", ProgramName, displayname ? displayname : getenv("DISPLAY")); Exit (1); } screenno = DefaultScreen (dpy); // ... } coccinelle-1.0.0-rc19/tests/multi_func1.res0000644000175000017500000000021612247437436017472 0ustar eugeneugenint f1() { } int f2() { } int f3() { bar(7); } int f4() { foo(12); } int f5() { bar(12); } int main() { f1(); f2(); f3(); } coccinelle-1.0.0-rc19/tests/oddifdef.c0000644000175000017500000000072312247437436016444 0ustar eugeneugenvoid one () { if (errno != ENOENT #ifdef ENOTDIR && errno != ENOTDIR #endif ) a = 5; #ifdef FOO x = 0; #else x = 0; #endif } void two() { #ifdef ENOTTY if (errno == ENOTTY) is_a_tty=0; else #endif a = 3; #ifdef FOO x = 0; #else x = 0; #endif } void three() { if (x) a = 3; #ifndef OPENSSL_NO_SSL2 else if (strcmp(*argv,"-ssl2") == 0) meth=SSLv2_client_method(); #endif #ifdef FOO x = 0; #else x = 0; #endif } coccinelle-1.0.0-rc19/tests/extra.cocci0000644000175000017500000000124412247437436016660 0ustar eugeneugen@r@ identifier f; fresh identifier ff = "_called_function_"; parameter list pl; type T; @@ T - f + ff (pl) { ... } + T f(pl) { return ff(); } @script:ocaml s@ (_,pl) << r.pl; ff << r.ff; newargs; @@ newargs := String.concat ", " (List.map (function pt -> match (Ast_c.unwrap pt).Ast_c.p_namei with None -> failwith "bad param" | Some nm -> Ast_c.str_of_name nm) pl) @@ identifier s.newargs; identifier r.ff; @@ ff( + newargs ) @t@ identifier r.ff; identifier x; type T; @@ ff(..., T *x, ...) { ... } @@ identifier r.f, r.ff, t.x; @@ f(...) { ++ assert(x != NULL); ... return ff(...); // be sure this is the right function } coccinelle-1.0.0-rc19/tests/ty.cocci0000644000175000017500000000003412247437436016165 0ustar eugeneugen@@ @@ + const struct foo coccinelle-1.0.0-rc19/tests/top.cocci0000644000175000017500000000015512247437436016337 0ustar eugeneugen@@ declarer name MODULE_PARM; declarer name module_param; @@ - MODULE_PARM(...); + module_param(I, int, 0); coccinelle-1.0.0-rc19/tests/dropf.c0000644000175000017500000000004212247437436016004 0ustar eugeneugenint main() { x = f(1) + f(3); } coccinelle-1.0.0-rc19/tests/fnret.res0000644000175000017500000000000112247437436016352 0ustar eugeneugen coccinelle-1.0.0-rc19/tests/deftodo.res0000644000175000017500000000041312247437436016667 0ustar eugeneugen#define UNIT_TYPE int /* * cpu_alloc area immediately follows the percpu area that is allocated for * each processor. */ #define cpu_alloc_start ((int *)__per_cpu_end) void __init cpu_alloc_init(void) { cpu_alloc_start = alloc_bootmem(nr_units * UNIT_SIZE); } coccinelle-1.0.0-rc19/tests/retest.cocci0000644000175000017500000000007212247437436017041 0ustar eugeneugen@@ expression e; statement S; @@ - if (e) S + if (f(e)) Scoccinelle-1.0.0-rc19/tests/video1bis.res0000644000175000017500000000022212247437436017126 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { if (cmd == VIDIOCGTUNER) { struct video_tuner v; } } coccinelle-1.0.0-rc19/tests/null_bool.cocci0000644000175000017500000000003012247437436017512 0ustar eugeneugen@@ @@ - x != NULL + 12 coccinelle-1.0.0-rc19/tests/ben.res0000644000175000017500000000064012247437436016011 0ustar eugeneugenstatic GType this_type = 0; static const GTypeInfo this_info = { sizeof(LassoProviderClass), NULL, NULL, (GClassInitFunc)class_init, NULL, NULL, sizeof(LassoProvider), 0, (GInstanceInitFunc)instance_init, NULL, }; GType lasso_provider_get_type() { if (!this_type) { this_type = g_type_register_static(LASSO_TYPE_NODE, "LassoProvider", &this_info, 0); } return this_type; } coccinelle-1.0.0-rc19/tests/max.res0000644000175000017500000000005012247437436016025 0ustar eugeneugenint main () { if (x < 25) return 3; } coccinelle-1.0.0-rc19/tests/test7.cocci0000644000175000017500000000007312247437436016602 0ustar eugeneugen@@ expression X; @@ - f(X); + f(X, "foo"); + f(X, "bar"); coccinelle-1.0.0-rc19/tests/array.cocci0000644000175000017500000000324512247437436016656 0ustar eugeneugen// Use the macro ARRAY_SIZE when possible // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, INRIA, DIKU. GPLv2. // URL: http://coccinelle.lip6.fr/rules/array.html // Options: -I ... -all_includes can give more complete results virtual org virtual patch @i@ @@ #include ///////////////////////////////////// ///////////////////////////////////// @depends on i && patch && !org@ type T; T[] E; @@ - (sizeof(E)/sizeof(*E)) + ARRAY_SIZE(E) @depends on i && patch && !org@ type T; T[] E; @@ - (sizeof(E)/sizeof(E[...])) + ARRAY_SIZE(E) @depends on i && patch && !org@ type T; T[] E; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) @n_patch depends on patch && !org@ identifier AS,E; @@ - #define AS(E) ARRAY_SIZE(E) @ depends on patch && !org@ expression E; identifier n_patch.AS; @@ - AS(E) + ARRAY_SIZE(E) ///////////////////////////////////// ///////////////////////////////////// @arr_ptr depends on i && !patch && org@ type T; T[] E; position p; @@ (sizeof(E@p)/sizeof(*E)) @arr_tab depends on i && !patch && org@ type T; T[] E; position p; @@ (sizeof(E@p)/sizeof(E[...])) @arr_typ depends on i && !patch && org@ type T; T[] E; position p; @@ (sizeof(E@p)/sizeof(T)) @n_org depends on !patch && org@ identifier AS,E; @@ #define AS(E) ARRAY_SIZE(E) @arr_def depends on !patch && org@ expression E; identifier n_org.AS; position p; @@ AS@p(E) @script:python@ p << arr_ptr.p; e << arr_ptr.E; @@ cocci.print_main(e,p) @script:python@ p << arr_tab.p; e << arr_tab.E; @@ cocci.print_main(e,p) @script:python@ p << arr_typ.p; e << arr_typ.E; @@ cocci.print_main(e,p) @script:python@ p << arr_def.p; e << arr_def.E; @@ cocci.print_main(e,p) coccinelle-1.0.0-rc19/tests/match_const.res0000644000175000017500000000000012247437436017535 0ustar eugeneugencoccinelle-1.0.0-rc19/tests/param_ver1.c0000644000175000017500000000003412247437436016730 0ustar eugeneugenvoid foo(int x) { return; } coccinelle-1.0.0-rc19/tests/param1.c0000644000175000017500000000003412247437436016054 0ustar eugeneugenvoid foo(int x) { return; } coccinelle-1.0.0-rc19/tests/null.c0000644000175000017500000000042312247437436015647 0ustar eugeneugenint main() { fsm->jumpmatrix = kmalloc(sizeof(FSMFNPTR) * fsm->state_count * fsm->event_count, GFP_KERNEL); if (fsm->jumpmatrix == NULL) { foo(fsm->jumpmatrix); return; } memset(fsm->jumpmatrix, 0, sizeof(FSMFNPTR) * fsm->state_count * fsm->event_count); } coccinelle-1.0.0-rc19/tests/type_annotated.cocci0000644000175000017500000000007012247437436020547 0ustar eugeneugen@@ struct foo x; //expression x; @@ - x.foo + x.newfoococcinelle-1.0.0-rc19/tests/inhpos.res0000644000175000017500000000002012247437436016535 0ustar eugeneugenint main () { } coccinelle-1.0.0-rc19/tests/deftodo.cocci0000644000175000017500000000113112247437436017154 0ustar eugeneugen// A pci_get_slot is not matched by a pci_put_slot before an error return. // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/get_slot.html // options: -no_includes -include_headers @@ expression E; statement S; @@ E = \(alloc_bootmem\|alloc_bootmem_low\|alloc_bootmem_pages\|alloc_bootmem_low_pages\)(...) ... when != E ( - BUG_ON (E == NULL); | - if (E == NULL) S ) @@ expression E,E1; @@ E = \(alloc_bootmem\|alloc_bootmem_low\|alloc_bootmem_pages\|alloc_bootmem_low_pages\)(...) ... when != E - memset(E,0,E1); coccinelle-1.0.0-rc19/tests/video3.cocci0000644000175000017500000000065412247437436016732 0ustar eugeneugen@@ local function ioctlfn; identifier dev, cmd, arg; identifier v; type T; identifier fld; @@ ioctlfn( struct video_device *dev, unsigned int cmd, void *arg) { <... { ... - T v; + T *v; ... - if (copy_from_user(v,arg,sizeof(v)) != 0) return ...; <... - v.fld + v->fld ...> ?- if (copy_to_user(arg,v,sizeof(v))) return ...; ... } ...> } coccinelle-1.0.0-rc19/tests/stm5.res0000644000175000017500000000007512247437436016137 0ustar eugeneugenint main(int x) { f(); h(); replace(); g(); g(); } coccinelle-1.0.0-rc19/tests/hmt.cocci0000644000175000017500000000004012247437436016316 0ustar eugeneugen@@ @@ - machine_is_frodo() +12 coccinelle-1.0.0-rc19/tests/null_ver11.c0000644000175000017500000000672712247437436016702 0ustar eugeneugen void udf_fill_spartable(struct super_block *sb, struct udf_sparing_data *sdata, int partlen) { Uint16 ident; Uint32 spartable; int i; struct buffer_head *bh; struct SparingTable *st; for (i=0; i<4; i++) { if (!(spartable = sdata->s_spar_loc[i])) continue; bh = udf_read_tagged(sb, spartable, spartable, &ident); if (!bh) { sdata->s_spar_loc[i] = 0; continue; } if (ident == 0) { st = (struct SparingTable *)bh->b_data; if (!strncmp(st->sparingIdent.ident, UDF_ID_SPARING, strlen(UDF_ID_SPARING))) { SparingEntry *se; Uint16 rtl = le16_to_cpu(st->reallocationTableLen); int index; if (!sdata->s_spar_map) { int num = 1, mapsize; sdata->s_spar_indexsize = 8; while (rtl*sizeof(Uint32) >= (1 << sdata->s_spar_indexsize)) { num ++; sdata->s_spar_indexsize <<= 1; } mapsize = (rtl * sizeof(Uint32)) + ((partlen/(1 << sdata->s_spar_pshift)) * sizeof(Uint8) * num); sdata->s_spar_map = kmalloc(mapsize, GFP_KERNEL); sdata->s_spar_remap.s_spar_remap32 = &sdata->s_spar_map[rtl]; memset(sdata->s_spar_map, 0xFF, mapsize); } index = sizeof(struct SparingTable); for (i=0; i sb->s_blocksize) { udf_release_data(bh); bh = udf_tread(sb, ++spartable, sb->s_blocksize); if (!bh) { sdata->s_spar_loc[i] = 0; continue; } index = 0; } se = (SparingEntry *)&(bh->b_data[index]); index += sizeof(SparingEntry); if (sdata->s_spar_map[i] == 0xFFFFFFFF) sdata->s_spar_map[i] = le32_to_cpu(se->mappedLocation); else if (sdata->s_spar_map[i] != le32_to_cpu(se->mappedLocation)) { udf_debug("Found conflicting Sparing Data (%d vs %d for entry %d)\n", sdata->s_spar_map[i], le32_to_cpu(se->mappedLocation), i); } if (le32_to_cpu(se->origLocation) < 0xFFFFFFF0) { int packet = le32_to_cpu(se->origLocation) >> sdata->s_spar_pshift; if (sdata->s_spar_indexsize == 8) { if (sdata->s_spar_remap.s_spar_remap8[packet] == 0xFF) sdata->s_spar_remap.s_spar_remap8[packet] = i; else if (sdata->s_spar_remap.s_spar_remap8[packet] != i) { udf_debug("Found conflicting Sparing Data (%d vs %d)\n", sdata->s_spar_remap.s_spar_remap8[packet], i); } } else if (sdata->s_spar_indexsize == 16) { if (sdata->s_spar_remap.s_spar_remap16[packet] == 0xFFFF) sdata->s_spar_remap.s_spar_remap16[packet] = i; else if (sdata->s_spar_remap.s_spar_remap16[packet] != i) { udf_debug("Found conflicting Sparing Data (%d vs %d)\n", sdata->s_spar_remap.s_spar_remap16[packet], i); } } else if (sdata->s_spar_indexsize == 32) { if (sdata->s_spar_remap.s_spar_remap32[packet] == 0xFFFFFFFF) sdata->s_spar_remap.s_spar_remap32[packet] = i; else if (sdata->s_spar_remap.s_spar_remap32[packet] != i) { udf_debug("Found conflicting Sparing Data (%d vs %d)\n", sdata->s_spar_remap.s_spar_remap32[packet], i); } } } } } } udf_release_data(bh); } } coccinelle-1.0.0-rc19/tests/sys.iso0000644000175000017500000000020412247437436016060 0ustar eugeneugenTopLevel @ mkinit @ type T; pure context T E; identifier I; identifier fld; expression E1; @@ E.fld = E1; => T I = { .fld = E1, }; coccinelle-1.0.0-rc19/tests/doublepos.cocci0000644000175000017500000000025112247437436017526 0ustar eugeneugen// this shows a constraint on an inherited position variable @a@ position p; @@ f@p(1,...) @b@ position p1; @@ f@p1(...,5) @@ position a.p != b.p1; @@ - f@p(...); coccinelle-1.0.0-rc19/tests/hmt.c0000644000175000017500000000030512247437436015464 0ustar eugeneugenint sa1100_mtd_init(void) { #ifdef CONFIG_SA1100_FRODO if (machine_is_frodo()) { } #ifdef CONFIG_SA1100_GRAPHICSCLIENT if (machine_is_graphicsclient()) { } #endif } coccinelle-1.0.0-rc19/tests/sizeof_julia.res0000644000175000017500000000013612247437436017730 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { foo(); } coccinelle-1.0.0-rc19/tests/stm10_ver1.c0000644000175000017500000000007512247437436016601 0ustar eugeneugenint main(int x) { f(); { replace(); replace();} g(); } coccinelle-1.0.0-rc19/tests/addelse.cocci0000644000175000017500000000017012247437436017133 0ustar eugeneugen@@ expression E; statement S; @@ if (E) S + else return 12; @@ expression E; statement S1,S2; @@ - if (E) S1 else S2 coccinelle-1.0.0-rc19/tests/pb_cfg.cocci0000644000175000017500000000002012247437436016744 0ustar eugeneugen@@ @@ -f(...); coccinelle-1.0.0-rc19/tests/bugon.res0000644000175000017500000000007712247437436016363 0ustar eugeneugenstatic void b44_tx(struct b44 *bp) { BUG_ON(skb == NULL); } coccinelle-1.0.0-rc19/tests/undef1.c0000644000175000017500000000006412247437436016060 0ustar eugeneugen#define foo 12 #define foo 12 #undef foo #undef foo coccinelle-1.0.0-rc19/tests/same_expr.res0000644000175000017500000000004012247437436017222 0ustar eugeneugenvoid main(int i) { f(1,2); } coccinelle-1.0.0-rc19/tests/inner2.c0000644000175000017500000000004012247437436016065 0ustar eugeneugenstruct ty x = { .i = a, }; coccinelle-1.0.0-rc19/tests/cr1a.c0000644000175000017500000000074212247437436015527 0ustar eugeneugenint __init probe_base_port(int base) { int b = 0x300, e = 0x370; /* this is the range of start addresses */ volatile int fool, i; if (base) b = e = base; for (base = b; base <= e; base += 0x10) { if (check_region(base, 0x10)) continue; for (i = 0; i < 3; i++) fool = inw(base + 2); /* empty possibly uart_receive_buffer */ if ((inw(base + 6) & 0xffef) != 0x0001 || /* line_status */ (inw(base) & 0xad00) != 0) continue; return (base); } return 0; } coccinelle-1.0.0-rc19/tests/ldecl.c0000644000175000017500000000010112247437436015751 0ustar eugeneugen int main(){ int a, b; int c = a + b; return 0; } coccinelle-1.0.0-rc19/tests/noty.res0000644000175000017500000000007112247437436016234 0ustar eugeneugenint main(int *x) { if (NULL == x) { return; } g(); } coccinelle-1.0.0-rc19/tests/rets.res0000644000175000017500000000004612247437436016222 0ustar eugeneugenint main () { foo(); return 12; } coccinelle-1.0.0-rc19/tests/badprint.c0000644000175000017500000000013012247437436016473 0ustar eugeneugen#define PRINTK(x) printk x #include "foo.h" int main () { printk("some stuff\n"); } coccinelle-1.0.0-rc19/tests/sgrep.c0000644000175000017500000000007112247437436016014 0ustar eugeneugenint main() { f(); x(); a(); g(); if (q) y(); } coccinelle-1.0.0-rc19/tests/after_if.res0000644000175000017500000000021112247437436017016 0ustar eugeneugen#ifdef ELMC_MULTICAST static void set_multicast_list(struct net_device *dev); #endif static const struct ethtool_ops netdev_ethtool_ops; coccinelle-1.0.0-rc19/tests/bug_expopt.cocci0000644000175000017500000000017512247437436017713 0ustar eugeneugen@@ identifier x; // struct xx struc; @@ ( - sprintf | - strlcpy | - strcpy | - strcat | - snprintf ) - (x->devfs_name, ...); coccinelle-1.0.0-rc19/tests/null_bool.res0000644000175000017500000000021312247437436017226 0ustar eugeneugenint main () { if (12 != NULL) return; if (a && 12 != NULL && b) return; if (12) return; if (a && 12 && b) return; x = x + 20; } coccinelle-1.0.0-rc19/tests/top.c0000644000175000017500000000004512247437436015477 0ustar eugeneugenMODULE_PARM(suppress_pollack, "i"); coccinelle-1.0.0-rc19/tests/badcomma.c0000644000175000017500000000015012247437436016435 0ustar eugeneugenstatic struct usb_serial_device_type cp2101_device = { .owner = THIS_MODULE, .name = "CP2101", }; coccinelle-1.0.0-rc19/tests/justremove.c0000644000175000017500000000023112247437436017075 0ustar eugeneugenint main () { if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); foo(); } coccinelle-1.0.0-rc19/tests/test_unsigned_meta.c0000644000175000017500000000013412247437436020555 0ustar eugeneugenint main () { unsigned int x; signed int y; unsigned char q; char m; return 0; } coccinelle-1.0.0-rc19/tests/strid2.res0000644000175000017500000000022412247437436016452 0ustar eugeneugenint main () { struct foo *a; enum foo1 *b; struct foo a1; enum foo1 b1; print(f(a, 12)); print(f(b, 12)); print(a1.x); print(b1); } coccinelle-1.0.0-rc19/tests/dropparam.res0000644000175000017500000000017512247437436017235 0ustar eugeneugenint f(char *x, int y, char* z) { return; } int g(char *x, char* z) { return; } void main(void) { g("toto", "tata"); } coccinelle-1.0.0-rc19/tests/decl2.res0000644000175000017500000000014512247437436016236 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { if (y) { return 0; } else { return 0; } } coccinelle-1.0.0-rc19/tests/fields.res0000644000175000017500000000012312247437436016507 0ustar eugeneugenstruct foo x = { .a = 1, .b = 2, .c = 3, .xa = 1, .xb = 2, .xc = 3, }; coccinelle-1.0.0-rc19/tests/regexp2.cocci0000644000175000017500000000142212247437436017107 0ustar eugeneugen@anyid@ type t; identifier id; constant cst; fresh identifier new = id ## "_is_constant"; @@ t id = cst; +t new; @contains@ type t; identifier anyid.id; constant anyid.cst =~ ".*FOO"; fresh identifier contains = id ##"_equals_cst_that_contains_FOO"; @@ t id = cst; +t contains; @nocontain@ type t; identifier anyid.id; constant anyid.cst !~ ".*FOO"; fresh identifier nocontain = id ##"_equals_cst_that_doesn_t_contain_FOO"; @@ t id = cst; +t nocontain; @endsby@ type t; identifier anyid.id; constant anyid.cst =~ ".*FOO$"; fresh identifier endsby = id ##"_equals_cst_that_ends_by_FOO"; @@ t id = cst; +t endsby; @beginsby@ type t; identifier anyid.id; constant anyid.cst =~ "^FOO"; fresh identifier beginsby = id ##"_equals_cst_that_begins_by_FOO"; @@ t id = cst; +t beginsby; coccinelle-1.0.0-rc19/tests/xfield.c0000644000175000017500000000011512247437436016146 0ustar eugeneugenFOO(a2,b2,c2); /* int y; struct foo { FOO(a,b,c); FOO(a1,b1,c1); }; */ coccinelle-1.0.0-rc19/tests/find_long.res0000644000175000017500000000016512247437436017206 0ustar eugeneugenlong function() { long a; int b; (long)(a + b); (long)(b + a); return a; } coccinelle-1.0.0-rc19/tests/devlink.c0000644000175000017500000000035712247437436016337 0ustar eugeneugenstatic void cm4000_release(dev_link_t *link); int main () { memset(&dev->atr_csum,0, sizeof(dev_link_t) - sizeof(dev_node)); } int xmain () { dev_link_t x; memset(&dev->atr_csum,0, sizeof(dev_link_t) - sizeof(dev_node)); } coccinelle-1.0.0-rc19/tests/cr1a.cocci0000644000175000017500000000052212247437436016361 0ustar eugeneugen@@ expression E, req_reg_arg2; identifier probe; @@ probe(...) { ... for(...; ...; ...) { ... + if (!request_region(E, req_reg_arg2, req_reg_arg3)) - if (check_region(E, req_reg_arg2)) { continue; } <... + release_region(E, req_reg_arg2); continue; ...> + release_region(E, req_reg_arg2); } ... } coccinelle-1.0.0-rc19/tests/dbg1.cocci0000644000175000017500000000004612247437436016351 0ustar eugeneugen@@ statement S1; @@ S1 + E = NULL; coccinelle-1.0.0-rc19/tests/parsing_pad.cocci0000644000175000017500000000007512247437436020025 0ustar eugeneugen@@ identifier x; @@ //- void* x; //+ int* x; - void* + int* coccinelle-1.0.0-rc19/tests/whitespace.cocci0000644000175000017500000000005512247437436017670 0ustar eugeneugen@@ expression E; @@ - foo(E); + foo(E, 12); coccinelle-1.0.0-rc19/tests/partial.res0000644000175000017500000000017412247437436016703 0ustar eugeneugen#define CS_THIS_MODULE THIS_MODULE, #define CS_OWNER owner: void cs46xx_null(struct pci_dev *pcidev) { return PAGE_SIZE2; } coccinelle-1.0.0-rc19/tests/video2.cocci0000644000175000017500000000030012247437436016715 0ustar eugeneugen@@ identifier x; expression E, E1, E2; @@ main(int x) { <... { ... - x(); ... - if (f()) return E1; <... - g(E) + h(E) ...> ?- if (i()) return E2; ... } ...> }coccinelle-1.0.0-rc19/tests/parameters_dots.cocci0000644000175000017500000000002012247437436020720 0ustar eugeneugen@@ @@ - f(...); coccinelle-1.0.0-rc19/tests/lid.res0000644000175000017500000000007212247437436016014 0ustar eugeneugenint main () { int a; static int b; f(12); f(b); } coccinelle-1.0.0-rc19/tests/sizestar.cocci0000644000175000017500000000010512247437436017374 0ustar eugeneugen@@ expression E1,E2,E3; @@ - kzalloc(E1 * E2,E3) + kzalloc(E1,E2,E3)coccinelle-1.0.0-rc19/tests/four.res0000644000175000017500000000003012247437436016211 0ustar eugeneugenint main () { f(1); } coccinelle-1.0.0-rc19/tests/bad_ptr_print.c0000644000175000017500000000013012247437436017517 0ustar eugeneugenstatic inline int tester(struct usb_endpoint_descriptor *epd) { f((struct foo *)x); } coccinelle-1.0.0-rc19/tests/ifb.c0000644000175000017500000000017212247437436015436 0ustar eugeneugenint main () { if (a) { if (x) { a = 3; if (m) goto foo; b = 4; foo: c = 6; } } } coccinelle-1.0.0-rc19/tests/pb_distribute_type4.res0000644000175000017500000000016212247437436021230 0ustar eugeneugenint foo() { float x; return 0; } int foo() { float x; return 0; } int foo() { float x; return 0; } coccinelle-1.0.0-rc19/tests/rcu3.c0000644000175000017500000000040712247437436015553 0ustar eugeneugenstatic struct mtd_chip_driver *get_mtd_chip_driver (const char *name) { struct list_head *pos; struct mtd_chip_driver *this; this = list_entry(pos, typeof(*this), list); this = list_entry(pos, struct foo, list); } coccinelle-1.0.0-rc19/tests/dowhile.cocci0000644000175000017500000000003312247437436017163 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.0-rc19/tests/double_lines.cocci0000644000175000017500000000002012247437436020170 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.0-rc19/tests/expopt.res0000644000175000017500000000005212247437436016561 0ustar eugeneugenint main() { int *x; f(x); x = 7; } coccinelle-1.0.0-rc19/tests/isotest2.cocci0000644000175000017500000000005312247437436017306 0ustar eugeneugen@@ identifier id; @@ ... - int id; ...coccinelle-1.0.0-rc19/tests/multichars.cocci0000644000175000017500000000002112247437436017700 0ustar eugeneugen@@ @@ - ab + 12 coccinelle-1.0.0-rc19/tests/comment.cocci0000644000175000017500000000001612247437436017173 0ustar eugeneugen@@ @@ - 1 + 2coccinelle-1.0.0-rc19/tests/ifzer.c0000644000175000017500000000036612247437436016022 0ustar eugeneugenint main() { #if 0 /* Accessing floppy->pc is not valid here, the previous pc may be gone and have lived on another thread's stack; that stack may have become unmapped meanwhile (CONFIG_DEBUG_PAGEALLOC). */ #endif foo(); } coccinelle-1.0.0-rc19/tests/video1.cocci0000644000175000017500000000074312247437436016727 0ustar eugeneugen@@ local function ioctlfn; identifier dev, cmd, arg; //fresh identifier i, f; identifier v; type T; identifier fld; @@ ioctlfn( struct video_device *dev, unsigned int cmd, void *arg) { <... - T v; + T *v; ... ( - if (copy_from_user(&v,arg,sizeof(v)) != 0) return ...; | - if (copy_from_user(&v,arg,sizeof(v))) return ...; ) <... - v.fld + v->fld ...> ?- if (copy_to_user(arg,&v,sizeof(v))) return ...; ...> } coccinelle-1.0.0-rc19/tests/positionc.res0000644000175000017500000000025512247437436017256 0ustar eugeneugenint main () { if (foo(6,7)) x = ret; else x = ret; if (foo(6,7)) x = ret; else x = ret; if (foo(7,7)) x = ret; else x = ret; if (bar(7,7)) x = ret; else x = ret; } coccinelle-1.0.0-rc19/tests/dbg.cocci0000644000175000017500000000011112247437436016261 0ustar eugeneugen@@ idexpression *E; statement S1; @@ if (E != NULL) S1 + else E = NULL; coccinelle-1.0.0-rc19/tests/jloop1.res0000644000175000017500000000052712247437436016455 0ustar eugeneugenvoid cpu_idle(void) { local_fiq_enable(); /* endless idle loop with no priority at all */ while (1) { if (!idle) idle = default_idle; preempt_disable(); leds_event(led_idle_start); while (!need_resched()) nkidle(); leds_event(led_idle_end); preempt_enable(); schedule(); } } coccinelle-1.0.0-rc19/tests/bug_expopt.c0000644000175000017500000000260012247437436017050 0ustar eugeneugenstatic int __init xpram_setup_blkdev(void) { unsigned long offset; int i, rc = -ENOMEM; for (i = 0; i < xpram_devs; i++) { struct gendisk *disk = alloc_disk(1); if (!disk) goto out; xpram_disks[i] = disk; } /* * Register xpram major. */ rc = register_blkdev(XPRAM_MAJOR, XPRAM_NAME); if (rc < 0) goto out; devfs_mk_dir("slram"); /* * Assign the other needed values: make request function, sizes and * hardsect size. All the minor devices feature the same value. */ xpram_queue = blk_alloc_queue(GFP_KERNEL); if (!xpram_queue) { rc = -ENOMEM; goto out_unreg; } blk_queue_make_request(xpram_queue, xpram_make_request); blk_queue_hardsect_size(xpram_queue, 4096); /* * Setup device structures. */ offset = 0; for (i = 0; i < xpram_devs; i++) { struct gendisk *disk = xpram_disks[i]; xpram_devices[i].size = xpram_sizes[i] / 4; xpram_devices[i].offset = offset; offset += xpram_devices[i].size; disk->major = XPRAM_MAJOR; disk->first_minor = i; disk->fops = &xpram_devops; disk->private_data = &xpram_devices[i]; disk->queue = xpram_queue; sprintf(disk->disk_name, "slram%d", i); sprintf(disk->devfs_name, "slram/%d", i); set_capacity(disk, xpram_sizes[i] << 1); add_disk(disk); } return 0; out_unreg: devfs_remove("slram"); unregister_blkdev(XPRAM_MAJOR, XPRAM_NAME); out: while (i--) put_disk(xpram_disks[i]); return rc; } coccinelle-1.0.0-rc19/tests/loop.c0000644000175000017500000000006512247437436015650 0ustar eugeneugenint main() { f(); while (1) { x : 15; } g(); } coccinelle-1.0.0-rc19/tests/metaline.c0000644000175000017500000000015212247437436016472 0ustar eugeneugenint main () { static int x; static int y; if (12) f(4+3); g(4+3); m(3+3); g(3+3); r(3+4); } coccinelle-1.0.0-rc19/tests/badexp.cocci0000644000175000017500000000006612247437436017001 0ustar eugeneugen@@ expression x; @@ foo(x); ... + 3 + x + * 27 coccinelle-1.0.0-rc19/tests/starprint.cocci0000644000175000017500000000004512247437436017561 0ustar eugeneugen@@ typedef LPINT; @@ - LPINT + int * coccinelle-1.0.0-rc19/tests/multiremove.cocci0000644000175000017500000000013212247437436020100 0ustar eugeneugen@@ expression x; expression list e1,e2; @@ -if (x) { <+... \(foo(e1);\|bar(e2);\) ...+> }coccinelle-1.0.0-rc19/tests/inc.c0000644000175000017500000000003412247437436015444 0ustar eugeneugen#define foo 3 #define xxx 4 coccinelle-1.0.0-rc19/tests/debug.c0000644000175000017500000000012712247437436015764 0ustar eugeneugenstatic int __init init_3c574_cs(void) { DEBUG(0, "%s\n", version); return 0; } coccinelle-1.0.0-rc19/tests/longlong.cocci0000644000175000017500000000005312247437436017351 0ustar eugeneugen@@ identifier x; @@ - long long + int x;coccinelle-1.0.0-rc19/tests/test1.cocci0000644000175000017500000000013012247437436016566 0ustar eugeneugen@ rule1 @ expression X,Y,Z; @@ f(X); ... g(Z); ... - h(Y); + h(X, Y, Z); coccinelle-1.0.0-rc19/tests/macro_int16.c0000644000175000017500000000014112247437436017014 0ustar eugeneugen#define INT16 int //typedef int INT16; void main(void) { INT16 a, b, c; c = a + b; } coccinelle-1.0.0-rc19/tests/stmt.cocci0000644000175000017500000000012612247437436016522 0ustar eugeneugen@@ statement S, S1; identifier f; @@ f (...) { ... when != S1 + foo(); S ... } coccinelle-1.0.0-rc19/tests/dbg1.res0000644000175000017500000000013712247437436016063 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { DBG("PCI"); E = NULL; } coccinelle-1.0.0-rc19/tests/list_test.res0000644000175000017500000000262312247437436017262 0ustar eugeneugenint main () { f(); g(b); h(x,y,b,z); h(y,b,z); h(x,b,z); h(x,y,b); h(b,z); h(x,b); h(b); } int f() { return; } int g(int b) { return; } int h(int x, int y, int b, int z) { return; } int h(int y, int b, int z) { return; } int h(int x, int b, int z) { return; } int h(int x, int y, int b) { return; } int h(int b, int z) { return; } int h(int x, int b) { return; } int h(int b) { return; } int f[] = { }; int g[] = { b }; int h[] = { x, y, b, z }; int h[] = { y, b, z, }; int h[] = { x, b, z }; int h[] = { x, y, b, }; int h[] = { b, z }; int h[] = { x, b, }; int h[] = { b }; int i[] = { x, a, y, b, z }; int i[] = { a, y, b, z, }; int i[] = { x, a, b, z }; int i[] = { x, a, y, }; int i[] = { a, b, z }; int i[] = { x, a, }; int i[] = { a, }; struct f { int b; }; struct g { int b; }; struct h { int x; int y; int b; int z; }; struct h { int y; int b; int z; }; struct h { int x; int b; int z; }; struct h { int x; int y; int b; }; struct h { int b; int z; }; struct h { int x; int b; }; struct h { int b; }; enum f { b }; enum g { b }; enum h { x, y, b, z, }; enum h { y, b, z }; enum h { x, b, z, }; enum h { x, y, b }; enum h { b, z, }; enum h { x, b }; enum h { b, }; enum i { x, a, y, b, z, }; enum i { a, y, b, z }; enum i { x, a, b, z, }; enum i { x, a, y, }; enum i { a, b, z, }; enum i { x, a, }; enum i { a, }; coccinelle-1.0.0-rc19/tests/badzero.cocci0000644000175000017500000000053212247437436017162 0ustar eugeneugen// A pointer should not be compared to NULL // // Confidence: High // Copyright: (C) Gilles Muller, Julia Lawall, EMN, DIKU. GPLv2. // URL: http://www.emn.fr/x-info/coccinelle/rules/badzero.html // Options: @r disable is_zero,isnt_zero @ expression *E; position p; @@ ( - E@p == 0 + 27 | - E@p != 0 + 27 | - 0 == E@p + 27 | - 0 != E@p + 27 ) coccinelle-1.0.0-rc19/tests/fnret.cocci0000644000175000017500000000014612247437436016653 0ustar eugeneugen@@ @@ // if int x is replaced by ..., there is a todo in transformation.ml - foo(int x) { return; } coccinelle-1.0.0-rc19/tests/comadd.cocci0000644000175000017500000000011612247437436016761 0ustar eugeneugen@@ identifier f; @@ +// some comment +// some other comment f(...) { ... } coccinelle-1.0.0-rc19/tests/minfn.cocci0000644000175000017500000000005612247437436016644 0ustar eugeneugen@@ @@ - f(...) { ... } @@ @@ - #define x 3 coccinelle-1.0.0-rc19/tests/header_modif.cocci0000644000175000017500000000006712247437436020145 0ustar eugeneugen@@ identifier x; @@ - int + float foo(int x) { ... }coccinelle-1.0.0-rc19/tests/test1_ver2.c0000644000175000017500000000025012247437436016671 0ustar eugeneugenvoid main(int foo) { f(1); //f(1); // if uncoment then problems g(2); //g(2);// if uncomment then problems if(1) { h(3); } else { h(4); } } coccinelle-1.0.0-rc19/tests/rcu2.cocci0000644000175000017500000001007112247437436016406 0ustar eugeneugen// prepare for transformation @@ idexpression struct list_head *I; @@ - I + _Y(I) @@ identifier I; expression E; iterator name list_for_each_rcu; statement S; @@ list_for_each_rcu( - _Y(I) + _X(I) ,E) S @@ identifier I; expression E; iterator name list_for_each; statement S; @@ list_for_each( - _Y(I) + _X(I) ,E) S @@ identifier I; expression E; iterator name list_for_each_prev; statement S; @@ list_for_each_prev( - _Y(I) + _X(I) ,E) S @@ type T; identifier I; expression E; @@ list_entry( - _Y(I) + _X(I) ,T,E) // the case where the list element is just stored in a variable @r@ type T,T1; identifier I, x; expression E, E1, E2; iterator name list_for_each_entry_rcu; @@ <... when != _Y(I) - list_for_each_rcu(_X(I),E1) + list_for_each_entry_rcu(x,E1,E2) { ... when != \(_Y(I)\|_X(I)\|x=E\) when != T1 x; - x = list_entry(_X(I),T,E2); ... when != \(_Y(I)\|_X(I)\|x=E\) } ...> @ra@ type T,T1; identifier I, x; expression E, E1, E2; iterator name list_for_each_entry; @@ <... when != _Y(I) - list_for_each(_X(I),E1) + list_for_each_entry(x,E1,E2) { ... when != \(_Y(I)\|_X(I)\|x=E\) when != T1 x; - x = list_entry(_X(I),T,E2); ... when != \(_Y(I)\|_X(I)\|x=E\) } ...> @rb@ type T,T1; identifier I, x; expression E, E1, E2; iterator name list_for_each_entry_reverse; @@ <... when != _Y(I) - list_for_each_prev(_X(I),E1) + list_for_each_entry_reverse(x,E1,E2) { ... when != \(_Y(I)\|_X(I)\|x=E\) when != T1 x; - x = list_entry(_X(I),T,E2); ... when != \(_Y(I)\|_X(I)\|x=E\) } ...> // instances of the above that we can't treat because of the local variable // problem. seems better to do nothing. @r1@ type T,T1; identifier I, x; expression E1, E2; @@ list_for_each_rcu( - _X(I) + _Y(I) ,E1) { ... ( T1 x; ... x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); | T1 x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); ) ... } @r1a@ type T,T1; identifier I, x; expression E1, E2; @@ list_for_each( - _X(I) + _Y(I) ,E1) { ... ( T1 x; ... x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); | T1 x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); ) ... } @r1b@ type T,T1; identifier I, x; expression E1, E2; @@ list_for_each_prev( - _X(I) + _Y(I) ,E1) { ... ( T1 x; ... x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); | T1 x = - list_entry(_X(I),T,E2); + _LOCAL_DECL(list_entry(_X(I),T,E2)); ) ... } // the case where the list element is used for something else (often a return) @@ type T; identifier I; expression E1, E2; @@ - struct list_head *I; + T *I; <+... when != _Y(I) - list_for_each_rcu(_X(I),E1) + list_for_each_entry_rcu(I,E1,E2) { <+... when != _Y(I) - list_entry(_X(I),T,E2) + I ...+> } ...+> @@ type T; identifier I; expression E1, E2; @@ - struct list_head *I; + T *I; <+... when != _Y(I) - list_for_each(_X(I),E1) + list_for_each_entry(I,E1,E2) { <+... when != _Y(I) - list_entry(_X(I),T,E2) + I ...+> } ...+> @@ type T; identifier I; expression E1, E2; @@ - struct list_head *I; + T *I; <+... when != _Y(I) - list_for_each_prev(_X(I),E1) + list_for_each_entry_reverse(I,E1,E2) { <+... when != _Y(I) - list_entry(_X(I),T,E2) + I ...+> } ...+> // clean up @@ struct list_head *I; @@ ( - _X(I) + I | - _Y(I) + I ) @@ expression I; @@ ( - _X(I) + _INCONSISTENT_MODIF(I) | - _Y(I) + _INCONSISTENT_MODIF(I) ) @ depends on r || ra @ identifier I; @@ - struct list_head *I; ... when != I coccinelle-1.0.0-rc19/tests/not_converted_ver1.c0000644000175000017500000000417412247437436020512 0ustar eugeneugen// -ifdef_to_if doesn't convert this ifdef static int do_accept(int acc_sock, int *sock, char **host) { int ret,i; struct hostent *h1,*h2; static struct sockaddr_in from; int len; /* struct linger ling; */ if (!ssl_sock_init()) return(0); #ifndef OPENSSL_SYS_WINDOWS redoit: #endif memset((char *)&from,0,sizeof(from)); len=sizeof(from); /* Note: under VMS with SOCKETSHR the fourth parameter is currently * of type (int *) whereas under other systems it is (void *) if * you don't have a cast it will choke the compiler: if you do * have a cast then you can either go for (int *) or (void *). */ ret=accept(acc_sock,(struct sockaddr *)&from,(void *)&len); if (ret == INVALID_SOCKET) { #if defined(OPENSSL_SYS_WINDOWS) || (defined(OPENSSL_SYS_NETWARE) && !defined(NETWARE_BSDSOCK)) i=WSAGetLastError(); BIO_printf(bio_err,"accept error %d\n",i); #else if (errno == EINTR) { /*check_timeout(); */ goto redoit; } fprintf(stderr,"errno=%d ",errno); perror("accept"); #endif return(0); } /* ling.l_onoff=1; ling.l_linger=0; i=setsockopt(ret,SOL_SOCKET,SO_LINGER,(char *)&ling,sizeof(ling)); if (i < 0) { perror("linger"); return(0); } i=0; i=setsockopt(ret,SOL_SOCKET,SO_KEEPALIVE,(char *)&i,sizeof(i)); if (i < 0) { perror("keepalive"); return(0); } */ if (host == NULL) goto end; #ifndef BIT_FIELD_LIMITS /* I should use WSAAsyncGetHostByName() under windows */ h1=gethostbyaddr((char *)&from.sin_addr.s_addr, sizeof(from.sin_addr.s_addr),AF_INET); #else h1=gethostbyaddr((char *)&from.sin_addr, sizeof(struct in_addr),AF_INET); #endif if (h1 == NULL) { BIO_printf(bio_err,"bad gethostbyaddr\n"); *host=NULL; /* return(0); */ } else { if ((*host=(char *)OPENSSL_malloc(strlen(h1->h_name)+1)) == NULL) { perror("OPENSSL_malloc"); return(0); } BUF_strlcpy(*host,h1->h_name,strlen(h1->h_name)+1); h2=GetHostByName(*host); if (h2 == NULL) { BIO_printf(bio_err,"gethostbyname failure\n"); return(0); } i=0; if (h2->h_addrtype != AF_INET) { BIO_printf(bio_err,"gethostbyname addr is not AF_INET\n"); return(0); } } end: *sock=ret; return(1); } coccinelle-1.0.0-rc19/tests/nameless.c0000644000175000017500000000010512247437436016501 0ustar eugeneugentypedef union { int foo; } t_foo; typedef struct { int foo; } t_foo; coccinelle-1.0.0-rc19/tests/incpos.cocci0000644000175000017500000000144312247437436017031 0ustar eugeneugen@initialize:python@ first = 0 second = 0 @first_hdr@ position p; @@ #include <...>@p @script:python@ p << first_hdr.p; @@ if first == 0: print "keeping first hdr %s" % (p[0].line) first = int(p[0].line) else: print "dropping first hdr" cocci.include_match(False) @second_hdr@ position p; @@ #include "..."@p @script:python@ p << second_hdr.p; @@ if int(p[0].line) > first and first != 0: print "dropping second hdr" cocci.include_match(False) else: if second == 0: print "keeping second hdr %s because of %d" % (p[0].line,first) second = int(p[0].line) else: print "dropping second hdr" cocci.include_match(False) @done@ position second_hdr.p; @@ +#include #include "..."@p @depends on never done@ @@ +#include #include <...> coccinelle-1.0.0-rc19/tests/kmalloc.cocci0000644000175000017500000000016612247437436017161 0ustar eugeneugen@@ expression x; expression E1,E2; type T; @@ x = - (T)kmalloc(E1,E2) + kzalloc(E1, E2) ... - memset(x,0,E1);coccinelle-1.0.0-rc19/tests/hex.res0000644000175000017500000000001712247437436016027 0ustar eugeneugenint main() { } coccinelle-1.0.0-rc19/tests/stat.cocci0000644000175000017500000000012012247437436016500 0ustar eugeneugen@@ expression YYY; identifier dev_info; @@ - static dev_info_t dev_info = YYY; coccinelle-1.0.0-rc19/tests/nest2.c0000644000175000017500000000004612247437436015731 0ustar eugeneugenint f(int i) { a(); a(); a(); } coccinelle-1.0.0-rc19/tests/nestseq.c0000644000175000017500000000004712247437436016361 0ustar eugeneugenint main () { f(); g(12); h(); } coccinelle-1.0.0-rc19/tests/multitypedef.cocci0000644000175000017500000000023112247437436020243 0ustar eugeneugen@ non_delayed_fn @ type local_type, T; local_type *device; identifier fld, fn; @@ - INIT_WORK(&device->fld, fn, device); + INIT_WORK(&device->fld, fn); coccinelle-1.0.0-rc19/tests/fieldsmin.cocci0000644000175000017500000000007112247437436017504 0ustar eugeneugen@@ @@ struct foo x = { - .a = 1, - .b = 2, .c = 3, }; coccinelle-1.0.0-rc19/tests/stat.c0000644000175000017500000000005312247437436015647 0ustar eugeneugenstatic dev_info_t dev_info = "orinoco_cs"; coccinelle-1.0.0-rc19/tests/longlong.res0000644000175000017500000000005512247437436017064 0ustar eugeneugenint a; int main () { int b; return 0; } coccinelle-1.0.0-rc19/tests/ifdef3.c0000644000175000017500000000031212247437436016032 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/define_param.cocci0000644000175000017500000000034012247437436020143 0ustar eugeneugen @ rule2 disable all @ expression E; @@ - (sizeof(E)/sizeof(*E)) + ARRAY_SIZE(E) @ rule53 @ identifier NUM, x; @@ - #define NUM(x) ARRAY_SIZE(x) @@ expression E; identifier rule53.NUM; @@ - NUM(E) + ARRAY_SIZE(E) coccinelle-1.0.0-rc19/tests/if.cocci0000644000175000017500000000034412247437436016133 0ustar eugeneugen@exists@ expression x; statement S1,S2; @@ f(x); + after(); ... when != true x == NULL || ... g(x); + after(); @exists@ expression x; statement S1,S2; @@ +before(); f(x); ... when != false x == NULL || ... +before(); g(x); coccinelle-1.0.0-rc19/tests/vpos.cocci0000644000175000017500000000025712247437436016527 0ustar eugeneugen// shows how a single position variable can get more than one value @a@ position p; identifier g; @@ f(...) ... g@p(1,...) @@ position a.p; identifier a.g; @@ - g@p(...); coccinelle-1.0.0-rc19/tests/doubleswitch.res0000644000175000017500000000037312247437436017744 0ustar eugeneugenvoid zfLnxRecvEth(zdev_t* dev, zbuf_t* buf, u16_t port) { #ifdef ZM_AVOID_UDP_LARGE_PACKET_FAIL zbuf_t *new_buf; switch(netif_rx(new_buf)) #else switch(netif_rx(buf)) #endif { case NET_RX_BAD: break; } return; } coccinelle-1.0.0-rc19/tests/badexp.res0000644000175000017500000000004712247437436016511 0ustar eugeneugenint main() { foo(a); b = 3+a*27; } coccinelle-1.0.0-rc19/tests/ifdef3.res0000644000175000017500000000061112247437436016403 0ustar eugeneugen#include #include #include #include #ifdef CONFIG_NKERNEL #include #define CONFIG_NKERNEL_NO_SHARED_IRQ // use local (native) mask/unmask #undef CONFIG_NKERNEL_DEBUG_IRQ #endif static inline void nop(void) { int i; } void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.0-rc19/tests/initializer_many_fields.res0000644000175000017500000000003512247437436022140 0ustar eugeneugen struct foo x = { .a = 12 }; coccinelle-1.0.0-rc19/tests/bigin.res0000644000175000017500000000042112247437436016332 0ustar eugeneugen// indentation algorithm is not perfect here, because it doesn't know how // much to outdent. But it gives the illusion of working. int main() { if (x) if (x) if (x) if (x) if (x) if (x) blah(); bar(); foo(); } coccinelle-1.0.0-rc19/tests/expopt4.cocci0000644000175000017500000000021712247437436017137 0ustar eugeneugen//@ rule1 @ //expression E; //@@ // // xxx(E); @ r @ type T; //expression rule1.E; expression E; @@ ( - f((T) E) + foo() | - f(E) + bar() ) coccinelle-1.0.0-rc19/tests/nocast.res0000644000175000017500000000013512247437436016533 0ustar eugeneugenint main (gfp_t gfp_mask, int x) { buf = kmalloc(sizeof *send_buf + buf_size, gfp_mask); } coccinelle-1.0.0-rc19/tests/protox.c0000644000175000017500000000005312247437436016227 0ustar eugeneugenint f(int x); int f(int x) { return 12; } coccinelle-1.0.0-rc19/tests/double.res0000644000175000017500000000030112247437436016511 0ustar eugeneugen static void BChannel_proc_xmt(struct BCState *bcs) { if (!test_bit(BC_FLG_BUSY, &bcs->Flag) && skb_queue_empty(&bcs->squeue)) { st->l2.l2l1(st, PH_DEACTIVATE | CONFIRM, NULL); } } coccinelle-1.0.0-rc19/tests/defe.res0000644000175000017500000000001412247437436016143 0ustar eugeneugen#define x 3 coccinelle-1.0.0-rc19/tests/voyager.c0000644000175000017500000000024412247437436016352 0ustar eugeneugenvoid voyager_cat_init(void) { voyager_module_t **modpp; *modpp = kmalloc(sizeof(voyager_module_t), GFP_KERNEL); memset(*modpp, 0, sizeof(voyager_module_t)); } coccinelle-1.0.0-rc19/tests/unl.c0000644000175000017500000000016512247437436015476 0ustar eugeneugenint main () { if (new_pe == NULL) { return NULL; } } int main () { if (new_pe == NULL) return NULL; } coccinelle-1.0.0-rc19/tests/switchtest.c0000644000175000017500000000020412247437436017073 0ustar eugeneugenvoid f(void) { switch (2) { int x; int y; case 2: i++; break; case 4: j++; break; } } coccinelle-1.0.0-rc19/tests/opt.cocci0000644000175000017500000000012712247437436016336 0ustar eugeneugen@ disable all @ identifier f; @@ f (...) { ... ( - xxx(); | ?- yyy(); ) ... } coccinelle-1.0.0-rc19/tests/ip.c0000644000175000017500000000027012247437436015305 0ustar eugeneugenvoid GetInfoDestTV(short sNoFo) { if(sNoFo == 1) printf("one"); else if(sNoFo == 2) printf("two"); else if(sNoFo == 2) printf("three"); else printf("other"); } coccinelle-1.0.0-rc19/tests/pb_distribute_type3.res0000644000175000017500000000017712247437436021235 0ustar eugeneugenint foo() { int y, x; return 0; } int foo() { int *y, *x; return 0; } int foo() { int y[45], x[45]; return 0; } coccinelle-1.0.0-rc19/tests/serio.res0000644000175000017500000000024212247437436016364 0ustar eugeneugen#include #include #include static void serio_init_port(struct serio *serio) { mutex_init(&serio->new_lock); } coccinelle-1.0.0-rc19/tests/tern.res0000644000175000017500000000007412247437436016216 0ustar eugeneugenint main () { return wc >= 0 && wc <= 0x7f ? wc : 0x7f; } coccinelle-1.0.0-rc19/tests/scope_problem.c0000644000175000017500000000014312247437436017525 0ustar eugeneugenvoid main(int i) { int a; foo(a); a = 1; if(1) { int a; a = 2; } a = 3; } coccinelle-1.0.0-rc19/tests/ifd.res0000644000175000017500000000015012247437436016003 0ustar eugeneugenint main () { one(); #ifdef 0 #ifdef 10 foo(); one(); one(); bar(); #endif #endif one(); } coccinelle-1.0.0-rc19/tests/test7.c0000644000175000017500000000011012247437436015734 0ustar eugeneugenvoid main() { if(1) { f(1); } f(3); /* nice comment */ } coccinelle-1.0.0-rc19/tests/exitc.res0000644000175000017500000000006612247437436016363 0ustar eugeneugenint main () { g(a1); g(a2); g(done); g(a4); } coccinelle-1.0.0-rc19/tests/spaces.c0000644000175000017500000000003612247437436016153 0ustar eugeneugenint main () { foo(x + y); } coccinelle-1.0.0-rc19/tests/type1.cocci0000644000175000017500000000010512247437436016572 0ustar eugeneugen@@ identifier q; @@ foo(...) { int + * q; ... } coccinelle-1.0.0-rc19/tests/retval.cocci0000644000175000017500000000025312247437436017031 0ustar eugeneugen@@ @@ if (retval1) { - if (retval2 != -ENODEV) { ... return ...; - } - ... } coccinelle-1.0.0-rc19/tests/toplevel_macrostmt.c0000644000175000017500000000010112247437436020611 0ustar eugeneugenvoid main(int i) { } MODULE_PARM(x,y); MODULE_AUTHOR("me"); coccinelle-1.0.0-rc19/tests/hex.cocci0000644000175000017500000000001612247437436016315 0ustar eugeneugen@@ @@ - f(0); coccinelle-1.0.0-rc19/tests/stm3.cocci0000644000175000017500000000004612247437436016422 0ustar eugeneugen@@ statement S; @@ f(); - S + g(); coccinelle-1.0.0-rc19/tests/tyex.cocci0000644000175000017500000000060012247437436016521 0ustar eugeneugen@@ @@ typedef struct { ... - char *name; ... } - Location + Point ; + typedef struct { + char *name; + Point p; + } Location; @@ typedef Location; Location some_location; identifier x; @@ ( some_location.name | - some_location.x + some_location.p.x ) @@ Location *some_location; identifier x; @@ ( some_location->name | - some_location->x + some_location->p.x ) coccinelle-1.0.0-rc19/tests/extra.res0000644000175000017500000000065712247437436016400 0ustar eugeneugen#ifdef FIRST int _called_function_0 (int a, struct foo *b, struct bar *c) { a = b->x; return c->d; } int main(int a, struct foo *b, struct bar *c) { assert(c != NULL); assert(b != NULL); return _called_function_0(a, b, c); } #else int _called_function_1 (int a, struct foo *xyz) { a = xyz->x; return xyz->d; } int main(int a, struct foo *xyz) { assert(xyz != NULL); return _called_function_1(a, xyz); } #endif coccinelle-1.0.0-rc19/tests/ali.c0000644000175000017500000000075212247437436015447 0ustar eugeneugenstatic int __init agp_i7x05_probe (struct pci_dev *dev, const struct pci_device_id *ent) { u8 cap_ptr = 0; cap_ptr = pci_find_capability(dev, PCI_CAP_ID_AGP); if (cap_ptr == 0) return -ENODEV; if (agp_lookup_host_bridge(dev) != -ENODEV) { agp_bridge.dev = dev; agp_bridge.capndx = cap_ptr; /* Fill in the mode register */ pci_read_config_dword(agp_bridge.dev, agp_bridge.capndx+PCI_AGP_STATUS, &agp_bridge.mode) agp_register_driver(dev); return 0; } return -ENODEV; } coccinelle-1.0.0-rc19/tests/doundo.c0000644000175000017500000000013612247437436016166 0ustar eugeneugens8 *noevent; int main() { const s8 (*queue_priority_mapping)[2]; s8 *noevent; foo(); } coccinelle-1.0.0-rc19/tests/indecl.cocci0000644000175000017500000000024712247437436016775 0ustar eugeneugen@r@ identifier x; @@ int x; @script:python@ x << r.x; @@ print x @rr@ identifier x; @@ struct x { ... int x; ... }; @script:python@ x << rr.x; @@ print "name",xcoccinelle-1.0.0-rc19/tests/video2.c0000644000175000017500000000060212247437436016064 0ustar eugeneugenint main(int x) { if (x == 1) { x(); if (f()) return 12; if (g(1)) return 15; g(1); g(2); y(); if (i()) return 120; g(2); } else if (x == 2) { x(); if (f()) return 16; x(); y(); if (i()) return 160; g(2); } else if (x == 3) { x(); if (f()) return 20; x(); g(1); y(); g(2); } else return 0; } coccinelle-1.0.0-rc19/tests/sizestar.res0000644000175000017500000000030312247437436017105 0ustar eugeneugenint main () { max = num_var_ranges; if (fcount == NULL) { fcount = kzalloc(max, sizeof *fcount, GFP_KERNEL); if (!fcount) return -ENOMEM; FILE_FCOUNT(file) = fcount; } } coccinelle-1.0.0-rc19/tests/return_implicit.cocci0000644000175000017500000000013012247437436020737 0ustar eugeneugen@@ identifier fn; @@ fn(...) { foo(...); ... - return; + return -ENODEV; }coccinelle-1.0.0-rc19/tests/lid.c0000644000175000017500000000007112247437436015444 0ustar eugeneugenint main () { int a; static int b; f(a); f(b); } coccinelle-1.0.0-rc19/tests/ptrar.cocci0000644000175000017500000000007612247437436016667 0ustar eugeneugen@@ type T; T[] e; @@ - e + 12 @@ type T; T *e; @@ - e + 20 coccinelle-1.0.0-rc19/tests/decl_split.res0000644000175000017500000000002512247437436017364 0ustar eugeneugenint func(int i) { } coccinelle-1.0.0-rc19/tests/ktype.cocci0000644000175000017500000000022412247437436016666 0ustar eugeneugen@@ type T, T2; type T1; T1 *x; T1 *y; expression E2; @@ - x = kmalloc(sizeof(T1),E2) + x = kzalloc(sizeof(T1), E2) ... - memset(x,0,sizeof(*y)); coccinelle-1.0.0-rc19/tests/double.cocci0000644000175000017500000000016512247437436017010 0ustar eugeneugen@@ expression E; @@ ( - (!skb_queue_len(E)) + skb_queue_empty(E) | - (skb_queue_len(E) == 0) + skb_queue_empty(E) ) coccinelle-1.0.0-rc19/tests/posnpb.cocci0000644000175000017500000000174612247437436017045 0ustar eugeneugen// problem with positions. in check_unprotected, we start with a set of // positions, but the binding that is deduced is only relevant to one of them // but since it was deduced from both of them, both of them are printed out // at the end @unprotected exists@ expression x; identifier fld; position p,p1; statement S; expression E; @@ x@p1 = FN(...); ... when != x = E ( if (x == NULL) { ... return ...; } else S | x@p->fld ) @check_unprotected exists@ // ensure both are present position unprotected.p, unprotected.p1; expression x; identifier fld; @@ x@p1 = FN(...); ... x@p->fld @ script:python depends on check_unprotected @ p << unprotected.p; // position of ref p1 << unprotected.p1; // position of call fld << check_unprotected.fld; // identifier @@ c = cocci.combine(fld,p1) print " call to FN on line %s column %s" % (c.location.line,c.location.column) c1 = cocci.combine(fld,p) print " ref to field %s on line %s column %s" % (fld,c1.location.line,c1.location.column) coccinelle-1.0.0-rc19/tests/cast_iso.res0000644000175000017500000000022512247437436017050 0ustar eugeneugenstatic int vx_hwdep_dsp_load(snd_hwdep_t *hw, snd_hwdep_dsp_image_t *dsp) { vx_core_t *vx = hw->private_data; ak4117_t *chip = (ak4117_t *)data; } coccinelle-1.0.0-rc19/tests/struct_typedef.cocci0000644000175000017500000000023512247437436020600 0ustar eugeneugen@@ @@ - struct dvb_frontend { + struct dvb2_frontend{ ... - struct dvb_frontend_ops* ops; + struct dvb_frontend_ops ops; ... }; coccinelle-1.0.0-rc19/tests/slow.c0000644000175000017500000000273212247437436015666 0ustar eugeneugenqboolean SV_ReadClientMessage (void) { int ret; int cmd; char *s; if (host_client->privileged) ret = 2; else ret = 0; if (Q_strncasecmp(s, "status", 6) == 0) ret = 1; else if (Q_strncasecmp(s, "god", 3) == 0) ret = 1; else if (Q_strncasecmp(s, "notarget", 8) == 0) ret = 1; else if (Q_strncasecmp(s, "fly", 3) == 0) ret = 1; else if (Q_strncasecmp(s, "name", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "noclip", 6) == 0) ret = 1; else if (Q_strncasecmp(s, "say", 3) == 0) ret = 1; else if (Q_strncasecmp(s, "say_team", 8) == 0) ret = 1; else if (Q_strncasecmp(s, "tell", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "color", 5) == 0) ret = 1; else if (Q_strncasecmp(s, "kill", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "pause", 5) == 0) ret = 1; else if (Q_strncasecmp(s, "spawn", 5) == 0) ret = 1; else if (Q_strncasecmp(s, "begin", 5) == 0) ret = 1; else if (Q_strncasecmp(s, "prespawn", 8) == 0) ret = 1; else if (Q_strncasecmp(s, "kick", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "ping", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "give", 4) == 0) ret = 1; else if (Q_strncasecmp(s, "ban", 3) == 0) ret = 1; if (ret == 2) Cbuf_InsertText (s); else if (ret == 1) Cmd_ExecuteString (s, src_client); else Con_DPrintf("%s tried to %s\n", host_client->name, s); } coccinelle-1.0.0-rc19/tests/video.cocci0000644000175000017500000000073712247437436016651 0ustar eugeneugen@@ local function ioctlfn; identifier dev, cmd, arg; //fresh identifier i, f; identifier v; type T; identifier fld; expression E1, E2; @@ ioctlfn( - struct video_device *dev, + struct inode *i, struct file *f, unsigned int cmd, void *arg) { <... - T v; + T *v; ... - if (copy_from_user(&v,arg,sizeof(v)) != 0) return E1; <... - v.fld + v->fld ...> ?- if (copy_to_user(arg,&v,sizeof(v))) return E2; ...> } coccinelle-1.0.0-rc19/tests/retval2.cocci0000644000175000017500000000037412247437436017117 0ustar eugeneugen@ voidfunc @ function fn; position voidpos; @@ void fn@voidpos(...) { ... } @ func disable ret exists @ type T; function fn; position pos != voidfunc.voidpos; @@ T - fn@pos + newname (...) { ... WHEN != return ...; } coccinelle-1.0.0-rc19/tests/check_order1.cocci0000644000175000017500000000010312247437436020057 0ustar eugeneugen@r@ expression E; @@ f(E); @script:python@ E << r.E; @@ print E coccinelle-1.0.0-rc19/tests/double_lines.res0000644000175000017500000000004712247437436017712 0ustar eugeneugenint main () { test(); endtest(); } coccinelle-1.0.0-rc19/tests/rem2.cocci0000644000175000017500000000003012247437436016372 0ustar eugeneugen@@ @@ - if (...) foo();coccinelle-1.0.0-rc19/tests/fn_todo.cocci0000644000175000017500000000023112247437436017160 0ustar eugeneugen@ device_arg disable all @ type T1; type local_type; local_type *device; identifier fld, fn; @@ INIT_WORK(&device->fld, - (T1)fn, device + fn ); coccinelle-1.0.0-rc19/tests/sys.cocci0000644000175000017500000000017212247437436016352 0ustar eugeneugen@r@ struct sys_timer E; expression E2; @@ * E.suspend = E2; @s@ struct sys_timer E; expression E2; @@ E.suspend = E2; coccinelle-1.0.0-rc19/tests/metastatement_for.res0000644000175000017500000000010312247437436020760 0ustar eugeneugenvoid main(void) { int i; if (i == 0) { printf("%d", i); } } coccinelle-1.0.0-rc19/tests/devlink.cocci0000644000175000017500000000007712247437436017174 0ustar eugeneugen@@ typedef dev_link_t; @@ - dev_link_t + struct pcmcia_device coccinelle-1.0.0-rc19/tests/fnret.c0000644000175000017500000000004312247437436016011 0ustar eugeneugenstatic void foo(int x) { return; } coccinelle-1.0.0-rc19/tests/distribute.c0000644000175000017500000000004012247437436017046 0ustar eugeneugenint main(int i) { f(1+1); } coccinelle-1.0.0-rc19/tests/doubleswitch.c0000644000175000017500000000040712247437436017373 0ustar eugeneugenvoid zfLnxRecvEth(zdev_t* dev, zbuf_t* buf, u16_t port) { #ifdef ZM_AVOID_UDP_LARGE_PACKET_FAIL zbuf_t *new_buf; foo(); switch(netif_rx(new_buf)) #else switch(netif_rx(buf)) #endif { case NET_RX_BAD: break; } return; } coccinelle-1.0.0-rc19/tests/stm8.res0000644000175000017500000000006612247437436016142 0ustar eugeneugenint main(int x) { f(); g(); replace(); g(); } coccinelle-1.0.0-rc19/tests/initializer_iso.cocci0000644000175000017500000000056312247437436020735 0ustar eugeneugen@ rule1 @ typedef SHT_t; {struct SHT, SHT_t} fops; //struct SHT fops; // this one works identifier proc_info_func; @@ fops.proc_info = proc_info_func; @ rule2 extends rule1 @ @@ - proc_info_func + foobar // necessary :( because previous rule is a Exp and funheader // is not an expression. @ rule3 extends rule1 @ @@ - proc_info_func + foobar (...) { ... }coccinelle-1.0.0-rc19/tests/arparam.cocci0000644000175000017500000000013012247437436017151 0ustar eugeneugen@@ identifier f,x; expression e; @@ + g(int x[e]) { return 12; } f (int x[e]) { ... } coccinelle-1.0.0-rc19/tests/stm1.res0000644000175000017500000000005712247437436016133 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.0-rc19/tests/addbefore.cocci0000644000175000017500000000005712247437436017451 0ustar eugeneugen@@ statement S; @@ if (...) { + foo(); S }coccinelle-1.0.0-rc19/tests/not.cocci0000644000175000017500000000013012247437436016326 0ustar eugeneugen@@ expression x != foo; identifier y != {foo,bar}; expression a; @@ - y(x,a); + f(20); coccinelle-1.0.0-rc19/tests/endif.res0000644000175000017500000000043112247437436016330 0ustar eugeneugenvoid f(int i) { x = 1; if(1) x = 3; foo(); x = 1; while(1) x = 3; foo(); x = 1; do x = 3; while(1); foo(); x = 1; for(1;1;1) x = 3; foo(); x = 1; for(1;1;1) { x = 3; } foo(); // switch(1) { // case 0: x = 3; // default: x = 3; // } } coccinelle-1.0.0-rc19/tests/multr.c0000644000175000017500000000006012247437436016035 0ustar eugeneugenint main() { foo(12); } int q() { xxx(); } coccinelle-1.0.0-rc19/tests/bad_kfree.res0000644000175000017500000000045612247437436017154 0ustar eugeneugenint main () { for (i = 0; i < IVTV_VBI_FRAMES; i++) { a = itv[i]; kfree(itv[i]); } print("foo",itv[i]); print("foo",itv[i]); a = itv[i]; itv[i]=12; a = itv[i]; } int bad () { kfree(itv[i]); print("foo",itv[i]); print("foo",itv[i]); a = NULL; itv[i]=12; a = itv[i]; } coccinelle-1.0.0-rc19/tests/fun.res0000644000175000017500000000005612247437436016036 0ustar eugeneugenstruct a {int a;}; int f(int x) { return x; } coccinelle-1.0.0-rc19/tests/header_modif.c0000644000175000017500000000006012247437436017300 0ustar eugeneugen#include "header_modif.h" int foo(int i) { } coccinelle-1.0.0-rc19/tests/pmac.cocci0000644000175000017500000000004112247437436016447 0ustar eugeneugen@@ type T; @@ - #define chip_t T coccinelle-1.0.0-rc19/tests/strangeorder.res0000644000175000017500000000046612247437436017752 0ustar eugeneugenstruct i2c_client * i2c_new_device(struct i2c_adapter *adap, struct i2c_board_info const *info) { struct i2c_client *client; client = kzalloc(sizeof *client, GFP_KERNEL); if (!client) { client = NULL; return NULL; } client->adapter = adap; if (status < 0) { client = NULL; } return client; } coccinelle-1.0.0-rc19/Makefile0000644000175000017500000005743112247442614015034 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ############################################################################# # Configuration section ############################################################################# include Makefile.libs # 'distclean' does not require configure to have run, and should also # clean all the bundled directories. Hence, a special case. ifeq ($(MAKECMDGOALS),distclean) MAKELIBS:=$(dir $(wildcard ./bundles/*/Makefile)) else ifneq ($(MAKECMDGOALS),configure) -include Makefile.config endif endif -include /etc/lsb-release -include Makefile.override # local customizations, if any -include /etc/Makefile.coccinelle # local customizations, if any VERSION=$(shell cat ./version | tr -d '\n') CCVERSION=$(shell cat scripts/coccicheck/README | egrep -o '[[:digit:]]+\.[[:digit:]]+\.[[:digit:]]+' | head -n1) PKGVERSION=$(shell dpkg-parsechangelog -ldebian/changelog.$(DISTRIB_CODENAME) 2> /dev/null \ | sed -n 's/^Version: \(.*\)/\1/p' ) ############################################################################## # Variables ############################################################################## TARGET=spatch PRJNAME=coccinelle SRC=flag_cocci.ml cocci.ml testing.ml test.ml $(LEXER_SOURCES:.mll=.ml) main.ml ifeq ($(FEATURE_PYTHON),1) PYTHON_INSTALL_TARGET=install-python else PYTHON_INSTALL_TARGET= endif SYSLIBS=str.cma unix.cma bigarray.cma nums.cma LIBS=commons/commons.cma \ globals/globals.cma \ ctl/ctl.cma \ parsing_cocci/cocci_parser.cma parsing_c/parsing_c.cma \ engine/cocciengine.cma popl09/popl.cma \ extra/extra.cma python/coccipython.cma ocaml/cocciocaml.cma MAKESUBDIRS=$(MAKELIBS) commons \ globals ctl parsing_cocci parsing_c \ engine popl09 extra python ocaml CLEANSUBDIRS=commons \ globals ctl parsing_cocci parsing_c \ engine popl09 extra python ocaml docs \ $(MAKELIBS) INCLUDEDIRSDEP=commons commons/ocamlextra \ globals ctl \ parsing_cocci parsing_c engine popl09 extra python ocaml \ $(MAKELIBS) INCLUDEDIRS=$(INCLUDEDIRSDEP) $(PCREDIR) $(INCLIBS) ############################################################################## # Generic variables ############################################################################## # sort to remove duplicates INCLUDESET=$(sort $(INCLUDEDIRS)) INCLUDES=$(INCLUDESET:%=-I %) OBJS= $(SRC:.ml=.cmo) OPTOBJS= $(SRC:.ml=.cmx) EXEC=$(TARGET) ############################################################################## # Generic ocaml variables ############################################################################## OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDES) OCAMLYACC_CMD=$(OCAMLYACC) -v OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDEDIRSDEP:%=-I %) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) # these are unused at the moment (todo: remove) EXTRA_CFLAGS= # -static -pie -fpie -fPIE -static-libgcc EXTRA_OCAML_CFLAGS=$(EXTRA_CFLAGS:%=-ccopt %) # 'make purebytecode' unsets this definition BYTECODE_EXTRA=-custom $(EXTRA_OCAML_FLAGS) ############################################################################## # Top rules ############################################################################## .PHONY:: all all.opt byte opt top clean distclean configure opt-compil .PHONY:: $(MAKESUBDIRS:%=%.all) $(MAKESUBDIRS:%=%.opt) subdirs.all subdirs.opt .PHONY:: all-opt all-byte byte-only opt-only pure-byte .PHONY:: copy-stubs install-stubs install install-man install-python install-common # below follow the main make targets when ocamlbuild is not enabled ifneq ($(FEATURE_OCAMLBUILD),yes) # All make targets that are expected to be an entry point have a dependency on # 'Makefile.config' to ensure that if Makefile.config is not present, an error # message is printed first before any other actions are executed. # In addition, the targets that actually build something have a dependency on # '.depend' and 'version.ml'. # dispatches to either 'all-dev' or 'all-release' all: Makefile.config @$(MAKE) .depend $(MAKE) $(TARGET_ALL) # make "all" comes in three flavours world: Makefile.config version.ml @$(ECHO) "Building both versions of spatch" $(MAKE) .depend $(MAKE) byte $(MAKE) opt-compil $(MAKE) preinstall $(MAKE) docs @$(ECHO) -e "\n\tcoccinelle can now be installed via 'make install'" # note: the 'all-dev' target excludes the documentation all-dev: Makefile.config version.ml @$(MAKE) .depend @$(ECHO) "Building the unoptimized version of spatch" $(MAKE) byte @$(MAKE) preinstall @$(ECHO) -e "\n\tcoccinelle can now be installed via 'make install'" all-release: Makefile.config version.ml @$(ECHO) "Building $(TARGET_SPATCH)" $(MAKE) .depend $(MAKE) $(TARGET_SPATCH) $(MAKE) preinstall $(MAKE) docs @$(ECHO) -e "\n\tcoccinelle can now be installed via 'make install'" all.opt: Makefile.config @$(MAKE) .depend $(MAKE) opt-only $(MAKE) preinstall byte: Makefile.config version.ml @$(MAKE) .depend @$(MAKE) subdirs.all @$(MAKE) $(EXEC) @$(ECHO) "The compilation of $(EXEC) finished." @$(ECHO) "$(EXEC) can be installed or used." opt-compil: Makefile.config version.ml $(MAKE) .depend $(MAKE) subdirs.opt BUILD_OPT=yes $(MAKE) $(EXEC).opt BUILD_OPT=yes @$(ECHO) "The compilation of $(EXEC).opt finished." @$(ECHO) "$(EXEC).opt can be installed or used." top: $(EXEC).top # the .cmi file of coccilib ocaml/coccilib/coccilib.cmi: ocaml/coccilib.cmi cp ocaml/coccilib.cmi ocaml/coccilib/coccilib.cmi # ocamlbuild version of the main make targets else all: Makefile.config $(MAKE) $(TARGET_ALL) world: Makefile.config myocamlbuild.ml version.ml prepare-bundles @$(ECHO) "Building both versions of spatch" $(MAKE) byte $(MAKE) opt-compil @$(MAKE) coccilib-cmi $(MAKE) preinstall $(MAKE) docs @$(ECHO) -e "\n\tcoccinelle can now be installed via 'make install'" # note: the 'all-dev' target excludes the documentation and is less noisy all-dev: Makefile.config myocamlbuild.ml version.ml prepare-bundles $(MAKE) byte @$(MAKE) coccilib-cmi @$(MAKE) preinstall all-release: Makefile.config myocamlbuild.ml version.ml prepare-bundles @$(ECHO) "Building $(TARGET_SPATCH)" $(MAKE) $(TARGET_SPATCH) @$(MAKE) coccilib-cmi $(MAKE) preinstall $(MAKE) docs @$(ECHO) -e "\n\tcoccinelle can now be installed via 'make install'" all.opt: Makefile.config myocamlbuild.ml version.ml prepare-bundles $(MAKE) opt-only @$(MAKE) coccilib-cmi $(MAKE) preinstall byte: Makefile.config myocamlbuild.ml version.ml prepare-bundles $(OCAMLBUILD) -j 0 main.byte cp _build/main.byte $(EXEC) pure-byte: Makefile.config myocamlbuild.ml version.ml prepare-bundles $(OCAMLBUILD) -j 0 -tag nocustom main.byte cp _build/main.byte $(EXEC) opt-compil: Makefile.config myocamlbuild.ml version.ml prepare-bundles $(OCAMLBUILD) -j 0 main.native cp _build/main.native $(EXEC).opt # the .cmi file of coccilib _build/ocaml/coccilib.cmi: $(OCAMLBUILD) -j 0 ocaml/coccilib.cmi ocaml/coccilib/coccilib.cmi: _build/ocaml/coccilib.cmi cp _build/ocaml/coccilib.cmi ocaml/coccilib/coccilib.cmi # end of main build target distinction on ocamlbuild endif # aliases for "byte" and "opt-compil" opt opt-only: Makefile.config opt-compil byte-only: Makefile.config byte # ensures that coccilib.cmi gets build .PHONY:: coccilib-cmi coccilib-cmi: ocaml/coccilib/coccilib.cmi distclean:: rm -f ocaml/coccilib/coccilib.cmi subdirs.all: @+for D in $(MAKESUBDIRS); do $(MAKE) $$D.all || exit 1 ; done subdirs.opt: @+for D in $(MAKESUBDIRS); do $(MAKE) $$D.opt || exit 1 ; done $(MAKESUBDIRS:%=%.all): @$(MAKE) -C $(@:%.all=%) all $(MAKESUBDIRS:%=%.opt): @$(MAKE) -C $(@:%.opt=%) all.opt # This make target prepares the bundled software for building. # Note that running 'make' in these subdirectories will # automatically prepare the bundled software. .PHONY:: prepare-bundles prepare-bundles: $(MAKELIBS:%=%/.prepare) $(MAKELIBS:%=%/.prepare): $(ECHO) $@ @$(MAKE) -C $(@:%.prepare=%) .prepare #dependencies: # commons: # globals: # menhirLib: # parsing_cocci: commons globals menhirLib # parsing_c:parsing_cocci # ctl:globals commonsg # engine: parsing_cocci parsing_c ctl # popl09:engine # extra: parsing_cocci parsing_c ctl # pycaml: # python:pycaml parsing_cocci parsing_c clean:: Makefile.config @set -e; for i in $(CLEANSUBDIRS); do $(MAKE) -C $$i $@; done @$(MAKE) -C demos/spp $@ $(LIBS): $(MAKESUBDIRS:%=%.all) $(LIBS:.cma=.cmxa): $(MAKESUBDIRS:%=%.opt) $(LNKLIBS) : $(MAKESUBDIRS:%=%.all) $(LNKOPTLIBS) : $(MAKESUBDIRS:%=%.opt) $(OBJS):$(LIBS) $(OPTOBJS):$(LIBS:.cma=.cmxa) $(EXEC): $(LNKLIBS) $(LIBS) $(OBJS) $(OCAMLC_CMD) $(BYTECODE_EXTRA) $(FLAGSLIBS) -o $@ $(SYSLIBS) $^ $(EXEC).opt: $(OPTLNKLIBS) $(LIBS:.cma=.cmxa) $(OPTOBJS) $(OCAMLOPT_CMD) $(OPTFLAGSLIBS) -o $@ $(SYSLIBS:.cma=.cmxa) $^ $(EXEC).top: $(LNKLIBS) $(LIBS) $(OBJS) $(OCAMLMKTOP_CMD) -custom -o $@ $(SYSLIBS) $(FLAGSLIBS) $^ clean distclean:: rm -f $(TARGET) $(TARGET).opt $(TARGET).top clean:: @if test -n "${OCAMLBUILD}" -d _build; then \ $(OCAMLBUILD) -clean; fi # distclean can run without ocamlbuild configured. distclean:: -@if test -d _build; then \ ocamlbuild -clean; fi rm -rf _build _log .PHONY:: tools configure configure: ./configure $(CONFIGURE_FLAGS) # the dependencies on Makefile.config should give a hint to the programmer that # configure should be run again Makefile.config: Makefile.config.in configure.ac @$(ECHO) "Makefile.config needs to be (re)build. Run ./configure $(CONFIGURE_FLAGS) to generate it." @false # as above, also for the ocamlbuild plugin myocamlbuild.ml: myocamlbuild.ml.in configure.ac tools: $(LIBS) $(LNKLIBS) $(MAKE) -C tools distclean:: @if [ -d tools ] ; then $(MAKE) -C tools distclean ; fi # it seems impossible to pass "-static" unless all dependent # libraries are also available as static archives. # set $(STATIC) to -static if you have such libraries. static: rm -f spatch.opt spatch $(MAKE) $(STATIC) opt-only cp spatch.opt spatch # creates a portable version of spatch, which, however, may # be dependent on non-portably dynamic libraries. You # may need the stubs, see 'copy-stubs'. purebytecode: rm -f spatch.opt spatch ifneq ($(FEATURE_OCAMLBUILD),yes) $(MAKE) BYTECODE_EXTRA="" byte-only else @$(MAKE) pure-byte endif sed -i '1 s,^#!.*$$,#!/usr/bin/ocamlrun,g' spatch # copies the stubs libraries (if any) to the root directory ifneq ($(FEATURE_OCAMLBUILD),yes) copy-stubs: @if test -f ./bundles/pycaml/dllpycaml_stubs.so; then \ cp -fv ./bundles/pycaml/dllpycaml_stubs.so .; fi @if test -f ./bundles/pcre/dllpcre_stubs.so; then \ cp -fv ./bundles/pcre/dllpcre_stubs.so .; fi else copy-stubs: @if test -f _build/bundles/pycaml/dllpycaml_stubs.so; then \ cp -fv _build/bundles/pycaml/dllpycaml_stubs.so .; fi @if test -f _build/bundles/pcre/dllpcre_stubs.so; then \ cp -fv _build/bundles/pcre/dllpcre_stubs.so .; fi endif ############################################################################## # Build version information ############################################################################## version.ml: @$(ECHO) "version.ml is missing. Run ./configure to generate it." @false ############################################################################## # Build documentation ############################################################################## .PHONY:: docs ifneq ($(FEATURE_OCAMLBUILD),yes) docs: else docs: prepare-bundles endif @$(MAKE) -C docs || ($(ECHO) "Warning: ignored the failed construction of the manual" 1>&2) ifneq ($(FEATURE_OCAMLBUILD),yes) @if test "x$(FEATURE_OCAML)" = x1; then \ if test -f ./parsing_c/ast_c.cmo -o -f ./parsing_c/ast_c.cmx; then \ $(MAKE) -C ocaml doc; \ else $(ECHO) "Note: to obtain coccilib documenation, it is required to build 'spatch' first so that ./parsing_c/ast_c.cm* gets build."; \ fi fi else @if test "x$(FEATURE_OCAML)" = x1; then \ $(MAKE) -C ocaml doc; fi endif @$(ECHO) "Finished building manuals" clean:: Makefile.config $(MAKE) -C docs clean $(MAKE) -C ocaml cleandoc ############################################################################## # Pre-Install (customization of spatch frontend script) ############################################################################## preinstall: docs/spatch.1 scripts/spatch scripts/spatch.opt scripts/spatch.byte docs/spatch.1: Makefile.config $(MAKE) -C docs spatch.1 # user will use spatch to run spatch.opt (native) scripts/spatch: Makefile.config scripts/spatch.sh cp scripts/spatch.sh scripts/spatch chmod +x scripts/spatch # user will use spatch to run spatch (bytecode) scripts/spatch.byte: Makefile.config scripts/spatch.sh cp scripts/spatch.sh scripts/spatch.byte chmod +x scripts/spatch.byte # user will use spatch.opt to run spatch.opt (native) scripts/spatch.opt: Makefile.config scripts/spatch.sh cp scripts/spatch.sh scripts/spatch.opt chmod +x scripts/spatch.opt distclean:: rm -f scripts/spatch scripts/spatch.byte scripts/spatch.opt ############################################################################## # Install ############################################################################## # don't remove DESTDIR, it can be set by package build system like ebuild # for staged installation. install-common: ocaml/coccilib/coccilib.cmi $(MKDIR_P) $(DESTDIR)$(BINDIR) $(MKDIR_P) $(DESTDIR)$(LIBDIR) $(MKDIR_P) $(DESTDIR)$(SHAREDIR)/ocaml # $(MKDIR_P) $(DESTDIR)$(SHAREDIR)/commons # $(MKDIR_P) $(DESTDIR)$(SHAREDIR)/globals # $(MKDIR_P) $(DESTDIR)$(SHAREDIR)/parsing_c $(INSTALL_DATA) standard.h $(DESTDIR)$(SHAREDIR) $(INSTALL_DATA) standard.iso $(DESTDIR)$(SHAREDIR) $(INSTALL_DATA) ocaml/coccilib/coccilib.cmi $(DESTDIR)$(SHAREDIR)/ocaml/ # $(INSTALL_DATA) parsing_c/*.cmi $(DESTDIR)$(SHAREDIR)/parsing_c/ # $(INSTALL_DATA) commons/*.cmi $(DESTDIR)$(SHAREDIR)/commons/ # $(INSTALL_DATA) globals/iteration.cmi $(DESTDIR)$(SHAREDIR)/globals/ install-man: @$(ECHO) "Installing manuals in: ${DESTDIR}${MANDIR}" $(MKDIR_P) $(DESTDIR)$(MANDIR)/man1 $(MKDIR_P) $(DESTDIR)$(MANDIR)/man3 $(INSTALL_DATA) docs/spatch.1 $(DESTDIR)$(MANDIR)/man1/ $(INSTALL_DATA) docs/Coccilib.3cocci $(DESTDIR)$(MANDIR)/man3/ install-bash: @$(ECHO) "Installing bash completion in: ${DESTDIR}${BASH_COMPLETION_DIR}" $(MKDIR_P) $(DESTDIR)$(BASH_COMPLETION_DIR) $(INSTALL_DATA) scripts/spatch.bash_completion \ $(DESTDIR)$(BASH_COMPLETION_DIR)/spatch install-tools: @$(ECHO) "Installing tools in: ${DESTDIR}${BINDIR}" $(MKDIR_P) $(DESTDIR)$(BINDIR) $(INSTALL_PROGRAM) tools/splitpatch \ $(DESTDIR)$(BINDIR)/splitpatch $(INSTALL_PROGRAM) tools/cocci-send-email.perl \ $(DESTDIR)$(BINDIR)/cocci-send-email.perl install-python: @$(ECHO) "Installing python support in: ${DESTDIR}${SHAREDIR}/python" $(MKDIR_P) $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/*.py \ $(DESTDIR)$(SHAREDIR)/python/coccilib $(INSTALL_DATA) python/coccilib/coccigui/*.py \ $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/coccigui/pygui.glade \ $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/coccigui/pygui.gladep \ $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui install-stubs: $(MKDIR_P) $(DESTDIR)$(SHAREDIR) @if test -f ./bundles/pycaml/dllpycaml_stubs.so; then \ cp -fv ./bundles/pycaml/dllpycaml_stubs.so $(DESTDIR)$(SHAREDIR); fi @if test -f ./bundles/pcre/dllpcre_stubs.so; then \ cp -fv ./bundles/pcre/dllpcre_stubs.so $(DESTDIR)$(SHAREDIR); fi install: install-man install-common install-stubs $(PYTHON_INSTALL_TARGET) rm -f $(DESTDIR)$(SHAREDIR)/spatch rm -f $(DESTDIR)$(SHAREDIR)/spatch.opt @if test -x spatch -o -x spatch.opt; then \ $(MAKE) install-def;fi @if test -x spatch ; then \ $(MAKE) install-byte; fi @if test -x spatch.opt ; then \ $(MAKE) install-opt;fi @if test ! -x spatch -a ! -x spatch.opt ; then \ $(ECHO) -e "\n\n\t==> Run 'make', 'make opt', or both first. <==\n\n";fi @$(ECHO) -e "\n\tYou can also install spatch by copying the program spatch" @$(ECHO) -e "\t(available in this directory) anywhere you want and" @$(ECHO) -e "\tgive it the right options to find its configuration files.\n" # # Installation of spatch and spatch.opt and their wrappers # # user will use spatch to run one of the binaries install-def: $(INSTALL_PROGRAM) scripts/spatch $(DESTDIR)$(BINDIR)/spatch # user will use spatch.byte to run spatch (bytecode) install-byte: $(INSTALL_PROGRAM) spatch $(DESTDIR)$(SHAREDIR) $(INSTALL_PROGRAM) scripts/spatch.byte $(DESTDIR)$(BINDIR)/spatch.byte # user will use spatch.opt to run spatch.opt (native) install-opt: $(INSTALL_PROGRAM) spatch.opt $(DESTDIR)$(SHAREDIR) $(INSTALL_PROGRAM) scripts/spatch.opt $(DESTDIR)$(BINDIR)/spatch.opt uninstall: rm -f $(DESTDIR)$(BINDIR)/spatch rm -f $(DESTDIR)$(BINDIR)/spatch.opt rm -f $(DESTDIR)$(BINDIR)/spatch.byte rm -f $(DESTDIR)$(SHAREDIR)/dllpycaml_stubs.so rm -f $(DESTDIR)$(SHAREDIR)/dllpcre_stubs.so rm -f $(DESTDIR)$(SHAREDIR)/spatch rm -f $(DESTDIR)$(SHAREDIR)/spatch.opt rm -f $(DESTDIR)$(SHAREDIR)/standard.h rm -f $(DESTDIR)$(SHAREDIR)/standard.iso rm -f $(DESTDIR)$(SHAREDIR)/ocaml/coccilib.cmi rm -f $(DESTDIR)$(SHAREDIR)/parsing_c/*.cmi rm -f $(DESTDIR)$(SHAREDIR)/commons/*.cmi rm -f $(DESTDIR)$(SHAREDIR)/globals/*.cmi rm -f $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui/* rm -f $(DESTDIR)$(SHAREDIR)/python/coccilib/*.py rmdir --ignore-fail-on-non-empty -p \ $(DESTDIR)$(SHAREDIR)/python/coccilib/coccigui rmdir $(DESTDIR)$(SHAREDIR)/globals rmdir $(DESTDIR)$(SHAREDIR)/commons rmdir $(DESTDIR)$(SHAREDIR)/parsing_c rmdir $(DESTDIR)$(SHAREDIR)/ocaml rmdir $(DESTDIR)$(SHAREDIR) rm -f $(DESTDIR)$(MANDIR)/man1/spatch.1 rm -f $(DESTDIR)$(MANDIR)/man3/Coccilib.3cocci uninstall-bash: rm -f $(DESTDIR)$(BASH_COMPLETION_DIR)/spatch rmdir --ignore-fail-on-non-empty -p \ $(DESTDIR)$(BASH_COMPLETION_DIR) uninstall-tools: rm -f $(DESTDIR)$(BINDIR)/splitpatch rm -f $(DESTDIR)$(BINDIR)/cocci-send-email.perl version: @$(ECHO) "spatch $(VERSION)" @$(ECHO) "spatch $(PKGVERSION) ($(DISTRIB_ID))" @$(ECHO) "coccicheck $(CCVERSION)" ############################################################################## # Deb package (for Ubuntu) and release rules ############################################################################## include Makefile.release ############################################################################## # Developer rules ############################################################################## -include Makefile.dev test: $(TARGET) ./$(TARGET) -testall testparsing: ./$(TARGET) -D standard.h -parse_c -dir tests/ # the check target runs: # * some feature tests (depending on what is enabled) # * the test suite check: scripts/spatch @$(ECHO) "Testing if spatch works on hello world..." @COCCINELLE_HOME="$$(pwd)" ./scripts/spatch --sp-file demos/hello/hello-smpl.cocci demos/hello/helloworld.c --very-quiet | grep -q '+ printf("world, hello!");' @$(ECHO) "Testing if spatch works with regexes..." @COCCINELLE_HOME="$$(pwd)" ./scripts/spatch --sp-file demos/hello/hello-regexp.cocci demos/hello/helloworld.c --very-quiet | grep -q '+ printf("world, hello!");' @if test "x${FEATURE_OCAML}" = x1 -a -z "${NO_OCAMLFIND}"; then \ $(ECHO) "Testing if spatch works with ocaml scripts..."; \ COCCINELLE_HOME="$$(pwd)" ./scripts/spatch --sp-file demos/hello/hello-ocaml.cocci demos/hello/helloworld.c --very-quiet | grep -q 'Hello at: 2'; fi @if test "x${FEATURE_PYTHON}" = x1; then \ $(ECHO) "Testing if spatch works with python scripts..."; \ COCCINELLE_HOME="$$(pwd)" ./scripts/spatch --sp-file demos/hello/hello-python.cocci demos/hello/helloworld.c --very-quiet | grep -q 'Hello at: 2'; fi @$(ECHO) running the test suite COCCINELLE_HOME="$$(pwd)" ./scripts/spatch --testall --no-update-score-file # -inline 0 to see all the functions in the profile. # Can also use the profile framework in commons/ and run your program # with -profile. forprofiling: $(MAKE) OPTFLAGS="-p -inline 0 ${EXTRA_OCAML_FLAGS}" opt clean distclean:: rm -f gmon.out ocamlprof.dump tags: otags -no-mli-tags -r . dependencygraph: find . -name "*.ml" |grep -v "scripts" | xargs $(OCAMLDEP) -I commons -I globals -I ctl -I parsing_cocci -I parsing_c -I engine -I popl09 -I extra > /tmp/dependfull.depend ocamldot -lr /tmp/dependfull.depend > /tmp/dependfull.dot dot -Tps /tmp/dependfull.dot > /tmp/dependfull.ps ps2pdf /tmp/dependfull.ps /tmp/dependfull.pdf ############################################################################## # Misc rules ############################################################################## # each member of the project can have its own test.ml. this file is # not under CVS. test.ml: $(ECHO) "let foo_ctl () = failwith \"there is no foo_ctl formula\"" \ > test.ml ############################################################################## # Generic ocaml rules ############################################################################## .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< .ml.mldepend: $(OCAMLC_CMD) -i $< clean distclean:: rm -f .depend rm -f *.cm[iox] *.o *.annot rm -f *~ .*~ *.exe #*# distclean:: set -e; for i in $(CLEANSUBDIRS); do $(MAKE) -C $$i $@; done rm -f test.ml rm -f TAGS *.native *.byte *.d.native *.p.byte if test -z "${KEEP_GENERATED}"; then \ rm -f tests/SCORE_actual.sexp tests/SCORE_best_of_both.sexp; fi find . -name ".#*1.*" | xargs rm -f rm -f $(EXEC) $(EXEC).opt $(EXEC).top rm -f setup/Makefile # using 'touch' to prevent infinite recursion with 'make depend' .PHONY:: depend .depend: Makefile.config test.ml version @touch .depend @$(MAKE) depend depend: Makefile.config test.ml version @$(ECHO) "Constructing '.depend'" @rm -f .depend @set -e; for i in $(MAKESUBDIRS); do $(MAKE) -C $$i depend; done $(OCAMLDEP_CMD) *.mli *.ml > .depend ############################################################################## # configure-related ############################################################################## distclean:: @echo "Cleaning configured files" if test -z "${KEEP_CONFIG}"; then rm -f Makefile.config; fi rm -rf autom4te.cache rm -f config.status rm -f config.log if test -z "${KEEP_GENERATED}"; then \ rm -f version.ml; fi rm -f globals/config.ml rm -f globals/regexp.ml python/pycocci.ml ocaml/prepare_ocamlcocci.ml rm -f scripts/spatch.sh rm -f aclocal.m4 @echo "Run 'configure' again prior to building coccinelle" # don't include depend for those actions that either don't need # depend or that call 'make .depend' explicitly. # TODO: find a nicer way to express this ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(MAKECMDGOALS),configure) ifneq ($(MAKECMDGOALS),prerelease) ifneq ($(MAKECMDGOALS),release) ifneq ($(MAKECMDGOALS),package) ifneq ($(MAKECMDGOALS),all-release) ifneq ($(MAKECMDGOALS),all-dev) ifneq ($(MAKECMDGOALS),all) ifneq ($(MAKECMDGOALS),.depend) ifneq ($(MAKECMDGOALS),depend) ifneq ($(FEATURE_OCAMLBUILD),yes) -include .depend endif endif endif endif endif endif endif endif endif endif endif endif include Makefile.common coccinelle-1.0.0-rc19/testing.ml0000644000175000017500000004402512247442614015376 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./testing.ml" open Common (*****************************************************************************) (* Test framework *) (*****************************************************************************) (* There can be multiple .c for the same cocci file. The convention * is to have one base.cocci and a base.c and some optional * base_vernn.[c,res]. * * If want to test without iso, use -iso_file empty.iso option. *) let testone prefix x compare_with_expected_flag = let x = if x =~ "\\(.*\\)_ver0$" then matched1 x else x in let base = if x =~ "\\(.*\\)_ver[0-9]+$" then matched1 x else x in let cfile = prefix ^ x ^ ".c" in let cocci_file = prefix ^ base ^ ".cocci" in let expected_res = prefix ^ x ^ ".res" in begin let (cocci_infos,_) = Cocci.pre_engine (cocci_file, !Config.std_iso) in let res = Cocci.full_engine cocci_infos [cfile] in Cocci.post_engine cocci_infos; let generated = match Common.optionise (fun () -> List.assoc cfile res) with | Some (Some outfile) -> if List.length res > 1 then pr2 ("note that not just " ^ cfile ^ " was involved"); let tmpfile = sprintf "%s/%s" Filename.temp_dir_name (Common.basename cfile) in pr2 (sprintf "One file modified. Result is here: %s" tmpfile); Common.command2 ("mv "^outfile^" "^tmpfile); tmpfile | Some None -> pr2 "no modification on the input file"; cfile | None -> raise (Impossible 163) in if compare_with_expected_flag then Compare_c.compare_default generated expected_res +> Compare_c.compare_result_to_string +> pr2; end (* ------------------------------------------------------------------------ *) (* note: if you get some weird results in -testall, and not in -test, * it is possible that a test file work in -test but may not * work while used inside a -testall. If we have some bugs in our * parser that modify some global state and that those states * are not reset between each test file, then having run previous * test files may have an influence on another test file which mean * than a test may work in isolation (via -test) but not otherwise * (via -testall). Fortunately such bugs are rare. * *) let testall expected_score_file update_score_file = let score = empty_score () in let expected_result_files = Common.glob "tests/*.res" +> List.filter (fun f -> Common.filesize f > 0) +> List.map Filename.basename +> List.sort compare in begin expected_result_files +> List.iter (fun res -> let x = if res =~ "\\(.*\\).res" then matched1 res else raise (Impossible 164) in let base = if x =~ "\\(.*\\)_ver[0-9]+" then matched1 x else x in let cfile = "tests/" ^ x ^ ".c" in let cocci_file = "tests/" ^ base ^ ".cocci" in let expected = "tests/" ^ res in let timeout_testall = 60 in try ( Common.timeout_function timeout_testall (fun () -> pr2 res; let (cocci_infos,_) = Cocci.pre_engine (cocci_file, !Config.std_iso) in let xs = Cocci.full_engine cocci_infos [cfile] in Cocci.post_engine cocci_infos; let generated = match List.assoc cfile xs with | Some generated -> generated | None -> cfile in let (correct, diffxs) = Compare_c.compare_default generated expected in (* I don't use Compare_c.compare_result_to_string because * I want to indent a little more the messages. *) (match correct with | Compare_c.Correct -> Hashtbl.add score res Common.Ok; | Compare_c.Pb s -> let s = Str.global_replace (Str.regexp "\"/tmp/cocci-output.*\"") "" s in (* on macos the temporary files are stored elsewhere *) let s = Str.global_replace (Str.regexp "\"/var/folders/.*/cocci-output.*\"") "" s in let s = "INCORRECT:" ^ s ^ "\n" ^ " diff (result(<) vs expected_result(>)) = \n" ^ (diffxs +> List.map(fun s -> " "^s^"\n") +> Common.join "") in Hashtbl.add score res (Common.Pb s) | Compare_c.PbOnlyInNotParsedCorrectly s -> let s = "seems incorrect, but only because of code that " ^ "was not parsable" ^ s in Hashtbl.add score res (Common.Pb s) ) ) ) with exn -> Common.reset_pr_indent(); let s = "PROBLEM\n" ^ (" exn = " ^ Printexc.to_string exn ^ "\n") in Hashtbl.add score res (Common.Pb s) ); pr2 "--------------------------------"; pr2 "statistics"; pr2 "--------------------------------"; Common.hash_to_list score +> List.iter (fun (s, v) -> pr_no_nl (Printf.sprintf "%-30s: " s); pr_no_nl ( match v with | Common.Ok -> "CORRECT\n" | Common.Pb s -> s ) ); flush stdout; flush stderr; pr2 "--------------------------------"; pr2 "regression testing information"; pr2 "--------------------------------"; let expected_score_file_orig = "tests/SCORE_expected_orig.sexp" in let best_of_both_file = "tests/SCORE_best_of_both.sexp" in let actual_score_file = "tests/SCORE_actual.sexp" in pr2 ("regression file: "^ expected_score_file); let (expected_score : score) = if Sys.file_exists expected_score_file then Common.load_score expected_score_file () (* let sexp = Sexp.load_sexp expected_score_file in Sexp_common.score_of_sexp sexp *) else if Sys.file_exists expected_score_file_orig then begin pr2 (spf "use expected orig file (%s)" expected_score_file_orig); Common.command2 (spf "cp %s %s" expected_score_file_orig expected_score_file); (* let sexp = Sexp.load_sexp expected_score_file in Sexp_common.score_of_sexp sexp *) Common.load_score expected_score_file () end else empty_score() in let new_bestscore = Common.regression_testing_vs score expected_score in (* let xs = Common.hash_to_list score in let sexp = Sexp_common.sexp_of_score_list xs in let s_score = Sexp.to_string_hum sexp in Common.write_file ~file:(actual_score_file) s_score; *) Common.save_score score actual_score_file; (* let xs2 = Common.hash_to_list new_bestscore in let sexp2 = Sexp_common.sexp_of_score_list xs2 in let s_score2 = Sexp.to_string_hum sexp2 in Common.write_file ~file:(best_of_both_file) s_score2; *) Common.save_score new_bestscore best_of_both_file; Common.print_total_score score; let (good, total) = Common.total_scores score in let (expected_good, expected_total) = Common.total_scores expected_score in if good = expected_good then begin pr2 "Current score is equal to expected score; everything is fine"; raise (UnixExit 0); end else if good < expected_good then begin pr2 "Current score is lower than expected :("; pr2 (spf "(was expecting %d but got %d)" expected_good good); pr2 ""; pr2 "If you think it's normal, then maybe you need to update the"; pr2 (spf "score file %s, copying info from %s." expected_score_file actual_score_file); raise (UnixExit 1); end else begin pr2 "Current score is greater than expected :)"; pr2 (spf "(was expecting %d but got %d)" expected_good good); if update_score_file then begin pr2 "Generating new expected score file and saving old one"; Common.command2_y_or_no_exit_if_no (spf "mv %s %s" expected_score_file (expected_score_file ^ ".save")); Common.command2_y_or_no_exit_if_no (spf "mv %s %s" best_of_both_file expected_score_file); end; (* when there are sufficient number of tests, abort if a substantial * amount of tests fail, which would indicate a broken build. *) if total > 40 && good < (total * 3) / 4 then begin pr2 "Still, less 75% the tests passed. Returning a nonzero exist status."; raise (UnixExit 1); end; raise (UnixExit 0); end end (* ------------------------------------------------------------------------ *) type okfailed = Ok | SpatchOK | Failed (* test_to_string *) let t_to_s = function | Ok -> ".ok" | SpatchOK -> ".spatch_ok" | Failed -> ".failed" let delete_previous_result_files infile = [Ok;SpatchOK;Failed] +> List.iter (fun kind -> Common.remove_file (infile ^ t_to_s kind) ) (* quite similar to compare_with_expected below *) let test_okfailed cocci_file cfiles = cfiles +> List.iter delete_previous_result_files; (* final_files contain the name of an output file (a .ok or .failed * or .spatch_ok), and also some additional strings to be printed in * this output file in addition to the general error message of * full_engine. *) let final_files = ref [] in let newout = Common.new_temp_file "cocci" ".stdout" in let t = Unix.gettimeofday () in let time_per_file_str () = let t' = Unix.gettimeofday () in let tdiff = t' -. t in let tperfile = tdiff /. (float_of_int (List.length cfiles)) in spf "time: %f" tperfile in Common.redirect_stdout_stderr newout (fun () -> try ( Common.timeout_function_opt !Flag_cocci.timeout (fun () -> let (cocci_infos,_) = Cocci.pre_engine (cocci_file, !Config.std_iso) in let outfiles = Cocci.full_engine cocci_infos cfiles in Cocci.post_engine cocci_infos; let time_str = time_per_file_str () in outfiles +> List.iter (fun (infile, outopt) -> let (dir, base, ext) = Common.dbe_of_filename infile in let expected_suffix = match ext with | "c" -> "res" | "h" -> "h.res" | s -> pr2 ("WEIRD: not a .c or .h :" ^ base ^ "." ^ s); "" (* no extension, will compare to same file *) in let expected_res = Common.filename_of_dbe (dir, base, expected_suffix) in let expected_res2 = Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) in (* can delete more than the first delete_previous_result_files * because here we can have more files than in cfiles, for instance * the header files *) delete_previous_result_files infile; match outopt, Common.lfile_exists expected_res with | None, false -> () | Some outfile, false -> let s =("PB: input file " ^ infile ^ " modified but no .res") in push2 (infile^t_to_s Failed, [s;time_str]) final_files | x, true -> let outfile = match x with | Some outfile -> outfile | None -> infile in let diff = Compare_c.compare_default outfile expected_res in let s1 = (Compare_c.compare_result_to_string diff) in if fst diff =*= Compare_c.Correct then push2 (infile ^ (t_to_s Ok), [s1;time_str]) final_files else if Common.lfile_exists expected_res2 then begin let diff = Compare_c.compare_default outfile expected_res2 in let s2 = Compare_c.compare_result_to_string diff in if fst diff =*= Compare_c.Correct then push2 (infile ^ (t_to_s SpatchOK),[s2;s1;time_str]) final_files else push2 (infile ^ (t_to_s Failed), [s2;s1;time_str]) final_files end else push2 (infile ^ (t_to_s Failed), [s1;time_str]) final_files ) ); ) with exn -> let clean s = Str.global_replace (Str.regexp "\\\\n") "\n" (Str.global_replace (Str.regexp ("\\\\\"")) "\"" (Str.global_replace (Str.regexp "\\\\t") "\t" s)) in let s = "PROBLEM\n"^(" exn = " ^ clean(Printexc.to_string exn) ^ "\n") in let time_str = time_per_file_str () in (* we may miss some file because cfiles is shorter than outfiles. * For instance the detected local headers are not in cfiles, so * may have less failed. But at least have some failed. *) cfiles +> List.iter (fun infile -> push2 (infile ^ (t_to_s Failed), [s;time_str]) final_files; ); ); !final_files +> List.iter (fun (file, additional_strs) -> Common.command2 ("cp " ^ newout ^ " " ^ file); with_open_outfile file (fun (pr, chan) -> additional_strs +> List.iter (fun s -> pr (s ^ "\n")) ); ) let test_regression_okfailed () = (* it's xxx.c.ok *) let chop_ext f = f +> Filename.chop_extension in let newscore = Common.empty_score () in let oks = Common.cmd_to_list ("find . -name \"*.ok\"") ++ Common.cmd_to_list ("find . -name \"*.spatch_ok\"") in let failed = Common.cmd_to_list ("find . -name \"*.failed\"") in if null (oks ++ failed) then failwith "no ok/failed file, you certainly did a make clean" else begin oks +> List.iter (fun s -> Hashtbl.add newscore (chop_ext s) Common.Ok ); failed +> List.iter (fun s -> Hashtbl.add newscore (chop_ext s) (Common.Pb "fail") ); pr2 "--------------------------------"; pr2 "regression testing information"; pr2 "--------------------------------"; Common.regression_testing newscore ("score_failed.marshalled") end (* ------------------------------------------------------------------------ *) (* quite similar to test_ok_failed. Maybe could factorize code *) let compare_with_expected outfiles = pr2 ""; outfiles +> List.iter (fun (infile, outopt) -> let (dir, base, ext) = Common.dbe_of_filename infile in let expected_suffix = match ext with | "c" -> "res" | "h" -> "h.res" | s -> failwith ("weird C file, not a .c or .h :" ^ s) in let expected_res = Common.filename_of_dbe (dir, base, expected_suffix) in let expected_res2 = Common.filename_of_dbe (dir,"corrected_"^ base,expected_suffix) in match outopt, Common.lfile_exists expected_res with | None, false -> () | Some outfile, false -> let s =("PB: input file " ^ infile ^ " modified but no .res") in pr2 s | x, true -> let outfile = match x with | Some outfile -> outfile | None -> infile in let diff = Compare_c.compare_default outfile expected_res in let s1 = (Compare_c.compare_result_to_string diff) in if fst diff =*= Compare_c.Correct then pr2_no_nl (infile ^ " " ^ s1) else if Common.lfile_exists expected_res2 then begin let diff = Compare_c.compare_default outfile expected_res2 in let s2 = Compare_c.compare_result_to_string diff in if fst diff =*= Compare_c.Correct then pr2 (infile ^ " is spatchOK " ^ s2) else pr2 (infile ^ " is failed " ^ s2) end else pr2 (infile ^ " is failed " ^ s1) ) (*****************************************************************************) (* Subsystem testing *) (*****************************************************************************) let test_parse_cocci file = if not (file =~ ".*\\.cocci") then pr2 "warning: seems not a .cocci file"; let (_,xs,_,_,_,_,(grep_tokens,query,_,_),_) = Parse_cocci.process file (Some !Config.std_iso) false in xs +> List.iter Pretty_print_cocci.unparse; Format.print_newline(); (* compile ocaml script code *) (match Prepare_ocamlcocci.prepare file xs with None -> () | Some ocaml_script_file -> (* compile file *) Prepare_ocamlcocci.load_file ocaml_script_file; (* remove file *) (if not !Common.save_tmp_files then Prepare_ocamlcocci.clean_file ocaml_script_file); (* Print the list of registered functions *) Prepare_ocamlcocci.test ()); Printf.printf "grep tokens\n"; (match grep_tokens with None -> pr "No query" | Some x -> pr (String.concat " || " x)); (* could update to accomodate WTCocciGrep *) (match query with None -> pr "No query" | Some x -> Printf.printf "glimpse tokens\n"; pr (String.concat "\nor on glimpse failure\n" x)) (*****************************************************************************) (* to be called by ocaml toplevel, to test. *) (*****************************************************************************) (* no point to memoize this one *) let sp_of_file file iso = Parse_cocci.process file iso false (* TODO: Remove *) (* let flows_of_ast astc = astc +> Common.map_filter (fun e -> ast_to_flow_with_error_messages e) let one_flow flows = List.hd flows let one_ctl ctls = List.hd (List.hd ctls) *) coccinelle-1.0.0-rc19/tools/0000755000175000017500000000000012247437436014530 5ustar eugeneugencoccinelle-1.0.0-rc19/tools/alloc_free.ml0000644000175000017500000001347012247442616017156 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./alloc_free.ml" (* The following finds out for each file, how it does deallocation for each allocator *) let collect i = let info = ref [] in let rec loop _ = let l = input_line i in (if String.length l > 2 && String.get l 0 = '+' then info := (String.sub l 1 (String.length l - 1))::!info); loop() in try loop() with End_of_file -> List.rev !info let split l = let rec loop acc = function [] -> acc | x::xs -> if String.get x 0 = '+' (* the start of a new file *) then (match Str.split (Str.regexp " ") x with _::x::_ -> loop ((x,[])::acc) xs | _ -> failwith ("no file: "^x)) else let acc = match acc with (file,instances)::rest -> (file,x::instances)::rest | _ -> failwith "not possible" in loop acc xs in let res = List.rev (loop [] l) in List.map (function (x,l) -> (x,List.rev l)) res let detect_alloc_free str l = let try_add a f l = let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in match same with [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff | _ -> (a,[f])::l in let rec loop acc = function [] -> acc | x::xs -> match Str.split (Str.regexp (str^"\", ")) x with _::matches -> let acc = List.fold_left (function acc -> function rest -> (match Str.split (Str.regexp "[, )]+") rest with alloc::free::_ -> try_add alloc free acc | _ -> acc)) acc matches in loop acc xs | _ -> loop acc xs in List.sort compare (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l)) let rec iterate str = function [] -> [] | (x,l)::xs -> List.fold_left (function rest -> function info -> let (same,diff) = List.partition (function (x1,l1) -> l1 = info) rest in match same with [(files,info)] -> (x::files,info)::diff | _ -> ([x],info)::diff) (iterate str xs) (detect_alloc_free str l) (* ------------------------------------------------------------------------ *) (* The following prints that information *) let print_output l = List.iter (function (files,(a,fs)) -> List.iter (function x -> Printf.printf "%s\n" x) files; Printf.printf " alloc: %s, free: %s\n" a (String.concat ", " fs); Printf.printf "\n") l (* ------------------------------------------------------------------------ *) (* The following makes a semantic patch for that information *) let sedify o generic_file dir l = List.iter (function (files,(a,fs)) -> match fs with [f] -> let _ = Sys.command (Printf.sprintf "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s.cocci\n" a generic_file f dir a f) in () | _ -> ()) l; List.iter (function (files,(a,fs)) -> match fs with [f] -> Printf.fprintf o "mono_spatch_linux %s-%s.cocci &\n" a f | _ -> ()) l let collect_allocs l = let union = List.fold_left (function rest -> function x -> if List.mem x rest then rest else x::rest) in List.fold_left (function rest -> function (files,(a,fs)) -> let (same,diff) = List.partition (function (a1,fs1) -> a = a1) rest in match same with [(a1,fs1)] -> (a,union fs fs1)::diff | [] -> (a,fs)::rest | _ -> failwith "not possible") [] l let sedify_ors o generic_file dir l = let l = collect_allocs l in List.iter (function (a,fs) -> match fs with [_] | [] -> () | (f::_) -> let sfs = Printf.sprintf "\"\\\\\\(%s\\\\\\)\"" (String.concat "\\\\\\|" fs) in let _ = Sys.command (Printf.sprintf "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s_et_al.cocci\n" a generic_file sfs dir a f) in ()) l; List.iter (function (a,fs) -> match fs with [_] | [] -> () | (f::_) -> Printf.fprintf o "mono_spatch_linux %s-%s_et_al.cocci &\n" a f) l (* ------------------------------------------------------------------------ *) let sed = ref false let gen = ref "generic2.cocci" let dir = ref "p2" let file = ref "" let str = ref "detected allocator" let options = [ "-sed", Arg.Set sed, "sed output"; "-sp", Arg.String (function x -> gen := x), "detection string"; "-str", Arg.String (function x -> str := x), "cocci file for use with sed"; "-dir", Arg.String (function x -> dir := x), "dir for sed output"; ] let usage = "" let _ = Arg.parse (Arg.align options) (fun x -> file := x) usage; let i = open_in !file in let l = collect i in close_in i; let l = split l in let l = iterate !str l in (if !sed then begin let o = open_out (Printf.sprintf "%s/files" !dir) in Printf.fprintf o "#! /bin/sh\n\n"; sedify o !gen !dir l; sedify_ors o !gen !dir l; Printf.fprintf o "\nwait\n/bin/rm tmp*out\n"; close_out o end); if not !sed then print_output l coccinelle-1.0.0-rc19/tools/all.opt.itarget0000644000175000017500000000021612247437436017461 0ustar eugeneugengitgrep.native gitsort.native process_isoprofile.native alloc_free.native bridge.native spp.native splitpatch.native extract_c_and_res.native coccinelle-1.0.0-rc19/tools/README.splitpatch0000644000175000017500000001311412247437436017562 0ustar eugeneugenSplitpatch is a program for splitting a set of diffs found in a single file according to the maintainers and then submitting the resulting patches. Splitpatch does not require that the diffs were produced using Coccinelle. Nevertheless, it is particularly useful when working with semantic patches, as these typically have an impact across the entire source code. Splitpatch is completely Linux dependent, and relies on the Linux tools checkpatch.pl and get_maintainers.pl. Splitpatch also relies on git send-email. We have had to modify this program, to extract To information from each patch. This modified version is currently called cocci-send-email.perl, and is installed with splitpatch. 1. Configuring splitpatch Splitpatch needs some information about the environment, which it looks for in the file .splitpatch in your home directory. An example configuration file, including the complete set of options, is as follows: from = Julia Lawall git_tree = /var/linuxes/linux-next git_options = --cc=kernel-janitors@vger.kernel.org --suppress-cc=self prefix_before = /var/linuxes/linux-next prefix_after = /var/julia/linuxcopy All of these options, and indeed the .splitpatch file itself, are optional, in at least some situations. These are described in more detail as follows: * from: Your patches will appear to come from this address. Splitpatch makes three attempts to find the from address. These are, in order of increasing priority: 1) The first Signed-off-by in the message file (the message file is defined below), 2) The from information in .git/config if the current directory or an ancestor of the current directory has a .git subdirectory, 3) The from information in ~/.splitpatch. * git_tree: This is the directory containing the root of your Linux distribution. This directory is expected to have a scripts subdirectory in which checkpatch.pl and get_maintainers.pl are found. Splitpatch makes two attempts to find this information. These are, in order of increasing priority: 1) The ancestor directory having .git as a subdirectory, 2) The git_tree information in ~/.splitpatch * git_options: These are any options that you would always like to pass along to git. This is only useful if you use splitpatch from a directory that is not part of your Linux source tree. If splitpatch is used from within the Linux source tree, the git options found in .git/config will be used as well, regardless of whether or not some git_options are provided in ~/.splitpatch * prefix_before, prefix_after: These are substrings to remove from the --- and +++ lines of each diff. These options are probably not useful if you are managing your work using git. Arguments for git send-email (cocci-send-email.perl) can also be passed on the splitpatch command line. Anything that starts with - on the splitpatch command line is interpreted as an argument to git send-email (cocci-send-email.perl). Finally, any further arguments can be passed to the generated command script (see send.cmd below). 2. Using splitpatch Beside any arguments for git send-email, the only argument to splitpatch is a file containing a sequence of diffs. The diffs may be in any order and may be produced in any manner. Each diff should start with the diff command, as generated by Coccinelle or by git diff. The file should not contain diffstat information, as that will be computed. The file may have any name, but we assume that it is called send. If desired, this file name may have an extension, such as send.txt. Given the file name send, splitpatch looks for a file send.msg in the same directory (send.txt would also cause splitpatch to look for send.msg). The file send.msg should contain a subject line (which must be a single line), an optional cover letter, and a commit log message. The sections should be separated by ---. An example of a .msg file is as follows: Eliminate memory leak --- These patches eliminate memory leaks in the uses of various functions. --- Allocated memory should be freed before dropping pointers to it. Signed-off-by: Julia Lawall --- If send.msg has three sections, the first is the subject, the second is the cover letter, and the third is the commit log message. If send.msg has only two sections, the first is the subject and the second is the commit log message. In each section the first and last blank line, if any, is dropped. Running splitpatch send generates a number of files. These are send.cmd, send.cover (if a cover letter was specified), and sendn for various values of n starting with 1. * send.cmd is the command line to use to send the patches. Patches are sent as threaded messages if a cover letter is specified and unthreaded messages if no cover letter is specified. * send.cover contains the cover letter in mailbox format. The destination of the cover letter is the intersection of the destinations of all of the patches. This will normally be at least linux-kernel@vger.kernel.org. * send1 ... sendn contains the n patches. Patches include the subject, commit log message, diffstat information, and the diff itself. The destination of each patch is determined using get_maintainers.pl. Each patch is checked using checkpatch.pl. This may take a little time. 3. Miscellaneous Often, it may be useful to specialize the commit log messages of the individual patches in some way. The sendn files may therefore be edited as needed. Rerunning splitpatch will, however, overwrite the generated sendn files. Indeed, there is no guarantee that the patches will continue to be distributed among the sendn files in the same way. coccinelle-1.0.0-rc19/tools/gitgrep.ml0000644000175000017500000001506412247442616016525 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./gitgrep.ml" (* adjust as convenient *) let prefix = "/tmp/" let prefix = "" (* The -grouped option means that all - and + code must appear in a single contiguous block of - + code. This option has no effect on the other kinds of patterns, ie Changelog (C) or Context (@) *) (* example: gitgrep -grouped -maxlen 25 - "[A-Z][A-Z]+" + "[A-Z][A-Z]+" usb_21_22 *) type dir = Minus | Plus | Context | ChangeLog type res = Git of string | Block of int * string let grouped = ref false let maxlen = ref None let space = Str.regexp " " let matches pattern line = try let _ = Str.search_forward pattern line 0 in true with Not_found -> false let res = ref [] let scan dir pattern i = let rec loop skipping cl git = let line = input_line i in match Str.split space line with ["commit";git] -> loop false true git | "diff"::_ -> loop skipping false git | _ -> if String.length line > 0 && not skipping && ((String.get line 0 = '-' && dir = Minus) or (String.get line 0 = '+' && dir = Plus) or (cl && dir = ChangeLog) or (not (String.get line 0 = '-') && not (String.get line 0 = '+') && dir = Context)) && matches pattern line then (res := Git(git)::!res; loop true cl git) else loop skipping cl git in loop false false "" (* for Minus and Plus directions only *) let scan_grouped dir pattern i = let block = ref 0 in (* mp = true in minus-plus region *) let rec loop mp git = let line = input_line i in match Str.split space line with ["commit";git] -> loop false git | "diff"::_ -> loop false git | _ -> if String.length line > 0 then let first_char = String.get line 0 in let new_mp = match first_char with '-' | '+' -> (if not mp then block := !block + 1; true) | _ -> false in match (first_char,dir) with ('-',Minus) | ('+',Plus) -> let info = Block(!block,git) in (if matches pattern line && not (List.mem info !res) then res := info::!res); loop new_mp git | _ -> loop new_mp git else loop mp git in loop false "" let scan_line max i = let rec loop skipping num git = let line = input_line i in match Str.split space line with ["commit";git1] -> loop false (-1) git1 | "diff"::_ -> if num > max && not skipping then (res:=Git(git)::!res;loop true (num+1) git) else loop skipping (if num = (-1) then 1 else num+1) git | _ -> if num > max && not skipping then (res:=Git(git)::!res;loop true (num+1) git) else loop skipping (if num = (-1) then num else num+1) git in loop false (-1) "" let dot = Str.regexp "\\." let open_git file = let tmp = prefix^file in if Sys.file_exists tmp then open_in tmp else match List.rev (Str.split dot file) with last::rest -> let last_int = int_of_string last in if last_int = 0 then failwith "can't go back one version from 0; make the log file by hand"; let prev = String.concat "." (List.rev ((string_of_int (last_int-1))::rest)) in let _ = Sys.command (Printf.sprintf "git log -p v%s..v%s > %s" prev file tmp) in open_in tmp | _ -> open_in file let rec split_args = function [] -> [] | "-grouped"::rest -> grouped := true; split_args rest | "-maxlen"::len::rest -> maxlen := Some (int_of_string len); split_args rest | "-"::pattern::rest -> (Minus,Str.regexp pattern) :: split_args rest | "+"::pattern::rest -> (Plus,Str.regexp pattern) :: split_args rest | "@"::pattern::rest -> (Context,Str.regexp pattern) :: split_args rest | "C"::pattern::rest -> (ChangeLog,Str.regexp pattern) :: split_args rest | _ -> failwith "bad argument list" let process_one (dir,pattern) version = res := []; let i = open_git version in try if !grouped && (dir = Minus or dir = Plus) then scan_grouped dir pattern i else scan dir pattern i with End_of_file -> (close_in i; List.rev !res) let process_len max version = res := []; let i = open_git version in try scan_line max i with End_of_file -> (close_in i; List.rev !res) let inter l1 l2 = List.rev (List.fold_left (function prev -> function (Git(git)) as x -> let rec loop = function [] -> prev | Git(git1)::rest when git = git1 -> x::prev | Block(b1,git1)::rest when git = git1 -> Block(b1,git1)::prev | _::rest -> loop rest in loop l2 | (Block(block,git)) as x -> let rec loop = function [] -> prev | Git(git1)::rest when git = git1 -> x::prev | Block(b1,git1)::rest when block = b1 && git = git1 -> Block(b1,git1)::prev | _::rest -> loop rest in loop l2) [] l1) let _ = if Array.length Sys.argv < 4 then failwith "arguments: -/+/@/C pattern -/+/@/C pattern ... version"; let args = List.tl(Array.to_list Sys.argv) in let version = List.hd(List.rev args) in let pairs = List.rev(List.tl(List.rev args)) in let requirements = split_args pairs in let res = List.map (function Git x -> x | Block (_,x) -> x) (List.fold_left (function all -> function pattern -> inter (process_one pattern version) all) (process_one (List.hd requirements) version) (List.tl requirements)) in let res = if !grouped then List.rev (List.fold_left (function prev -> function x -> if List.mem x prev then prev else x::prev) [] res) else res in let res = match !maxlen with None -> res | Some max -> let badgits = process_len max version in List.filter (function x -> not(List.mem (Git(x)) badgits)) res in List.iter (function name -> Printf.printf "%s\n" name) res coccinelle-1.0.0-rc19/tools/distributed/0000755000175000017500000000000012247437436017052 5ustar eugeneugencoccinelle-1.0.0-rc19/tools/distributed/README0000644000175000017500000000106012247437436017727 0ustar eugeneugenThis directory contains code to distribute cpatch among multiple processors. To adjust the actual call to spatch, modify the file spatch_linux_script. spatch_linux.c has to be updated with the explicit path of the scripts (spatch_linux_script and cleanup_script). Normally, after running make and make install, spatch_linux foo.cocci will make 9 processes applying foo.cocci to the files in the directory mentioned in spatch_linux_script. The result will be in foo. spatch_linux -processes n foo.cocci will do the same, but for n processes rather than 9. coccinelle-1.0.0-rc19/tools/distributed/cleanup.ml0000644000175000017500000000422112247437436021032 0ustar eugeneugenlet read_to_diff i = let lines = ref [] in let rec loop _ = let l = input_line i in if Str.string_match (Str.regexp "diff -u -p ") l 0 then (List.rev !lines,Some l) else (lines := l::!lines; loop ()) in try loop() with End_of_file -> (List.rev !lines,None) let get_file l = (* l is a diff line *) match Str.split (Str.regexp " ") l with [_diff;_u;_p;old;_new] -> old | _ -> failwith "bad diff line" let get_files prefix = let files = Array.to_list(Sys.readdir(Sys.getcwd())) in let relevant name = let rel_re = Str.regexp "\\(.*\\)\\.[0-9]+\\.out" in if Str.string_match rel_re name 0 then let pref = Str.matched_group 1 name in pref = prefix else false in List.filter relevant files let process_file fl = let i = open_in fl in let elements = ref [] in (match read_to_diff i with (_,Some first_line) -> let rec loop diff = let (cur,more) = read_to_diff i in elements := (get_file diff,diff::cur) :: !elements; match more with Some next_line -> loop next_line | None -> () in loop first_line | _ -> ()); (* file is empty *) close_in i; !elements let process_all_files files out = let elements = List.sort compare (List.concat (List.map process_file files)) in match elements with [] -> (* only python output *) let fl = String.concat " " (List.sort compare files) in let _ = Sys.command (Printf.sprintf "cat %s > %s" fl out) in () | _ -> let o = open_out out in List.iter (function (_,code) -> List.iter (function x -> Printf.fprintf o "%s\n" x) code) elements let _ = let arg = List.hd(List.tl(Array.to_list Sys.argv)) in Printf.printf "arg %s\n" arg; let arg = Filename.chop_extension arg in let files = get_files arg in process_all_files files (arg^".out"); let tmp_files = String.concat " " (List.map (function x -> "tmp."^x) (List.sort compare files)) in let _ = Sys.command (Printf.sprintf "cat %s > %s.tmp" tmp_files arg) in List.iter (function file -> let _ = Sys.command (Printf.sprintf "/bin/rm %s" file) in let _ = Sys.command (Printf.sprintf "/bin/rm tmp.%s" file) in ()) files coccinelle-1.0.0-rc19/tools/distributed/spatch_linux.c0000644000175000017500000000374512247437436021730 0ustar eugeneugen#include #include #include #include #define MAX 9 #ifndef HOME #define HOME "/home/julia/coccinelle/tools/distributed/" #endif void do_child(int id, unsigned int argc, char **argv, int max, char *script) { int i; char **new_args = malloc(sizeof(char*) * (argc + 5)); char string1[50],string2[50]; for(i=1; i!=argc; i++) { new_args[i+4] = argv[i]; } new_args[i+4] = NULL; new_args[0] = "nothing"; new_args[1] = new_args[5]; // cocci file must be first new_args[2] = "-index"; sprintf(string1, "%d", id); new_args[3] = string1; // processor number must be third new_args[4] = "-max"; sprintf(string2, "%d", max); new_args[5] = string2; execvp(script,new_args); printf("tried to execute %s\n",HOME "spatch_linux_script"); perror("exec failure"); _exit(0); } void cleanup(char **argv) { char **new_args = malloc(sizeof(char*) * 3); new_args[0] = "nothing"; new_args[1] = argv[1]; new_args[2] = NULL; printf ("doing cleanup on %s\n",argv[1]); execvp(HOME "cleanup",new_args); } int main(unsigned int argc, char **argv) { int i, start=0, max; char script[150]; // interpret the arguments max = MAX; if (!strcmp(argv[1],"-processes")) {max = atoi(argv[2]); start = 2;} if (!strcmp(argv[1],"-script")) { strcpy(script,HOME); strcat(script,argv[2]); start = 2; } else strcpy(script,HOME "spatch_linux_script"); if (!strcmp(argv[1],"--help")) { printf("spatch_linux [-processes n] foo.cocci ...\n"); exit (0); } // run the child processes int pid; for(i=0;i!=max;i++) { if (!(pid=fork())) { // child do_child(i,argc-start,&argv[start],max,script); } else if (pid > 0) { // printf("Child born: %d\n", pid); } else printf("*** forking error ***\n"); } int status; for(i=0;i!=max;i++) { pid = wait(&status); // printf("Child dead: %d -- %d\n", pid,status); } cleanup(&argv[start]); } coccinelle-1.0.0-rc19/tools/distributed/spatch_linux_script0000755000175000017500000000042012247437436023061 0ustar eugeneugen#!/bin/tcsh setenv PYTHONPATH ${COCCINELLE_HOME}/python setenv LD_LIBRARY_PATH ${COCCINELLE_HOME}/pycaml # -allow_inconsistent_paths (spatch.opt -quiet -timeout 120 \ -dir /var/linuxes/linux-next -use_glimpse -cocci_file $* > ${1:r}.${3}.out) \ >& tmp.${1:r}.${3}.out coccinelle-1.0.0-rc19/tools/distributed/Makefile0000644000175000017500000000045312247437436020514 0ustar eugeneugenspatch_linux: spatch_linux.c gcc -D HOME="\"${COCCINELLE_HOME}/tools/distributed/\"" -o spatch_linux spatch_linux.c install: spatch_linux cleanup cp spatch_linux /usr/local/bin cleanup: cleanup.ml ocamlc -o cleanup str.cma cleanup.ml clean: rm -f cleanup cleanup.cmi cleanup.cmo spatch_linux coccinelle-1.0.0-rc19/tools/licensify.ml0000644000175000017500000001137712247442616017054 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./licensify.ml" let lines = ["Copyright 2012, INRIA"; "Julia Lawall, Gilles Muller"; "Copyright 2010-2011, INRIA, University of Copenhagen"; "Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix"; "Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen"; "Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix"; "This file is part of Coccinelle."; ""; "Coccinelle is free software: you can redistribute it and/or modify"; "it under the terms of the GNU General Public License as published by"; "the Free Software Foundation, according to version 2 of the License."; ""; "Coccinelle is distributed in the hope that it will be useful,"; "but WITHOUT ANY WARRANTY; without even the implied warranty of"; "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"; "GNU General Public License for more details."; ""; "You should have received a copy of the GNU General Public License"; "along with Coccinelle. If not, see ."; ""; "The authors reserve the right to distribute this or future versions of"; "Coccinelle under other licenses." ] let comment_lines = List.map (function x -> if x <> "" then " * "^x else " *") lines let cpp_lines = "/*" :: comment_lines @ [" */"] let ml_lines = "(*" :: comment_lines @ [" *)"] let make_lines = (List.map (function x -> if x <> "" then "# "^x else "#") lines) let c_lines = (List.map (function x -> if x <> "" then "// "^x else "//") lines) let do_one file = let lines = if Filename.check_suffix file ".cocci" then c_lines else if Filename.check_suffix file ".mly" then cpp_lines else if Filename.check_suffix file ".ml" then ml_lines else if Filename.check_suffix file ".mli" then ml_lines else if Filename.check_suffix file ".mll" then ml_lines else if Filename.check_suffix file ".pl" then make_lines else if Filename.basename file = "Makefile" then make_lines else failwith (Printf.sprintf "unknown file type: %s" file) in let tmpfl = Filename.temp_file "cocci_licence" "orig" in let _ = Sys.command (Printf.sprintf "cp %s %s" file tmpfl) in let o = open_out file in List.iter (function l -> Printf.fprintf o "%s\n" l) lines; Printf.fprintf o "\n"; Printf.fprintf o "\n"; if List.exists (Filename.check_suffix file) [ ".ml" ; ".mli" ; ".mll" ] then Printf.fprintf o "# 0 \"%s\"\n" file; close_out o; let _ = Sys.command (Printf.sprintf "cat %s >> %s" tmpfl file) in Sys.remove tmpfl (* pad's modif *) let (+>) o f = f o let cat file = let chan = open_in file in let rec cat_aux acc () = (* cant do input_line chan::aux() cos ocaml eval from right to left ! *) let (b, l) = try (true, input_line chan) with End_of_file -> (false, "") in if b then cat_aux (l::acc) () else acc in cat_aux [] () +> List.rev +> (fun x -> close_in chan; x) let rec process dir = let files = try List.map (function fl -> dir^"/"^fl) (Array.to_list(Sys.readdir dir)) with Sys_error _ -> [] in List.iter (function file -> try let xs = cat file in if List.exists (fun s -> s = "* This file is part of Coccinelle." || s = "# This file is part of Coccinelle." || s = "// This file is part of Coccinelle." || Str.string_match (Str.regexp_string "Copyright") s 0 ) xs then print_string ("already processed: " ^ file ^ "\n") else begin do_one file; print_string ("processed: " ^ file ^ "\n"); end with _ -> print_string ("skipped: " ^ file ^ "\n"); () ) files; (* pad: no recursive call in directory List.iter process files *) () let _ = process "." coccinelle-1.0.0-rc19/tools/splitpatch.ml0000644000175000017500000004615512247442616017244 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./splitpatch.ml" (* split patch per file *) (* ------------------------------------------------------------------------ *) (* The following are a reminder of what this information should look like. These values are not used. See the README file for information on how to create a .splitpatch file in your home directory. *) let from = ref "email@xyz.org" let git_tree = ref "/var/linuxes/linux-next" let git_options = ref "--cc=kernel-janitors@vger.kernel.org --suppress-cc=self" let not_linux = ref "--suppress-cc=self" let prefix_before = ref (Some "/var/linuxes/linux-next") let prefix_after = ref (Some "/var/julia/linuxcopy") (* ------------------------------------------------------------------------ *) (* misc *) let process_output_to_list2 = fun command -> let chan = Unix.open_process_in command in let res = ref ([] : string list) in let rec process_otl_aux () = let e = input_line chan in res := e::!res; process_otl_aux() in try process_otl_aux () with End_of_file -> let stat = Unix.close_process_in chan in (List.rev !res,stat) let cmd_to_list command = let (l,_) = process_output_to_list2 command in l let process_output_to_list = cmd_to_list let cmd_to_list_and_status = process_output_to_list2 let safe_chop_extension s = try Filename.chop_extension s with _ -> s let safe_get_extension s = match List.rev (Str.split (Str.regexp_string ".") s) with ext::_::rest -> Some (String.concat "." (List.rev rest)) | _ -> None let intersect l1 l2 = List.rev (List.fold_left (fun i cur -> if List.mem cur l2 then cur :: i else i) [] l1) let union l1 l2 = List.rev (List.fold_left (fun i cur -> if not(List.mem cur l2) then cur :: i else i) l2 l1) (* ------------------------------------------------------------------------ *) (* set configuration variables *) let from_from_template template = let signed_offs = cmd_to_list (Printf.sprintf "grep Signed-off-by: %s" template) in match signed_offs with x::xs -> String.concat " " (Str.split (Str.regexp "[ \t]+") x) | _ -> failwith "No Signed-off-by in template file" let from_from_gitconfig path = let config = path^"/.git/config" in if Sys.file_exists config then let i = open_in config in let rec inner_loop _ = let l = input_line i in match Str.split (Str.regexp "[ \t]+") l with "from"::"="::f -> from := String.concat " " f | _ -> if String.length l >= 1 && String.get l 0 = '[' then () else inner_loop() in let rec outer_loop _ = let l = input_line i in if l = "[sendemail]" then inner_loop() else outer_loop() in (try outer_loop() with Not_found -> ()); close_in i let read_configs template = let temporary_git_tree = ref None in git_options := ""; prefix_before := None; prefix_after := None; (* get information in message template, lowest priority *) from := from_from_template template; (* get information in git config *) let rec loop = function "/" -> () | path -> if Sys.file_exists ".git" then begin temporary_git_tree := Some path; from_from_gitconfig path end else loop (Filename.dirname path) in loop (Sys.getcwd()); (* get information from .splitpatch *) let home = List.hd(cmd_to_list "ls -d ~") in let config = home^"/.splitpatch" in (if Sys.file_exists config then let i = open_in config in let rec loop _ = let l = input_line i in (* bounded split doesn't split at = in value part *) (match Str.bounded_split (Str.regexp "[ \t]*=[ \t]*") l 2 with ["from";s] -> from := s | ["git_tree";s] -> temporary_git_tree := Some s | ["git_options";s] -> git_options := s; not_linux := s | ["prefix_before";s] -> prefix_before := Some s | ["prefix_after";s] -> prefix_after := Some s | _ -> Printf.fprintf stderr "unknown line: %s\n" l); loop() in try loop() with End_of_file -> close_in i); match !temporary_git_tree with None -> failwith "Unable to find Linux source tree" | Some g -> git_tree := g (* ------------------------------------------------------------------------ *) let maintainer_command file = Printf.sprintf "cd %s; scripts/get_maintainer.pl --nokeywords --separator , --nogit --nogit-fallback --norolestats -f %s" !git_tree file let maintainer_list_command file = Printf.sprintf "cd %s; scripts/get_maintainer.pl --nokeywords --nogit --nogit-fallback --norolestats --nom -f %s" !git_tree file let subsystem_command file = Printf.sprintf "cd %s; scripts/get_maintainer.pl --nokeywords --nogit-fallback --subsystem --norolestats -f %s | grep -v @" !git_tree file let subject_command file = Printf.sprintf "cd %s; git log --pretty=oneline --abbrev-commit %s" !git_tree file let checkpatch_command file = Printf.sprintf "cd %s; scripts/checkpatch.pl %s" !git_tree file let default_string = "THE REST" (* split by file *) (* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *) (* Template file processing *) let read_up_to_dashes i = let lines = ref [] in let rec loop _ = let l = input_line i in if l = "---" then () else begin lines := l :: !lines; loop() end in (try loop() with End_of_file -> ()); let lines = match !lines with ""::lines -> List.rev lines (* drop last line if blank *) | lines -> List.rev lines in match lines with ""::lines -> lines (* drop first line if blank *) | _ -> lines let get_template_information file = let i = open_in file in (* subject *) let subject = read_up_to_dashes i in match subject with [subject] -> let cover = read_up_to_dashes i in let message = read_up_to_dashes i in if message = [] then (subject,None,cover) else (subject,Some cover,message) | _ -> failwith ("Subject must be exactly one line "^ (string_of_int (List.length subject))) (* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *) (* Patch processing *) let spaces = Str.regexp "[ \t]+" let fix_before_after l prefix = function Some old_prefix -> (match Str.split spaces l with ("diff"|"+++"|"---")::_ -> (match Str.split (Str.regexp old_prefix) l with [a;b] -> (match Str.split_delim (Str.regexp ("[ \t]"^prefix)) a with [_;""] -> a^b (* prefix is already there *) | _ -> a^prefix^b) | _ -> l) | _ -> l) | _ -> l let fix_date l = match Str.split spaces l with (("+++"|"---") as a)::path::rest -> Printf.sprintf "%s %s" a path | _ -> l (* ------------------------------------------------------------------------ *) let is_diff = Str.regexp "diff " let split_patch i = let patches = ref [] in let cur = ref [] in let get_size l = match Str.split_delim (Str.regexp ",") l with [_;size] -> int_of_string size | [_] -> 1 | _ -> failwith ("bad size: "^l) in let rec read_diff_or_atat _ = let l = input_line i in let l = fix_date(fix_before_after l "a" !prefix_before) in let l = fix_date(fix_before_after l "b" !prefix_after) in match Str.split spaces l with "diff"::_ -> (if List.length !cur > 0 then patches := List.rev !cur :: !patches); cur := [l]; read_diff() | "@@"::min::pl::"@@"::rest -> let msize = get_size min in let psize = get_size pl in cur := l :: !cur; read_hunk msize psize | "\\"::_ -> cur := l :: !cur; read_diff_or_atat() | _ -> failwith "expected diff or @@ (diffstat information should not be present)" and read_diff _ = let l = input_line i in let l = fix_date(fix_before_after l "a" !prefix_before) in let l = fix_date(fix_before_after l "b" !prefix_after) in cur := l :: !cur; match Str.split spaces l with "+++"::_ -> read_diff_or_atat() | _ -> read_diff() and read_hunk msize psize = if msize = 0 && psize = 0 then read_diff_or_atat() else let l = input_line i in cur := l :: !cur; match String.get l 0 with '-' -> read_hunk (msize - 1) psize | '+' -> read_hunk msize (psize - 1) | _ -> read_hunk (msize - 1) (psize - 1) in try read_diff_or_atat() with End_of_file -> List.rev ((List.rev !cur)::!patches) (* ------------------------------------------------------------------------ *) let uctr = ref 0 let found_a_maintainer = ref false let common_prefix l1 l2 = let rec loop = function ([],_) | (_,[]) -> [] | (x::xs,y::ys) when x = y -> x :: (loop (xs,ys)) | _ -> [] in match loop (l1,l2) with [] -> None | res -> Some (String.concat "/" res) let find_common_path file cell = let fs = Str.split (Str.regexp "/") file in let rec loop = function [] -> let c1 = ref [] in cell := ((ref file),c1)::!cell; c1 | (f,c1)::xs -> (match common_prefix fs (Str.split (Str.regexp "/") !f) with None -> loop xs | Some cp -> f := cp; c1) in loop !cell let resolve_maintainers patches = let maintainer_table = Hashtbl.create (List.length patches) in List.iter (function diff_line::rest -> (match Str.split (Str.regexp " a/") diff_line with [before;after] -> (match Str.split spaces after with file::_ -> let maintainers = match (cmd_to_list (maintainer_command file)) with m::_ -> found_a_maintainer := true; m | [] -> (* maybe the file is new? *) (match (cmd_to_list (maintainer_command (Filename.dirname file))) with m::_ -> found_a_maintainer := true; m | [] -> uctr := !uctr + 1; "unknown"^(string_of_int !uctr)) in let subsystems = cmd_to_list (subsystem_command file) in let info = (subsystems,maintainers) in let cell = try Hashtbl.find maintainer_table info with Not_found -> let cell = ref [] in Hashtbl.add maintainer_table info cell; cell in let cell1 = find_common_path file cell in cell1 := (file,(diff_line :: rest)) :: !cell1 | _ -> failwith "filename not found") | _ -> failwith (Printf.sprintf "prefix a/ not found in %s" diff_line)) | _ -> failwith "bad diff line") patches; maintainer_table (* ------------------------------------------------------------------------ *) (* most common subject from the git logs *) let last_char s = String.get s ((String.length s) - 1) let get_counts l = let tbl = Hashtbl.create 101 in let ct = ref 0 in let max = ((List.length l) / 10) + 1 in (* 10 ranges *) List.iter (function file -> ct := !ct + 1; let cell = try Hashtbl.find tbl file with Not_found -> let cell = ref 0.0 in Hashtbl.add tbl file cell; cell in (* only use 5 ranges *) let weight = 1. /. (float_of_int ((!ct / (max * 2)) + 1)) in cell := !cell +. weight) l; let weighted = List.rev (List.sort compare (Hashtbl.fold (fun k v rest -> (!v,k)::rest) tbl [])) in let rec loop n = function [] -> [] | (_,k)::rest -> (k,n) :: (loop (n+1) rest) in loop 1 weighted let get_most_common_subject files default = let all = List.map (function file -> cmd_to_list (subject_command file)) files in if List.exists (function x -> x = []) all then default^":" else let entries = List.map (function entries -> List.map (function line -> match Str.split (Str.regexp " +") line with [] -> failwith ("bad git log line: " ^ line) | _::rest -> let rec loop = function [] -> [] | x::xs -> if last_char x = ':' then x :: loop xs else [] in loop rest) entries) all in let common_entries = List.fold_left intersect (List.hd entries) (List.tl entries) in let entries = List.map get_counts entries in let common_entry_counts = List.sort compare (List.map (function entry -> (List.fold_left (+) 0 (List.map (List.assoc entry) entries), entry)) common_entries) in match common_entry_counts with [] -> default^":" | (_,x)::_ -> String.concat " " x (* ------------------------------------------------------------------------ *) let print_all o l = List.iter (function x -> Printf.fprintf o "%s\n" x) l let make_mail_header o date maintainers ctr number subject = Printf.fprintf o "From nobody %s\n" date; Printf.fprintf o "From: %s\n" !from; (match Str.split (Str.regexp_string ",") maintainers with [x] -> Printf.fprintf o "To: %s\n" x | x::xs -> Printf.fprintf o "To: %s\n" x; Printf.fprintf o "Cc: %s\n" (String.concat "," xs) | _ -> failwith "no maintainers"); if number = 1 then Printf.fprintf o "Subject: [PATCH] %s\n\n" subject else Printf.fprintf o "Subject: [PATCH %d/%d] %s\n\n" ctr number subject let make_message_files subject cover message date maintainer_table patch front add_ext nomerge = let ctr = ref 0 in let elements = Hashtbl.fold (function (services,maintainers) -> function diffs -> function rest -> if services=[default_string] or nomerge then (* if no maintainer, then one file per diff *) let diffs = List.concat (List.map (function (common,diffs) -> !diffs) !diffs) in (List.map (function (file,diff) -> ctr := !ctr + 1; let subject = get_most_common_subject [file] file in (subject,(!ctr,true,maintainers,[file],[diff]))) (List.rev diffs)) @ rest else (List.map (function (common,diffs) -> ctr := !ctr + 1; let (files,diffs) = List.split (List.rev !diffs) in let subject = get_most_common_subject files !common in (subject,(!ctr,false,maintainers,files,diffs))) !diffs) @ rest) maintainer_table [] in let number = List.length elements in let generated = List.map (function (common,(ctr,the_rest,maintainers,files,diffs)) -> let output_file = add_ext(Printf.sprintf "%s%d" front ctr) in let o = open_out output_file in make_mail_header o date maintainers ctr number (Printf.sprintf "%s %s" common subject); print_all o message; Printf.fprintf o "\n---\n"; let (nm,o1) = Filename.open_temp_file "patch" "patch" in List.iter (print_all o1) (List.rev diffs); close_out o1; let diffstat = cmd_to_list (Printf.sprintf "diffstat -p1 < %s ; /bin/rm %s" nm nm) in List.iter (print_all o) [diffstat]; Printf.fprintf o "\n"; List.iter (print_all o) diffs; Printf.fprintf o "\n"; close_out o; let (info,stat) = cmd_to_list_and_status (checkpatch_command ((Sys.getcwd())^"/"^output_file)) in (if not(stat = Unix.WEXITED 0) then (print_all stderr info; Printf.fprintf stderr "\n")); output_file) (List.rev elements) in let later = add_ext(Printf.sprintf "%s%d" front (number+1)) in if Sys.file_exists later then Printf.fprintf stderr "Warning: %s and other files may be left over from a previous run\n" later; generated let make_cover_file n subject cover front date maintainer_table = match cover with None -> () | Some cover -> let common_maintainers = let start = ref true in (Hashtbl.fold (function (services,maintainers) -> function diffs -> function rest -> let cur = Str.split (Str.regexp_string ",") maintainers in if !start then begin start := false; cur end else intersect cur rest) maintainer_table []) in let maintainers_and_lists = Hashtbl.fold (function (services,maintainers) -> function diffs -> function rest -> let files = List.map (function (file,_) -> !file) !diffs in List.fold_left (function prev -> function file -> union (cmd_to_list (maintainer_list_command file)) prev) rest files) maintainer_table common_maintainers in let maintainers_and_lists = String.concat "," maintainers_and_lists in let output_file = Printf.sprintf "%s.cover" front in let o = open_out output_file in make_mail_header o date maintainers_and_lists 0 n subject; print_all o cover; Printf.fprintf o "\n"; close_out o let mail_sender = "git send-email" (* use this when it works *) let mail_sender = "cocci-send-email.perl" let generate_command front cover generated = let output_file = front^".cmd" in let o = open_out output_file in (match cover with None -> Printf.fprintf o "%s --auto-to --no-thread --from=\"%s\" %s $* %s\n" mail_sender !from !git_options (String.concat " " generated) | Some cover -> Printf.fprintf o "%s --auto-to --thread --from=\"%s\" %s $* %s\n" mail_sender !from !git_options (String.concat " " ((front^".cover") :: generated))); close_out o let make_output_files subject cover message maintainer_table patch nomerge = let date = List.hd (cmd_to_list "date") in let front = safe_chop_extension patch in let add_ext = match safe_get_extension patch with Some ext -> (function s -> s ^ "." ^ ext) | None -> (function s -> s) in let generated = make_message_files subject cover message date maintainer_table patch front add_ext nomerge in make_cover_file (List.length generated) subject cover front date maintainer_table; generate_command front cover generated (* ------------------------------------------------------------------------ *) let nomerge = ref false let parse_args l = let (other_args,files) = List.partition (function a -> String.length a > 1 && String.get a 0 = '-') l in let (nomergep,other_args) = List.partition (function a -> a = "-nomerge") other_args in (if not(nomergep = []) then nomerge := true); match files with [file] -> (file,String.concat " " other_args) | _ -> failwith "Only one file allowed" let _ = let (file,git_args) = parse_args (List.tl (Array.to_list Sys.argv)) in let message_file = (safe_chop_extension file)^".msg" in (* set up environment *) read_configs message_file; (* get message information *) let (subject,cover,message) = get_template_information message_file in (* split patch *) let i = open_in file in let patches = split_patch i in close_in i; let maintainer_table = resolve_maintainers patches in (if !found_a_maintainer = false then git_options := !not_linux); (if not (git_args = "") then git_options := !git_options^" "^git_args); make_output_files subject cover message maintainer_table file !nomerge coccinelle-1.0.0-rc19/tools/dir_stats.ml0000644000175000017500000001330612247442616017055 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./dir_stats.ml" (* for each marked thing, how often does it occur and in what files and directories *) let collect i = let info = ref [] in let rec loop _ = let l = input_line i in (if String.length l > 2 && String.get l 0 = '+' then info := (String.sub l 1 (String.length l - 1))::!info); loop() in try loop() with End_of_file -> List.rev !info let split l = let rec loop acc = function [] -> acc | x::xs -> if String.get x 0 = '+' (* the start of a new file *) then (match Str.split (Str.regexp " ") x with _::x::_ -> loop ((x,[])::acc) xs | _ -> failwith ("no file: "^x)) else let acc = match acc with (file,instances)::rest -> (file,x::instances)::rest | _ -> failwith "not possible" in loop acc xs in let res = List.rev (loop [] l) in List.map (function (x,l) -> (x,List.rev l)) res let detect_alloc_free str l = let try_add a f l = let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in match same with [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff | _ -> (a,[f])::l in let rec loop acc = function [] -> acc | x::xs -> match Str.split (Str.regexp (str^"\", ")) x with _::matches -> let acc = List.fold_left (function acc -> function rest -> (match Str.split (Str.regexp "[, )]+") rest with alloc::free::_ -> try_add alloc free acc | _ -> acc)) acc matches in loop acc xs | _ -> loop acc xs in List.sort compare (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l)) let rec iterate str = function [] -> [] | (x,l)::xs -> List.fold_left (function rest -> function info -> let (same,diff) = List.partition (function (x1,l1) -> l1 = info) rest in match same with [(files,info)] -> (x::files,info)::diff | _ -> ([x],info)::diff) (iterate str xs) (detect_alloc_free str l) (* ------------------------------------------------------------------------ *) let get_dir d = Filename.dirname d let get_subsystem d = let pieces = Str.split (Str.regexp "/") d in let front = List.hd(List.tl pieces) in match front with "arch" | "drivers" -> front ^ "/" ^ (List.hd(List.tl(List.tl pieces))) | _ -> front let rec remdup = function [] -> [] | x::xs -> if List.mem x xs then remdup xs else x :: remdup xs let inc tbl key = let cell = (try let cell = Hashtbl.find tbl key in cell with Not_found -> let c = ref 0 in Hashtbl.add tbl key c; c) in cell := !cell + 1 let files_per_protocol = Hashtbl.create(10) let dirs_per_protocol = Hashtbl.create(10) let subsystems_per_protocol = Hashtbl.create(10) let protocols_per_subsystem = Hashtbl.create(10) let collect_counts l = List.iter (function (files,(a,fs)) -> let how_many_files = List.length files in let how_many_dirs = remdup (List.map get_dir files) in let how_many_subsystems = remdup (List.map get_subsystem files) in let ct = if how_many_files < 10 then how_many_files else ((how_many_files / 10) * 10) in inc files_per_protocol ct; inc dirs_per_protocol (List.length how_many_dirs); inc subsystems_per_protocol (List.length how_many_subsystems); List.iter (inc protocols_per_subsystem) how_many_subsystems) l let print_hashtable f tbl = let l = Hashtbl.fold (function key -> function vl -> function rest -> (key,!vl) :: rest) tbl [] in let l = List.sort compare l in List.iter (function (key,vl) -> Printf.printf " "; f key; Printf.printf ": %d\n" vl) l let print_range_int_hashtable range = print_hashtable (function x -> if x < range then Printf.printf "%d" x else Printf.printf "%d-%d" x (x + range - 1)) let print_int_hashtable = print_hashtable (function x -> Printf.printf "%d" x) let print_string_hashtable = print_hashtable (function x -> Printf.printf "%s" x) let histify _ = Printf.printf "files per protocol:\n"; print_range_int_hashtable 10 files_per_protocol; Printf.printf "dirs per protocol:\n"; print_int_hashtable dirs_per_protocol; Printf.printf "subsystems per protocol:\n"; print_int_hashtable subsystems_per_protocol; Printf.printf "protocols per subsystem:\n"; print_string_hashtable protocols_per_subsystem (* ------------------------------------------------------------------------ *) let dir = ref "p2" let file = ref "" let str = ref "detected allocator" let options = [] let usage = "" let _ = Arg.parse (Arg.align options) (fun x -> file := x) usage; let i = open_in !file in let l = collect i in close_in i; let l = split l in let l = iterate !str l in collect_counts l; histify() coccinelle-1.0.0-rc19/tools/obsolete/0000755000175000017500000000000012247437436016344 5ustar eugeneugencoccinelle-1.0.0-rc19/tools/obsolete/generate_dependencies.ml0000644000175000017500000000542012247437436023177 0ustar eugeneugenopen Common (*****************************************************************************) (* Flags *) (*****************************************************************************) let generate_dependencies dir = let c_info = Common.glob (Filename.concat dir "*.[c]") +> List.map (fun file -> let (x,_) = Parse_c.parse_cache file in let defined = C_info.defined_stuff x in let used = C_info.used_stuff x in let extra = C_info.extra_stuff x in C_info.adjust_used_only_external used defined; file, { C_info.used = used; defined = defined; is_module = extra} ) in let global = C_info.mk_global_definitions_index c_info in c_info +> List.iter (fun (file, used_defined) -> pr2 ("HANDLING : " ^ file); C_info.print_entities used_defined.C_info.used; ); C_info.check_no_duplicate_global_definitions global; let g = C_info.build_graph c_info global (Filename.concat dir "depgraph.dot") in C_info.generate_makefile g (Filename.concat dir "depcocci.dep") (* let path = match xs with | [] -> "/home/pad/kernels/git/linux-2.6/drivers/net" | [x] -> x | _ -> failwith "too much path" in let dirs = if dir then Common.cmd_to_list ("find " ^ path ^ " -type d") +> Kbuild.adjust_dirs else [path] in dirs +> List.iter (fun dir -> *) (* let test_yyy () = Sys.chdir "/home/pad/kernels/git/linux-2.6"; let path="drivers/net" in let c_info = Common.cmd_to_list ("find " ^ path ^ " -name \"*.c\" ") +> List.map (fun file -> let x = cprogram_of_file_cached file in let defined = defined_stuff x in let used = used_stuff x in let extra = extra_stuff x in adjust_used_only_external used defined; file, { used = used; defined = defined; is_module = extra} ) in let global = mk_global_definitions_index c_info in c_info +> List.iter (fun (file, used_defined) -> pr2 ("HANDLING : " ^ file); print_entities used_defined.used; ); check_no_duplicate_global_definitions global (*build_graph c_info global (Filename.concat dir "depgraph.dot");*) *) (*****************************************************************************) (* Main entry point *) (*****************************************************************************) let main () = begin let args = ref [] in let options = [ ] in let usage_msg = "Usage: " ^ basename Sys.argv.(0) ^ " [options]" ^ "\n" ^ "Options are:" in Arg.parse (Arg.align options) (fun x -> args := x::!args) usage_msg; args := List.rev !args; (match (!args) with | [x] -> generate_dependencies x | _ -> Arg.usage (Arg.align options) usage_msg; ) end (*****************************************************************************) let _ = main () coccinelle-1.0.0-rc19/tools/spp.ml0000644000175000017500000000630212247442616015661 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./spp.ml" open Common exception WrongArguments (* could do via a List.filter because cpp flags are simple as it's * "-I/usr/include" not ["-I";"/usr/include"] like in ocaml so no * need to look multiple args. *) let rec cpp_flags_filter xs = match xs with | [] -> [] | x::xs -> (match x with | s when x =~ "-D.*" -> s::cpp_flags_filter xs | s when s =~ "-I.*" -> s::cpp_flags_filter xs | _ -> cpp_flags_filter xs ) let is_compile_command xs = List.mem "-c" xs let source_file xs = xs +> List.filter (fun s -> s =~ ".*\\.c$") let rec fix_args args file = match args with [] -> [] | hd::tail -> if hd = file then (hd^".i") :: tail else hd::fix_args tail file let rec get_outputfile args = match args with [] -> ([],"") | hd::tail -> if hd = "-o" then let (hd',tail') = match tail with hd'::tail' -> (hd',tail') | _ -> raise WrongArguments in (tail', hd') else let (ntail, out) = get_outputfile tail in (hd::ntail, out) let main () = let args = List.tl (Array.to_list Sys.argv) in (*args +> List.iter pr2;*) if is_compile_command args then begin let file = source_file args in (match file with | [file] -> let cpp_flags = cpp_flags_filter args in let cmd2 = (spf "cpp %s %s > %s.i" (Common.join " " cpp_flags) file file) in pr2 cmd2; let ret2 = Sys.command cmd2 in if ret2 > 0 then exit ret2; let sp_args = fix_args args file in let cmd = "spatch " ^ (Common.join " " sp_args) in pr2 cmd; let ret = Sys.command cmd in exit ret | [] -> failwith "could not find name of source file" | x::y::xs -> failwith "multiple source files" ); end else begin let (nargs, outfile) = get_outputfile args in let cmd2 = (spf "cat %s > %s" (Common.join " " nargs) outfile) in pr2 cmd2; Sys.command cmd2 end let _ = main () coccinelle-1.0.0-rc19/tools/gitsort.ml0000644000175000017500000001153612247442616016557 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./gitsort.ml" (* sort a list of git codes such that the most recent comes first *) let git_home = ref "/home/julia/linux-2.6" let unwind_protect f cleanup = try f () with e -> begin cleanup e; raise e end let (with_open_infile: string -> ((in_channel) -> 'a) -> 'a) = fun file f -> let chan = open_in file in unwind_protect (fun () -> let res = f chan in close_in chan; res) (fun e -> close_in chan) (* ----------------------------------------------------------------------- *) let months = [("Jan",1);("Feb",2);("Mar",3);("Apr",4);("May",5);("Jun",6);("Jul",7); ("Aug",8);("Sep",9);("Oct",10);("Nov",11);("Dec",12)] let antimonths = [(1,31);(2,28);(3,31);(4,30);(5,31); (6,30);(7,31);(8,31);(9,30);(10,31); (11,30);(12,31);(0,31)] let normalize (year,month,day,hour,minute,second) = if hour < 0 then let (day,hour) = (day - 1,hour + 24) in if day = 0 then let month = month - 1 in let day = List.assoc month antimonths in let day = if month = 2 && year / 4 * 4 = year && not (year / 100 * 100 = year) then 29 else day in if month = 0 then (year-1,12,day,hour,minute,second) else (year,month,day,hour,minute,second) else (year,month,day,hour,minute,second) else (year,month,day,hour,minute,second) exception Fail of string let read_info code = let _ = Sys.command (Printf.sprintf "pushd %s >& /dev/null ; git log %s^..%s | grep Date: > /tmp/gitsort_info ; popd >& /dev/null" !git_home code code) in with_open_infile "/tmp/gitsort_info" (fun i -> let l = try input_line i with End_of_file -> raise (Fail "bad git file") in match Str.split (Str.regexp " ") l with [date;_;_;weekday;month;day;time;year;offset] -> let day = int_of_string day in let month = List.assoc month months in let year = int_of_string year in (match Str.split (Str.regexp ":") time with [hour;minute;second] -> let hour = int_of_string hour in let minute = int_of_string minute in let second = int_of_string second in let modifier = match String.get offset 0 with '-' -> -1 | '+' -> 1 | _ -> raise (Fail "bad offset") in (if not (String.sub offset 3 2 = "00") then raise (Fail "require 0 minutes difference")); let hour = hour + (modifier * (int_of_string (String.sub offset 1 2))) in normalize (year,month,day,hour,minute,second) | _ -> raise (Fail "bad date2")) | l -> raise (Fail ("bad date1: "^(String.concat "|" l)))) let rec get_dates = function [] -> [] | code::rest -> let date = try Some (read_info code) with Fail s -> Printf.printf "problem in %s: %s\n" code s; None | _ -> Printf.printf "problem in %s\n" code; None in match date with Some date -> (date,code)::(get_dates rest) | None -> get_dates rest let get_codes file = let gits = ref ([] : string list) in with_open_infile file (fun i -> let rec loop _ = let git = try Some (input_line i) with End_of_file -> None in match git with Some x -> gits := x :: !gits; loop() | None -> () in loop ()); List.concat (List.map (function l -> List.filter (* all because I don't know how to make a backslash regexp...*) (function x -> String.length x > 10) (Str.split (Str.regexp "[ \t]+") l)) !gits) let _ = let args = Array.to_list Sys.argv in let file = match args with [_;git_home_info;gits] -> git_home := git_home_info; gits | [_;gits] -> gits | _ -> failwith "args: [git home] git_codes_file" in let codes = get_codes file in let dates = get_dates codes in match List.sort compare dates with (_,last)::prev -> List.iter (function (_,x) -> Printf.printf "%s \\\n" x) (List.rev prev); Printf.printf "%s\n" last | _ -> () coccinelle-1.0.0-rc19/tools/dumper.ml0000644000175000017500000000732412247442616016360 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./dumper.ml" (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). * dumper.ml 1.2 2005/02/06 12:38:21 rich Exp *) open Printf open Obj let rec dump r = if is_int r then string_of_int (magic r : int) else ( (* Block. *) let rec get_fields acc = function | 0 -> acc | n -> let n = n-1 in get_fields (field r n :: acc) n in let rec is_list r = if is_int r then ( if (magic r : int) = 0 then true (* [] *) else false ) else ( let s = size r and t = tag r in if t = 0 && s = 2 then is_list (field r 1) (* h :: t *) else false ) in let rec get_list r = if is_int r then [] else let h = field r 0 and t = get_list (field r 1) in h :: t in let opaque name = (* XXX In future, print the address of value 'r'. Not possible in * pure OCaml at the moment. *) "<" ^ name ^ ">" in let s = size r and t = tag r in (* From the tag, determine the type of block. *) if is_list r then ( (* List. *) let fields = get_list r in "[" ^ String.concat "; " (List.map dump fields) ^ "]" ) else if t = 0 then ( (* Tuple, array, record. *) let fields = get_fields [] s in "(" ^ String.concat ", " (List.map dump fields) ^ ")" ) (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not * clear if very large constructed values could have the same * tag. XXX *) else if t = lazy_tag then opaque "lazy" else if t = closure_tag then opaque "closure" else if t = object_tag then ( (* Object. *) let fields = get_fields [] s in let clasz, id, slots = match fields with h::h'::t -> h, h', t | _ -> assert false in (* No information on decoding the class (first field). So just print * out the ID and the slots. *) "Object #" ^ dump id ^ " (" ^ String.concat ", " (List.map dump slots) ^ ")" ) else if t = infix_tag then opaque "infix" else if t = forward_tag then opaque "forward" else if t < no_scan_tag then ( (* Constructed value. *) let fields = get_fields [] s in "Tag" ^ string_of_int t ^ " (" ^ String.concat ", " (List.map dump fields) ^ ")" ) else if t = string_tag then ( "\"" ^ String.escaped (magic r : string) ^ "\"" ) else if t = double_tag then ( string_of_float (magic r : float) ) else if t = abstract_tag then opaque "abstract" else if t = custom_tag then opaque "custom" else if t = final_tag then opaque "final" else failwith ("dump: impossible tag (" ^ string_of_int t ^ ")") ) let dump v = dump (repr v) coccinelle-1.0.0-rc19/tools/bridge.ml0000644000175000017500000002041512247442616016314 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./bridge.ml" let drop_spaces s = String.concat "" (Str.split (Str.regexp "[ ]+") s) let parse_line fp l n = if List.mem l fp then None else if Str.string_match (Str.regexp "#") l 0 then None (* comment line *) else let top_split = Str.split (Str.regexp ":") l in match top_split with cocci::first::others -> let rec loop tag = function [x] -> let x = String.concat "\\ " (Str.split (Str.regexp "[ ]+") x) in [(tag,x)] | first::rest -> let splitted = Str.split (Str.regexp "[ ]+") first in (match List.rev splitted with new_tag::info -> let rest = loop new_tag rest in (tag,String.concat "\\ " (List.rev info))::rest | _ -> failwith "bad element") | _ -> failwith "no data" in Some (cocci,loop (drop_spaces first) others) | _ -> failwith (Printf.sprintf "bad line: %s" l) let collect_lines fp i = let lines = ref [] in let ln = ref 0 in let rec loop _ = ln := !ln + 1; (match parse_line fp (input_line i) !ln with Some l -> if List.mem l !lines then () else lines := l::!lines | None -> ()); loop() in try loop() with End_of_file -> !lines (* --------------------------------------------------------------------- *) let process_fp fl = let i = open_in fl in let lines = ref ([] : string list) in let rec loop _ = let l = input_line i in (if not(Str.string_match (Str.regexp "#") l 0) then lines := l :: !lines); loop() in (try loop() with End_of_file -> ()); close_in i; !lines (* --------------------------------------------------------------------- *) (* same info, different categories *) let discard_ambiguous lines = let rec loop = function [] -> [] | (cocci,tags)::rest -> let (same,others) = List.partition (function (cocci2,tags2) -> tags = tags2 && not(cocci = cocci2)) rest in match same with [] -> (cocci,tags)::loop rest | _ -> Printf.printf "ignoring ambiguity:\n"; List.iter (function (cocci,tags) -> Printf.printf "%s: %s\n" cocci (String.concat ", " (List.map (function (tag,tagval) -> Printf.sprintf "%s: %s" tag tagval) tags))) ((cocci,tags)::same); loop others in loop lines (* --------------------------------------------------------------------- *) (* only actually collects the rightmost element into ors *) let split_or (cocci,line) = let rev = List.rev line in (cocci,List.rev(List.tl rev), List.hd rev) let collect_ors fp lines = let rec loop = function [] -> failwith "no lines" | [line] -> let (c,k,v) = split_or line in ((c,k,[v]),[]) | line::xs -> let (c,k,v) = split_or line in let ((c1,k1,v1),rest) = loop xs in if c = c1 && k = k1 && not (k = []) then if List.mem v v1 then ((c1,k1,v1),rest) else ((c1,k1,v::v1),rest) else ((c,k,[v]),((c1,k1,v1)::rest)) in let ((c,k,v),rest) = loop lines in let res = (c,k,v)::rest in List.fold_left (function prev -> function (c,k,v) -> match v with [] -> failwith "not possible" | [x] -> (c,k@v) :: prev | (tag,_)::_ -> (*let vs = Printf.sprintf "%s:(%s)" tag (String.concat "|" (List.sort compare (List.map (function (_,vl) -> vl) v))) in let attempt = Printf.sprintf "%s: %s %s" c (String.concat " " (List.map (function (k,v) -> k^":"^v) k)) vs in*) if true (*List.mem attempt fp*) then let vs = Printf.sprintf "\\\\\\\\\\(%s\\\\\\\\\\)" (String.concat "\\\\\\\\\\|" (List.sort compare (List.map (function (_,vl) -> vl) v))) in (c,k@[(tag,vs)]) :: prev else (List.map (function vi -> (c,k@[vi])) v) @ prev) [] res (* --------------------------------------------------------------------- *) let command s = let _ = Sys.command s in () let created = ref ([] : (string * (string list ref * out_channel)) list) let mktag n = Printf.sprintf "x%d" n let created_files = ref ([] : (string * int ref) list) let process_line env (cocci,tags) = let files = List.filter (function (c,f) -> c = cocci) env in List.iter (function (_,cocci_file) -> let resdir = Filename.chop_extension cocci_file in (if not(Sys.file_exists cocci_file) then failwith "no cocci file"); let (n,o) = try List.assoc resdir !created with Not_found -> begin if Sys.file_exists resdir then command (Printf.sprintf "test %s -nt %s && /bin/rm -r -f %s && mkdir %s" cocci_file resdir resdir resdir) else command (Printf.sprintf "mkdir %s" resdir); let files = Printf.sprintf "%s/files" resdir in let o = open_out files in Printf.fprintf o "all: real_all\n\n"; let cell = ((ref []),o) in created := (resdir,cell) :: !created; cell end in let temp_file = Filename.temp_file cocci ".cocci" in command (Printf.sprintf "cp %s %s" cocci_file temp_file); let first_tag_val = match tags with [] -> failwith "no tags" | (_,first_tag_val)::_ -> let cell = try List.assoc first_tag_val !created_files with Not_found -> let c = ref (-1) in created_files := (first_tag_val,c)::!created_files; c in cell := !cell + 1; if !cell = 0 then first_tag_val else Printf.sprintf "%s%d" first_tag_val !cell in List.iter (function (tag,tagval) -> command (Printf.sprintf "sed s+%s+%s+ %s > %s_out; cp %s_out %s" tag tagval temp_file temp_file temp_file temp_file)) tags; command (Printf.sprintf "mv %s %s/%s.cocci" temp_file resdir first_tag_val); Printf.fprintf o "%s.out:\n\tmono_spatch_linux %s.cocci ${ARGS}\n\n" first_tag_val first_tag_val; n := (first_tag_val^".out") :: !n) files (* --------------------------------------------------------------------- *) let rec mkenv = function [] -> [] | [_] -> failwith "required arguments: file (category x cocci file)*" | category::cocci::rest -> if Filename.check_suffix cocci ".cocci" then (category,cocci)::mkenv rest else failwith "required arguments: file (category x cocci file)*" let rec upto = function 0 -> [] | n -> (mktag (n-1)) :: (upto (n-1)) let _ = let (no_ors,args) = List.partition (function "-no_ors" -> true | _ -> false) (Array.to_list Sys.argv) in let (file,fp,env) = match List.tl args with file::env -> let rec loop prev = function [] -> if prev = "" then ([],[]) else ([prev],[]) | x::xs -> try let _ = Str.search_forward (Str.regexp ".cocci") x 0 in if prev = "" then ([],x::xs) else ([],prev::x::xs) with Not_found -> let (fp,env) = loop x xs in if prev = "" then (fp,env) else (prev::fp,env) in let (fp,env) = loop "" env in (file,fp,mkenv env) | _ -> failwith "one argument expected" in let fp = List.fold_left (@) [] (List.map process_fp fp) in let i = open_in file in let lines = collect_lines fp i in let lines = if no_ors = [] then collect_ors fp lines else lines in close_in i; let lines = discard_ambiguous lines in List.iter (process_line env) lines; List.iter (function (resdir,(n,o)) -> Printf.fprintf o "real_all: %s\n" (String.concat " " (List.rev !n)); Printf.fprintf o "\tcat %s > completed\n" (String.concat " " (List.rev !n)); close_out o) !created coccinelle-1.0.0-rc19/tools/process_isoprofile.ml0000644000175000017500000001420112247442616020765 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./process_isoprofile.ml" (* This is for processing information created with the -profile_iso option. Runs are assumed separated with a line beginning with =. The first run is discarded *) let is_marker l = String.get l 0 = '=' let is_nothing l = String.sub l 0 2 = "ls" let skip_start i = (* skip over the ========== at the beginning *) let rec loop _ = let l = input_line i in if not (is_marker l) then loop() in loop() let get_data l = match Str.split (Str.regexp ":") l with [_;after] -> (match Str.split (Str.regexp " sec") after with [info;_] -> float_of_string info | _ -> failwith "bad data") | _ -> failwith (Printf.sprintf "bad data %s" l) type more = MORE | NOMORE | INFO of float * float * float * float | CONT let read_data_one i = try let start = input_line i in (* three lines of header *) if is_marker start then MORE else if is_nothing start then CONT else let _ = input_line i in let _ = input_line i in (match List.sort compare [input_line i;input_line i;input_line i;input_line i] with [asttoctl;full_engine;mysat;parse_cocci] -> if String.get full_engine 0 = '*' then (let _ = input_line i in CONT) (* hack!!! *) else let asttoctl = get_data asttoctl in let full_engine = get_data full_engine in let mysat = get_data mysat in let parse_cocci = get_data parse_cocci in INFO(full_engine,mysat,parse_cocci,asttoctl) | _ -> failwith "not possible") with End_of_file -> NOMORE let read_data i = skip_start i; let optcons x y = if x = [] then y else x::y in let rec loop all_acc acc = match read_data_one i with NOMORE -> optcons acc all_acc | MORE -> loop (optcons acc all_acc) [] | CONT -> loop all_acc acc | INFO(a,b,c,d) -> loop all_acc ((a,b,c,d)::acc) in let table = loop [] [] in let all_infos = (* a list with a list of information for each file *) List.fold_left (function all_infos -> function one_run -> List.map2 (function ainfo -> function orun -> orun::ainfo) all_infos one_run) (List.map (function _ -> []) (List.hd table)) table in let overheads = List.concat (List.map (List.map (function (_,x,y,z) -> x+.y+.z)) all_infos) in let total_times = List.concat (List.map (List.map (function (x,_,_,_) -> x)) all_infos) in let mysat_times = List.concat (List.map (List.map (function (_,x,_,_) -> x)) all_infos) in let parse_time = List.concat (List.map (List.map (function (_,_,x,y) -> x +. y)) all_infos) in (overheads,total_times,mysat_times,parse_time) let percent pct = (int_of_float ((100.0 *. pct) +. 0.5)) - 100 let mpercent pct = (int_of_float ((100.0 *. pct) +. 0.5)) let minf l = List.fold_left min (List.hd l) l let maxf l = List.fold_left max (List.hd l) l let ave = function [] -> 0.0 | l -> let total = List.fold_left (+.) 0.0 l in total /. (float_of_int(List.length l)) let process_files iso_file noiso_file = let i = open_in iso_file in let (iso_over,iso_total,iso_mysat,iso_parse) = read_data i in close_in i; let i = open_in noiso_file in let (noiso_over,noiso_total,noiso_mysat,noiso_parse) = read_data i in close_in i; Printf.printf "isos: min %f max %f ave %f\n" (minf iso_total) (maxf iso_total) (ave iso_total); Printf.printf "noisos: min %f max %f ave %f\n" (minf noiso_total) (maxf noiso_total) (ave noiso_total); Printf.printf "Overhead in total time %d%%: min %f max %f\n" (percent (ave (List.map2 (/.) iso_total noiso_total))) (minf (List.map2 (-.) iso_total noiso_total)) (maxf (List.map2 (-.) iso_total noiso_total)); Printf.printf "Portion of overhead due to parsing %d%%: min %f max %f\n" (mpercent (ave (List.fold_left2 (function acc -> (function (iso_total,iso_parse) -> (function (noiso_total,noiso_parse) -> let total_ovd = iso_total -. noiso_total in let parse_ovd = iso_parse -. noiso_parse in if total_ovd < 0.001 or parse_ovd > total_ovd or parse_ovd < 0.0 then acc else (parse_ovd /. total_ovd) :: acc))) [] (List.combine iso_total iso_parse) (List.combine noiso_total noiso_parse)))) (minf (List.map2 (-.) iso_parse noiso_parse)) (maxf (List.map2 (-.) iso_parse noiso_parse)); Printf.printf "Portion of overhead due to matching %d%%: min %f max %f\n\n" (mpercent (ave (List.fold_left2 (function acc -> (function (iso_total,iso_mysat) -> (function (noiso_total,noiso_mysat) -> let total_ovd = iso_total -. noiso_total in let mysat_ovd = iso_mysat -. noiso_mysat in if total_ovd < 0.001 or mysat_ovd > total_ovd or mysat_ovd < 0.0 then acc else (mysat_ovd /. total_ovd) :: acc))) [] (List.combine iso_total iso_mysat) (List.combine noiso_total noiso_mysat)))) (minf (List.map2 (-.) iso_mysat noiso_mysat)) (maxf (List.map2 (-.) iso_mysat noiso_mysat)) let _ = let iso = Array.get Sys.argv 1 in let noiso = Array.get Sys.argv 2 in process_files iso noiso coccinelle-1.0.0-rc19/tools/cstripenv.ml0000644000175000017500000000743012247442616017077 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cstripenv.ml" (* This tool strips code from a C file that relies on the external * macro and type environment, which we would obtain via commandline * parameters and includes. * The resulting file is more likely to be analyzable without the * headers, although it does affect the semantics of the original * program. * * It does so by removing toplevel elements that cannot be parsed * correctly because of macro's. Macro's that are interpreted as * functions are still kept. * It also removes expressions that have an unknown type, and * remapping unknown types in types of declarations. *) (* Visitor that hides tokens that cannot be parsed. *) let hide_visitor = { Visitor_c.default_visitor_c with Visitor_c.ktoplevel = fun (f, self) p -> begin match p with Ast_c.NotParsedCorrectly ii -> let first_i = List.hd ii in let last_i = List.hd (List.rev ii) in Ast_c.put_annot_info first_i Token_annot.Exclude_start Token_annot.Unit; Ast_c.put_annot_info last_i Token_annot.Exclude_end Token_annot.Unit | _ -> () end; f p } (* todo: remap visitor *) (* Visitor_c.ktype = fun (f, bigf) ft -> let (_, (t, _)) = ft in begin match t with Ast_c.NoType -> Common.pr2 "no type" | Ast_c.BaseType _ -> Common.pr2 "base type" | Ast_c.TypeName (nm, optTp) -> begin match optTp with None -> Common.pr2 ("type name " ^ (Ast_c.str_of_name nm) ^ " without fullType") | Some _ -> Common.pr2 ("type name " ^ (Ast_c.str_of_name nm) ^ " with fullType") end | Ast_c.Pointer _ -> Common.pr2 "pointer" | Ast_c.ParenType _ -> Common.pr2 "parens" | _ -> Common.pr2 "other" end; f ft; *) let stripenv source_file dest_file = let (ast2,_) = Parse_c.parse_c_and_cpp source_file in let ast = Parse_c.program_of_program2 ast2 in ignore (Type_annoter_c.annotate_program !Type_annoter_c.initial_env ast); ignore (Visitor_c.vk_program hide_visitor ast); Unparse_c.pp_program_default ast2 dest_file let main () = Common.print_to_stderr := true; Flag_parsing_c.show_parsing_error := true; let source = ref None in let dest = ref None in let path_arg ref path = ref := Some path in Arg.parse_argv Sys.argv [("--output",Arg.String (path_arg dest),"path to the output file")] (path_arg source) "cstripenv "; let source_file = match !source with None -> raise (Arg.Bad "a source file argument is required") | Some path -> path in let dest_file = match !dest with None -> raise (Arg.Bad "an output file argument is required") | Some path -> path in stripenv source_file dest_file let _ = main () coccinelle-1.0.0-rc19/tools/all.itarget0000644000175000017500000000017612247437436016665 0ustar eugeneugengitgrep.byte gitsort.byte process_isoprofile.byte alloc_free.byte bridge.byte spp.byte splitpatch.byte extract_c_and_res.byte coccinelle-1.0.0-rc19/tools/extract_c_and_res.ml0000644000175000017500000000523112247442616020526 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./extract_c_and_res.ml" open Common (*****************************************************************************) (* *) (*****************************************************************************) (* requirments: * - extract from one git commit, or from a set of git commits * - files from drivers/ and also from other directories now * - .c and .h, local .h and also not local .h * - files that were part of the patch, and so modified, but also * other files (especially .h) to get more type information * *) (*****************************************************************************) (* Flags *) (*****************************************************************************) (*****************************************************************************) (* Main entry point *) (*****************************************************************************) let ex_kmallocmemset = "dd00cc486ab1c17049a535413d1751ef3482141c" let ex_new_driver = "3faa1ffb4f4be7d10715f4b003ff7b27d14eae26" let ex_delete_driver = "4d8506b806cc726c96db1c1a55edfb2da52217a9" let main () = begin let args = ref [] in let options = [ ] in let usage_msg = "Usage: " ^ basename Sys.argv.(0) ^ " [options]" ^ "\n" ^ "Options are:" in Arg.parse (Arg.align options) (fun x -> args := x::!args) usage_msg; args := List.rev !args; (match (!args) with | [x] -> pr x | _ -> Arg.usage (Arg.align options) usage_msg; ) end (*****************************************************************************) let _ = main () coccinelle-1.0.0-rc19/tools/Makefile0000644000175000017500000000666112247442616016175 0ustar eugeneugen# Copyright 2012, INRIA # Julia Lawall, Gilles Muller # Copyright 2010-2011, INRIA, University of Copenhagen # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix # This file is part of Coccinelle. # # Coccinelle is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, according to version 2 of the License. # # Coccinelle is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Coccinelle. If not, see . # # The authors reserve the right to distribute this or future versions of # Coccinelle under other licenses. ifneq ($(MAKECMDGOALS),distclean) include ../Makefile.config endif OCAMLCFLAGS ?= -g OPTFLAGS ?= -g SYSLIBS = str.cma unix.cma bigarray.cma INCLUDE=-I ../commons -I ../extra -I ../parsing_c LIBS=../commons/commons.cma ../globals/globals.cma \ ../parsing_c/parsing_c.cma ../extra/extra.cma OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDE) OCAMLOPT_CMD=$(OCAMLOPT) $(OPTFLAGS) $(INCLUDE) OCAMLDEP_CMD=$(OCAMLDEP) $(INCLUDE) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDE) OCAMLYACC_CMD=$(OCAMLYACC) -v PROGS=spp gitgrep splitpatch extract_c_and_res \ gitsort alloc_free bridge \ process_isoprofile #generate_dependencies ifneq ($(FEATURE_OCAMLBUILD),yes) all: $(PROGS) all.opt: @$(MAKE) $(PROGS) BUILD_OPT=yes gitgrep: gitgrep.ml $(OCAMLOPT) -o gitgrep str.cmxa gitgrep.ml gitsort: gitsort.ml $(OCAMLOPT) -o gitsort str.cmxa gitsort.ml process_isoprofile: process_isoprofile.ml $(OCAMLC) -g -o process_isoprofile str.cma process_isoprofile.ml alloc_free: alloc_free.ml $(OCAMLOPT) -o alloc_free str.cmxa alloc_free.ml # more flexible version of alloc_free bridge: bridge.ml $(OCAMLOPT) -o bridge str.cmxa dumper.mli dumper.ml bridge.ml install_bridge: bridge cp -f bridge /usr/local/bin spp: spp.ml $(OCAMLC_CMD) -o $@ $(SYSLIBS) $(INCLUDE) $(LIBS) $+ splitpatch: splitpatch.cmo $(OCAMLC_CMD) -o $@ $(SYSLIBS) $(INCLUDE) $+ extract_c_and_res: extract_c_and_res.cmo $(OCAMLC_CMD) -o $@ $(SYSLIBS) $(INCLUDE) $(LIBS) $+ generate_dependencies: generate_dependencies.cmo $(OCAMLC_CMD) -o $@ $(SYSLIBS) $(INCLUDE) $(LIBS) $+ else .PHONY: $(PROGS) $(PROGS:%.opt) isoprof all: $(PROGS) all.opt: $(PROGS:%=%.opt) $(PROGS): cd .. && $(OCAMLBUILD) tools/$@.byte cp ../_build/tools/$@.byte $@ $(PROGS:%=%.opt): cd .. && $(OCAMLBUILD) tools/$(@:%.opt=%).native cp ../_build/tools/$(@:%.opt=%).native $(@:%.opt=%) clean:: cd .. && $(OCAMLBUILD) -clean rm -f $(PROGS) endif isoprof: process_isoprofile cp process_isoprofile isoprof .SUFFIXES: .ml .mli .cmo .cmi .cmx .ml.cmo: $(OCAMLC_CMD) -c $< .mli.cmi: $(OCAMLC_CMD) -c $< .ml.cmx: $(OCAMLOPT_CMD) -c $< clean:: rm -f $(PROGS) isoprof rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f .depend distclean: clean .PHONEY: depend .depend depend: beforedepend ocamldep $(INCLUDE) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.0-rc19/tools/cocci-send-email.perl0000644000175000017500000011276012247437436020517 0ustar eugeneugen#!/usr/bin/perl -w # # Copyright 2002,2005 Greg Kroah-Hartman # Copyright 2005 Ryan Anderson # # GPL v2 (See COPYING) # # Added the --auto-to option, to get To information from an mbox # (Julia Lawall ) # Ported to support git "mbox" format files by Ryan Anderson # # Sends a collection of emails to the given email addresses, disturbingly fast. # # Supports two formats: # 1. mbox format files (ignoring most headers and MIME formatting - this is designed for sending patches) # 2. The original format support by Greg's script: # first line of the message is who to CC, # and second line is the subject of the message. # use strict; use warnings; use Term::ReadLine; use Getopt::Long; use Text::ParseWords; use Data::Dumper; use Term::ANSIColor; use File::Temp qw/ tempdir tempfile /; use Error qw(:try); use Git; Getopt::Long::Configure qw/ pass_through /; package FakeTerm; sub new { my ($class, $reason) = @_; return bless \$reason, shift; } sub readline { my $self = shift; die "Cannot use readline on FakeTerm: $$self"; } package main; sub usage { print < Composing: --from * Email From: --[no-]to * Email To: --[no-]cc * Email Cc: --[no-]bcc * Email Bcc: --subject * Email "Subject:" --in-reply-to * Email "In-Reply-To:" --annotate * Review each patch that will be sent in an editor. --compose * Open an editor for introduction. --8bit-encoding * Encoding to assume 8bit mails if undeclared Sending: --envelope-sender * Email envelope sender. --smtp-server * Outgoing SMTP server to use. The port is optional. Default 'localhost'. --smtp-server-port * Outgoing SMTP server port. --smtp-user * Username for SMTP-AUTH. --smtp-pass * Password for SMTP-AUTH; not necessary. --smtp-encryption * tls or ssl; anything else disables. --smtp-ssl * Deprecated. Use '--smtp-encryption ssl'. --smtp-domain * The domain name sent to HELO/EHLO handshake --smtp-debug <0|1> * Disable, enable Net::SMTP debug. Automating: --identity * Use the sendemail. options. --cc-cmd * Email Cc: via ` \$patch_path` --suppress-cc * author, self, sob, cc, cccmd, body, bodycc, all. --[no-]signed-off-by-cc * Send to Signed-off-by: addresses. Default on. --[no-]suppress-from * Send to self. Default off. --[no-]chain-reply-to * Chain In-Reply-To: fields. Default off. --[no-]thread * Use In-Reply-To: field. Default on. Administering: --confirm * Confirm recipients before sending; auto, cc, compose, always, or never. --quiet * Output one line of info per email. --dry-run * Don't actually send the emails. --[no-]validate * Perform patch sanity checks. Default on. --[no-]format-patch * understand any non optional arguments as `git format-patch` ones. EOT exit(1); } # most mail servers generate the Date: header, but not all... sub format_2822_time { my ($time) = @_; my @localtm = localtime($time); my @gmttm = gmtime($time); my $localmin = $localtm[1] + $localtm[2] * 60; my $gmtmin = $gmttm[1] + $gmttm[2] * 60; if ($localtm[0] != $gmttm[0]) { die "local zone differs from GMT by a non-minute interval\n"; } if ((($gmttm[6] + 1) % 7) == $localtm[6]) { $localmin += 1440; } elsif ((($gmttm[6] - 1) % 7) == $localtm[6]) { $localmin -= 1440; } elsif ($gmttm[6] != $localtm[6]) { die "local time offset greater than or equal to 24 hours\n"; } my $offset = $localmin - $gmtmin; my $offhour = $offset / 60; my $offmin = abs($offset % 60); if (abs($offhour) >= 24) { die ("local time offset greater than or equal to 24 hours\n"); } return sprintf("%s, %2d %s %d %02d:%02d:%02d %s%02d%02d", qw(Sun Mon Tue Wed Thu Fri Sat)[$localtm[6]], $localtm[3], qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$localtm[4]], $localtm[5]+1900, $localtm[2], $localtm[1], $localtm[0], ($offset >= 0) ? '+' : '-', abs($offhour), $offmin, ); } my $have_email_valid = eval { require Email::Valid; 1 }; my $have_mail_address = eval { require Mail::Address; 1 }; my $smtp; my $auth; sub unique_email_list(@); sub cleanup_compose_files(); # Variables we fill in automatically, or via prompting: my (@to,@msgto,$no_to,$auto_to,@cc,$no_cc,@initial_cc,@bcclist,$no_bcc,@xh, $initial_reply_to,$initial_subject,@files, $author,$sender,$smtp_authpass,$annotate,$compose,$time); my $envelope_sender; # Example reply to: #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>'; my $repo = eval { Git->repository() }; my @repo = $repo ? ($repo) : (); my $term = eval { $ENV{"GIT_SEND_EMAIL_NOTTY"} ? new Term::ReadLine 'git-send-email', \*STDIN, \*STDOUT : new Term::ReadLine 'git-send-email'; }; if ($@) { $term = new FakeTerm "$@: going non-interactive"; } # Behavior modification variables my ($quiet, $dry_run) = (0, 0); my $format_patch; my $compose_filename; # Handle interactive edition of files. my $multiedit; my $editor; sub do_edit { if (!defined($editor)) { $editor = Git::command_oneline('var', 'GIT_EDITOR'); } if (defined($multiedit) && !$multiedit) { map { system('sh', '-c', $editor.' "$@"', $editor, $_); if (($? & 127) || ($? >> 8)) { die("the editor exited uncleanly, aborting everything"); } } @_; } else { system('sh', '-c', $editor.' "$@"', $editor, @_); if (($? & 127) || ($? >> 8)) { die("the editor exited uncleanly, aborting everything"); } } } # Variables with corresponding config settings my ($thread, $chain_reply_to, $suppress_from, $signed_off_by_cc, $cc_cmd); my ($smtp_server, $smtp_server_port, $smtp_authuser, $smtp_encryption); my ($identity, $aliasfiletype, @alias_files, @smtp_host_parts, $smtp_domain); my ($validate, $confirm); my (@suppress_cc); my ($auto_8bit_encoding); my ($debug_net_smtp) = 0; # Net::SMTP, see send_message() my $not_set_by_user = "true but not set by the user"; my %config_bool_settings = ( "thread" => [\$thread, 1], "chainreplyto" => [\$chain_reply_to, $not_set_by_user], "suppressfrom" => [\$suppress_from, undef], "signedoffbycc" => [\$signed_off_by_cc, undef], "signedoffcc" => [\$signed_off_by_cc, undef], # Deprecated "validate" => [\$validate, 1], ); my %config_settings = ( "smtpserver" => \$smtp_server, "smtpserverport" => \$smtp_server_port, "smtpuser" => \$smtp_authuser, "smtppass" => \$smtp_authpass, "smtpdomain" => \$smtp_domain, "to" => \@to, "cc" => \@initial_cc, "cccmd" => \$cc_cmd, "aliasfiletype" => \$aliasfiletype, "bcc" => \@bcclist, "aliasesfile" => \@alias_files, "suppresscc" => \@suppress_cc, "envelopesender" => \$envelope_sender, "multiedit" => \$multiedit, "confirm" => \$confirm, "from" => \$sender, "assume8bitencoding" => \$auto_8bit_encoding, ); # Help users prepare for 1.7.0 sub chain_reply_to { if (defined $chain_reply_to && $chain_reply_to eq $not_set_by_user) { print STDERR "In git 1.7.0, the default has changed to --no-chain-reply-to\n" . "Set sendemail.chainreplyto configuration variable to true if\n" . "you want to keep --chain-reply-to as your default.\n"; $chain_reply_to = 0; } return $chain_reply_to; } # Handle Uncouth Termination sub signal_handler { # Make text normal print color("reset"), "\n"; # SMTP password masked system "stty echo"; # tmp files from --compose if (defined $compose_filename) { if (-e $compose_filename) { print "'$compose_filename' contains an intermediate version of the email you were composing.\n"; } if (-e ($compose_filename . ".final")) { print "'$compose_filename.final' contains the composed email.\n" } } exit; }; $SIG{TERM} = \&signal_handler; $SIG{INT} = \&signal_handler; # Begin by accumulating all the variables (defined above), that we will end up # needing, first, from the command line: my $rc = GetOptions("sender|from=s" => \$sender, "in-reply-to=s" => \$initial_reply_to, "subject=s" => \$initial_subject, "to=s" => \@to, "no-to" => \$no_to, "auto-to" => \$auto_to, "cc=s" => \@initial_cc, "no-cc" => \$no_cc, "bcc=s" => \@bcclist, "no-bcc" => \$no_bcc, "chain-reply-to!" => \$chain_reply_to, "smtp-server=s" => \$smtp_server, "smtp-server-port=s" => \$smtp_server_port, "smtp-user=s" => \$smtp_authuser, "smtp-pass:s" => \$smtp_authpass, "smtp-ssl" => sub { $smtp_encryption = 'ssl' }, "smtp-encryption=s" => \$smtp_encryption, "smtp-debug:i" => \$debug_net_smtp, "smtp-domain:s" => \$smtp_domain, "identity=s" => \$identity, "annotate" => \$annotate, "compose" => \$compose, "quiet" => \$quiet, "cc-cmd=s" => \$cc_cmd, "suppress-from!" => \$suppress_from, "suppress-cc=s" => \@suppress_cc, "signed-off-cc|signed-off-by-cc!" => \$signed_off_by_cc, "confirm=s" => \$confirm, "dry-run" => \$dry_run, "envelope-sender=s" => \$envelope_sender, "thread!" => \$thread, "validate!" => \$validate, "format-patch!" => \$format_patch, "8bit-encoding=s" => \$auto_8bit_encoding, ); unless ($rc) { usage(); } die "Cannot run git format-patch from outside a repository\n" if $format_patch and not $repo; # Now, let's fill any that aren't set in with defaults: sub read_config { my ($prefix) = @_; foreach my $setting (keys %config_bool_settings) { my $target = $config_bool_settings{$setting}->[0]; $$target = Git::config_bool(@repo, "$prefix.$setting") unless (defined $$target); } foreach my $setting (keys %config_settings) { my $target = $config_settings{$setting}; next if $setting eq "to" and defined $no_to; next if $setting eq "cc" and defined $no_cc; next if $setting eq "bcc" and defined $no_bcc; if (ref($target) eq "ARRAY") { unless (@$target) { my @values = Git::config(@repo, "$prefix.$setting"); @$target = @values if (@values && defined $values[0]); } } else { $$target = Git::config(@repo, "$prefix.$setting") unless (defined $$target); } } if (!defined $smtp_encryption) { my $enc = Git::config(@repo, "$prefix.smtpencryption"); if (defined $enc) { $smtp_encryption = $enc; } elsif (Git::config_bool(@repo, "$prefix.smtpssl")) { $smtp_encryption = 'ssl'; } } } # read configuration from [sendemail "$identity"], fall back on [sendemail] $identity = Git::config(@repo, "sendemail.identity") unless (defined $identity); read_config("sendemail.$identity") if (defined $identity); read_config("sendemail"); # fall back on builtin bool defaults foreach my $setting (values %config_bool_settings) { ${$setting->[0]} = $setting->[1] unless (defined (${$setting->[0]})); } # 'default' encryption is none -- this only prevents a warning $smtp_encryption = '' unless (defined $smtp_encryption); # Set CC suppressions my(%suppress_cc); if (@suppress_cc) { foreach my $entry (@suppress_cc) { die "Unknown --suppress-cc field: '$entry'\n" unless $entry =~ /^(all|cccmd|cc|author|self|sob|body|bodycc)$/; $suppress_cc{$entry} = 1; } } if ($suppress_cc{'all'}) { foreach my $entry (qw (cccmd cc author self sob body bodycc)) { $suppress_cc{$entry} = 1; } delete $suppress_cc{'all'}; } # If explicit old-style ones are specified, they trump --suppress-cc. $suppress_cc{'self'} = $suppress_from if defined $suppress_from; $suppress_cc{'sob'} = !$signed_off_by_cc if defined $signed_off_by_cc; if ($suppress_cc{'body'}) { foreach my $entry (qw (sob bodycc)) { $suppress_cc{$entry} = 1; } delete $suppress_cc{'body'}; } # Set confirm's default value my $confirm_unconfigured = !defined $confirm; if ($confirm_unconfigured) { $confirm = scalar %suppress_cc ? 'compose' : 'auto'; }; die "Unknown --confirm setting: '$confirm'\n" unless $confirm =~ /^(?:auto|cc|compose|always|never)/; # Debugging, print out the suppressions. if (0) { print "suppressions:\n"; foreach my $entry (keys %suppress_cc) { printf " %-5s -> $suppress_cc{$entry}\n", $entry; } } my ($repoauthor, $repocommitter); ($repoauthor) = Git::ident_person(@repo, 'author'); ($repocommitter) = Git::ident_person(@repo, 'committer'); # Verify the user input foreach my $entry (@to) { die "Comma in --to entry: $entry'\n" unless $entry !~ m/,/; } foreach my $entry (@initial_cc) { die "Comma in --cc entry: $entry'\n" unless $entry !~ m/,/; } foreach my $entry (@bcclist) { die "Comma in --bcclist entry: $entry'\n" unless $entry !~ m/,/; } sub parse_address_line { if ($have_mail_address) { return map { $_->format } Mail::Address->parse($_[0]); } else { return split_addrs($_[0]); } } sub split_addrs { return quotewords('\s*,\s*', 1, @_); } my %aliases; my %parse_alias = ( # multiline formats can be supported in the future mutt => sub { my $fh = shift; while (<$fh>) { if (/^\s*alias\s+(?:-group\s+\S+\s+)*(\S+)\s+(.*)$/) { my ($alias, $addr) = ($1, $2); $addr =~ s/#.*$//; # mutt allows # comments # commas delimit multiple addresses $aliases{$alias} = [ split_addrs($addr) ]; }}}, mailrc => sub { my $fh = shift; while (<$fh>) { if (/^alias\s+(\S+)\s+(.*)$/) { # spaces delimit multiple addresses $aliases{$1} = [ quotewords('\s+', 0, $2) ]; }}}, pine => sub { my $fh = shift; my $f='\t[^\t]*'; for (my $x = ''; defined($x); $x = $_) { chomp $x; $x .= $1 while(defined($_ = <$fh>) && /^ +(.*)$/); $x =~ /^(\S+)$f\t\(?([^\t]+?)\)?(:?$f){0,2}$/ or next; $aliases{$1} = [ split_addrs($2) ]; }}, elm => sub { my $fh = shift; while (<$fh>) { if (/^(\S+)\s+=\s+[^=]+=\s(\S+)/) { my ($alias, $addr) = ($1, $2); $aliases{$alias} = [ split_addrs($addr) ]; } } }, gnus => sub { my $fh = shift; while (<$fh>) { if (/\(define-mail-alias\s+"(\S+?)"\s+"(\S+?)"\)/) { $aliases{$1} = [ $2 ]; }}} ); if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) { foreach my $file (@alias_files) { open my $fh, '<', $file or die "opening $file: $!\n"; $parse_alias{$aliasfiletype}->($fh); close $fh; } } ($sender) = expand_aliases($sender) if defined $sender; # returns 1 if the conflict must be solved using it as a format-patch argument sub check_file_rev_conflict($) { return unless $repo; my $f = shift; try { $repo->command('rev-parse', '--verify', '--quiet', $f); if (defined($format_patch)) { return $format_patch; } die(<command('format-patch', '-o', tempdir(CLEANUP => 1), @rev_list_opts); } if ($validate) { foreach my $f (@files) { unless (-p $f) { my $error = validate_patch($f); $error and die "fatal: $f: $error\nwarning: no patches were sent\n"; } } } if (@files) { unless ($quiet) { print $_,"\n" for (@files); } } else { print STDERR "\nNo patch files specified!\n\n"; usage(); } sub get_patch_subject($) { my $fn = shift; open (my $fh, '<', $fn); while (my $line = <$fh>) { next unless ($line =~ /^Subject: (.*)$/); close $fh; return "GIT: $1\n"; } close $fh; die "No subject line in $fn ?"; } if ($compose) { # Note that this does not need to be secure, but we will make a small # effort to have it be unique $compose_filename = ($repo ? tempfile(".gitsendemail.msg.XXXXXX", DIR => $repo->repo_path()) : tempfile(".gitsendemail.msg.XXXXXX", DIR => "."))[1]; open(C,">",$compose_filename) or die "Failed to open for writing $compose_filename: $!"; my $tpl_sender = $sender || $repoauthor || $repocommitter || ''; my $tpl_subject = $initial_subject || ''; my $tpl_reply_to = $initial_reply_to || ''; print C <",$compose_filename . ".final") or die "Failed to open $compose_filename.final : " . $!; open(C,"<",$compose_filename) or die "Failed to open $compose_filename : " . $!; my $need_8bit_cte = file_has_nonascii($compose_filename); my $in_body = 0; my $summary_empty = 1; while() { next if m/^GIT:/; if ($in_body) { $summary_empty = 0 unless (/^\n$/); } elsif (/^\n$/) { $in_body = 1; if ($need_8bit_cte) { print C2 "MIME-Version: 1.0\n", "Content-Type: text/plain; ", "charset=UTF-8\n", "Content-Transfer-Encoding: 8bit\n"; } } elsif (/^MIME-Version:/i) { $need_8bit_cte = 0; } elsif (/^Subject:\s*(.+)\s*$/i) { $initial_subject = $1; my $subject = $initial_subject; $_ = "Subject: " . ($subject =~ /[^[:ascii:]]/ ? quote_rfc2047($subject) : $subject) . "\n"; } elsif (/^In-Reply-To:\s*(.+)\s*$/i) { $initial_reply_to = $1; next; } elsif (/^From:\s*(.+)\s*$/i) { $sender = $1; next; } elsif (/^(?:To|Cc|Bcc):/i) { print "To/Cc/Bcc fields are not interpreted yet, they have been ignored\n"; next; } print C2 $_; } close(C); close(C2); if ($summary_empty) { print "Summary email is empty, skipping it\n"; $compose = -1; } } elsif ($annotate) { do_edit(@files); } sub ask { my ($prompt, %arg) = @_; my $valid_re = $arg{valid_re}; my $default = $arg{default}; my $resp; my $i = 0; return defined $default ? $default : undef unless defined $term->IN and defined fileno($term->IN) and defined $term->OUT and defined fileno($term->OUT); while ($i++ < 10) { $resp = $term->readline($prompt); if (!defined $resp) { # EOF print "\n"; return defined $default ? $default : undef; } if ($resp eq '' and defined $default) { return $default; } if (!defined $valid_re or $resp =~ /$valid_re/) { return $resp; } } return undef; } my %broken_encoding; sub file_declares_8bit_cte($) { my $fn = shift; open (my $fh, '<', $fn); while (my $line = <$fh>) { last if ($line =~ /^$/); return 1 if ($line =~ /^Content-Transfer-Encoding: .*8bit.*$/); } close $fh; return 0; } foreach my $f (@files) { next unless (body_or_subject_has_nonascii($f) && !file_declares_8bit_cte($f)); $broken_encoding{$f} = 1; } if (!defined $auto_8bit_encoding && scalar %broken_encoding) { print "The following files are 8bit, but do not declare " . "a Content-Transfer-Encoding.\n"; foreach my $f (sort keys %broken_encoding) { print " $f\n"; } $auto_8bit_encoding = ask("Which 8bit encoding should I declare [UTF-8]? ", default => "UTF-8"); } my $prompting = 0; if (!defined $sender) { $sender = $repoauthor || $repocommitter || ''; $sender = ask("Who should the emails appear to be from? [$sender] ", default => $sender); print "Emails will be sent from: ", $sender, "\n"; $prompting++; } if (!@to && !$auto_to) { my $to = ask("Who should the emails be sent to? "); push @to, parse_address_line($to) if defined $to; # sanitized/validated later $prompting++; } sub expand_aliases { return map { expand_one_alias($_) } @_; } my %EXPANDED_ALIASES; sub expand_one_alias { my $alias = shift; if ($EXPANDED_ALIASES{$alias}) { die "fatal: alias '$alias' expands to itself\n"; } local $EXPANDED_ALIASES{$alias} = 1; return $aliases{$alias} ? expand_aliases(@{$aliases{$alias}}) : $alias; } @to = expand_aliases(@to); @to = (map { sanitize_address($_) } @to); @initial_cc = expand_aliases(@initial_cc); @bcclist = expand_aliases(@bcclist); if ($thread && !defined $initial_reply_to && $prompting) { $initial_reply_to = ask( "Message-ID to be used as In-Reply-To for the first email? "); } if (defined $initial_reply_to) { $initial_reply_to =~ s/^\s*?\s*$//; $initial_reply_to = "<$initial_reply_to>" if $initial_reply_to ne ''; } if (!defined $smtp_server) { foreach (qw( /usr/sbin/sendmail /usr/lib/sendmail )) { if (-x $_) { $smtp_server = $_; last; } } $smtp_server ||= 'localhost'; # could be 127.0.0.1, too... *shrug* } if ($compose && $compose > 0) { @files = ($compose_filename . ".final", @files); } # Variables we set as part of the loop over files our ($message_id, %mail, $subject, $reply_to, $references, $message, $needs_confirm, $message_num, $ask_default); sub extract_valid_address { my $address = shift; my $local_part_regexp = '[^<>"\s@]+'; my $domain_regexp = '[^.<>"\s@]+(?:\.[^.<>"\s@]+)+'; # check for a local address: return $address if ($address =~ /^($local_part_regexp)$/); $address =~ s/^\s*<(.*)>\s*$/$1/; if ($have_email_valid) { return scalar Email::Valid->address($address); } else { # less robust/correct than the monster regexp in Email::Valid, # but still does a 99% job, and one less dependency $address =~ /($local_part_regexp\@$domain_regexp)/; return $1; } } # Usually don't need to change anything below here. # we make a "fake" message id by taking the current number # of seconds since the beginning of Unix time and tacking on # a random number to the end, in case we are called quicker than # 1 second since the last time we were called. # We'll setup a template for the message id, using the "from" address: my ($message_id_stamp, $message_id_serial); sub make_message_id { my $uniq; if (!defined $message_id_stamp) { $message_id_stamp = sprintf("%s-%s", time, $$); $message_id_serial = 0; } $message_id_serial++; $uniq = "$message_id_stamp-$message_id_serial"; my $du_part; for ($sender, $repocommitter, $repoauthor) { $du_part = extract_valid_address(sanitize_address($_)); last if (defined $du_part and $du_part ne ''); } if (not defined $du_part or $du_part eq '') { use Sys::Hostname qw(); $du_part = 'user@' . Sys::Hostname::hostname(); } my $message_id_template = "<%s-git-send-email-%s>"; $message_id = sprintf($message_id_template, $uniq, $du_part); #print "new message id = $message_id\n"; # Was useful for debugging } $time = time - scalar $#files; sub unquote_rfc2047 { local ($_) = @_; my $encoding; if (s/=\?([^?]+)\?q\?(.*)\?=/$2/g) { $encoding = $1; s/_/ /g; s/=([0-9A-F]{2})/chr(hex($1))/eg; } return wantarray ? ($_, $encoding) : $_; } sub quote_rfc2047 { local $_ = shift; my $encoding = shift || 'UTF-8'; s/([^-a-zA-Z0-9!*+\/])/sprintf("=%02X", ord($1))/eg; s/(.*)/=\?$encoding\?q\?$1\?=/; return $_; } sub is_rfc2047_quoted { my $s = shift; my $token = '[^][()<>@,;:"\/?.= \000-\037\177-\377]+'; my $encoded_text = '[!->@-~]+'; length($s) <= 75 && $s =~ m/^(?:"[[:ascii:]]*"|=\?$token\?$token\?$encoded_text\?=)$/o; } # use the simplest quoting being able to handle the recipient sub sanitize_address { my ($recipient) = @_; my ($recipient_name, $recipient_addr) = ($recipient =~ /^(.*?)\s*(<.*)/); if (not $recipient_name) { return "$recipient"; } # if recipient_name is already quoted, do nothing if (is_rfc2047_quoted($recipient_name)) { return $recipient; } # rfc2047 is needed if a non-ascii char is included if ($recipient_name =~ /[^[:ascii:]]/) { $recipient_name =~ s/^"(.*)"$/$1/; $recipient_name = quote_rfc2047($recipient_name); } # double quotes are needed if specials or CTLs are included elsif ($recipient_name =~ /[][()<>@,;:\\".\000-\037\177]/) { $recipient_name =~ s/(["\\\r])/\\$1/g; $recipient_name = "\"$recipient_name\""; } return "$recipient_name $recipient_addr"; } # Returns the local Fully Qualified Domain Name (FQDN) if available. # # Tightly configured MTAa require that a caller sends a real DNS # domain name that corresponds the IP address in the HELO/EHLO # handshake. This is used to verify the connection and prevent # spammers from trying to hide their identity. If the DNS and IP don't # match, the receiveing MTA may deny the connection. # # Here is a deny example of Net::SMTP with the default "localhost.localdomain" # # Net::SMTP=GLOB(0x267ec28)>>> EHLO localhost.localdomain # Net::SMTP=GLOB(0x267ec28)<<< 550 EHLO argument does not match calling host # # This maildomain*() code is based on ideas in Perl library Test::Reporter # /usr/share/perl5/Test/Reporter/Mail/Util.pm ==> sub _maildomain () sub valid_fqdn { my $domain = shift; return !($^O eq 'darwin' && $domain =~ /\.local$/) && $domain =~ /\./; } sub maildomain_net { my $maildomain; if (eval { require Net::Domain; 1 }) { my $domain = Net::Domain::domainname(); $maildomain = $domain if valid_fqdn($domain); } return $maildomain; } sub maildomain_mta { my $maildomain; if (eval { require Net::SMTP; 1 }) { for my $host (qw(mailhost localhost)) { my $smtp = Net::SMTP->new($host); if (defined $smtp) { my $domain = $smtp->domain; $smtp->quit; $maildomain = $domain if valid_fqdn($domain); last if $maildomain; } } } return $maildomain; } sub maildomain { return maildomain_net() || maildomain_mta() || 'localhost.localdomain'; } # Returns 1 if the message was sent, and 0 otherwise. # In actuality, the whole program dies when there # is an error sending a message. sub send_message { my @recipients = unique_email_list(@to,@msgto); @cc = (grep { my $cc = extract_valid_address($_); not grep { $cc eq $_ } @recipients } map { sanitize_address($_) } @cc); my $to = join (",\n\t", @recipients); @recipients = unique_email_list(@recipients,@cc,@bcclist); @recipients = (map { extract_valid_address($_) } @recipients); my $date = format_2822_time($time++); my $gitversion = '@@GIT_VERSION@@'; if ($gitversion =~ m/..GIT_VERSION../) { $gitversion = Git::version(); } my $cc = join(",\n\t", unique_email_list(@cc)); my $ccline = ""; if ($cc ne '') { $ccline = "\nCc: $cc"; } my $sanitized_sender = sanitize_address($sender); make_message_id() unless defined($message_id); my $header = "From: $sanitized_sender To: $to${ccline} Subject: $subject Date: $date Message-Id: $message_id X-Mailer: git-send-email $gitversion "; if ($reply_to) { $header .= "In-Reply-To: $reply_to\n"; $header .= "References: $references\n"; } if (@xh) { $header .= join("\n", @xh) . "\n"; } my @sendmail_parameters = ('-i', @recipients); my $raw_from = $sanitized_sender; if (defined $envelope_sender && $envelope_sender ne "auto") { $raw_from = $envelope_sender; } $raw_from = extract_valid_address($raw_from); unshift (@sendmail_parameters, '-f', $raw_from) if(defined $envelope_sender); if ($needs_confirm && !$dry_run) { print "\n$header\n"; if ($needs_confirm eq "inform") { $confirm_unconfigured = 0; # squelch this message for the rest of this run $ask_default = "y"; # assume yes on EOF since user hasn't explicitly asked for confirmation print " The Cc list above has been expanded by additional\n"; print " addresses found in the patch commit message. By default\n"; print " send-email prompts before sending whenever this occurs.\n"; print " This behavior is controlled by the sendemail.confirm\n"; print " configuration setting.\n"; print "\n"; print " For additional information, run 'git send-email --help'.\n"; print " To retain the current behavior, but squelch this message,\n"; print " run 'git config --global sendemail.confirm auto'.\n\n"; } $_ = ask("Send this email? ([y]es|[n]o|[q]uit|[a]ll): ", valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i, default => $ask_default); die "Send this email reply required" unless defined $_; if (/^n/i) { return 0; } elsif (/^q/i) { cleanup_compose_files(); exit(0); } elsif (/^a/i) { $confirm = 'never'; } } if ($dry_run) { # We don't want to send the email. } elsif ($smtp_server =~ m#^/#) { my $pid = open my $sm, '|-'; defined $pid or die $!; if (!$pid) { exec($smtp_server, @sendmail_parameters) or die $!; } print $sm "$header\n$message"; close $sm or die $?; } else { if (!defined $smtp_server) { die "The required SMTP server is not properly defined." } if ($smtp_encryption eq 'ssl') { $smtp_server_port ||= 465; # ssmtp require Net::SMTP::SSL; $smtp_domain ||= maildomain(); $smtp ||= Net::SMTP::SSL->new($smtp_server, Hello => $smtp_domain, Port => $smtp_server_port); } else { require Net::SMTP; $smtp_domain ||= maildomain(); $smtp ||= Net::SMTP->new((defined $smtp_server_port) ? "$smtp_server:$smtp_server_port" : $smtp_server, Hello => $smtp_domain, Debug => $debug_net_smtp); if ($smtp_encryption eq 'tls' && $smtp) { require Net::SMTP::SSL; $smtp->command('STARTTLS'); $smtp->response(); if ($smtp->code == 220) { $smtp = Net::SMTP::SSL->start_SSL($smtp) or die "STARTTLS failed! ".$smtp->message; $smtp_encryption = ''; # Send EHLO again to receive fresh # supported commands $smtp->hello(); } else { die "Server does not support STARTTLS! ".$smtp->message; } } } if (!$smtp) { die "Unable to initialize SMTP properly. Check config and use --smtp-debug. ", "VALUES: server=$smtp_server ", "encryption=$smtp_encryption ", "hello=$smtp_domain", defined $smtp_server_port ? "port=$smtp_server_port" : ""; } if (defined $smtp_authuser) { if (!defined $smtp_authpass) { system "stty -echo"; do { print "Password: "; $_ = ; print "\n"; } while (!defined $_); chomp($smtp_authpass = $_); system "stty echo"; } $auth ||= $smtp->auth( $smtp_authuser, $smtp_authpass ) or die $smtp->message; } $smtp->mail( $raw_from ) or die $smtp->message; $smtp->to( @recipients ) or die $smtp->message; $smtp->data or die $smtp->message; $smtp->datasend("$header\n$message") or die $smtp->message; $smtp->dataend() or die $smtp->message; $smtp->code =~ /250|200/ or die "Failed to send $subject\n".$smtp->message; } if ($quiet) { printf (($dry_run ? "Dry-" : "")."Sent %s\n", $subject); } else { print (($dry_run ? "Dry-" : "")."OK. Log says:\n"); if ($smtp_server !~ m#^/#) { print "Server: $smtp_server\n"; print "MAIL FROM:<$raw_from>\n"; foreach my $entry (@recipients) { print "RCPT TO:<$entry>\n"; } } else { print "Sendmail: $smtp_server ".join(' ',@sendmail_parameters)."\n"; } print $header, "\n"; if ($smtp) { print "Result: ", $smtp->code, ' ', ($smtp->message =~ /\n([^\n]+\n)$/s), "\n"; } else { print "Result: OK\n"; } } return 1; } $reply_to = $initial_reply_to; $references = $initial_reply_to || ''; $subject = $initial_subject; $message_num = 0; foreach my $t (@files) { open(F,"<",$t) or die "can't open file $t"; my $author = undef; my $author_encoding; my $has_content_type; my $body_encoding; @cc = (); @msgto = (); @xh = (); my $input_format = undef; my @header = (); $message = ""; $message_num++; # First unfold multiline header fields while() { last if /^\s*$/; if (/^\s+\S/ and @header) { chomp($header[$#header]); s/^\s+/ /; $header[$#header] .= $_; } else { push(@header, $_); } } # Now parse the header foreach(@header) { if (/^From /) { $input_format = 'mbox'; next; } chomp; if (!defined $input_format && /^[-A-Za-z]+:\s/) { $input_format = 'mbox'; } if (defined $input_format && $input_format eq 'mbox') { if (/^Subject:\s+(.*)$/) { $subject = $1; } elsif (/^From:\s+(.*)$/) { ($author, $author_encoding) = unquote_rfc2047($1); next if $suppress_cc{'author'}; next if $suppress_cc{'self'} and $author eq $sender; printf("(mbox) Adding cc: %s from line '%s'\n", $1, $_) unless $quiet; push @cc, $1; } elsif (/^Cc:\s+(.*)$/) { foreach my $addr (parse_address_line($1)) { if (unquote_rfc2047($addr) eq $sender) { next if ($suppress_cc{'self'}); } else { next if ($suppress_cc{'cc'}); } printf("(mbox) Adding cc: %s from line '%s'\n", $addr, $_) unless $quiet; push @cc, $addr; } } elsif ($auto_to && /^To:\s+(.*)$/) { foreach my $addr (parse_address_line($1)) { printf("(mbox) Adding to: %s from line '%s'\n", $addr, $_) unless $quiet; push @msgto, $addr; } } elsif (/^Content-type:/i) { $has_content_type = 1; if (/charset="?([^ "]+)/) { $body_encoding = $1; } push @xh, $_; } elsif (/^Message-Id: (.*)/i) { $message_id = $1; } elsif (!/^Date:\s/ && /^[-A-Za-z]+:\s+\S/) { push @xh, $_; } } else { # In the traditional # "send lots of email" format, # line 1 = cc # line 2 = subject # So let's support that, too. $input_format = 'lots'; if (@cc == 0 && !$suppress_cc{'cc'}) { printf("(non-mbox) Adding cc: %s from line '%s'\n", $_, $_) unless $quiet; push @cc, $_; } elsif (!defined $subject) { $subject = $_; } } } # Now parse the message body while() { $message .= $_; if (/^(Signed-off-by|Cc): (.*)$/i) { chomp; my ($what, $c) = ($1, $2); chomp $c; if ($c eq $sender) { next if ($suppress_cc{'self'}); } else { next if $suppress_cc{'sob'} and $what =~ /Signed-off-by/i; next if $suppress_cc{'bodycc'} and $what =~ /Cc/i; } push @cc, $c; printf("(body) Adding cc: %s from line '%s'\n", $c, $_) unless $quiet; } } close F; if (defined $cc_cmd && !$suppress_cc{'cccmd'}) { open(F, "$cc_cmd \Q$t\E |") or die "(cc-cmd) Could not execute '$cc_cmd'"; while() { my $c = $_; $c =~ s/^\s*//g; $c =~ s/\n$//g; next if ($c eq $sender and $suppress_from); push @cc, $c; printf("(cc-cmd) Adding cc: %s from: '%s'\n", $c, $cc_cmd) unless $quiet; } close F or die "(cc-cmd) failed to close pipe to '$cc_cmd'"; } if ($broken_encoding{$t} && !$has_content_type) { $has_content_type = 1; push @xh, "MIME-Version: 1.0", "Content-Type: text/plain; charset=$auto_8bit_encoding", "Content-Transfer-Encoding: 8bit"; $body_encoding = $auto_8bit_encoding; } if ($broken_encoding{$t} && !is_rfc2047_quoted($subject)) { $subject = quote_rfc2047($subject, $auto_8bit_encoding); } if (defined $author and $author ne $sender) { $message = "From: $author\n\n$message"; if (defined $author_encoding) { if ($has_content_type) { if ($body_encoding eq $author_encoding) { # ok, we already have the right encoding } else { # uh oh, we should re-encode } } else { $has_content_type = 1; push @xh, 'MIME-Version: 1.0', "Content-Type: text/plain; charset=$author_encoding", 'Content-Transfer-Encoding: 8bit'; } } } $needs_confirm = ( $confirm eq "always" or ($confirm =~ /^(?:auto|cc)$/ && @cc) or ($confirm =~ /^(?:auto|compose)$/ && $compose && $message_num == 1)); $needs_confirm = "inform" if ($needs_confirm && $confirm_unconfigured && @cc); @cc = (@initial_cc, @cc); my $message_was_sent = send_message(); # set up for the next message if ($thread && $message_was_sent && (chain_reply_to() || !defined $reply_to || length($reply_to) == 0)) { $reply_to = $message_id; if (length $references > 0) { $references .= "\n $message_id"; } else { $references = "$message_id"; } } $message_id = undef; } cleanup_compose_files(); sub cleanup_compose_files() { unlink($compose_filename, $compose_filename . ".final") if $compose; } $smtp->quit if $smtp; sub unique_email_list(@) { my %seen; my @emails; foreach my $entry (@_) { if (my $clean = extract_valid_address($entry)) { $seen{$clean} ||= 0; next if $seen{$clean}++; push @emails, $entry; } else { print STDERR "W: unable to extract a valid address", " from: $entry\n"; } } return @emails; } sub validate_patch { my $fn = shift; open(my $fh, '<', $fn) or die "unable to open $fn: $!\n"; while (my $line = <$fh>) { if (length($line) > 998) { return "$.: patch contains a line longer than 998 characters"; } } return undef; } sub file_has_nonascii { my $fn = shift; open(my $fh, '<', $fn) or die "unable to open $fn: $!\n"; while (my $line = <$fh>) { return 1 if $line =~ /[^[:ascii:]]/; } return 0; } sub body_or_subject_has_nonascii { my $fn = shift; open(my $fh, '<', $fn) or die "unable to open $fn: $!\n"; while (my $line = <$fh>) { last if $line =~ /^$/; return 1 if $line =~ /^Subject.*[^[:ascii:]]/; } while (my $line = <$fh>) { return 1 if $line =~ /[^[:ascii:]]/; } return 0; } coccinelle-1.0.0-rc19/tools/dumper.mli0000644000175000017500000000243112247442616016523 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./dumper.mli" (* Dump an OCaml value into a printable string. * By Richard W.M. Jones (rich@annexia.org). * dumper.mli 1.1 2005/02/03 23:07:47 rich Exp *) val dump : 'a -> string coccinelle-1.0.0-rc19/release.nix0000644000175000017500000004531112247437436015534 0ustar eugeneugen# Hydra build file for coccinelle { nixpkgs ? "/etc/nixos/nixpkgs" , cocciSrc ? { outPath = ./.; revCount = 1234; gitTag = "abcdef"; } , testsSrc ? { outPath = ../big-tests; rev = 1234; } , officialRelease ? false , performRegress ? true }: let # version information version = builtins.readFile ./version; versionSuffix = if officialRelease then "" else "pre${toString cocciSrc.revCount}-${cocciSrc.gitTag}"; # # Source release (tarball) # # The source tarball taken from the repository. # The tarball should actually be compilable using # ./configure && make depend && make opt && make install # on systems other than nix. tarball = let pkgs = import nixpkgs { }; in with pkgs; with ocamlPackages; releaseTools.sourceTarball { name = "coccinelle-tarball"; src = cocciSrc; inherit officialRelease; inherit version; inherit versionSuffix; buildInputs = [ ocaml findlib menhir python texLiveFull # for building the documentation pkgconfig # for the autoconf macros ]; preDist = '' local PREVHOME=$HOME export HOME=$TMPDIR # the latex installation needs to write to the $HOME directory, so rename it here ''; dontCopyDist = 1; # we'll copy the tarball to the tarballs folder ourselves (and rename it) postDist = '' export HOME=$PREVHOME # restore the home directory mkdir -p "$out/tarballs" # rename the tarball to give it a version-specific name cp coccinelle-*.tar.gz "$out/tarballs/coccinelle-${version}${versionSuffix}.tar.gz" ''; }; # # Helper functions for building configurations # selOcamlDefault = orig: orig.ocamlPackages; selOcaml400 = orig: orig.ocamlPackages_4_00_0; selOcaml312 = orig: orig.ocamlPackages_3_12_1; selOcaml311 = orig: orig.ocamlPackages_3_11_2; selOcaml310 = orig: orig.ocamlPackages_3_10_0; selCommonOcamlPkgs = ocamlPackages: with ocamlPackages; [ findlib menhir ocaml_sexplib ]; selMinimalOcamlPkgs = ocamlPackages: with ocamlPackages; [ findlib menhir ]; selAllOcamlPkgs = ocamlPackages: with ocamlPackages; [ findlib menhir ocaml_sexplib ocaml_pcre pycaml ]; selCommonInputs = pkgs: [ pkgs.pkgconfig pkgs.pcre ]; selDefaultShell = pkgs: pkgs.stdenv.shell; selPythonNone = pkgs: []; selPythonDefault = pkgs: [ pkgs.python ]; selPython2 = pkgs: [ pkgs.python27 ]; selPython3 = pkgs: [ pkgs.python3 ]; # creates a configuration for a given python version mkCfgPython = f: pkgs: with (f pkgs); { inherit name pythons flags; ocamls = selCommonOcamlPkgs pkgs.ocamlPackages ++ [ pkgs.ocamlPackages.pycaml ]; selOcaml = selOcamlDefault; extras = selCommonInputs pkgs; shell = selDefaultShell pkgs; extraAttrs = { }; }; # creates a configuration for a given ocaml version mkCfgOcaml = { name, selOcaml, flags }: pkgs: { inherit flags selOcaml; name = "ocaml-${name}"; pythons = selPythonDefault pkgs; ocamls = selMinimalOcamlPkgs pkgs.ocamlPackages; extras = selCommonInputs pkgs; shell = selDefaultShell pkgs; extraAttrs = { }; }; # creates a default configuration with additional flags mkCfgDefault = { name, flags, extra ? {} }: pkgs: { inherit name flags; pythons = selPythonDefault pkgs; ocamls = selAllOcamlPkgs pkgs.ocamlPackages; selOcaml = selOcamlDefault; extras = selCommonInputs pkgs; shell = selDefaultShell pkgs; extraAttrs = extra; }; # creates a minimal configuration with additional flags mkCfgMinimal = { name, flags }: pkgs: { inherit name flags; pythons = []; ocamls = []; selOcaml = selOcamlDefault; extras = []; shell = selDefaultShell pkgs; extraAttrs = { }; }; # creates a configuration for the given ocaml packages mkCfgPackage = { name, ocamls, flags }: pkgs: { inherit name flags; pythons = selPythonDefault pkgs; ocamls = selMinimalOcamlPkgs pkgs.ocamlPackages ++ ocamls pkgs.ocamlPackages; selOcaml = selOcamlDefault; extras = selCommonInputs pkgs; shell = selDefaultShell pkgs; extraAttrs = { }; }; # build the project using the given shell # it takes a minimal configuration, but then with all the # libraries that trigger features of coccinelle to be enabled. mkCfgShell = { name, selShell }: pkgs: { inherit name; pythons = selPythonDefault pkgs; ocamls = selMinimalOcamlPkgs pkgs.ocamlPackages; selOcaml = selOcamlDefault; flags = []; extras = [ pkgs.pcre ]; shell = selShell pkgs; extraAttrs = { }; }; # creates a configuration with multiple ocaml versions: this gives # conflicts. This is just a test to see whether our build system is # not too much confused in this case. It seems at least that ocamlfind # cannot be used in this setting. mkCfgManyOcaml = let selOcaml = pkgs: ocamlPkgSel: with (ocamlPkgSel pkgs); ocaml; selPkgs = pkgs: ocamlPkgSel: with (ocamlPkgSel pkgs); [ menhir ]; in sels: pkgs: { name = "many-ocaml"; pythons = []; ocamls = pkgs.lib.concatMap (selPkgs pkgs) sels; selOcaml = selOcamlDefault; flags = []; extras = selCommonInputs pkgs ++ map (selOcaml pkgs) sels; shell = selDefaultShell pkgs; extraAttrs = { }; }; # # Configurations # defaultCfg = mkCfgDefault { name = "default"; flags = []; }; debugCfg = mkCfgDefault { name = "debug"; flags = [ "--enable-release=no" ]; }; wrappersCfg = mkCfgDefault { name = "wrappers"; flags = [ "--enable-python" "--enable-ocaml" "--without-pkg-config" "--without-ocamlfind" ]; }; manyOcamlCfg = mkCfgManyOcaml [ selOcaml400 selOcaml312 selOcaml311 selOcaml310 ]; minimalCfgs = map mkCfgMinimal [ { name = "minimal"; flags = []; } { name = "noocamlscripting"; flags = [ "--disable-ocaml" ]; } ]; # Several configurations testing different python versions. # We exlicitly pass the "--enable-python" flag so that the # build should fail if no suitable python can be detected. pythonCfgs = map mkCfgPython [ ( _ : { name = "no-python"; pythons = []; flags = []; }) (pkgs: { name = "python2-local"; pythons = selPython2 pkgs; flags = [ "--enable-python" "--disable-pycaml" ]; }) (pkgs: { name = "python3-local"; pythons = selPython3 pkgs; flags = [ "--enable-python" "--disable-pycaml" ]; }) (pkgs: { name = "python3-global"; pythons = selPython3 pkgs; flags = [ "--enable-python" ]; }) (pkgs: { name = "python-nopkgconfig"; pythons = selPython2 pkgs; flags = [ "--enable-python" "--without-pkg-config" ]; }) # disabled because this combination does not work in NixOS # (pkgs: { # name = "many-pythons"; # pythons = selPython3 pkgs ++ selPython2 pkgs; # flags = [ "--with-python=python3" ]; # }) ]; # Several configurations testing different OCaml versions. # These versions ship with minimal global packages in order # to thest the bundled packages with these ocaml versions. ocamlCfgs = map mkCfgOcaml [ { name = "400nat"; selOcaml = selOcaml400; flags = [ "--enable-release=yes" ]; } { name = "400byt"; selOcaml = selOcaml400; flags = []; } { name = "312"; selOcaml = selOcaml312; flags = []; } { name = "311"; selOcaml = selOcaml311; flags = [ "--enable-release=yes" ]; } { name = "310"; selOcaml = selOcaml310; flags = []; } ]; # Several configurations testing different available # ocaml packages. pkgCfgs = map mkCfgPackage [ { name = "pcre"; ocamls = ps: [ ps.ocaml_pcre ]; flags = [ "--enable-pcre-syntax" ]; } { name = "sexplib"; ocamls = ps: [ ps.ocaml_sexplib ]; flags = [ "--enable-sexplib" ]; } { name = "pycaml"; ocamls = ps: [ ps.pycaml ]; flags = [ "--enable-pycaml" ]; } ]; # Tests using several different types of shells. shellCfgs = map mkCfgShell [ { name = "bash"; selShell = pkgs: "${pkgs.bash}/bin/bash"; } { name = "dash"; selShell = pkgs: "${pkgs.dash}/bin/dash"; } { name = "zsh"; selShell = pkgs: "${pkgs.zsh}/bin/zsh"; } # the configure script is not compatible with tcsh # { name = "tcsh"; selShell = pkgs: "${pkgs.tcsh}/bin/tcsh"; } ]; # # Configurations for the compilation of coccinelle using ocamlbuild. # ocamlbuildZeroCfg = mkCfgMinimal { name = "ocamlbuild-zero"; flags = [ "--enable-ocamlbuild" "--enable-release" ]; }; ocamlbuildFullCfg = mkCfgDefault { name = "ocamlbuild-full"; flags = [ "--enable-ocamlbuild" "--enable-release" ]; }; ocamlbuildCfgs = map mkCfgOcaml [ { name = "ocamlbuild-400nat"; selOcaml = selOcaml400; flags = [ "--enable-ocamlbuild" "--enable-release=yes" ]; } { name = "ocamlbuild-400byte"; selOcaml = selOcaml400; flags = [ "--enable-ocamlbuild" ]; } { name = "ocamlbuild-312"; selOcaml = selOcaml312; flags = [ "--enable-ocamlbuild" "--enable-release" ]; } { name = "ocamlbuild-311"; selOcaml = selOcaml311; flags = [ "--enable-ocamlbuild" ]; } { name = "ocamlbuild-310"; selOcaml = selOcaml310; flags = [ "--enable-ocamlbuild" "--enable-release" ]; } ] ++ [ ocamlbuildZeroCfg ocamlbuildFullCfg ]; altCfgs = [ debugCfg manyOcamlCfg ] ++ minimalCfgs ++ ocamlCfgs ++ pythonCfgs ++ pkgCfgs ++ shellCfgs ++ ocamlbuildCfgs; # # Builds for specific configurations # # builds coccinelle, parameterized over the ocaml and python packages, and the configure flags. # the result should be a usable nix-expression # mkConfiguration is a function that takes the nix package collection of the build # (called 'pkgs') and results in a record containing: # name of the configuration, python packages, ocaml packages selection function # (which takes the original 'pkgs' as parameter), and ocaml packages. The selection # function is used by 'mkConfiguration' to determine the appropriate ocamlPackages # field in 'pkgs'. mkBuild = mkConfiguration: { system ? builtins.currentSystem }: let pkgs = import nixpkgs { inherit system; config.packageOverrides = orig : { ocamlPackages = cfg.selOcaml orig; }; }; cfg = mkConfiguration pkgs; flags = [ "--enable-release=world" ] ++ cfg.flags; in with pkgs; releaseTools.nixBuild ({ inherit (cfg) shell; name = "cocci-build-${cfg.name}"; src = tarball; enableParallelBuilding = true; buildInputs = cfg.extras ++ [ ncurses ocamlPackages.ocaml ] ++ cfg.ocamls ++ cfg.pythons; configureFlags = pkgs.lib.concatStringsSep " " flags; # hmm, flags are now not allowed to contain spaces doCheck = true; buildPhase = '' mkdir -p "$out/nix-support/" touch "$out/nix-support/make.log" echo "report log $out/nix-support/result.log" >> "$out/nix-support/hydra-build-products" make all 2> >(tee -a "$out/nix-support/make.log" >&2) ''; # changes the shell in some of the scripts to the configured one prePatch = '' echo "patching the shell in scripts to: ${cfg.shell}" for script in configure scripts/spatch.sh.in scripts/genversion.sh \ setup/fake-subst.sh setup/fake-menhir.sh setup/fake-pdflatex.sh; do substituteInPlace $script --replace '#! /bin/sh' '#! ${cfg.shell}' done ''; } // cfg.extraAttrs); build = mkBuild defaultCfg; altBuilds = map mkBuild altCfgs; allBuilds = [ build ] ++ altBuilds; # compile with ocaml profiling turned on and then running the # test suite to collect results. profileCfg = mkCfgDefault { name = "profiling"; flags = [ "--enable-release=profile" ]; extra = { installPhase = '' mkdir -p "$out/nix-support" cp ocamlprof.dump "$out/ocamlprof.dump" echo "file binary $out/ocamlprof.dump" >> "$out/nix-support/hydra-build-products" ''; }; }; profile = mkBuild profileCfg {}; # # Package builders # # package builder for Debian-based OS'ses makeDeb = system: diskImageFun: with import nixpkgs { inherit system; }; releaseTools.debBuild { name = "coccinelle-deb"; src = tarball; diskImage = diskImageFun vmTools.diskImageFuns { extraPackages = [ "python" "python-support" "ocaml-nox" "ocaml-findlib" ]; }; debRequires = [ "python" "python-support" "ocaml-nox" "ocaml-findlib" ]; doCheck = false; buildPhase = '' make depend make all make all.opt ''; }; makeDeb_i686 = makeDeb "i686-linux"; makeDeb_x86_64 = makeDeb "x86_64-linux"; # different debian builds # deb_ubuntu1010_i386 = makeDeb_i686 (disk: disk.ubuntu1010i386); # deb_ubuntu1010_x86_64 = makeDeb_x86_64 (disk: disk.ubuntu1010x86_64); # # Testing tasks # mkTask = argsfun: { system ? builtins.currentSystem }: let pkgs = import nixpkgs { inherit system; }; args = argsfun pkgs system; name = "${args.name}-${version}${versionSuffix}"; in pkgs.stdenv.mkDerivation ({ phases = [ "runPhase" ]; runPhase = '' mkdir -p "$out" mkdir -p "$out/nix-support" touch "$TMPDIR/result.log" exec > >(tee -a "$TMPDIR/result.log") 2> >(tee -a "$TMPDIR/result.log" >&2) runHook execPhase cp "$TMPDIR/result.log" "$out/" echo "report log $out/result.log" >> "$out/nix-support/hydra-build-products" echo "$name" > "$out/nix-support/hydra-release-name" ''; meta = { description = "Coccinelle post-build task"; schedulingPriority = 8; }; } // args // { inherit name; }); mkReport = inputs: mkTask (pkgs: _: with pkgs; let builds = map (i: i { inherit (pkgs.stdenv) system; }) inputs; in { name = "report"; execPhase = '' echo "collecting logs" for build in ${lib.concatStringsSep " " builds}; do echo "log: $build/nix-support/make.log" cat "$build/nix-support/make.log" done echo "grepping OCaml warnings" if grep -2 "Warning " "$TMPDIR/result.log" then echo "found warnings!" false else echo "there are apparently no significant warnings" fi ''; meta = { description = "Analysis of the coccinelle build reports"; schedulingPriority = 5; }; }); report = mkReport allBuilds; # # Regression tests # # Produces regression test results, which can be positive or # negative. The build should succeed regardless of the outcome # of individual tests unless coccinelle is horribly broken. # The resulting files are stored in a tarball so that it allows # manual inspection. mkRegress = cocciSelect: mkTask (pkgs: system: with pkgs; let coccinelle = cocciSelect { inherit system; }; in { name = "regression-${toString testsSrc.rev}"; buildInputs = [ coccinelle ]; execPhase = '' # prepare a writeable tests directory # as this directory contains large # files, we'll create links to the # individual files. mkdir -p "$TMPDIR/tests" cp -rs ${testsSrc}/* "$TMPDIR/tests/" chmod -R u+w "$TMPDIR/tests/" cd "$TMPDIR/tests" # initialize essential environment variables # for the makefile export COCCINELLE_HOME=${coccinelle}/share/coccinelle export COCCIDIR=$TMPDIR export SPATCH=${coccinelle}/bin/spatch.opt export ISO=${coccinelle}/share/coccinelle/standard.iso export DEFS=${coccinelle}/share/coccinelle/standard.h # generate the test outcomes using a parallel build make -e all -j$NIX_BUILD_CORES -l$NIX_BUILD_CORES # collect the results # note: the tarball is likely to contain useless # symbolic links to files in the nix store. We therefore # delete these symlinks. As a result, you should be able # to unpack the tarball in the tests directory. find "$TMPDIR/tests" -depth -type l -delete cd "$TMPDIR" tar -czf "$out/results.tar.gz" ./tests echo "file binary-dist $out/results.tar.gz" >> "$out/nix-support/hydra-build-products" ''; meta = { description = "Regression test of Coccinelle"; schedulingPriority = 8; }; }); # Checks whether the regression tests meet our expectations. # If the set of failed tests is different than specified in # the tests repository, this check fails. checkRegress = regressSelect: mkTask (pkgs: system: with pkgs; let regress = regressSelect { inherit system; }; in { name = "test-${toString testsSrc.rev}"; execPhase = '' # prepare a writeable tests directory # as this directory contains large # files, we'll create links to the # individual files. mkdir -p "$TMPDIR/tests" cp -rs ${testsSrc}/* "$TMPDIR/tests/" chmod -R u+w "$TMPDIR/tests/" # extract the outcome of the regression test over it echo "reconstructing regression directory" cd "$TMPDIR" tar xfz "${regress}/results.tar.gz" cd "$TMPDIR/tests" echo "analyzing results" make failedlog echo "verifying the outcome" make check ''; meta = { description = "Regression test of Coccinelle"; schedulingPriority = 8; }; }); regress = mkRegress build; test = checkRegress regress; # # Performing release actions # dist = let pkgs = import nixpkgs { }; name = "release-${version}${versionSuffix}"; in with pkgs; releaseTools.nixBuild { inherit name; src = cocciSrc; buildInputs = with ocamlPackages; [ pkgconfig ncurses texLiveFull ocaml findlib menhir python pcre patchelf ]; configureFlags = "--enable-release"; buildPhase = '' export TARGETDIR="$TMPDIR/dists" mkdir -p $TARGETDIR export HOME=$TMPDIR make prerelease GIT=echo TMP=$TARGETDIR make release GIT=echo TMP=$TARGETDIR make package TMP=$TARGETDIR ''; installPhase = '' mkdir -p "$out/nix-support/" echo "cocci-dist-${version}" > "$out/nix-support/hydra-release-name" cp $TMPDIR/dists/*.tgz "$out/" for file in $out/*.tgz; do echo "file binary-dist $file" >> $out/nix-support/hydra-build-products done ''; dontInstall = false; doCheck = false; }; # # collections of build tasks # basicAttrs = { inherit tarball; inherit build; inherit report; inherit dist; inherit profile; }; # artificial dependency on report to ensure that we are not going through # an expensive regression test when there is already something wrong with # the build process. reportFirst = x : if report == null then x else x; testAttrs = reportFirst { inherit regress; inherit test; }; in basicAttrs // (if performRegress then testAttrs else {}) coccinelle-1.0.0-rc19/cocci.ml0000644000175000017500000020365212247442614015004 0ustar eugeneugen(* * Copyright 2012, INRIA * Julia Lawall, Gilles Muller * Copyright 2010-2011, INRIA, University of Copenhagen * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix * This file is part of Coccinelle. * * Coccinelle is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation, according to version 2 of the License. * * Coccinelle is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with Coccinelle. If not, see . * * The authors reserve the right to distribute this or future versions of * Coccinelle under other licenses. *) # 0 "./cocci.ml" open Common module CCI = Ctlcocci_integration module TAC = Type_annoter_c module Ast_to_flow = Control_flow_c_build (*****************************************************************************) (* This file is a kind of driver. It gathers all the important functions * from coccinelle in one place. The different entities in coccinelle are: * - files * - astc * - astcocci * - flow (contain nodes) * - ctl (contain rule_elems) * This file contains functions to transform one in another. *) (*****************************************************************************) (* --------------------------------------------------------------------- *) (* C related *) (* --------------------------------------------------------------------- *) let cprogram_of_file saved_typedefs saved_macros parse_strings file = let (program2, _stat) = Parse_c.parse_c_and_cpp_keep_typedefs (if !Flag_cocci.use_saved_typedefs then (Some saved_typedefs) else None) (Some saved_macros) parse_strings file in program2 let cprogram_of_file_cached parse_strings file = let ((program2,typedefs,macros), _stat) = Parse_c.parse_cache parse_strings file in if !Flag_cocci.ifdef_to_if then let p2 = program2 +> Parse_c.with_program2 (fun asts -> Cpp_ast_c.cpp_ifdef_statementize asts ) in (p2,typedefs,macros) else (program2,typedefs,macros) let cfile_of_program program2_with_ppmethod outf = Unparse_c.pp_program program2_with_ppmethod outf (* for memoization, contains only one entry, the one for the SP *) let _hparse = Hashtbl.create 101 let _h_ocaml_init = Hashtbl.create 101 let _hctl = Hashtbl.create 101 (* --------------------------------------------------------------------- *) (* Cocci related *) (* --------------------------------------------------------------------- *) (* for a given pair (file,iso), only keep an instance for the most recent virtual rules and virtual_env *) let sp_of_file2 file iso = let redo _ = let new_code = let (_,xs,_,_,_,_,_,_) as res = Parse_cocci.process file iso false in (* if there is already a compiled ML code, do nothing and use that *) try let _ = Hashtbl.find _h_ocaml_init (file,iso) in res with Not_found -> begin Hashtbl.add _h_ocaml_init (file,iso) (); match Prepare_ocamlcocci.prepare file xs with None -> res | Some ocaml_script_file -> (* compile file *) Prepare_ocamlcocci.load_file ocaml_script_file; (if not !Common.save_tmp_files then Prepare_ocamlcocci.clean_file ocaml_script_file); res end in Hashtbl.add _hparse (file,iso) (!Flag.defined_virtual_rules,!Flag.defined_virtual_env,new_code); new_code in try let (rules,env,code) = Hashtbl.find _hparse (file,iso) in if rules = !Flag.defined_virtual_rules && env = !Flag.defined_virtual_env then code else (Hashtbl.remove _hparse (file,iso); redo()) with Not_found -> redo() let sp_of_file file iso = Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso) (* --------------------------------------------------------------------- *) (* Flow related *) (* --------------------------------------------------------------------- *) let print_flow flow = Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true let ast_to_flow_with_error_messages2 x = let flowopt = try Ast_to_flow.ast_to_control_flow x with Ast_to_flow.Error x -> Ast_to_flow.report_error x; None in flowopt +> do_option (fun flow -> (* This time even if there is a deadcode, we still have a * flow graph, so I can try the transformation and hope the * deadcode will not bother us. *) try Ast_to_flow.deadcode_detection flow with Ast_to_flow.Error (Ast_to_flow.DeadCode x) -> Ast_to_flow.report_error (Ast_to_flow.DeadCode x); ); flowopt let ast_to_flow_with_error_messages a = Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a) (* --------------------------------------------------------------------- *) (* Ctl related *) (* --------------------------------------------------------------------- *) let ctls_of_ast2 ast (ua,fua,fuas) pos = List.map2 (function ast -> function (ua,(fua,(fuas,pos))) -> List.combine (if !Flag_cocci.popl then Popl.popl ast else Asttoctl2.asttoctl ast (ua,fua,fuas) pos) (Asttomember.asttomember ast ua)) ast (List.combine ua (List.combine fua (List.combine fuas pos))) let ctls_of_ast ast ua pl = Common.profile_code "asttoctl2" (fun () -> ctls_of_ast2 ast ua pl) (*****************************************************************************) (* Some debugging functions *) (*****************************************************************************) (* the inputs *) let show_or_not_cfile2 cfile = if !Flag_cocci.show_c then begin Common.pr2_xxxxxxxxxxxxxxxxx (); pr2 ("processing C file: " ^ cfile); Common.pr2_xxxxxxxxxxxxxxxxx (); Common.command2 ("cat " ^ cfile); end let show_or_not_cfile a = Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a) let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles let show_or_not_cocci2 coccifile isofile = if !Flag_cocci.show_cocci then begin Common.pr2_xxxxxxxxxxxxxxxxx (); pr2 ("processing semantic patch file: " ^ coccifile); isofile +> (fun s -> pr2 ("with isos from: " ^ s)); Common.pr2_xxxxxxxxxxxxxxxxx (); Common.command2 ("cat " ^ coccifile); pr2 ""; end let show_or_not_cocci a b = Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b) (* ---------------------------------------------------------------------- *) (* the output *) let fix_sgrep_diffs l = let l = List.filter (function s -> (s =~ "^\\+\\+\\+") || not (s =~ "^\\+")) l in let l = List.rev l in (* adjust second number for + code *) let rec loop1 n = function [] -> [] | s::ss -> if s =~ "^-" && not(s =~ "^---") then s :: loop1 (n+1) ss else if s =~ "^@@" then (match Str.split (Str.regexp " ") s with bef::min::pl::aft -> let (n1,n2) = match Str.split (Str.regexp ",") pl with [n1;n2] -> (n1,n2) | [n1] -> (n1,"1") | _ -> failwith "bad + line information" in let n2 = int_of_string n2 in (Printf.sprintf "%s %s %s,%d %s" bef min n1 (n2-n) (String.concat " " aft)) :: loop1 0 ss | _ -> failwith "bad @@ information") else s :: loop1 n ss in let rec loop2 n = function [] -> [] | s::ss -> if s =~ "^---" then s :: loop2 0 ss else if s =~ "^@@" then (match Str.split (Str.regexp " ") s with bef::min::pl::aft -> let (m2,n1,n2) = match (Str.split (Str.regexp ",") min, Str.split (Str.regexp ",") pl) with ([_;m2],[n1;n2]) -> (m2,n1,n2) | ([_],[n1;n2]) -> ("1",n1,n2) | ([_;m2],[n1]) -> (m2,n1,"1") | ([_],[n1]) -> ("1",n1,"1") | _ -> failwith "bad -/+ line information" in let n1 = int_of_string (String.sub n1 1 ((String.length n1)-1)) in let m2 = int_of_string m2 in let n2 = int_of_string n2 in (Printf.sprintf "%s %s +%d,%d %s" bef min (n1-n) n2 (String.concat " " aft)) :: loop2 (n+(m2-n2)) ss | _ -> failwith "bad @@ information") else s :: loop2 n ss in loop2 0 (List.rev (loop1 0 l)) let normalize_path file = let fullpath = if String.get file 0 = '/' then file else (Sys.getcwd()) ^ "/" ^ file in let elements = Str.split_delim (Str.regexp "/") fullpath in let rec loop prev = function [] -> String.concat "/" (List.rev prev) | "." :: rest -> loop prev rest | ".." :: rest -> (match prev with x::xs -> loop xs rest | _ -> failwith "bad path") | x::rest -> loop (x::prev) rest in loop [] elements let generated_patches = Hashtbl.create(100) let show_or_not_diff2 cfile outfile = if !Flag_cocci.show_diff then begin match Common.fst(Compare_c.compare_to_original cfile outfile) with Compare_c.Correct -> () (* diff only in spacing, etc *) | _ -> (* may need --strip-trailing-cr under windows *) pr2 "diff = "; let line = match !Flag_parsing_c.diff_lines with | None -> "diff -u -p " ^ cfile ^ " " ^ outfile | Some n -> "diff -U "^n^" -p "^cfile^" "^outfile in let res = Common.cmd_to_list line in let res = List.map (function l -> match Str.split (Str.regexp "[ \t]+") l with "---"::file::date -> "--- "^file | "+++"::file::date -> "+++ "^file | _ -> l) res in let xs = match (!Flag.patch,res) with (* create something that looks like the output of patch *) (Some prefix,minus_file::plus_file::rest) -> let prefix = let lp = String.length prefix in if String.get prefix (lp-1) = '/' then String.sub prefix 0 (lp-1) else prefix in let drop_prefix file = let file = normalize_path file in if Str.string_match (Str.regexp prefix) file 0 then let lp = String.length prefix in let lf = String.length file in if lp < lf then String.sub file lp (lf - lp) else failwith (Printf.sprintf "prefix %s doesn't match file %s" prefix file) else failwith (Printf.sprintf "prefix %s doesn't match file %s" prefix file) in let diff_line = match List.rev(Str.split (Str.regexp " ") line) with new_file::old_file::cmdrev -> let old_base_file = drop_prefix old_file in if !Flag.sgrep_mode2 then String.concat " " (List.rev (("/tmp/nothing"^old_base_file) :: old_file :: cmdrev)) else String.concat " " (List.rev (("b"^old_base_file)::("a"^old_base_file):: cmdrev)) | _ -> failwith "bad command" in let (minus_line,plus_line) = match (Str.split (Str.regexp "[ \t]") minus_file, Str.split (Str.regexp "[ \t]") plus_file) with ("---"::old_file::old_rest,"+++"::new_file::new_rest) -> let old_base_file = drop_prefix old_file in if !Flag.sgrep_mode2 then (minus_file,"+++ /tmp/nothing"^old_base_file) else (String.concat " " ("---"::("a"^old_base_file)::old_rest), String.concat " " ("+++"::("b"^old_base_file)::new_rest)) | (l1,l2) -> failwith (Printf.sprintf "bad diff header lines: %s %s" (String.concat ":" l1) (String.concat ":" l2)) in diff_line::minus_line::plus_line::rest | _ -> res in let xs = if !Flag.sgrep_mode2 then fix_sgrep_diffs xs else xs in let cfile = normalize_path cfile in let patches = try Hashtbl.find generated_patches cfile with Not_found -> let cell = ref [] in Hashtbl.add generated_patches cfile cell; cell in if List.mem xs !patches then () else begin patches := xs :: !patches; xs +> List.iter pr end end let show_or_not_diff a b = Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b) (* the derived input *) let show_or_not_ctl_tex2 astcocci ctls = if !Flag_cocci.show_ctl_tex then begin let ctls = List.map (List.map (function ((Asttoctl2.NONDECL ctl | Asttoctl2.CODE ctl),x) -> (ctl,x))) ctls in Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls; Common.command2 ("cd /tmp; latex __cocci_ctl.tex; " ^ "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^ "gv __cocci_ctl.ps &"); end let show_or_not_ctl_tex a b = Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b) let show_or_not_rule_name ast rulenb = if !Flag_cocci.show_ctl_text or !Flag.show_trying or !Flag.show_transinfo or !Flag_cocci.show_binding_in_out then begin let name = match ast with Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm | _ -> i_to_s rulenb in Common.pr_xxxxxxxxxxxxxxxxx (); pr (name ^ " = "); Common.pr_xxxxxxxxxxxxxxxxx () end let show_or_not_scr_rule_name rulenb = if !Flag_cocci.show_ctl_text or !Flag.show_trying or !Flag.show_transinfo or !Flag_cocci.show_binding_in_out then begin let name = i_to_s rulenb in Common.pr_xxxxxxxxxxxxxxxxx (); pr ("script rule " ^ name ^ " = "); Common.pr_xxxxxxxxxxxxxxxxx () end let show_or_not_ctl_text2 ctl ast rulenb = if !Flag_cocci.show_ctl_text then begin adjust_pp_with_indent (fun () -> Format.force_newline(); Pretty_print_cocci.print_plus_flag := true; Pretty_print_cocci.print_minus_flag := true; Pretty_print_cocci.unparse ast; ); pr "CTL = "; let ((Asttoctl2.CODE ctl | Asttoctl2.NONDECL ctl),_) = ctl in adjust_pp_with_indent (fun () -> Format.force_newline(); Pretty_print_engine.pp_ctlcocci !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl; ); pr ""; end let show_or_not_ctl_text a b c = Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_text2 a b c) (* running information *) let get_celem celem : string = match celem with Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) -> Ast_c.str_of_name namefuncs | Ast_c.Declaration (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) -> Ast_c.str_of_name name | _ -> "" let show_or_not_celem2 prelude celem = let (tag,trying) = (match celem with | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) -> let funcs = Ast_c.str_of_name namefuncs in Flag.current_element := funcs; (" function: ",funcs) | Ast_c.Declaration (Ast_c.DeclList ([{Ast_c.v_namei = Some (name,_)}, _], _)) -> let s = Ast_c.str_of_name name in Flag.current_element := s; (" variable ",s); | _ -> Flag.current_element := "something_else"; (" ","something else"); ) in if !Flag.show_trying then pr2 (prelude ^ tag ^ trying) let show_or_not_celem a b = Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b) let show_or_not_trans_info2 trans_info = (* drop witness tree indices for printing *) let trans_info = List.map (function (index,trans_info) -> trans_info) trans_info in if !Flag.show_transinfo then begin if null trans_info then pr2 "transformation info is empty" else begin pr2 "transformation info returned:"; let trans_info = List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2) trans_info in indent_do (fun () -> trans_info +> List.iter (fun (i, subst, re) -> pr2 ("transform state: " ^ (Common.i_to_s i)); indent_do (fun () -> adjust_pp_with_indent_and_header "with rule_elem: " (fun () -> Pretty_print_cocci.print_plus_flag := true; Pretty_print_cocci.print_minus_flag := true; Pretty_print_cocci.rule_elem "" re; ); adjust_pp_with_indent_and_header "with binding: " (fun () -> Pretty_print_engine.pp_binding subst; ); ) ); ) end end let show_or_not_trans_info a = Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a) let show_or_not_binding2 s binding = if !Flag_cocci.show_binding_in_out then begin adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () -> Pretty_print_engine.pp_binding binding ) end let show_or_not_binding a b = Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b) (*****************************************************************************) (* Some helper functions *) (*****************************************************************************) let worth_trying2 cfiles (tokens,_,query,_) = (* drop the following line for a list of list by rules. since we don't allow multiple minirules, all the tokens within a rule should be in a single CFG entity *) let res = match (!Flag_cocci.windows,!Flag.scanner,tokens,query,cfiles) with (true,_,_,_,_) | (_,_,None,_,_) | (_,_,_,None,_) | (_,Flag.CocciGrep,_,_,_) -> true | (_,_,_,Some query,[cfile]) -> Cocci_grep.interpret query cfile | (_,_,Some tokens,_,_) -> (* could also modify the code in get_constants.ml *) let tokens = tokens +> List.map (fun s -> match () with | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" -> "\\b" ^ s ^ "\\b" | _ when s =~ "^[A-Za-z_]" -> "\\b" ^ s | _ when s =~ ".*[A-Za-z_]$" -> s ^ "\\b" | _ -> s ) in let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles) in (match Sys.command com with | 0 (* success *) -> true | _ (* failure *) -> (if !Flag.show_misc then Printf.printf "grep failed: %s\n" com); false (* no match, so not worth trying *)) in (match (res,tokens) with (false,Some tokens) -> pr2_once ("Expected tokens " ^ (Common.join " " tokens)); pr2 ("Skipping:" ^ (Common.join " " cfiles)) | _ -> ()); res let worth_trying a b = Common.profile_code "worth_trying" (fun () -> worth_trying2 a b) let check_macro_in_sp_and_adjust = function None -> () | Some tokens -> tokens +> List.iter (fun s -> if Hashtbl.mem !Parse_c._defs s then begin if !Flag_cocci.verbose_cocci then begin pr2 "warning: macro in semantic patch was in macro definitions"; pr2 ("disabling macro expansion for " ^ s); end; Hashtbl.remove !Parse_c._defs s end) let contain_loop gopt = match gopt with | Some g -> g#nodes#tolist +> List.exists (fun (xi, node) -> Control_flow_c.extract_is_loop node ) | None -> true (* means nothing, if no g then will not model check *) let sp_contain_typed_metavar_z toplevel_list_list = let bind x y = x or y in let option_default = false in let mcode _ _ = option_default in let donothing r k e = k e in let expression r k e = match Ast_cocci.unwrap e with | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true | _ -> k e in let combiner = Visitor_ast.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing donothing expression donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing in toplevel_list_list +> List.exists (function (nm,_,rule) -> (List.exists combiner.Visitor_ast.combiner_top_level rule)) let sp_contain_typed_metavar rules = sp_contain_typed_metavar_z (List.map (function x -> match x with Ast_cocci.CocciRule (a,b,c,d,_) -> (a,b,c) | _ -> failwith "error in filter") (List.filter (function x -> match x with Ast_cocci.CocciRule (a,b,c,d,Ast_cocci.Normal) -> true | _ -> false) rules)) (* finding among the #include the one that we need to parse * because they may contain useful type definition or because * we may have to modify them * * For the moment we base in part our heuristic on the name of the file, e.g. * serio.c is related we think to #include *) let include_table = Hashtbl.create(100) let interpret_include_path relpath = let maxdepth = List.length relpath in let unique_file_exists dir f = let cmd = Printf.sprintf "find %s -maxdepth %d -mindepth %d -path \"*/%s\"" dir maxdepth maxdepth f in match Common.cmd_to_list cmd with [x] -> Some x | _ -> None in let native_file_exists dir f = let f = Filename.concat dir f in if Sys.file_exists f then Some f else None in let rec search_include_path exists searchlist relpath = match searchlist with [] -> None | hd::tail -> (match exists hd relpath with Some x -> Some x | None -> search_include_path exists tail relpath) in let rec search_path exists searchlist = function [] -> let res = Common.concat "/" relpath in Hashtbl.add include_table (searchlist,relpath) res; Some res | (hd::tail) as relpath1 -> let relpath1 = Common.concat "/" relpath1 in (match search_include_path exists searchlist relpath1 with None -> search_path unique_file_exists searchlist tail | Some f -> Hashtbl.add include_table (searchlist,relpath) f; Some f) in let searchlist = match !Flag_cocci.include_path with [] -> ["include"] | x -> List.rev x in try Some(Hashtbl.find include_table (searchlist,relpath)) with Not_found -> search_path native_file_exists searchlist relpath let (includes_to_parse: (Common.filename * Parse_c.extended_program2) list -> Flag_cocci.include_options -> 'a) = fun xs choose_includes -> match choose_includes with Flag_cocci.I_UNSPECIFIED -> failwith "not possible" | Flag_cocci.I_NO_INCLUDES -> !Flag_cocci.extra_includes | x -> let all_includes = List.mem x [Flag_cocci.I_ALL_INCLUDES; Flag_cocci.I_REALLY_ALL_INCLUDES] in let xs = List.map (function (file,(cs,_,_)) -> (file,cs)) xs in xs +> List.map (fun (file, cs) -> let dir = Common.dirname file in cs +> Common.map_filter (fun (c,_info_item) -> match c with | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;}) -> (match x with | Ast_c.Local xs -> let relpath = Common.join "/" xs in let f = Filename.concat dir relpath in if (Sys.file_exists f) then Some f else if !Flag_cocci.relax_include_path (* for our tests, all the files are flat in the current dir *) then let attempt2 = Filename.concat dir (Common.last xs) in if not (Sys.file_exists attempt2) && all_includes then interpret_include_path xs else Some attempt2 else if all_includes then interpret_include_path xs else None | Ast_c.NonLocal xs -> if all_includes || Common.fileprefix (Common.last xs) =$= Common.fileprefix file then interpret_include_path xs else None | Ast_c.Weird _ -> None ) | _ -> None)) +> List.concat +> (fun x -> (List.rev (Common.uniq (!Flag_cocci.extra_includes@(List.rev x)))))(*uniq keeps last*) let rec interpret_dependencies local global = function Ast_cocci.Dep s -> List.mem s local | Ast_cocci.AntiDep s -> (if !Flag_ctl.steps != None then failwith "steps and ! dependency incompatible"); not (List.mem s local) | Ast_cocci.EverDep s -> List.mem s global | Ast_cocci.NeverDep s -> (if !Flag_ctl.steps != None then failwith "steps and ! dependency incompatible"); not (List.mem s global) | Ast_cocci.AndDep(s1,s2) -> (interpret_dependencies local global s1) && (interpret_dependencies local global s2) | Ast_cocci.OrDep(s1,s2) -> (interpret_dependencies local global s1) or (interpret_dependencies local global s2) | Ast_cocci.NoDep -> true | Ast_cocci.FailDep -> false let rec print_dependencies str local global dep = if !Flag_cocci.show_dependencies then begin pr2 str; let seen = ref [] in let rec loop = function Ast_cocci.Dep s | Ast_cocci.AntiDep s -> if not (List.mem s !seen) then begin if List.mem s local then pr2 (s^" satisfied") else pr2 (s^" not satisfied"); seen := s :: !seen end | Ast_cocci.EverDep s | Ast_cocci.NeverDep s -> if not (List.mem s !seen) then begin if List.mem s global then pr2 (s^" satisfied") else pr2 (s^" not satisfied"); seen := s :: !seen end | Ast_cocci.AndDep(s1,s2) -> loop s1; loop s2 | Ast_cocci.OrDep(s1,s2) -> loop s1; loop s2 | Ast_cocci.NoDep -> () | Ast_cocci.FailDep -> pr2 "False not satisfied" in loop dep end (* --------------------------------------------------------------------- *) (* #include relative position in the file *) (* --------------------------------------------------------------------- *) (* compute the set of new prefixes * on * "a/b/x"; (* in fact it is now a list of string so ["a";"b";"x"] *) * "a/b/c/x"; * "a/x"; * "b/x"; * it would give for the first element * ""; "a"; "a/b"; "a/b/x" * for the second * "a/b/c/x" * * update: if the include is inside a ifdef a put nothing. cf -test incl. * this is because we dont want code added inside ifdef. *) let compute_new_prefixes xs = xs +> Common.map_withenv (fun already xs -> let subdirs_prefixes = Common.inits xs in let new_first = subdirs_prefixes +> List.filter (fun x -> not (List.mem x already) ) in new_first, new_first @ already ) [] +> fst (* does via side effect on the ref in the Include in Ast_c *) let rec update_include_rel_pos cs = let only_include = cs +> Common.map_filter (fun c -> match c with | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_)); i_rel_pos = aref; i_is_in_ifdef = inifdef}) -> (match x with | Ast_c.Weird _ -> None | _ -> if inifdef then None else Some (x, aref) ) | _ -> None ) in let (locals, nonlocals) = only_include +> Common.partition_either (fun (c, aref) -> match c with | Ast_c.Local x -> Left (x, aref) | Ast_c.NonLocal x -> Right (x, aref) | Ast_c.Weird x -> raise (Impossible 161) ) in update_rel_pos_bis locals; update_rel_pos_bis nonlocals; cs and update_rel_pos_bis xs = let xs' = List.map fst xs in let the_first = compute_new_prefixes xs' in let the_last = List.rev (compute_new_prefixes (List.rev xs')) in let merged = Common.zip xs (Common.zip the_first the_last) in merged +> List.iter (fun ((x, aref), (the_first, the_last)) -> aref := Some { Ast_c.first_of = the_first; Ast_c.last_of = the_last; } ) (*****************************************************************************) (* All the information needed around the C elements and Cocci rules *) (*****************************************************************************) type toplevel_c_info = { ast_c: Ast_c.toplevel; (* contain refs so can be modified *) tokens_c: Parser_c.token list; fullstring: string; flow: Control_flow_c.cflow option; (* it's the "fixed" flow *) contain_loop: bool; env_typing_before: TAC.environment; env_typing_after: TAC.environment; was_modified: bool ref; all_typedefs: (string, Lexer_parser.identkind) Common.scoped_h_env; all_macros: (string, Cpp_token_c.define_def) Hashtbl.t; (* id: int *) } type rule_info = { rulename: string; dependencies: Ast_cocci.dependency; used_after: Ast_cocci.meta_name list; ruleid: int; was_matched: bool ref; } type toplevel_cocci_info_script_rule = { scr_ast_rule: string * (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar) list * Ast_cocci.meta_name list (*fresh vars*) * string; language: string; script_code: string; scr_rule_info: rule_info; } type toplevel_cocci_info_cocci_rule = { ctl: Asttoctl2.top_formula * (CCI.pred list list); metavars: Ast_cocci.metavar list; ast_rule: Ast_cocci.rule; isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *) (* There are also some hardcoded rule names in parse_cocci.ml: * let reserved_names = ["all";"optional_storage";"optional_qualifier"] *) dropped_isos: string list; free_vars: Ast_cocci.meta_name list; negated_pos_vars: Ast_cocci.meta_name list; positions: Ast_cocci.meta_name list; ruletype: Ast_cocci.ruletype; rule_info: rule_info; } type toplevel_cocci_info = ScriptRuleCocciInfo of toplevel_cocci_info_script_rule | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule | FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule type cocci_info = toplevel_cocci_info list * bool (* parsing of format strings needed *) type constant_info = (string list option (*grep tokens*) * string list option (*glimpse tokens*) * (Str.regexp * Str.regexp list) option (*coccigrep tokens*) * Get_constants2.combine option) type kind_file = Header | Source type file_info = { fname : string; full_fname : string; was_modified_once: bool ref; asts: toplevel_c_info list; fpath : string; fkind : kind_file; } let g_contain_typedmetavar = ref false let last_env_toplevel_c_info xs = (Common.last xs).env_typing_after let concat_headers_and_c (ccs: file_info list) : (toplevel_c_info * string) list = (List.concat (ccs +> List.map (fun x -> x.asts +> List.map (fun x' -> (x', x.fname))))) let for_unparser xs = xs +> List.map (fun x -> (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr ) let gen_pdf_graph () = (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile -> Printf.printf "Generation of %s%!" outfile; let filename_stack = Ctl_engine.get_graph_comp_files outfile in List.iter (fun filename -> ignore (Unix.system ("dot " ^ filename ^ " -Tpdf -o " ^ filename ^ ".pdf;")) ) filename_stack; let (head,tail) = (List.hd filename_stack, List.tl filename_stack) in ignore(Unix.system ("cp " ^ head ^ ".pdf " ^ outfile ^ ".pdf;")); tail +> List.iter (fun filename -> ignore(Unix.system ("mv " ^ outfile ^ ".pdf /tmp/tmp.pdf;")); ignore(Unix.system ("pdftk " ^ filename ^ ".pdf /tmp/tmp.pdf cat output " ^ outfile ^ ".pdf")); ); ignore(Unix.system ("rm /tmp/tmp.pdf;")); List.iter (fun filename -> ignore (Unix.system ("rm " ^ filename ^ " " ^ filename ^ ".pdf;")) ) filename_stack; Printf.printf " - Done\n") let local_python_code = "from coccinelle import *\n" let python_code = "import coccinelle\n"^ "import coccilib\n"^ "import coccilib.org\n"^ "import coccilib.report\n" ^ "import coccilib.xml_firehose\n" ^ local_python_code ^ "cocci = Cocci()\n" let make_init lang code rule_info = let mv = [] in { scr_ast_rule = (lang, mv, [], code); language = lang; script_code = (if lang = "python" then python_code else "") ^code; scr_rule_info = rule_info; } (* --------------------------------------------------------------------- *) let prepare_cocci ctls free_var_lists negated_pos_lists (ua,fua,fuas) positions_list metavars astcocci = let gathered = Common.index_list_1 (zip (zip (zip (zip (zip (zip (zip (zip ctls metavars) astcocci) free_var_lists) negated_pos_lists) ua) fua) fuas) positions_list) in gathered +> List.map (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list), negated_pos_list),ua),fua),fuas),positions_list),rulenb) -> let build_rule_info rulename deps = {rulename = rulename; dependencies = deps; used_after = (List.hd ua) @ (List.hd fua); ruleid = rulenb; was_matched = ref false;} in let is_script_rule r = match r with Ast_cocci.ScriptRule _ | Ast_cocci.InitialScriptRule _ | Ast_cocci.FinalScriptRule _ -> true | _ -> false in if not (List.length ctl_toplevel_list =|= 1) && not (is_script_rule ast) then failwith "not handling multiple minirules"; match ast with Ast_cocci.ScriptRule (name,lang,deps,mv,script_vars,code) -> let r = { scr_ast_rule = (lang, mv, script_vars, code); language = lang; script_code = code; scr_rule_info = build_rule_info name deps; } in ScriptRuleCocciInfo r | Ast_cocci.InitialScriptRule (name,lang,deps,code) -> let r = make_init lang code (build_rule_info name deps) in InitialScriptRuleCocciInfo r | Ast_cocci.FinalScriptRule (name,lang,deps,code) -> let mv = [] in let r = { scr_ast_rule = (lang, mv, [], code); language = lang; script_code = code; scr_rule_info = build_rule_info name deps; } in FinalScriptRuleCocciInfo r | Ast_cocci.CocciRule (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) -> CocciRuleCocciInfo ( { ctl = List.hd ctl_toplevel_list; metavars = metavars; ast_rule = ast; isexp = List.hd isexp; dropped_isos = dropped_isos; free_vars = List.hd free_var_list; negated_pos_vars = List.hd negated_pos_list; positions = List.hd positions_list; ruletype = ruletype; rule_info = build_rule_info rulename dependencies; }) ) (* --------------------------------------------------------------------- *) let build_info_program (cprogram,typedefs,macros) env = let (cs, parseinfos) = Common.unzip cprogram in let alltoks = parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in (* I use cs' but really annotate_xxx work by doing side effects on cs *) let cs' = Comment_annotater_c.annotate_program alltoks cs in let cs_with_envs = Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs' in zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)-> let (fullstr, tokens) = parseinfo in let flow = ast_to_flow_with_error_messages c +> Common.map_option (fun flow -> let flow = Ast_to_flow.annotate_loop_nodes flow in (* remove the fake nodes for julia *) let fixed_flow = CCI.fix_flow_ctl flow in if !Flag_cocci.show_flow then print_flow fixed_flow; if !Flag_cocci.show_before_fixed_flow then print_flow flow; fixed_flow ) in { ast_c = c; (* contain refs so can be modified *) tokens_c = tokens; fullstring = fullstr; flow = flow; contain_loop = contain_loop flow; env_typing_before = enva; env_typing_after = envb; was_modified = ref false; all_typedefs = typedefs; all_macros = macros; }) (* Optimization. Try not unparse/reparse the whole file when have modifs *) let rebuild_info_program cs file isexp parse_strings = cs +> List.map (fun c -> if !(c.was_modified) then let file = Common.new_temp_file "cocci_small_output" ".c" in cfile_of_program [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal] file; (* Common.command2 ("cat " ^ file); *) let cprogram = cprogram_of_file c.all_typedefs c.all_macros parse_strings file in let xs = build_info_program cprogram c.env_typing_before in (* TODO: assert env has not changed, * if yes then must also reparse what follows even if not modified. * Do that only if contain_typedmetavar of course, so good opti. *) (* Common.list_init xs *) (* get rid of the FinalDef *) xs else [c] ) +> List.concat let rebuild_info_c_and_headers ccs isexp parse_strings = ccs +> List.iter (fun c_or_h -> if c_or_h.asts +> List.exists (fun c -> !(c.was_modified)) then c_or_h.was_modified_once := true; ); ccs +> List.map (fun c_or_h -> { c_or_h with asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp parse_strings } ) let rec prepare_h seen env (hpath : string) choose_includes parse_strings : file_info list = if not (Common.lfile_exists hpath) then begin pr2_once ("TYPE: header " ^ hpath ^ " not found"); [] end else begin let h_cs = cprogram_of_file_cached parse_strings hpath in let local_includes = if choose_includes =*= Flag_cocci.I_REALLY_ALL_INCLUDES then List.filter (function x -> not (List.mem x !seen)) (includes_to_parse [(hpath,h_cs)] choose_includes) else [] in seen := local_includes @ !seen; let others = List.concat (List.map (function x -> prepare_h seen env x choose_includes parse_strings) local_includes) in let info_h_cs = build_info_program h_cs !env in env := if null info_h_cs then !env else last_env_toplevel_c_info info_h_cs; others@ [{ fname = Common.basename hpath; full_fname = hpath; asts = info_h_cs; was_modified_once = ref false; fpath = hpath; fkind = Header; }] end let prepare_c files choose_includes parse_strings : file_info list = let cprograms = List.map (cprogram_of_file_cached parse_strings) files in let includes = includes_to_parse (zip files cprograms) choose_includes in let seen = ref includes in (* todo?: may not be good to first have all the headers and then all the c *) let env = ref !TAC.initial_env in let includes = includes +> List.map (function hpath -> prepare_h seen env hpath choose_includes parse_strings) +> List.concat in let cfiles = (zip files cprograms) +> List.map (function (file, cprogram) -> (* todo?: don't update env ? *) let cs = build_info_program cprogram !env in (* we do that only for the c, not for the h *) ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c))); { fname = Common.basename file; full_fname = file; asts = cs; was_modified_once = ref false; fpath = file; fkind = Source }) in includes @ cfiles (*****************************************************************************) (* Manage environments as they are being built up *) (*****************************************************************************) let init_env _ = Hashtbl.create 101 let update_env env v i = Hashtbl.replace env v i; env (* know that there are no conflicts *) let safe_update_env env v i = Hashtbl.add env v i; env let end_env env = List.sort compare (Hashtbl.fold (fun k v rest -> (k,v) :: rest) env []) (*****************************************************************************) (* Processing the ctls and toplevel C elements *) (*****************************************************************************) (* The main algorithm =~ * The algorithm is roughly: * for_all ctl rules in SP * for_all minirule in rule (no more) * for_all binding (computed during previous phase) * for_all C elements * match control flow of function vs minirule * with the binding and update the set of possible * bindings, and returned the possibly modified function. * pretty print modified C elements and reparse it. * * * On ne prends que les newbinding ou returned_any_state est vrai. * Si ca ne donne rien, on prends ce qu'il y avait au depart. * Mais au nouveau depart de quoi ? * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ? * - ou alors si ca donne rien, apres avoir traité toutes les fonctions * avec tous les bindings du round d'avant ? * * Julia pense qu'il faut prendre la premiere solution. * Example: on a deux environnements candidats, E1 et E2 apres avoir traité * la regle ctl 1. On arrive sur la regle ctl 2. * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3. * E2 donne un match a un endroit et rend E2' alors on utilise ca pour * la regle 3. * * I have not to look at used_after_list to decide to restart from * scratch. I just need to look if the binding list is empty. * Indeed, let's suppose that a SP have 3 regions/rules. If we * don't find a match for the first region, then if this first * region does not bind metavariable used after, that is if * used_after_list is empty, then mysat(), even if does not find a * match, will return a Left, with an empty transformation_info, * and so current_binding will grow. On the contrary if the first * region must bind some metavariables used after, and that we * don't find any such region, then mysat() will returns lots of * Right, and current_binding will not grow, and so we will have * an empty list of binding, and we will catch such a case. * * opti: julia says that because the binding is * determined by the used_after_list, the items in the list * are kind of sorted, so could optimize the insert_set operations. *) (* r(ule), c(element in C code), e(nvironment) *) let merge_env new_e old_e = List.iter (function (e,rules) -> let _ = update_env old_e e rules in ()) new_e; old_e let contains_binding e (_,(r,m),_) = try let _ = List.find (function ((re, rm), _) -> r =*= re && m =$= rm) e in true with Not_found -> false exception Exited let python_application mv ve script_vars r = let mv = List.map (function ((Some x,None),y,z) -> (x,y,z) | _ -> failwith (Printf.sprintf "unexpected ast metavar in rule %s" r.scr_rule_info.rulename)) mv in try Pycocci.build_classes (List.map (function (x,y) -> x) ve); Pycocci.construct_variables mv ve; Pycocci.construct_script_variables script_vars; let _ = Pycocci.pyrun_simplestring (local_python_code ^r.script_code) in if !Pycocci.exited then raise Exited else if !Pycocci.inc_match then Some (Pycocci.retrieve_script_variables script_vars) else None with Pycocci.Pycocciexception -> (pr2 ("Failure in " ^ r.scr_rule_info.rulename); raise Pycocci.Pycocciexception) let ocaml_application mv ve script_vars r = try let script_vals = Run_ocamlcocci.run mv ve script_vars r.scr_rule_info.rulename r.script_code in if !Coccilib.exited then raise Exited else if !Coccilib.inc_match then Some script_vals else None with e -> (pr2 ("Failure in " ^ r.scr_rule_info.rulename); raise e) (* returns Left in case of dependency failure, Right otherwise *) let apply_script_rule r cache newes e rules_that_have_matched rules_that_have_ever_matched script_application = Common.profile_code r.language (fun () -> show_or_not_scr_rule_name r.scr_rule_info.ruleid; if not(interpret_dependencies rules_that_have_matched !rules_that_have_ever_matched r.scr_rule_info.dependencies) then begin print_dependencies "dependencies for script not satisfied:" rules_that_have_matched !rules_that_have_ever_matched r.scr_rule_info.dependencies; show_or_not_binding "in environment" e; (cache, safe_update_env newes e rules_that_have_matched) end else begin let (_, mv, script_vars, _) = r.scr_ast_rule in let ve = (List.map (function (n,v) -> (("virtual",n),Ast_c.MetaIdVal (v,[]))) !Flag.defined_virtual_env) @ e in let not_bound x = not (contains_binding ve x) in (match List.filter not_bound mv with [] -> let relevant_bindings = List.filter (function ((re,rm),_) -> List.exists (function (_,(r,m),_) -> r =*= re && m =$= rm) mv) e in (try match List.assoc relevant_bindings cache with None -> (cache,newes) | Some script_vals -> print_dependencies "dependencies for script satisfied, but cached:" rules_that_have_matched !rules_that_have_ever_matched r.scr_rule_info.dependencies; show_or_not_binding "in" e; (* env might be bigger than what was cached against, so have to merge with newes anyway *) let new_e = (List.combine script_vars script_vals) @ e in let new_e = new_e +> List.filter (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in (cache,update_env newes new_e rules_that_have_matched) with Not_found -> begin print_dependencies "dependencies for script satisfied:" rules_that_have_matched !rules_that_have_ever_matched r.scr_rule_info.dependencies; show_or_not_binding "in" e; match script_application mv ve script_vars r with None -> (* failure means we should drop e, no new bindings *) (((relevant_bindings,None) :: cache), newes) | Some script_vals -> let script_vals = List.map (function x -> Ast_c.MetaIdVal(x,[])) script_vals in let new_e = (List.combine script_vars script_vals) @ e in let new_e = new_e +> List.filter (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in r.scr_rule_info.was_matched := true; (((relevant_bindings,Some script_vals) :: cache), update_env newes new_e (r.scr_rule_info.rulename :: rules_that_have_matched)) end) | unbound -> (if !Flag_cocci.show_dependencies then let m2c (_,(r,x),_) = r^"."^x in pr2 (Printf.sprintf "script not applied: %s not bound" (String.concat ", " (List.map m2c unbound)))); let e = e +> List.filter (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in (cache, update_env newes e rules_that_have_matched)) end) let rec apply_cocci_rule r rules_that_have_ever_matched parse_strings es (ccs:file_info list ref) = Common.profile_code r.rule_info.rulename (fun () -> show_or_not_rule_name r.ast_rule r.rule_info.ruleid; show_or_not_ctl_text r.ctl r.ast_rule r.rule_info.ruleid; let reorganized_env = reassociate_positions r.free_vars r.negated_pos_vars !es in (* looping over the environments *) let (_,newes (* envs for next round/rule *)) = List.fold_left (function (cache,newes) -> function ((e,rules_that_have_matched),relevant_bindings) -> if not(interpret_dependencies rules_that_have_matched !rules_that_have_ever_matched r.rule_info.dependencies) then begin print_dependencies ("dependencies for rule "^r.rule_info.rulename^ " not satisfied:") rules_that_have_matched !rules_that_have_ever_matched r.rule_info.dependencies; show_or_not_binding "in environment" e; (cache, update_env newes (e +> List.filter (fun (s,v) -> List.mem s r.rule_info.used_after)) rules_that_have_matched) end else let new_bindings = try List.assoc relevant_bindings cache with Not_found -> print_dependencies ("dependencies for rule "^r.rule_info.rulename^ " satisfied:") rules_that_have_matched !rules_that_have_ever_matched r.rule_info.dependencies; show_or_not_binding "in" e; show_or_not_binding "relevant in" relevant_bindings; (* applying the rule *) (match r.ruletype with Ast_cocci.Normal -> (* looping over the functions and toplevel elements in .c and .h *) List.rev (concat_headers_and_c !ccs +> List.fold_left (fun children_e (c,f) -> if c.flow <> None then (* does also some side effects on c and r *) let processed = process_a_ctl_a_env_a_toplevel r relevant_bindings c f in match processed with | None -> children_e | Some newbindings -> newbindings +> List.fold_left (fun children_e newbinding -> if List.mem newbinding children_e then children_e else newbinding :: children_e) children_e else children_e) []) | Ast_cocci.Generated -> process_a_generated_a_env_a_toplevel r relevant_bindings !ccs; []) in let old_bindings_to_keep = Common.nub (e +> List.filter (fun (s,v) -> List.mem s r.rule_info.used_after)) in let new_e = if null new_bindings then begin (*use the old bindings, specialized to the used_after_list*) if !Flag_ctl.partial_match then printf "Empty list of bindings, I will restart from old env\n"; [(old_bindings_to_keep,rules_that_have_matched)] end else (* combine the new bindings with the old ones, and specialize to the used_after_list *) let old_variables = List.map fst old_bindings_to_keep in (* have to explicitly discard the inherited variables because we want the inherited value of the positions variables not the extended one created by reassociate_positions. want to reassociate freshly according to the free variables of each rule. *) let new_bindings_to_add = Common.nub (new_bindings +> List.map (List.filter (function (* see comment before combine_pos *) (s,Ast_c.MetaPosValList []) -> false | (s,v) -> List.mem s r.rule_info.used_after && not (List.mem s old_variables)))) in List.map (function new_binding_to_add -> (List.sort compare (Common.union_set old_bindings_to_keep new_binding_to_add), r.rule_info.rulename::rules_that_have_matched)) new_bindings_to_add in ((relevant_bindings,new_bindings)::cache, Common.profile_code "merge_env" (function _ -> merge_env new_e newes))) ([],init_env()) reorganized_env in (* end iter es *) if !(r.rule_info.was_matched) then Common.push2 r.rule_info.rulename rules_that_have_ever_matched; es := end_env newes; (* apply the tagged modifs and reparse *) if not !Flag.sgrep_mode2 then ccs := rebuild_info_c_and_headers !ccs r.isexp parse_strings) and reassociate_positions free_vars negated_pos_vars envs = (* issues: isolate the bindings that are relevant to a given rule. separate out the position variables associate all of the position variables for a given set of relevant normal variable bindings with each set of relevant normal variable bindings. Goal: if eg if@p (E) matches in two places, then both inherited occurrences of E should see both bindings of p, not just its own. Otherwise, a position constraint for something that matches in two places will never be useful, because the position can always be different from the other one. *) let relevant = List.map (function (e,_) -> List.filter (function (x,_) -> List.mem x free_vars) e) envs in let splitted_relevant = (* separate the relevant variables into the non-position ones and the position ones *) List.map (function r -> List.fold_left (function (non_pos,pos) -> function (v,_) as x -> if List.mem v negated_pos_vars then (non_pos,x::pos) else (x::non_pos,pos)) ([],[]) r) relevant in let splitted_relevant = List.map (function (non_pos,pos) -> (List.sort compare non_pos,List.sort compare pos)) splitted_relevant in let non_poss = List.fold_left (function non_pos -> function (np,_) -> if List.mem np non_pos then non_pos else np::non_pos) [] splitted_relevant in let extended_relevant = (* extend the position variables with the values found at other identical variable bindings *) List.map (function non_pos -> let others = List.filter (function (other_non_pos,other_pos) -> (* do we want equal? or just somehow compatible? eg non_pos binds only E, but other_non_pos binds both E and E1 *) non_pos =*= other_non_pos) splitted_relevant in (non_pos, List.sort compare (non_pos @ (combine_pos negated_pos_vars (List.map (function (_,x) -> x) others))))) non_poss in List.combine envs (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant) splitted_relevant) (* If the negated posvar is not bound at all, this function will nevertheless bind it to []. If we get rid of these bindings, then the matching of the term the position variable with the constraints will fail because some variables are unbound. So we let the binding be [] and then we will have to clean these up afterwards. This should be the only way that a position variable can have an empty binding. *) and combine_pos negated_pos_vars others = List.map (function posvar -> let positions = List.sort compare (List.fold_left (function positions -> function other_list -> try match List.assoc posvar other_list with Ast_c.MetaPosValList l1 -> Common.union_set l1 positions | _ -> failwith "bad value for a position variable" with Not_found -> positions) [] others) in (posvar,Ast_c.MetaPosValList positions)) negated_pos_vars and process_a_generated_a_env_a_toplevel2 r env = function [cfile] -> let free_vars = List.filter (function (rule,_) when rule =$= r.rule_info.rulename -> false | (_,"ARGS") -> false | _ -> true) r.free_vars in let env_domain = List.map (function (nm,vl) -> nm) env in let metavars = List.filter (function md -> let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rule_info.rulename) r.metavars in if Common.include_set free_vars env_domain then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname | _ -> failwith "multiple files not supported" and process_a_generated_a_env_a_toplevel rule env ccs = Common.profile_code "process_a_ctl_a_env_a_toplevel" (fun () -> process_a_generated_a_env_a_toplevel2 rule env ccs) (* does side effects on C ast and on Cocci info rule *) and process_a_ctl_a_env_a_toplevel2 r e c f = indent_do (fun () -> show_or_not_celem "trying" c.ast_c; Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c); match (r.ctl,c.ast_c) with ((Asttoctl2.NONDECL ctl,t),Ast_c.Declaration _) -> None | ((Asttoctl2.NONDECL ctl,t), _) | ((Asttoctl2.CODE ctl,t), _) -> let ctl = (ctl,t) in (* ctl and other info *) let (trans_info, returned_any_states, inherited_bindings, newbindings) = Common.save_excursion Flag_ctl.loop_in_src_code (fun () -> Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop; (***************************************) (* !Main point! The call to the engine *) (***************************************) let model_ctl = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e in CCI.mysat model_ctl ctl (r.rule_info.rulename, r.rule_info.used_after, e)) in if not returned_any_states then None else begin show_or_not_celem "found match in" c.ast_c; show_or_not_trans_info trans_info; List.iter (show_or_not_binding "out") newbindings; r.rule_info.was_matched := true; if not (null trans_info) && not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff) then begin c.was_modified := true; try (* les "more than one var in a decl" et "already tagged token" * font crasher coccinelle. Si on a 5 fichiers, donc on a 5 * failed. Le try limit le scope des crashes pendant la * transformation au type concerne. *) (* modify ast via side effect *) ignore (Transformation_c.transform r.rule_info.rulename r.dropped_isos inherited_bindings trans_info (Common.some c.flow)); with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i) end; Some (List.map (function x -> x@inherited_bindings) newbindings) end ) and process_a_ctl_a_env_a_toplevel a b c f= Common.profile_code "process_a_ctl_a_env_a_toplevel" (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f) let rec bigloop2 rs (ccs: file_info list) parse_strings = let init_es = [(Ast_c.emptyMetavarsBinding,[])] in let es = ref init_es in let ccs = ref ccs in let rules_that_have_ever_matched = ref [] in (try (* looping over the rules *) rs +> List.iter (fun r -> match r with InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> () | ScriptRuleCocciInfo r -> if !Flag_cocci.show_ctl_text then begin Common.pr_xxxxxxxxxxxxxxxxx (); pr ("script: " ^ r.language); Common.pr_xxxxxxxxxxxxxxxxx (); adjust_pp_with_indent (fun () -> Format.force_newline(); let (l,mv,script_vars,code) = r.scr_ast_rule in let nm = r.scr_rule_info.rulename in let deps = r.scr_rule_info.dependencies in Pretty_print_cocci.unparse (Ast_cocci.ScriptRule (nm,l,deps,mv,script_vars,code))); end; (*pr2 (List.hd(cmd_to_list "free -m | grep Mem"));*) if !Flag.show_misc then print_endline "RESULT ="; let (_, newes) = List.fold_left (function (cache, newes) -> function (e, rules_that_have_matched) -> match r.language with "python" -> apply_script_rule r cache newes e rules_that_have_matched rules_that_have_ever_matched python_application | "ocaml" -> apply_script_rule r cache newes e rules_that_have_matched rules_that_have_ever_matched ocaml_application | "test" -> concat_headers_and_c !ccs +> List.iter (fun (c,_) -> if c.flow <> None then Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring); (cache, newes) | _ -> Printf.printf "Unknown language: %s\n" r.language; (cache, newes)) ([],init_env()) !es in (if !(r.scr_rule_info.was_matched) then Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched); (* just newes can't work, because if one does include_match false on everything that binds a variable, then nothing is left *) es := (*newes*) (if Hashtbl.length newes = 0 then init_es else end_env newes) | CocciRuleCocciInfo r -> apply_cocci_rule r rules_that_have_ever_matched parse_strings es ccs) with Exited -> ()); if !Flag.sgrep_mode2 then begin (* sgrep can lead to code that is not parsable, but we must * still call rebuild_info_c_and_headers to pretty print the * action (MINUS), so that later the diff will show what was * matched by sgrep. But we don't want the parsing error message * hence the following flag setting. So this code probably * will generate a NotParsedCorrectly for the matched parts * and the very final pretty print and diff will work *) Flag_parsing_c.verbose_parsing := false; ccs := rebuild_info_c_and_headers !ccs false parse_strings end; !ccs (* return final C asts *) let bigloop a b c = Common.profile_code "bigloop" (fun () -> bigloop2 a b c) type init_final = Initial | Final let initial_final_bigloop2 ty rebuild r = if !Flag_cocci.show_ctl_text then begin Common.pr_xxxxxxxxxxxxxxxxx (); pr ((match ty with Initial -> "initial" | Final -> "final") ^ ": " ^ r.language); Common.pr_xxxxxxxxxxxxxxxxx (); adjust_pp_with_indent (fun () -> Format.force_newline(); Pretty_print_cocci.unparse(rebuild r.scr_ast_rule r.scr_rule_info.dependencies)); end; match r.language with "python" -> (* include_match makes no sense in an initial or final rule, although we have no way to prevent it *) let newes = init_env() in let _ = apply_script_rule r [] newes [] [] (ref []) python_application in () | "ocaml" when ty = Initial -> () (* nothing to do *) | "ocaml" -> (* include_match makes no sense in an initial or final rule, although we have no way to prevent it *) let newes = init_env() in let _ = apply_script_rule r [] newes [] [] (ref []) ocaml_application in () | _ -> failwith ("Unknown language for initial/final script: "^ r.language) let initial_final_bigloop a b c = Common.profile_code "initial_final_bigloop" (fun () -> initial_final_bigloop2 a b c) (*****************************************************************************) (* The main functions *) (*****************************************************************************) let pre_engine2 (coccifile, isofile) = show_or_not_cocci coccifile isofile; Pycocci.set_coccifile coccifile; let isofile = if not (Common.lfile_exists isofile) then begin pr2 ("warning: Can't find default iso file: " ^ isofile); None end else Some isofile in (* useful opti when use -dir *) let (metavars,astcocci, free_var_lists,negated_pos_lists,used_after_lists, positions_lists,((toks,_,_,_) as constants),parse_strings) = sp_of_file coccifile isofile in let ctls = ctls_of_ast astcocci used_after_lists positions_lists in g_contain_typedmetavar := sp_contain_typed_metavar astcocci; check_macro_in_sp_and_adjust toks; show_or_not_ctl_tex astcocci ctls; let cocci_infos = prepare_cocci ctls free_var_lists negated_pos_lists used_after_lists positions_lists metavars astcocci in let used_languages = List.fold_left (function languages -> function ScriptRuleCocciInfo(r) -> if List.mem r.language languages then languages else r.language::languages | _ -> languages) [] cocci_infos in let runrule r = let rlang = r.language in let rname = r.scr_rule_info.rulename in try let _ = List.assoc (rlang,rname) !Iteration.initialization_stack in () with Not_found -> begin Iteration.initialization_stack := ((rlang,rname),!Flag.defined_virtual_rules) :: !Iteration.initialization_stack; initial_final_bigloop Initial (fun (x,_,_,y) -> fun deps -> Ast_cocci.InitialScriptRule(rname,x,deps,y)) r end in let initialized_languages = List.fold_left (function languages -> function InitialScriptRuleCocciInfo(r) -> let rlang = r.language in if interpret_dependencies [] [] r.scr_rule_info.dependencies then begin (if List.mem rlang languages then failwith ("double initializer found for "^rlang)); runrule r; rlang::languages end else languages | _ -> languages) [] cocci_infos in let uninitialized_languages = List.filter (fun used -> not (List.mem used initialized_languages)) used_languages in List.iter (fun lgg -> let rule_info = {rulename = ""; dependencies = Ast_cocci.NoDep; used_after = []; ruleid = (-1); was_matched = ref false;} in runrule (make_init lgg "" rule_info)) uninitialized_languages; ((cocci_infos,parse_strings),constants) let pre_engine a = Common.profile_code "pre_engine" (fun () -> pre_engine2 a) let full_engine2 (cocci_infos,parse_strings) cfiles = show_or_not_cfiles cfiles; if !Flag_cocci.selected_only then begin pr2 ("selected " ^ (Common.join " " cfiles)); cfiles +> List.map (fun s -> s, None) end else begin if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx(); if !Flag.show_misc then pr "let's go"; if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx(); if !Flag_cocci.show_binding_in_out then begin (match !Flag.defined_virtual_rules with [] -> () | l -> pr (Printf.sprintf "Defined virtual rules: %s" (String.concat " " l))); List.iter (function (v,vl) -> pr (Printf.sprintf "%s = %s" v vl)) !Flag.defined_virtual_env; Common.pr_xxxxxxxxxxxxxxxxx() end; let choose_includes = match !Flag_cocci.include_options with Flag_cocci.I_UNSPECIFIED -> if !g_contain_typedmetavar then Flag_cocci.I_NORMAL_INCLUDES else Flag_cocci.I_NO_INCLUDES | x -> x in let c_infos = prepare_c cfiles choose_includes parse_strings in (* ! the big loop ! *) let c_infos' = bigloop cocci_infos c_infos parse_strings in if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx (); if !Flag.show_misc then pr "Finished"; if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx (); if !Flag_ctl.graphical_trace then gen_pdf_graph (); c_infos' +> List.map (fun c_or_h -> if !(c_or_h.was_modified_once) then begin let outfile = Common.new_temp_file "cocci-output" ("-" ^ c_or_h.fname) in if c_or_h.fkind =*= Header then pr2 ("a header file was modified: " ^ c_or_h.fname); (* and now unparse everything *) cfile_of_program (for_unparser c_or_h.asts) outfile; show_or_not_diff c_or_h.fpath outfile; (c_or_h.fpath, if !Flag.sgrep_mode2 then None else Some outfile) end else (c_or_h.fpath, None)) end let full_engine a b = Common.profile_code "full_engine" (fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res) let post_engine2 (cocci_infos,_) = List.iter (function ((language,_),virt_rules) -> Flag.defined_virtual_rules := virt_rules; let _ = List.fold_left (function languages -> function FinalScriptRuleCocciInfo(r) -> (if r.language = language && List.mem r.language languages then failwith ("double finalizer found for "^r.language)); initial_final_bigloop Final (fun (x,_,_,y) -> fun deps -> Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename, x,deps,y)) r; r.language::languages | _ -> languages) [] cocci_infos in ()) !Iteration.initialization_stack let post_engine a = Common.profile_code "post_engine" (fun () -> post_engine2 a) (*****************************************************************************) (* check duplicate from result of full_engine *) (*****************************************************************************) let check_duplicate_modif2 xs = (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *) if !Flag_cocci.verbose_cocci then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files"); let groups = Common.group_assoc_bykey_eff xs in groups +> Common.map_filter (fun (file, xs) -> match xs with | [] -> raise (Impossible 162) | [res] -> Some (file, res) | res::xs -> match res with | None -> if not (List.for_all (fun res2 -> res2 =*= None) xs) then begin pr2 ("different modification result for " ^ file); None end else Some (file, None) | Some res -> if not(List.for_all (fun res2 -> match res2 with | None -> false | Some res2 -> let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2) in null diff ) xs) then begin pr2 ("different modification result for " ^ file); None end else Some (file, Some res) ) let check_duplicate_modif a = Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a) coccinelle-1.0.0-rc19/version0000644000175000017500000000001212247442603014761 0ustar eugeneugen1.0.0-rc19coccinelle-1.0.0-rc19/Makefile.libs0000644000175000017500000000536512247437436015771 0ustar eugeneugen# # Static configuration of Ocaml libraries # Add these libraries to the library list in configure in order to use them. # # Template: # LOCAL_$lib = modules to include when compiling $lib locally with bytecode ocaml # LOCALOPT_$lib = moduels to include when compiling $lib locally with optimizing ocaml # GLOBAL_$lib = modules to include when using $lib globally with bytecode ocaml # GLOBALOPT_$lib = modules to include when using $lib globally with optimizing ocaml # FLAGS_$lib = extra flags to pass to optimizing ocaml when using $lib at link time # # This file is included in the Makefile where these variables may be used depending # on your actual configuration. # # *Note* # Pay attention to the difference between -cclib and -ccopt: although the documentation # of -ccopt suggest that it subsumes -cclib, be sure to use -cclib for library includes. # # *Note* # the order in which library includes are specified matters! # pycaml library # Note: we added the pycaml_stubs wrapper twice: once for dynamic and once for # static linking. The ocaml compiler should use the static linking with the # stubs if possible. LOCAL_pycaml = $(PYCAMLDIR)/pycaml.cma LOCALOPT_pycaml = $(PYCAMLDIR)/pycaml.cmxa GLOBAL_pycaml = $(PYCAMLDIR)/pycaml.cma GLOBALOPT_pycaml = $(PYCAMLDIR)/pycaml.cmxa FLAGS_pycaml = $(CFLAGS_pycaml:%=-ccopt %) -dllib -lpycaml_stubs -cclib -lpycaml_stubs $(PYTHON_LIBS:%=-cclib %) OPTFLAGS_pycaml = $(CFLAGS_pycaml:%=-ccopt %) -cclib -lpycaml_stubs $(PYTHON_LIBS:%=-cclib %) # sexplib library LOCAL_sexplib = $(SEXPDIR)/sexplib.cmo LOCALOPT_sexplib = $(SEXPDIR)/sexplib.cmx GLOBAL_sexplib = $(SEXPDIR)/sexplib.cma GLOBALOPT_sexplib = $(SEXPDIR)/sexplib.cmxa FLAGS_sexplib = OPTFLAGS_sexplib = # pcre library # Note: see the comment of the pycaml library about the double appearance of the stubs library. LOCAL_pcre = $(PCREDIR)/pcre.cmo LOCALOPT_pcre = $(PCREDIR)/pcre.cmx GLOBAL_pcre = $(PCREDIR)/pcre.cma GLOBALOPT_pcre = $(PCREDIR)/pcre.cmxa FLAGS_pcre = $(PCRE_LIBS:%=-ccopt %) -dllib -lpcre_stubs -cclib -lpcre_stubs OPTFLAGS_pcre = $(PCRE_LIBS:%=-ccopt %) -cclib -lpcre_stubs # dynlink library LOCAL_dynlink = LOCALOPT_dynlink = GLOBAL_dynlink = $(DYNLINKDIR)/dynlink.cma GLOBALOPT_dynlink = $(DYNLINKDIR)/dynlink.cmxa FLAGS_dynlink = OPTFLAGS_dynlink = # extlib library LOCAL_extlib = $(EXTLIBDIR)/extLib.cma LOCALOPT_extlib = $(EXTLIBDIR)/extLib.cmxa GLOBAL_extlib = $(EXTLIBDIR)/extLib.cma GLOBALOPT_extlib = $(EXTLIBDIR)/extLib.cmxa FLAGS_extlib = OPTFLAGS_extlib = # type conv library LOCAL_type_conv = pa_type_conv.cma LOCALOPT_type_conv = pa_type_conv.cmxa GLOBAL_type_conv = pa_type_conv.cma GLOBALOPT_type_conv = pa_type_conv.cma FLAGS_type_conv = OPTFLAGS_type_conv =