coccinelle-1.0.4/0000755000175000017500000000000012616742627012621 5ustar eugeneugencoccinelle-1.0.4/Makefile.common0000644000175000017500000000220512614153277015542 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # 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 built 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.4/Makefile.config.in0000644000175000017500000000741412614153277016133 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr VERSION=@PACKAGE_VERSION@ # * for each library $1, add another entry in the same manner MAKELIBS=@MAKE_dynlink@ @MAKE_menhirLib@ @MAKE_pycaml@ @MAKE_pcre@ \ @MAKE_parmap@ LNKLIBS=@MODULES_dynlink@ @MODULES_menhirLib@ @MODULES_pycaml@ @MODULES_pcre@ \ @MODULES_parmap@ @MODULES_profiling@ OPTLNKLIBS=@MODULESOPT_dynlink@ @MODULESOPT_menhirLib@ @MODULESOPT_pycaml@ \ @MODULESOPT_pcre@ @MODULESOPT_parmap@ INCLIBS=@PATH_dynlink@ @PATH_menhirLib@ @PATH_pycaml@ @PATH_pcre@ \ @PATH_parmap@ FLAGSLIBS=@FLAGS_dynlink@ @FLAGS_menhirLib@ @FLAGS_pycaml@ @FLAGS_pcre@ \ @FLAGS_pcre@ @FLAGS_parmap@ OPTFLAGSLIBS=@OPTFLAGS_dynlink@ @OPTFLAGS_menhirLib@ @OPTFLAGS_pycaml@ \ @OPTFLAGS_pcre@ @OPTFLAGS_parmap@ # * 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 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@ # Include paths PCREDIR=@PATH_pcre@ PARMAPDIR=@PATH_parmap@ PYCAMLDIR=@PATH_pycaml@ MENHIRDIR=@PATH_menhirLib@ DYNLINKDIR=@PATH_dynlink@ # selected ocaml modules PYCOCCI_FILE=@PYCOCCI_FILE@ OCAMLCOCCI_FILE=@OCAMLCOCCI_FILE@ REGEXP_FILE=@REGEXP_FILE@ COMPILE_EMBEDDED_BYTES_MODULE=@COMPILE_EMBEDDED_BYTES_MODULE@ coccinelle-1.0.4/Makefile.am0000644000175000017500000000046012614153277014650 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.4/changes.txt0000644000175000017500000014707612614153277015004 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.4 ** Language: - Length for statement list metavariables ** Features: ** Bugfix: - build system: delete pregenerated parsers if menhir is installed * 1.0.3 ** Language: - Conjunction (analogous to disjunction) - Drop Circles, Stars - Drop Unique - Default values for script metavariables ** Features: - Removed the extlib and sexp bundles which were not used any more. - Drop support for OCaml 3.11 which did not allow to compile coccinelle in native code - Print metavariables properly for script code. - Print metavariables properly for cocci code. - SYSCALL_DEFINE macros, contributed by Jörn Engel - --indent option, giving default indent, for projects not using tabs - Introduce .cocciconfig configuration file - Add some support for MetaStmtList. Allowed at top level of {}. - timeout of 0 is no timeout, to allow cancelling this option. - --print-options-only to see accumulated options. ** Bugfix: - Allow virtual variable definition to contain an =. - Improvement when exists rule contains when forall. - The presence of camlp4 is no longer checked when not needed (only required to compile the bundled OCaml bindings for Python) * 1.0.2 ** Language: ** Features: - Positions of C tokens are now computed while lexing rather than during a distinct pass. This makes use of the Lexing.new_line function which has been introduced in OCaml 3.11. Coccinelle can thus no longer be compiled with OCaml 3.10. - --use-gitgrep falls back to --use-coccigrep for a non-git repository. - ocaml coccilib allows propagating identifiers, expressions, statements, listlens, and positions to subsequent matching rules, via new ocaml code constructors: make_ident, make_expr, make_expr_with_env etc. - Allow @S, for statement metavariable S on expressions - Exploit explicit positive constraints (no regexps) on identifiers in file filtering - Ability to declare a rule as matching an identifier. Doesn't work properly for names of typedefs, enums, structures, or unions. - autogen creates a version number that corresponds to the most recent commit. ** Bugfix: - Coccinelle's "make install" now copies files to /usr/local/lib instead of /usr/local/share - Iso: allow mixed for model for the case where the model is just a metavar Thanks to Kris Borer for reporting the problem - Allow ! to propagate into == or other ops in more cases. * 1.0.1 ** Language: - allow static on type-level declarers - ... in for loop header and in array declaration size matches nothing. ** Features: - add --use-gitgrep option, for scanning with git grep ** Bugfix: - Take into account constraints when determining whether a metavar is pure - don't add switch fall through when a default is hidden under another case label. - Safer handing of loops in ... * 1.0.0 ** Language: - Add metavariables for matcing assignment and binary operators. - Add ...... to match ... in C function declarations and definitions. - 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 - Initialize and finalize rules contain a metavariable declaration region. - Added documentation about iteration. - Allow changes within strings. - EXEC, for use with the --ibm option. - Limited matching of decimal format strings, with the --ibm option - Add a global idexpression operator, like the local one. - Positive constraint set for identifier metavariables. ** 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. - Allow multidecls when removing variable names or when modifying type. - Take fresh declarations into account when computing get_constants to create dependencies - Leave ifdefs-like directives in unparsed code, if they don't have beginning or ending counterparts. - Improved interpret_cocci_grep to try to avoid no accumulating lots of anded data. - Improve type inference performance when many files included by using maps. - Extend file names only if the mentioned file does not exist. - Better support for functions that have no specified return type. - Added --include-headers-for-types option. - Cope with unreadable C files. Thanks to Akos PASZTORY for the suggestion. - Add the ability to add, but not match or remove, attributes. Thanks to Johannes Berg for the suggestion. - Recognize for_each thing followed by ++ or -- as a loop. Problem found by Wolfram Sang. - Newline before python code in error messages. Suggested by Markus Elfring. - Add prototypes implicit isomorphism to allow disabling generation of rules based on changes in function prototypes. - Support dynamic parallelism via the Parmap library. - Allow disjunction in struct or enum name. Problem noticed by Daniel Granat. - --test-spacing option for regression testing of format issues ** 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. - Try to fix pretty printing of directives. - Allow renaming types in multidecls, including renames in initializers. - Save virtual identifiers from the command line for use in finalize code. - Make ocaml file prefix name be just a constant string rather than being determined by the semantic patch file name, to avoid incompatabilities between the semantic patch file name and what is allowed for the names of ocaml modules. Thanks to Markus Elfring for noticing the problem. - Improved use of parsing_hacks when an item of interest is preceded by a #define or #undef. Thanks to Nic Volanschi for finding the problem. - Improved handling of commas in multidecls. Thanks to Nic Volanschi for finding the problem. - Try to improve column offsets in complex strings. - Improve performance of error handling code detection by only doing it when there is an escaping then branch. Thanks to Ning Jiang for motivating investigation of the problem. - Don't consider a break for a switch a indicating error handling code. Thanks to Ning Jiang for motivating investigation of the problem. - Allow adding things after an escaping compound. Thanks to Nic Volanschi for finding the problem. - split apart added strings when moving mcode information to bef of for loop, function definition, etc. Thanks to Luis R. Rodriguez for reporting the problem. - Take into account dependencies when considering plus information in get_constants. Also removing constraints based on plus information results in True, regardless on whether & or v is being considered. Thanks to Luis R. Rodriguez for reporting the problem. - Move pcre regular expressions to a hashtable, and out of parsed smpl terms to avoid problems with comparing rule_elems in ctl matching. Note that this hash table is global and is never cleared, since we work on only one semantic patch per execution of Coccinelle. Thanks to SF Markus Elfring for pointing out the problem. - Leave constraints in function prototypes, now that they are comparable. - Make it possible to add something after the last brace of a function. Thanks to Benoit Taine for motivating this change. - Avoiding attaching # directives to , after ... as this comma may get dropped or not match any code. Thanks to Stefan Assmann for reporting the problem. - Manage trailing comma in Constructor code. Thanks to Viresh Kumar for noting the problem. - For multidecls, take into account that type may comprise multiple tokens. Thanks to Nic Volanschi for noticing the problem. - don't add newlines in #defines, even if lines get long - consider # as a comment character in script code - Don't take into account string constants in get_constants, as these are not likely to be indexed. Thanks to Benoit Taine for noting the problem. - Better pretty printing indentation for ifs. - Don't multiply propagate positions to the same token in isos that use the same token more than once. Problem reported by Riccardo Lucchese. - Don't require balanced parentheses in + code for stars. Problem reported by Chi Pham. - Unfavor commas for attaching plus code; commas can disappear. - In pretty printing added if branch braces, allow minus code as well as spaces and newlines between the ) and the {. - Make the --keep-comments flag work. - Make the --force-diff flag work. - Improve newlines around added else tokens. - Improve parsing of multi strings. - Improve pretty printing of expression list metavariable values. Problem reported by Cyril Hrubis. - Improve pretty printing of long parameter lists, improve added newlines for things in parentheses. Problem reported by Luis Rodriguez. - Lex comment at end of #if. Problem reported by Markus Elfring. - Allow '' - Make fix_tokens_strings, List.flatten tail recursive to avoid stack overflow - Make nothing match against empty statements. - Improved propagation of #ifdef additions to function prototypes. Reported by Stefan Assman. - Allow adding directives before and after ..., see ifif.cocci - No space after trailing comma. - Drop newlines when removing consecutive statements. - Make build system use installed rather than bundled parmap when available. - Extend parsing_hacks to recognize constant function pointers. This issue was detected by Sören Brinkmann. - Unfavor only trailing commas in insert_plus. This has an impact on where plus code is put, and thus formatting of output. - Put newlines only after certain Tokens in unparse_cocci. * 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.4/python/0000755000175000017500000000000012614156171014131 5ustar eugeneugencoccinelle-1.0.4/python/pycocci_aux.ml0000644000175000017500000000652312614153277017003 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) open Ast_c open Common let caller s f a = let str = ref ([] : string list) in let pr_elem info = let comments_before = List.map Token_c.str_of_token (Ast_c.get_comments_before info) in let comments_after = List.map Token_c.str_of_token (Ast_c.get_comments_after info) in (* constructed backwards *) str := (List.rev comments_after) @ (Ast_c.str_of_info info) :: (List.rev comments_before) @ !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.MetaAssignOpVal op -> call_pretty Pretty_print_c.pp_assignOp_gen op | Ast_c.MetaBinaryOpVal op -> call_pretty Pretty_print_c.pp_binaryOp_gen op | 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.MetaStmtListVal (statxs,_) -> call_pretty Pretty_print_c.pp_statement_seq_list_gen statxs | 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 Printf.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2) | Ast_c.MetaPosValList positions -> "TODO: <>" | Ast_c.MetaNoVal -> failwith "no value, should not occur" coccinelle-1.0.4/python/pycocci.mli0000644000175000017500000000154212614153277016273 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val build_classes : Ast_cocci.meta_name list -> unit val construct_variables : (string * Ast_cocci.meta_name * Ast_cocci.metavar * Ast_cocci.mvinit) 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 -> Ast_c.metavar_binding_kind 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.4/python/coccipython.cmxa0000644000175000017500000000513512614155355017334 0ustar eugeneugenCaml1999Z010 =Ұ(+Pycocci_aux@%Int320Lvg2J.Control_flow_c0$qEEC`2u<&Printf020=#Arg062ojpi}砠&Regexp0*]%[nDj)Ast_cocci0nDPܓ_:@$Setb0XUِ!>'Hashtbl0N5@;rPRq'Token_c0j(#`HLC#Obj0AunCt%SetPt0Sa5Wk)Tw+Regexp_pcre0{sJYЭ$#Str0=DҘ$>?P|K̠/Ograph_extended0ĭJ¹&Oassoc0^dLuT|ڃ $Unix0sj9M='#`*Type_cocci0i mFj +Pycocci_aux0H2jzA7Ye.Pretty_print_c0f"ⷸ6tV$Oset0ޥhƒ9_b;͠&String04IR=6Ơ%Ast_c0GF,Vķ&'Marshal0_5o)m u&Buffer0>LN1N4&Common0ZQh-``$Lazy0;^ }㜎AҠ&Lexing0PY+K$r4*ȩ+Ocollection0iuo*Pervasives06'ܙE$List0WvS1NJA%Objet0_JVޒE=E$Seti0ً$#<$Pcre09ۗɓ6*Mqc+Token_annot0i f3+&gS@&Printf0s-v:gܘ .Pretty_print_c0̡^,*XǠ&String0Ogr2Q#p*Pervasives0. ËT[%Ast_c0Ui1ÆN-}+cǠ'Token_c0JPpw<1رŠ$List0LҪ]BxUxe@@DBC@CB@@@0,JTZT d(*No_pycocci@$Unix0sj9M='#`*Type_cocci0i mFj +Pycocci_aux0H2jzA7Ye#Arg062ojpi}砠&Regexp0*]%[nDj)Ast_cocci0nDPܓ_:@&String04IR=6Ơ%Ast_c0GF,Vķ&'Marshal0_5o)m u&Buffer0>LN1N4,0]dp4 ဌFdTc&Common0ZQh-``'Hashtbl0N5@;rPRq$Lazy0;^ }㜎AҠ&Lexing0PY+K$r4*ȩ'Token_c0j(#`HLC*Pervasives06'ܙE$List0WvS1NJA#Map0} 9rٻB+Regexp_pcre0{sJYЭ$#Str0=DҘ$>?P|K̠$Pcre09ۗɓ6*Mqc+Token_annot0i f3+&gS@*Pervasives0. ËT[&String0Ogr2Q#p#Map0+3nSm' n@@DB@@@@0UytW72_;e=\('Pycocci@$Unix0sj9M='#`*Type_cocci0i mFj +Pycocci_aux0H2jzA7Ye#Arg062ojpi}砠&Regexp0*]%[nDj)Ast_cocci0nDPܓ_:@&String04IR=6Ơ'Pycocci0c;`B5`s*No_pycocci0]dp4 ဌFdTc%Ast_c0GF,Vķ&'Marshal0_5o)m u&Buffer0>LN1N4&Common0ZQh-``'Hashtbl0N5@;rPRq$Lazy0;^ }㜎AҠ&Lexing0PY+K$r4*ȩ'Token_c0j(#`HLC*Pervasives06'ܙE$List0WvS1NJA#Map0} 9rٻB+Regexp_pcre0{sJYЭ$#Str0=DҘ$>?P|K̠$Pcre09ۗɓ6*Mqc+Token_annot0i f3+&gS@*No_pycocci0UytW72_;e=\@@@@@@0-k+z$@@@coccinelle-1.0.4/python/pycocci.ml.in0000644000175000017500000000003112614153277016517 0ustar eugeneugeninclude @PYCOCCI_MODULE@ coccinelle-1.0.4/python/no_pycocci.ml0000644000175000017500000000377612614153277016631 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) open Ast_c open Common open Pycocci_aux module StringMap = Map.Make (String) exception Pycocciexception let errmsg = "Semantic patch uses python, but Coccinelle has been compiled without Python support" let python_support = false let check_return_value v = failwith errmsg let check_int_return_value v = failwith errmsg let initialised = ref false let cocci_file_name = ref "" (* dealing with python modules loaded *) let get_module module_name = failwith errmsg let is_module_loaded module_name = failwith errmsg let load_module module_name = failwith errmsg (* 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 errmsg let pycocci_get_class_type fqn = failwith errmsg let pycocci_instantiate_class fqn args = failwith errmsg (* end python interaction *) let inc_match = ref false let exited = ref false let include_match v = failwith errmsg let sp_exit _ = failwith errmsg let build_method (mname, camlfunc, args) pymodule classx classdict = failwith errmsg let build_class cname parent methods pymodule = failwith errmsg let has_environment_binding env name = failwith errmsg let get_cocci_file args = failwith errmsg let build_classes env = failwith errmsg let build_variable name value = failwith errmsg let contains_binding e (_,(r,m),_) = failwith errmsg let construct_variables mv e = failwith errmsg let construct_script_variables mv = failwith errmsg let retrieve_script_variables mv = failwith errmsg let set_coccifile cocci_file = cocci_file_name := cocci_file; () let pyrun_simplestring s = failwith errmsg let py_isinitialized () = failwith errmsg let py_finalize () = failwith errmsg coccinelle-1.0.4/python/pycocci_aux.mli0000644000175000017500000000110112614153277017137 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/python/coccilib/0000755000175000017500000000000012614153277015704 5ustar eugeneugencoccinelle-1.0.4/python/coccilib/org.py0000644000175000017500000000213412614153277017045 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.4/python/coccilib/coccigui/0000755000175000017500000000000012614153277017471 5ustar eugeneugencoccinelle-1.0.4/python/coccilib/coccigui/vimcom.py0000644000175000017500000006505712614153277021352 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.4/python/coccilib/coccigui/vimeditor.py0000644000175000017500000002310712614153277022050 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.4/python/coccilib/coccigui/vim.py0000644000175000017500000002172112614153277020641 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.4/python/coccilib/coccigui/pygui.gladep0000644000175000017500000000041712614153277022006 0ustar eugeneugen pygui pygui FALSE coccinelle-1.0.4/python/coccilib/coccigui/vimembed.py0000644000175000017500000001041412614153277021633 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.4/python/coccilib/coccigui/coccigui.py0000644000175000017500000001100512614153277021625 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.4/python/coccilib/coccigui/pycoccimodel.py0000644000175000017500000000112712614153277022516 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.4/python/coccilib/coccigui/__init__.py0000644000175000017500000000003012614153277021573 0ustar eugeneugen# python infrastructure coccinelle-1.0.4/python/coccilib/coccigui/pygui.glade0000644000175000017500000001153112614153277021625 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.4/python/coccilib/coccigui/Makefile0000644000175000017500000000004312614153277021126 0ustar eugeneugenall: depend: clean: rm -f *.pyc coccinelle-1.0.4/python/coccilib/output.py0000644000175000017500000000560512614153277017624 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.4/python/coccilib/__init__.py0000644000175000017500000000003012614153277020006 0ustar eugeneugen# python infrastructure coccinelle-1.0.4/python/coccilib/elems.py0000644000175000017500000000151212614153277017362 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.4/python/coccilib/xml_firehose.py0000644000175000017500000002252212614153277020745 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.4/python/coccilib/Makefile0000644000175000017500000000041612614153277017345 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.4/python/coccilib/trac.py0000644000175000017500000000105512614153277017210 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.4/python/coccilib/report.py0000644000175000017500000000024212614153277017567 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.4/python/Makefile0000644000175000017500000000644112614153277015602 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr ############################################################################# # 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) 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) 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 *.a ############################################################################## # 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 *~ .*~ #*# .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/python/yes_pycocci.ml0000644000175000017500000002521312614153277017003 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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; 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),_,init) -> match find_binding (r,m) with None -> (match init with Ast_cocci.MVInitString s -> let _ = build_variable py (pystring_fromstring s) in () | Ast_cocci.MVInitPosList -> let pylocs = pytuple_fromarray (Array.of_list []) in let _ = build_variable py pylocs in () | Ast_cocci.NoMVInit -> failwith "python variables should be bound") (* | 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) -> Ast_c.MetaIdVal(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:\n" ^ s) res; res let py_isinitialized () = Pycaml.py_isinitialized () let py_finalize () = Pycaml.py_finalize () coccinelle-1.0.4/editors/0000755000175000017500000000000012614153277014265 5ustar eugeneugencoccinelle-1.0.4/editors/emacs/0000755000175000017500000000000012614153277015355 5ustar eugeneugencoccinelle-1.0.4/editors/emacs/cocci-ediff.el0000644000175000017500000007434012614153277020042 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.4/editors/emacs/cocci.el0000644000175000017500000002572212614153277016767 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.4/editors/vim/0000755000175000017500000000000012614153277015060 5ustar eugeneugencoccinelle-1.0.4/editors/vim/README0000644000175000017500000000060012614153277015734 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.4/editors/vim/ftdetect/0000755000175000017500000000000012614153277016662 5ustar eugeneugencoccinelle-1.0.4/editors/vim/ftdetect/cocci.vim0000644000175000017500000000055712614153277020466 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.4/editors/vim/syntax/0000755000175000017500000000000012614153277016406 5ustar eugeneugencoccinelle-1.0.4/editors/vim/syntax/cocci.vim0000644000175000017500000000234012614153277020202 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.4/env.csh0000644000175000017500000000040412614153277014101 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.4/bugs.txt0000644000175000017500000000017012614153277014313 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.4/env.sh0000644000175000017500000000271512614153277013745 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.4/scripts/0000755000175000017500000000000012614156171014277 5ustar eugeneugencoccinelle-1.0.4/scripts/extractor_README.pl0000755000175000017500000000334612614153277017701 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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.4/scripts/extractor.awk0000755000175000017500000000505212614153277017027 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.4/scripts/gather_failed.pl0000755000175000017500000000063512614153277017425 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # 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.4/scripts/glimpseindex_cocci.sh0000755000175000017500000000022412614153277020470 0ustar eugeneugen#! /bin/sh if [ ! -z $1 ]; then DIR=$1 else DIR=`pwd` fi pushd $DIR echo Indexing in $DIR find * -name "*.[ch]" | glimpseindex -o -H $DIR -F popd coccinelle-1.0.4/scripts/spatch.bash_completion0000644000175000017500000000623212614153277020660 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.4/scripts/idutils_index.sh0000755000175000017500000000006012614153277017502 0ustar eugeneugen#!/bin/sh mkid -i C --output .id-utils.index * coccinelle-1.0.4/scripts/stat_directories.pl0000755000175000017500000000241612614153277020215 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr #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.4/scripts/extract_examples.pl0000755000175000017500000000124612614153277020216 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr #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.4/scripts/stat_directories_complete.pl0000755000175000017500000000136412614153277022106 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr #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.4/scripts/coccicheck/0000755000175000017500000000000012614153277016361 5ustar eugeneugencoccinelle-1.0.4/scripts/coccicheck/README0000644000175000017500000000301412614153277017237 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.4/scripts/coccicheck/configure0000755000175000017500000000541212614153277020272 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.4/scripts/coccicheck/cocci/0000755000175000017500000000000012614153277017441 5ustar eugeneugencoccinelle-1.0.4/scripts/coccicheck/cocci/find_unsigned.cocci0000644000175000017500000000072612614153277023264 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.4/scripts/coccicheck/cocci/unused.cocci0000644000175000017500000000116612614153277021752 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.4/scripts/coccicheck/cocci/malloc.cocci0000644000175000017500000000144512614153277021716 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.4/scripts/coccicheck/cocci/kmalloc7.cocci0000644000175000017500000000152312614153277022155 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.4/scripts/coccicheck/cocci/noderef2.cocci0000644000175000017500000000075412614153277022155 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.4/scripts/coccicheck/cocci/noderef.cocci0000644000175000017500000000076612614153277022076 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.4/scripts/coccicheck/cocci/isnull.cocci0000644000175000017500000000125012614153277021747 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.4/scripts/coccicheck/cocci/notand.h0000644000175000017500000005603212614153277021103 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.4/scripts/coccicheck/cocci/notnull.cocci0000644000175000017500000000253612614153277022144 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.4/scripts/coccicheck/cocci/notand.cocci0000644000175000017500000000073212614153277021730 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.4/scripts/coccicheck/cocci/open.cocci0000644000175000017500000000151512614153277021406 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.4/scripts/coccicheck/cocci/null_ref.cocci0000644000175000017500000000223112614153277022247 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.4/scripts/coccicheck/cocci/empty.cocci.model0000644000175000017500000000002512614153277022675 0ustar eugeneugen@@@@ -NicolasPalix() coccinelle-1.0.4/scripts/coccicheck/cocci/kc.cocci0000644000175000017500000000102412614153277021035 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.4/scripts/coccicheck/cocci/kzmem.cocci0000644000175000017500000000137112614153277021570 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.4/scripts/coccicheck/cocci/badzero.cocci0000644000175000017500000000071212614153277022071 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.4/scripts/coccicheck/bin/0000755000175000017500000000000012614153277017131 5ustar eugeneugencoccinelle-1.0.4/scripts/coccicheck/bin/update_result_tree0000755000175000017500000000402412614153277022756 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.4/scripts/stat_directory_complete.pl0000755000175000017500000002322312614153277021574 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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.4/scripts/readme.pl0000755000175000017500000000313212614153277016077 0ustar eugeneugen#!/usr/bin/perl # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # # 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.4/scripts/genversion.sh0000755000175000017500000000045612614153277017026 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.4/scripts/extract_c_and_res.pl0000755000175000017500000001344512614153277020321 0ustar eugeneugen#!/usr/bin/perl -w # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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.4/scripts/setlocalversion0000755000175000017500000001016512614153277017450 0ustar eugeneugen#!/bin/sh # # Copyright (c) 2005-2006 Ryan Anderson # Copyright (c) 2006 Rene Scharfe # Copyright (c) 2006 Uwe Zeisberger # Copyright (c) 2007 Aron Griffis # Copyright (c) 2007 Theodore Ts'o # Copyright (c) 2008 Bryan Wu # Copyright (c) 2008 Mike Frysinger # Copyright (c) 2008 Peter Korsgaard # Copyright (c) 2008 Sebastian Siewior # Copyright (c) 2008 Trent Piepho # Copyright (c) 2009 Mike Frysinger # Copyright (c) 2009 Nico Schottelius # Copyright (c) 2009 Peter Korsgaard # Copyright (c) 2010 Linus Torvalds # Copyright (c) 2010 Michael Prokop # Copyright (c) 2010 Michał Górny # Copyright (c) 2010 Michal Marek # Copyright (c) 2010 Milton Miller # Copyright (c) 2011 Mike Crowe # Copyright (c) 2012 Roland Dreier # Copyright (c) 2013 Christian Kujau # Copyright (c) 2013 Christophe Leroy # Copyright (c) 2013 Franck Bui-Huu # Copyright (c) 2015 Luis R. Rodriguez # # This file is released under the GPLv2. # # Taken from the Linux kernel as of v4.2-rc2 with a few modifications # described below. # # This scripts adds local version information from the version # control systems. It was taken from the Linux kernel as of v4.2-rc2 # and simplified for use on Coccinelle by mcgrof. The version info # was hard coded to use long version. The svn postfix details were # also removed. I also added the option to enable this script to # work well for trees that do not use PGP signed tags or annotated # tags (git tag -s or git tag -a), git describe by default will only # look for these tags. If you do not use these you will want to set # the below variable to TAGS="--tags". If you requires --tags, consider # to start signing your releases "git tag -s" and use a subkey for that. # If you do that, consider also using another PGP subkey for annotating # releases as deprecated. # # Set to emtpy variable if you use properly signed tags. You should do this! TAGS="--tags" srctree=. scm_version() { local short short=false # Check for git and a git repo. if test -z "$(git rev-parse --show-cdup 2>/dev/null)" && head=`git rev-parse --verify --short HEAD 2>/dev/null`; then # If we are at a tagged commit (like "v2.6.30-rc6"), we ignore # it, because this version is defined in the top level Makefile. if [ -z "`git describe $TAGS --exact-match 2>/dev/null`" ]; then # If only the short version is requested, don't bother # running further git commands if $short; then echo "+" return fi # If we are past a tagged commit (like # "v2.6.30-rc5-302-g72357d5"), we pretty print it. if atag="`git describe $TAGS 2>/dev/null`"; then echo "$atag" | awk -F- '{printf("-%05d-%s", $(NF-1),$(NF))}' # If we don't have a tag at all we print -g{commitish}. else printf '%s%s' -g $head fi fi # Check for uncommitted changes if git diff-index --name-only HEAD | grep -qv "^scripts/package"; then printf '%s' -dirty fi # All done with git return fi # Check for mercurial and a mercurial repo. if test -d .hg && hgid=`hg id 2>/dev/null`; then # Do we have an tagged version? If so, latesttagdistance == 1 if [ "`hg log -r . --template '{latesttagdistance}'`" == "1" ]; then id=`hg log -r . --template '{latesttag}'` printf '%s%s' -hg "$id" else tag=`printf '%s' "$hgid" | cut -d' ' -f2` if [ -z "$tag" -o "$tag" = tip ]; then id=`printf '%s' "$hgid" | sed 's/[+ ].*//'` printf '%s%s' -hg "$id" fi fi # Are there uncommitted changes? # These are represented by + after the changeset id. case "$hgid" in *+|*+\ *) printf '%s' -dirty ;; esac # All done with mercurial return fi } res="$res$(scm_version)" echo "$res" coccinelle-1.0.4/scripts/spatch.sh.in0000644000175000017500000000242312614153277016527 0ustar eugeneugen#! /bin/sh -e # generic wrapper script to invoke 'spatch' or 'spatch.opt' # it sets the python variables (if relevant) # and COCCINELLE_HOME exec_prefix=@prefix@ LIBDIR="@libdir@/coccinelle" if test ! -d "$LIBDIR"; then LIBDIR="$(pwd)" fi COCCINELLE_HOME="${COCCINELLE_HOME:=$LIBDIR}" 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.4/read_options.mli0000644000175000017500000000053412614153277016007 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val read_options : string list (* opts with args *) -> string list (* original arglist *) -> string list coccinelle-1.0.4/read_options.ml0000644000175000017500000001041112614153277015631 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* This reads Coccinelle command line arguments from a configuration file. The configuration file is named .cocci. The only format allowed at the moment is [spatch] options = --opt1 --opt2 options = --opt3 --opt4 ... Perhaps entries for other tools may be added later. Multiple options lines are permitted only for readability. Later lines extend and may override earlier ones. .cocciconfig files can be placed in the user's home directory, the directory from which spatch is called, and the directory provided with the --dir option. The .cocciconfig file in the user's home directory is processed first, the .cocciconfig file in the directory from which spatch is called is processed next, and the .cocciconfig file in the directory provided with the --dir option is processed last. In each case, the read options extend/override the previously read ones. In all cases, the user can extend/override the options found in the .cocciconfig files on the command line. Newlines, even with \, are not tolerated in attribute values *) let get_home () = Sys.getenv "HOME" let split_at_spaces s = Str.split (Str.regexp "[ \t]+") s (* not very robust - may just skip some garbage lines *) let rec read_to_header i l = if l = "" || String.get l 0 = '#' (* comment character *) then read_to_header i (input_line i) else match Str.split_delim (Str.regexp_string "[") l with [before;after] -> (match Str.split_delim (Str.regexp_string "]") after with [spatch;after] -> spatch | _ -> failwith ("unexpected entry: "^l)) | _ -> read_to_header i (input_line i) let parse_file file = let i = open_in file in let options = ref [] in let rec loop l = let header = read_to_header i l in match header with "spatch" -> let rec iloop _ = let l = input_line i in if l = "" || String.get l 0 = '#' (* comment character *) then iloop() else (* bounded split doesn't split at = in value part *) match Str.bounded_split (Str.regexp "[ \t]*=[ \t]*") l 2 with [opts;new_options] -> (match split_at_spaces opts with ["options"] -> options := split_at_spaces new_options :: !options; iloop() | [other] -> failwith (Printf.sprintf "expected options, found %s" other) | xs -> failwith ("options is the only supported attribute: "^l)) | _ -> loop l in iloop() | _ -> failwith "only spatch supported as a header in a .cocciconfig file" in try loop (input_line i) with End_of_file -> List.concat (List.rev !options) (* ------------------------------------------------------------------------ *) let process_arglist strings = function spatch::rest -> let before = [spatch] in let after = rest in let rec loop = function x::opt::xs when List.mem opt strings -> loop xs | ""::xs -> loop xs (* not sure why it would arise *) | x::xs -> if String.get x 0 = '-' then loop xs else if Filename.check_suffix x ".cocci" then loop xs else if Sys.file_exists x && Common.is_directory x then Some x else loop xs | [] -> None in (before,after,loop (List.rev rest)) | [] -> failwith "arglist should always contain the command" (* ------------------------------------------------------------------------ *) let check_one file = if Sys.file_exists file then Some (parse_file file) else None let unoption = function None -> [] | Some l -> l let read_options strings arglist = let hd = get_home() in let cwd = Sys.getcwd() in let home_dir_options = check_one (Printf.sprintf "%s/.cocciconfig" hd) in let cwd_options = check_one ".cocciconfig" in let (before,after,dir) = process_arglist strings arglist in let dir_options = let rec loop dir = if dir = "/" || dir = "." || dir = hd || dir = cwd then None else match check_one (Printf.sprintf "%s/.cocciconfig" dir) with None -> loop (Filename.dirname dir) | Some l -> Some l in match dir with None -> None | Some dir -> loop dir in before @ (unoption home_dir_options) @ (unoption cwd_options) @ (unoption dir_options) @ after coccinelle-1.0.4/flag_cocci.ml0000644000175000017500000000302212614153277015214 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 there 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 include_headers_for_types = ref 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! *) (* caching of header file information *) let cache_threshold = 500 let elem_threshold = 10 coccinelle-1.0.4/extra/0000755000175000017500000000000012614156171013733 5ustar eugeneugencoccinelle-1.0.4/extra/classic_patch.ml0000644000175000017500000000132212614153277017067 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.4/extra/maintainers.ml0000644000175000017500000000623412614153277016610 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 (Printf.sprintf "%-40s : %s" s (String.concat " ," emails)); ys +> List.iter (fun (s, emails) -> pr (Printf.sprintf " %-40s : %s" s (String.concat " ," 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.4/extra/kbuild.ml0000644000175000017500000001504212614153277015545 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 (" " ^ (String.concat " " 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: " ^ (String.concat "|" objs)) | s when s =~ "[a-zA-Z0-9_]+-objs[ \t]*[\\+:]=\\(.*\\)" -> let s = matched1 s in let objs = Common.split "[ \t]+" s in pr2 ("OBJSMODULE: " ^ (String.concat "|" 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.4/extra/Makefile0000644000175000017500000000332712614153277015404 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) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SOURCES:.ml=.cmo) OPTOBJS = $(SOURCES:.ml=.cmx) 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 .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) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/extra/classic_patch.mli0000644000175000017500000000037012614153277017242 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.4/extra/maintainers.mli0000644000175000017500000000140712614153277016756 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.4/extra/kbuild.mli0000644000175000017500000000160212614153277015713 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.4/globals/0000755000175000017500000000000012614156171014233 5ustar eugeneugencoccinelle-1.0.4/globals/config.ml.in0000644000175000017500000000050612614153277016444 0ustar eugeneugenlet version = "@COCCI_VERSION@" let path = try (Sys.getenv "COCCINELLE_HOME") with Not_found->"@libdir@/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@ let get_temp_dir_name = @GET_TEMP_DIR_NAME_EXPR@ coccinelle-1.0.4/globals/flag.ml0000644000175000017500000000310212614153277015476 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 | GitGrep | 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_delim (Str.regexp "=") s with [_] -> defined_virtual_rules := s :: !defined_virtual_rules | name::vl -> let vl = String.concat "=" vl in defined_virtual_env := (name,vl) :: !defined_virtual_env | _ -> failwith "nothing defined" let c_plus_plus = ref false let ibm = ref false (* was in main *) let include_headers = ref false exception UnreadableFile of string coccinelle-1.0.4/globals/regexp.ml.in0000644000175000017500000000003012614153277016461 0ustar eugeneugeninclude @REGEXP_MODULE@ coccinelle-1.0.4/globals/iteration.mli0000644000175000017500000000246712614153277016751 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) type init_info = (string (* language *) * string (* rule name *)) * (string list (* defined virtual rules *) * (string * string) list (* defined virtual env *)) 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 and bool for environment extension *) (string list option * string list * (string * string) list * bool) -> unit val get_pending_instance : unit -> pending_info option (* ----------------------------------------------------------------------- *) val check_virtual_rule : string -> unit val check_virtual_ident : string -> unit coccinelle-1.0.4/globals/iteration.ml0000644000175000017500000000524112614153277016571 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) type init_info = (string (* language *) * string (* rule name *)) * (string list (* defined virtual rules *) * (string * string) list (* defined virtual env *)) 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,vrules,vids,extend_vids) = let vids = if extend_vids then let newdefs = List.map fst vids in let olddefs = List.filter (function (id,_) -> not (List.mem id newdefs)) !Flag.defined_virtual_env in vids @ olddefs else vids in match files with None -> pending_instances_dir := (!base_file_list,vrules,vids) :: !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,vrules,vids)] | ((f1,vr1,vi1) as front)::rest -> if f = f1 then front :: (loop rest) else (f,vrules,vids) :: front :: rest in pending_instances_file := loop !pending_instances_file let get_pending_instance _ = (if (List.length !pending_instances_file) > 0 || (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.4/globals/Makefile0000644000175000017500000000407712614153277015707 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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 ############################################################################## 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) ############################################################################## # 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 .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/globals/regexp_pcre.ml0000644000175000017500000000237612614153277017104 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) type regexp = Pcre of int (* Pcre.regexp *) | Str of Str.regexp (* A table is used because PCRE regular expressions are not comparable. They sit in constraints of rule_elems that get bound to exists v variables in the matching process. It would be expensive to strip them at runtime, and complex to strip them statically, because both stripped and unstripped versions would be needed in cocci_vs_c. So instead we just replace them by integers, which are comparable. *) let pcre_table = Hashtbl.create 101 let pcre_ctr = ref 0 let pcre_support = ref true let regexp string = if !pcre_support then begin let c = !pcre_ctr in pcre_ctr := !pcre_ctr + 1; Hashtbl.add pcre_table c (Pcre.regexp string); Pcre c end else Str (Str.regexp string) let string_match regexp string = match regexp with Pcre regexp -> let regexp = Hashtbl.find pcre_table regexp in Pcre.pmatch ~rex:regexp string | Str regexp -> try ignore(Str.search_forward regexp string 0); true with _ -> false coccinelle-1.0.4/globals/regexp_str.ml0000644000175000017500000000066012614153277016755 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/version.sh0000755000175000017500000000016712614153277014644 0ustar eugeneugen#!/bin/sh tr -d '\n' < ./version if test "x$MAKE_COCCI_RELEASE" = "x"; then ./scripts/setlocalversion | tr -d '\n' fi coccinelle-1.0.4/empty.h0000644000175000017500000000000012614153277014111 0ustar eugeneugencoccinelle-1.0.4/ctl/0000755000175000017500000000000012614156171013372 5ustar eugeneugencoccinelle-1.0.4/ctl/ast_ctl.ml0000644000175000017500000000647612614153277015376 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ---------------------------------------------------------------------- *) (* 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.4/ctl/flag_ctl.ml0000644000175000017500000000117312614153277015505 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/ctl/wrapper_ctl.mli0000644000175000017500000000432512614153277016427 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 type 'pred preprocfunc = 'pred -> bool 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 * predicate preprocfunc * 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 * predicate preprocfunc * 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.4/ctl/ctl_engine.mli0000644000175000017500000000377412614153277016223 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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) * (P.t -> bool) * 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.4/ctl/wrapper_ctl.ml0000644000175000017500000002055012614153277016254 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ********************************************************************** * * 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 type 'pred preprocfunc = 'pred -> bool (* pad: what is 'wit ? *) type ('pred,'mvar) wrapped_preprocfunc = ('pred * 'mvar Ast_ctl.modif) -> bool (* ********************************************************************** *) (* 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) (* Wrap a preproc function - selects interesting predicates *) let (wrap_preproc: 'pred preprocfunc -> ('pred,'mvar) wrapped_preprocfunc) = fun oldpreprocfunc -> fun (p, predvar) -> oldpreprocfunc 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 || !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,preproc,states) (phi,reqopt) : ('pred,'anno) WRAPPER_ENGINE.triples = WRAPPER_ENGINE.sat (grp,wrap_label lab,wrap_preproc preproc,states) phi reqopt (* Returns the "cleaned up" result from satbis_noclean *) let (satbis : G.cfg * (predicate,G.node,SUB.mvar,SUB.value) labelfunc * predicate preprocfunc * 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.4/ctl/pretty_print_ctl.mli0000644000175000017500000000055412614153277017512 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val pp_ctl: ('pred -> unit) * ('mvar -> unit) -> bool (* inline_let_def *) -> ('pred, 'mvar, 'info) Ast_ctl.generic_ctl -> unit coccinelle-1.0.4/ctl/pretty_print_ctl.ml0000644000175000017500000001145112614153277017337 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 phi1 -> pp "XX"; pp_arg_paren env phi1 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.4/ctl/test_ctl.ml0000644000175000017500000002234012614153277015552 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ********************************************************************** *) (* 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.4/ctl/ctl_engine.ml0000644000175000017500000023057012614153277016046 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (*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 (string_of_int 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 rec some_tolist (opts : 'a option list) : 'a list = 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 state_compare (s1,_,_) (s2,_,_) = compare s1 s2 let setifyBy eq xs = nubBy eq xs;; let setify xs = Common.nub xs;; let inner_setify xs = List.sort compare (Common.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 = Common.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 || 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) = let ss' = match dir with A.FORWARD -> G.predecessors grp s | A.BACKWARD -> G.successors grp s in concatmap (fun s' -> if check s' then [(s',th,wit)] else []) ss' 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)) (* 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 ;; let satEU_forAW dir ((cfg,_,states) as m) s1 s2 reqst print_graph = if s1 = [] then s2 else if !pNEW_INFO_OPT then let rec f y new_info = if List.exists (G.extract_is_loop cfg) (get_states new_info) then raise AW else match new_info with [] -> y | new_info -> 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 f res new_info in f s2 s2 else let f y = 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 strip s = List.map (function s -> (s,[],[])) (get_states s) in let ctr = ref 0 in inc satAU_calls; if s1 = [] then AUok s2 else (*let ctr = ref 0 in*) if !pNEW_INFO_OPT then let rec f y newinfo = inc_step(); match newinfo with [] -> AUok y | new_info -> ctr := !ctr + 1; print_graph y ctr; let pre = pre_forall dir m new_info y reqst in match triples_conj s1 pre with [] -> AUok y | first -> let res = triples_union first y in let new_info = if not !something_dropped then first else setdiff res y in f res new_info in try (if !Flag_ctl.loop_in_src_code then let _ = satEU_forAW dir m (strip s1) (strip s2) reqst print_graph in ()); f s2 s2 with AW -> AUfailed 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 (Common.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(101) : (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,preproc,_) = function [] -> true (* no information, try everything *) | l -> let sz = G.size cfg in let verbose_output pred = function false -> Printf.printf "did not find:\n"; P.print_predicate pred; Format.print_newline() | true -> 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 = preproc x in (if verbose then verbose_output x res); 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,preproc,states) = m in if (!Flag_ctl.bench > 0) || preprocess m 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.4/ctl/double_negate_ml0000644000175000017500000000346512614153277016616 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.4/ctl/Makefile0000644000175000017500000000330112614153277015033 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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) 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 .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 .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/docs/0000755000175000017500000000000012614156171013540 5ustar eugeneugencoccinelle-1.0.4/docs/spatch.1.in0000644000175000017500000003453412614153277015526 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH SPATCH 1 "Feb 26, 2015" .\" 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. Semantic patch examples can be found at \fBhttp://coccinellery.org/\fP, and at the \fBscripts/coccinelle\fP directory of the Linux Kernel source code. .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/lib/coccinelle/standard.iso) .TP \fB\-\-macro\-file\fR .TP \fB\-\-macro\-file\-builtins\fR (default=/usr/local/lib/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. The supported extensions for source files are .cpp, .cxx, .cc, and for header files are .h, .hpp and .hxx. Note that this option disables the processing of .c files as Coccinelle behaviour is different for C++. .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. Julien Brunel, Damien Doligez, René Rydhof Hansen, Julia L. Lawall, Gilles Muller. "A foundation for flow-based program matching: using temporal logic and model checking", .I POPL 2009 , Savannah, GA, USA, January 21-23, 2009, pp. 114-126. .SH AUTHOR \fBspatch\fP was written by Julia Lawall , Yoann Padioleau , Rene Rydhof Hansen , Henrik Stuart , Nicolas Palix , Peter Senna Tschudin , Sébastien Hinderer , Xavier Clerc and Matthieu Caneill . .PP This manual page was written by Yoann Padioleau , Julia Lawall , Nicolas Palix and Peter Senna Tschudin . .SH REPORTING BUGS Send a mail to .SH COPYRIGHT Copyright 2012, 2015, INRIA and University of Grenoble-Alpes LIG. 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.4/docs/manual/0000755000175000017500000000000012616742627015026 5ustar eugeneugencoccinelle-1.0.4/docs/manual/find-xxdate0000755000175000017500000000121512614153277017161 0ustar eugeneugen#!/bin/sh # This script is used to find the xxdate.exe file needed by Hevea. # It is needed because different distributions store it in different places: # For Gentoo: /usr/lib64/hevea # For Ubuntu family: /usr/share/hevea # Etc. # If the file is found, its absolute path is printed to stdout. # Otherwise, a warning is printed on stderr and the script returns 1 file=xxdate.exe directories="/usr/lib64/hevea /usr/share/hevea /usr/local/lib/hevea /opt/local/share/hevea" for dir in ${directories}; do fullpath=${dir}/${file}; if [ -f ${fullpath} ]; then echo ${fullpath}; exit; fi done echo "*** Hevea: Unable to find xxdate.exe ***" >&2 exit 1 coccinelle-1.0.4/docs/manual/macros_grammar.tex0000644000175000017500000000302512614153277020535 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.4/docs/manual/tips.tex0000644000175000017500000000234712614153277016530 0ustar eugeneugen \section{Tips and Tricks} This section presents some tips and tricks for using Coccinelle. \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.4/docs/manual/tutorial.tex0000644000175000017500000000002312614153277017401 0ustar eugeneugen\chapter{Tutorial} coccinelle-1.0.4/docs/manual/main_grammar.tex0000644000175000017500000000157712614153277020207 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.4/docs/manual/installing.tex0000644000175000017500000000105412614153277017707 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.4/docs/manual/options.tex0000644000175000017500000000021212614153277017231 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.4/docs/manual/macros_options.tex0000644000175000017500000000050412614153277020601 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.4/docs/manual/main.tex0000644000175000017500000001200112614153277016461 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.4/docs/manual/macros.tex0000644000175000017500000000026412614153277017031 0ustar eugeneugen\newcommand{\spatch}{\texttt{spatch}\xspace} \newcommand{\sgrep}{\texttt{sgrep}\xspace} \newcommand{\cpp}{\texttt{cpp}\xspace} \newcommand{\cocciversion}{\input{../../version}} coccinelle-1.0.4/docs/manual/examples.tex0000644000175000017500000003234612614153277017371 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 previous 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 several positions are matched by a single position variable and 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 expressions} 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.4/docs/manual/hevea.sty0000644000175000017500000000576112614153277016663 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.4/docs/manual/parsing.tex0000644000175000017500000000026112614153277017205 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.4/docs/manual/license.txt0000644000175000017500000005465012614153277017216 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.4/docs/manual/copyright.txt0000644000175000017500000000073312614153277017575 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.4/docs/manual/introduction.tex0000644000175000017500000000463712614153277020276 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 a specific language called SmPL, for Semantic Patch Language, which as its name suggests is very close to the syntax of a patch, but does not work at a line level, as traditional patches do, but rather at higher, semantic level. Here is an example of a simple program transformation. To replace every call to \verb+foo+ of any expression $x$ by a call to \verb+bar+, create a semantic patch file \verb+ex1.cocci+ (semantic patches usually end 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.4/docs/manual/python.tex0000644000175000017500000000266512614153277017075 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.4/docs/manual/cocci_syntax.tex0000644000175000017500000014373712614153277020250 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. A square bracket that is surrounded by spaces in the description of a term should appear explicitly in the term, as in an array reference. On the other hand, square brackets that surround some other term indicat that the presence of that term is optional. % \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 it is 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{optional\_attributes}: This is similar to \KW{optional\_attributes}, except that here is it an attribute (e.g., \_\_init) that does not have to be specified in the SmPL code, but may be present in the C code. \textbf{Note that this isomorphism is currently useless, because matching of attributes is not supported, due to the difficulty of parsing attributes in 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. \item \KW{prototypes}: A rule for transforming a function prototype is generated when a function header changes. \end{itemize} The possible types of metavariable declarations are defined by the grammar rule below. Metavariables should occur at least once in the transformation code 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. In the minus code, a statement list metavariable can only appear as a complete function body or as the complete body of a sequence statement. In the plus code, a statement list metavariable can occur anywhere a statement list is allowed, i.e., including as an element of another statement list. \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{attribute \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 \mth{\mid} global} idexpression \opt{\NT{ctype}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{\opt{local \mth{\mid} global} idexpression \OPT{\ttlb \NT{ctypes}\ttrb~\any{*}} \NT{COMMA\_LIST}\mth{(}\NT{pmid\_with\_not\_eq}\mth{)} ;} \CASE{\opt{local \mth{\mid} global} 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} ;} \CASE{assignment operator \NT{COMMA\_LIST}\mth{(}\T{assignopdecl}\mth{)} ;} \CASE{binary operator \NT{COMMA\_LIST}\mth{(}\T{binopdecl}\mth{)} ;} \RULE{\rt{assignopdecl}} \CASE{\NT{id} \OPT{ = \NT{assignop\_contraint}}} \RULE{\rt{assignop\_contraint}} \CASE{\mth{\{}\NT{COMMA\_LIST}\mth{(}\NT{assign\_op}\mth{)}\mth{\}}} \CASE{\NT{assign\_op}} \RULE{\rt{binopdecl}} \CASE{\NT{id} \OPT{ = \NT{binop\_contraint}}} \RULE{\rt{binop\_contraint}} \CASE{\mth{\{}\NT{COMMA\_LIST}\mth{(}\NT{bin\_op}\mth{)}\mth{\}}} \CASE{\NT{bin\_op}} \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 idexpression. 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 given 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. An attribute declaration indicates a name that should be considered to be an attribute. It is not possible to match or remove an attribute, only to add one. 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. Assignment (resp. binary) operator metavariables match any assignment (resp. binary) operator. The list of operators that can be matched can be restricted by adding an operator constraint, i.e. a list of accepted operators. 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. Another particular case is {\tt E@S}, where {\tt E} is any expression and {\tt S} is a statement metavariable. {\tt S} matches the closest enclosing statement, which may be more than what is matches by the semantic match pattern itself. Matching of various kinds of format strings within strings is supported. With the {\tt --ibm} option, matching of decimal format declarations is supported, but the length and precision arguments are not interpreted. Thus it is not possible to match metavariables in these fields. Instead, the entire format is matched as a single string. \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}. It is possible to give an identifier metavariable a list of constraints that it should or should not be equal to. If the constraint is a list of (unquoted) strings, then the value of the metavariable should be the same as one of the strings, in the case of an equality constraint, or different from all of the strings, in the case of an inequality constraint. It is also possible to include inherited identifier metavariables among the constraints. In the case of a positive constraint, things work in the same way, but not with respect to the inherited value of the metavariable. On the other hand, an inequality constraint does not work so well, because the only value available is the one available in the current environment. If the proposed value is different from the one in the current environment, but perhaps the same as the one in some other environment, the match will still succeed. \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}} @ \any{\NT{script\_virt\_metadecl}} @@} \CASE{@ finalize:\NT{language} \OPT{depends on \NT{dep}} @ \any{\NT{script\_virt\_metadecl}} @@} \RULE{\rt{language}} \CASE{python} \CASE{ocaml} \RULE{\rt{script\_metadecl}} \CASE{\T{id} <{}< \T{rulename\_id}.\T{id} ;} \CASE{\T{id} <{}< \T{rulename\_id}.\T{id} = "..." ;} \CASE{\T{id} <{}< \T{rulename\_id}.\T{id} = [] ;} \CASE{\T{id} ;} \RULE{\rt{script\_virt\_metadecl}} \CASE{\T{id} <{}< virtual.\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. Initialize and finalize rules do have access to virtual metavariables, using the usual syntax. As for other scripting language rules, the rule is not run (and essentially does not exist) if some of the required virtual metavariables are not bound. In ocaml, a warning is printed in this case. An example is found in demos/initvirt.cocci. 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. Script metavariables can have default values. This is only allowed if the abstract syntax tree of the metavariable is not requested. The default value of a position metavariable is written as {\tt []}. The default value of any other kind of metavariable is a string. There is no control that the string actually represents the kind of term represented by the metavariable. Normally, a script rule is only applied if all of the metavariables have values. If default values are provided, then the script rule is only applied if all of the metavariables for which there are no default values have values. See demos/defaultscript.cocci for examples of the use of this feature. \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 marked \texttt{+}. \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}}}} \CASE{......} \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. Varargs are written in C using {\tt \ldots}. Unfortunately, this notation is already used in the semantic patch language. A pattern for a varargs parameter is written as a sequence of 6 dots. The C parser allows functions that have no return type, and assumes that the return type is \texttt{int}. The support for parsing such functions is limited. In particular, the parameter list must contain a type for each parameter, and may not contain varargs. %\newpage \section{Declarations} \begin{grammar} \RULE{\rt{decl\_var}} \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} ;} % \CASE{\NT{type} \opt{\NT{id} \opt{[\opt{\NT{dot\_expr}}]} % \ANY{, \NT{id} \opt{[ \opt{\NT{dot\_expr}}]}}};} \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} \mth{\T{metaid}^{\ssf{AssignOp}}} \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} \mth{\T{metaid}^{\ssf{BinOp}}} \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. \section{Iteration} It is possible to iterate Coccinelle, giving the subsequent iterations a different set of virtual rules or virtual identifier bindings. And example is found in {\tt demos/iteration.cocci}. The example shown there is as follows: \begin{quote} \begin{verbatim} 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() \end{verbatim} \end{quote} The virtual rule {\tt after\_start} is used to distinguish between the first iteration (in which it is not considered to have matched) and all others. This is done by not mentioning {\tt after\_start} in the command line, but adding it on each iteration. The main code for performing the iteration is found in the function {\tt add\_if\_not\_present}, between the lines calling {\tt new iteration} and {\tt register}. {\tt New iteration} creates a structure representing the new iteration. {\tt set\_files} sets the list of files to be considered on the new iteration. If this function is not called, the new iteration treats the same files as the current iteration. {\tt add\_virtual\_rule A} has the same effect as putting {\tt -D a} on the command line. Note that the first letter of the rule name is capitalized, although this is not done elsewhere. {\tt add\_virtual\_identifier X v} has the same effect as putting {\tt -D x=v} on the command line. Note again the case change. {\tt extend\_virtual\_identifiers()} (not shown) preserves all virtual identifiers of the current iteration that are not overridden by calls to {\tt add\_virtual\_identifier}. Finally, the call to {\tt register} queues the collected information to trigger a new iteration at some time in the future. Modification is not allowed when using iteration. Thus, it is required to use the {\tt --no-show-diff}, unless the semantic patch contains {\tt *}s (a semantic match rather than a semantic patch). The remainder of the code above uses a hash table to ensure that the same information is not enqueued more than once. Coccinelle itself provides no support for this. %%% Local Variables: %%% mode: LaTeX %%% TeX-master: "main_grammar" %%% coding: utf-8 %%% TeX-PDF-mode: t %%% ispell-local-dictionary: "american" %%% End: coccinelle-1.0.4/docs/manual/advanced.tex0000644000175000017500000000003412614153277017305 0ustar eugeneugen\chapter{Advanced Features} coccinelle-1.0.4/docs/manual/cocci-python.txt0000644000175000017500000000612412614153277020164 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.4/docs/manual/main_options.tex0000644000175000017500000000114012614153277020236 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.4/docs/manual/macros_common.tex0000644000175000017500000000214012614153277020374 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.4/docs/manual/isomorphisms.tex0000644000175000017500000000025712614153277020303 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.4/docs/manual/manual.tex0000644000175000017500000000020012614153277017010 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.4/docs/manual/Makefile0000644000175000017500000000654112614153277016467 0ustar eugeneugen############################################################################## # Variables ############################################################################## ifneq ($(MAKECMDGOALS),distclean) include ../../Makefile.config endif HEVEA = hevea HEVEA_XXDATE := $(shell ./find-xxdate) HEVEA_CMD := $(HEVEA) -exec $(HEVEA_XXDATE) MAINSRC=main.tex SRC=$(wildcard *.tex) PDFLATEX_CMD=$(PDFLATEX) -halt-on-error PDF=manual.pdf main_grammar.pdf options.pdf #tools: # latex, pdflatex # xfig # emacs, auctex, ediff # darcs # latexdiff ############################################################################## # Top rules ############################################################################## .PHONY: all clean distclean .SUFFIXES: .pdf .tex all: pdf html pdf: $(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 WEBBASE?=~/website WEBDOCS=$(WEBBASE)/docs HTML=$(TEX:.tex=.html) html: $(HTML) clean:: rm -f *.aux *.dvi *.pdf *.html *.haux *.htoc *.log *.out *~ distclean:: clean @if test -z "${KEEP_GENERATED}"; then \ rm -f *.pdf *.html *.gif *.css; fi check: $(HTML) checklink $< .tex.html: $(HEVEA_CMD) $< $(HEVEA_CMD) $< hacha -o index.html main_grammar.html ############################################################################## # Install ############################################################################## install: all cp *.css *.gif *.html $(WEBDOCS) cp $(PDF) $(WEBDOCS) # chown apache:apache -R $(WEBDOCS) # chmod a-w -R $(WEBDOCS) ############################################################################## # 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.4/docs/manual/spatch_options.tex0000644000175000017500000010244112614153277020602 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.} \normal{-{}-debug-parse-cocci}{ Print some information about the definition of virtual rules and the bindings of virtual identifiers. This is particularly useful when using iteration, as it prints out this information for each iteration.} \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 {\bf -{}-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. If the argument -()-expected-score-file is provided, then that file is used for the result. Otherwise, the result goes in ``tests/SCORE\_expected.sexp''. {\bf Warning:} It is intended that not all of the test cases provided with Coccinelle actually pass.} \rare{-{}-test-spacing}{Like -{}-testall, but ensures that the spacing is the same as in the .res file. If the argument -()-expected-spacing-score-file is provided, then that file is used for the result. Otherwise, the result goes in ``tests/SCORE\_spacing\_expected.sexp''.} \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 {\bf -{}-parse-error-msg.}} \rare{-{}-parse-handler $\langle$file$\rangle$}{Loads the file containing the OCaml code in charge of parse error reporting. This function should have arguments 1) the line number containing the error, 2) the sequence of tokens, the starting and ending line of the function containing the error, and array containing the lines of the file containing the error, and the pass of the parser on which the error occurs. This functyion should then be passed to the fuction {\tt Parse\_c.set\_parse\_error\_function}.} \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 {\bf -{}-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 {\bf -{}-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.} \normal{-{}-include-headers-for-types}{Header files are parsed to collect type information, but are not involved in the subsequent matching and transformation process.} \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.} \normal{-{}-indent $n$}{The number of spaces to indent, if no other information is available. If this information is not provided, then the default indentation is a tab. This option is thus particularly relevent to projects that don't use tabs.} \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 {\bf -{}-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. A timeout of 0 is no timeout.} \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{Parallelism} \normal{-{}-jobs $\langle$int$\rangle$}{Run the specified number of jobs in parallel. Can be abbreviated as {\bf -j}. This option is not compatible with the use of an {\tt initialize} or {\tt finalize} rule in the semantic patch. This option furthermore creates a temporary directory in the directory from which spatch is executed that has the name of the semantic patch (without its extension) and that contains stdout and stderr files generated by the various processes. When the semantic patch completes, the contents of these files are printed to standard output and standard error, respectively, and the directory is removed.} \developer{-{}-chunksize $\langle$int$\rangle$}{The specified number of files are dispatched as a single unit of parallelism. This option is only interesting with the options {\bf -{}-all-includes} or {\bf -{}-recursive-includes}, when combined with the option {\bf -{}-include-headers-for-types}. In this case, parsed header files are cached. It is only the files that are treated within a single chunk that can benefit from this cache, due to the lack of shared memory in ocaml.} \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.4/docs/manual/macros_listing_cocci.tex0000644000175000017500000000303512614153277021721 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.4/docs/manual/workflow.tex0000644000175000017500000000011312614153277017410 0ustar eugeneugen\chapter{Developing a Semantic Patch} %editing semantic patch, emacs mode coccinelle-1.0.4/docs/dev/0000755000175000017500000000000012614153277014322 5ustar eugeneugencoccinelle-1.0.4/docs/dev/README0000644000175000017500000000023112614153277015176 0ustar eugeneugenThis directry contains notes related to the developemnt of Coccinelle, such as things that are not yet working and should be made working improved, etc. coccinelle-1.0.4/docs/dev/test2.c0000644000175000017500000000004512614153277015526 0ustar eugeneugenvoid main(void) { int a; a = 18; } coccinelle-1.0.4/docs/dev/file-path-error.cocci0000644000175000017500000000012712614153277020324 0ustar eugeneugen@r1@ identifier i; @@ i @script:python@ i << r1.i; @@ import ThisDoesNotExist print i coccinelle-1.0.4/docs/dev/test3.c0000644000175000017500000000004512614153277015527 0ustar eugeneugenvoid main(void) { int a; a = 18; } coccinelle-1.0.4/docs/dev/test1.c0000644000175000017500000000004512614153277015525 0ustar eugeneugenvoid main(void) { int a; a = 18; } coccinelle-1.0.4/docs/dev/test4.c0000644000175000017500000000004512614153277015530 0ustar eugeneugenvoid main(void) { int a; a = 18; } coccinelle-1.0.4/docs/dev/python-integration0000644000175000017500000000272512614153277020115 0ustar eugeneugenNotes from Peter: Python scripts inside .cocci files: ### Issue 1 ### $ spatch file-path-error.cocci test1.c Recently I needed to extract the path from the .cocci from the python script for including a Python file using import. I needed to do something like: source_dir = abspath(dirname(cocci.cocci_file)) This returns the directory correctly, but the Python way of doing it would be something like: source_dir = abspath(dirname(__file__)) Similar issue, maybe related issue, happens when there is an error on the Python script. On the example below File contains "", instead of the path to the .cocci file [peter@hp-peter linux]$ spatch /tmp/test777.cocci . init_defs_builtins: /usr/local/lib/coccinelle/standard.h HANDLING: ./net/mac802154/tx.c Traceback (most recent call last): File "", line 3, in NameError: name '__file__' is not defined while running simple python string: from coccinelle import * print __file__ : Failure in rule starting on line 6 Fatal error: exception Yes_pycocci.Pycocciexception ### Issue 2 ### $ spatch -j 2 file-path-error.cocci . When using -j option python script errors are not displayed, instead, spatch only reports: [Parmap]: aborting due to exception on core 19: Yes_pycocci.Pycocciexception This is a problem as using only one core can lead to a long time to reach the corner case that is causing the error on the script coccinelle-1.0.4/docs/Coccilib.3cocci0000644000175000017500000001277612614153277016355 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH COCCILIB 3COCCI "Jul 26, 2015" .\" 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 .I val make_ident : .B string -> Ast_c.metavar_binding_kind .sp Make an identifier .sp .I val make_expr : .B string -> Ast_c.metavar_binding_kind .sp Make an expression .sp .I val make_expr_with_env : .B string -> string -> Ast_c.metavar_binding_kind .sp Make an expression in a type environment. The first argument is a string containing any C variable declarations needed to make the environment and the second argument is a string containing the expression. .sp .I val make_stmt : .B string -> Ast_c.metavar_binding_kind .sp Make a single statement .sp .I val make_stmt_in_env : .B string -> Ast_c.metavar_binding_kind .sp Make a single statement in a type environment. The first argument is a string containing any C variable declarations needed to make the environment and the second argument is a string containing the statement. .sp .I val make_type : .B string -> Ast_c.metavar_binding_kind .sp Make a type .sp .I val make_listlen : .B int -> Ast_c.metavar_binding_kind .sp Make a list length, for parameter lists, expression lists, etc. .sp .I val make_position : .B string -> string -> int -> int -> int -> int -> Ast_c.metavar_binding_kind .sp Make a position. The arguments are the file name, the function or other toplevel element containing the position, the starting line, the starting column, the ending line, and the ending column. Lines start at 1. Columns start at 0. The ending line is the one that contains the last character of what is to be matched. The ending character is one past the last character of the thing to be matched. .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 file : .B unit -> string .sp Returns the file on which spatch is currently working. This raises a Failure exception if spatch is not currently working on any file (eg, in an initialize or finalize rule). .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. Copyright 2012-2015, INRIA. coccinelle-1.0.4/docs/spgen.10000644000175000017500000001175012614153277014746 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH spgen 1 "October 17, 2015" .\" 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 ./spgen.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 spgen \- harden a Coccinelle semantic patch .B spgen .I .B [\-c | \-\-config ] .B [\-i | \-\-interactive] .B [\-\-default] .B [\-o ] .B [\-\-no-output] .B [\-help | \-\-help] .\" .SH DESCRIPTION \fBspgen\fP is a source-to-source transformation tool for hardening Coccinelle semantic patch scripts. .br It takes a semantic patch and outputs the same patch with added metadata and more options in the form of virtual rules: .RS - \fBpatch\fP: used for + or - rules that transform matching C code. - \fBcontext\fP: used for * rules that find matching C code. - \fBorg\fP: used for script rules that output matches in emacs org format. - \fBreport\fP: used for script rules that output matches in pretty print format. .RE A semantic patch hardened with \fBspgen\fP thus preserves the functionality of the original patch, but allows the user to control the output mode. The user can also specify metadata to be included in the hardened script. .RS - Description of the patch's functionality. - Confidence level for the patch. - Authors of the patch. - URL for gaining more information about the patch. - Known limitations of the patch. - Keywords for the patch. - \fBspatch\fP options with which to run the patch. - Additional comments regarding the patch. - Rule messages to be output in script mode for each match. .RE The metadata can be specified in a configuration file or entered through the commandline in interactive mode. The syntax of the configuration file follows a simple newline-separated pattern. Use interactive mode to get an automatically generated configuration file. .SH EXAMPLES Generate a hardened version of using the configuration in : ./spgen --config Generate a hardened version of using interactive mode through the commandline. The user will be able to save their interactively specified configuration to a file: ./spgen --interactive By default, \fBspgen\fP will look for a foo.config file in the same directory and use that as configuration. If not found, it will start in interactive mode: ./spgen Output the hardened version to instead of stdout: ./spgen -o Suppose that is the original patch and is the hardened version of . Then what could be achieved with spatch --sp-file can now be achieved with spatch --sp-file -D \fIpatch\fP Substitute \fIpatch\fP with \fIcontext\fP, \fIorg\fP, or \fIreport\fP for any of the other modes. .SH OPTIONS Here is a summary of the options available on \fBspgen\fP: .SH SYNOPSIS .B spgen .I .B [\-c | \-\-config ] .B [\-i | \-\-interactive] .B [\-\-default] .B [\-o ] .B [\-\-no-output] .B [\-help | \-\-help] .TP .B \-help | \-\-help Print the help menu. .TP .B \-c | \-\-config Harden the using the configuration specified in . .TP .B \-i | \-\-interactive Harden the using configuration options specified through the commandline. .TP .B \-o Output the hardened semantic patch to instead of stdout. .TP .B \-\-default Harden the without a configuration, instead using default values. This option mainly exists to see what the generated script would look like, as the default values are not specific to the input script. .TP .B \-\-no-output Run the program without outputting anything. This option mainly exists to check that the input script and configuration file are parsable. .SH AUTHOR \fBspgen\fP and this man page were written by Chi Pham .SH REPORTING BUGS Send an mail to .SH COPYRIGHT Copyright 2015, Chi Pham spgen is free software: 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 \fIspatch\fP(1), \fIpycocci\fP(1), \fIdiff\fP(1) coccinelle-1.0.4/docs/pycocci.10000644000175000017500000002263612614153277015270 0ustar eugeneugen.\" -*- nroff -*- .\" Please adjust this date whenever revising the manpage. .TH pycocci 1 "July 20, 2015" .\" 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 pycocci \- Coccinelle wrapper for SmPL patch development .B pycocci .B [\-h | \-\-help] .B [\-p | \-\-profile\-cocci] .B [\-j | \-\-jobs ] .B [\-v | \-\-verbose] .B [\-s | \-\-show\-proof] .I .I .B ] .\" .SH DESCRIPTION \fBpycocci\fP is wrapper around \fBspatch\fP, it enables a set of default arguments and also uses a bit of heuristics to infers which arguments you likely want enabled. It takes two arguments, the and your which can either be a directory or file. The actual command run is always displayed on standard output. Coccinelle \fBspatch\fP is a very rich tool, it provides a large set of features for use with the Coccinelle engine. Typical day to day SmPL patch development may only require a base set of features though, we can also infer a set of features depending on your target. \fBpycocci\fP enables a set of flags which over time have been determined to be required for day to day Linux kernel development, for instance through a cronjob, it also uses a set of heuristics to infer a set of arguments to use depending on your release of Coccinelle. \fBpycocci\fP also checks to see which version of Coccinelle you have installed and looks to enable arguments depending on what version of Coccinelle you have installed. \fBpycocci\fP can also be used to help write and verify SmPL patches when replacing a regular patch series. \fBpycocci\fP checks the version of \fBspatch\fP installed and based on this enables a set of features. This man page will document what options it always enables by default, why it has done this and it will also document the heuristics used and logic behind them. .SH DEFAULT ARGUMENTS By default \fBpycocci\fP will always enable when running \fBspatch\fP: \fB--in-place\fP \fB--recursive-includes\fP \fB--relax-include-path\fP \fB--timeout 120\fP \fB--dir \fP The \fB--in-place\fP option is enabled by default as most development these days happens on version control systems and built-in version control systems can typically display differences better. \fB--relax-include-path\fP and \fB--relax-include-path\fP are enabled by default given that at least for Linux kernel development some C files tend to include headers in paths only specified by a target's Makefile through utilities such as subdir-ccflags or ccflags-y making it difficult to ensure all required header files are read by Coccinelle. We are agressive with headers search and inclusion. A default timeout of 120 seconds is used by default. Not using a timeout is typically not a good idea. The value of 120 is used by default and is considered significantly large enough to support most SmPL patches. We make use of \fB--dir\fP to enable use of a target directory and its subdirectories recursively. .SH MULTITHREAD ARGUMENT HEURISTICS Coccinelle \fBspatch\fP prior to release 1.0.0 provided support for multithreading but required the developer to spawn each thread on their own, and provide an index reference number identifying each thread. Coccinelle would divide the amount of work required to be done and based on the index grant the thread a specific set of work. Some shell scripts could be used to help split the work out for you. \fBpycocci\fP was originally written to supercede these scripts and use Python's multithreaded support, while also enabling some sensible arguments by default. If you have a version of \fBspatch\fP older than 1.0.2 \fBpycocci\fP will provide its own built-in multithreaded batched solution, the \fBspatch\fP --jobs argument is enabled on \fBspatch\fP >= 1.0.2. The \fBspatch\fP --jobs arguments takes advantage of Coccinelle's built-in paramap support, and performance-wise yields better results than \fBpycocci\fP's multithreaded solution. The number of threads used will always default to the number of number of CPUs on your system, this is taken from what Python multiprocessing.cpu_count() returns. You can override the number of threads \fBpycocci\fP will use with the --jobs argument. .SH INDEXING ARGUMENT HEURISTICS Coccinelle \fBpycocci\fP supports using a series of indexing alternatives: \fB--use-glimpse\fP \fB--use-gitgrep\fP \fB--use-coccigrep\fP Coccinelle puts the onus of which indexing feature to enable on the developer. \fBpycocci\fP will figure things out for you and make sure that only supported options are used in specific supported releases of coccinelle. So for instance, although --use-gitgrep has been available on 1.0.1 \fBpycocci\fP will only it on 1.0.2. The order of preference for what indexing option to uses the following heuristics: If your target directory has a .glimpse_index file we assume you will want to use --use-glimpse. Glimpse is now released under the ISC license and performance-wise is known to work as the best indexing alternative, this is why we always check for a glimpse index first. This heuristic is however limited, you need the target path to be the base directory where the .glimpse_index file exists, otherwise \fBpycocci\fP will not recurse below on sub-directories. If we determine glimpse cannot be used then \fBpycocci\fP will use \fBgit rev-parse --toplevel\fP on the specified path to determine if the provided path is part of a git directory to enable --use-gitgrep. Although coccinelle provides a fail-safe mechanism to enable use of --use-gitgrep and fall back onto --use-coccigrep if a git tree is not used, we avoid the failure case ahead of time. \fBpycocci\fP will be tuned through each release to infer the best indexing option known to use on your target path. .PP Further information about spatch is available at \fBhttp://coccinelle.lip6.fr/\fP. .SH OPTIONS Here is a summary of the options available on \fBpycocci\fP: .SH SYNOPSIS .B pycocci .B [\-h | \-\-help] .B [\-p | \-\-profile\-cocci] .B [\-j | \-\-jobs] .B [\-v | \-\-verbose] .B [\-s | \-\-show\-proof] .I .I .B ] .TP .B \-h | \-\-help print short help menu .TP .B\-p | \-\-profile\-cocci Profile the when run against .TP .B\-j | \-\-jobs Override the default number of jobs to use with . You really only need this if the heuristics for the default number of jobs is determined to be incorrect. .TP .B\-v | \-\-verbose Output all possible information when run. By default \fBpycocci\fP will provide no output unless an error is found. .TP .B\-s | \-\-show\-proof Show that the can replace a series of patches. The must have a .cocci postfix. A series of patches are expected to exist in the directory named after the with the .cocci postfix removed. \fBpycocci\fP will use git in order to show a proof of equivalence between the two. A new git branch will be created and used to apply the series of patches ("pycocci-patch-8-random-chars") onto the , another git branch will be created and used to apply the ("pycocci-smpl-8-random-chars"). \fBpycocci\fP will display name of the newly created branches and finally provide the output of \fBgit diff --stat ..\fP. You should see no changes, and therefore a \fBperfect SmPL patch equivalence\fP, when the diffstat on the ouput shows no changes. The way to interpet a positive diffstat is that the is introducing more changes than the patch series. The way to interpret a negative diffstat is that the is lacking some changes in place on the patch series. \fBpycocci\fP will use \fBgit rev-parse --toplevel\fP against the to see if the is part of a git tree. If the is not part of a git tree a git tree is created for you on if is a directory or on the base directory of if is a file. \fBpycocci\fP will return you to the branch previously set on the if one was previously set, otherwise if a new git tree was created for you \fBpycocci\fP will set the tree back to the master branch. Each run of \fBpycocci --show-proof\fP will create two new git branches. 8 random characters are postixed to each new git branch created to avoid conflicts with previous runs. .SH AUTHOR \fBpycocci\fP and this man page was written by Luis R. Rodriguez .SH REPORTING BUGS Send an mail to .SH COPYRIGHT Copyright 2015, Luis R. Rodriguez pycocci is free software: 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 \fIspatch\fP(1), \fIpycocci\fP(1), \fIdiff\fP(1) coccinelle-1.0.4/docs/Makefile0000644000175000017500000000046312614153277015207 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.4/configure.ac0000644000175000017500000004426012614153277015110 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([./version.sh]), [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([OCAMLATLEAST312],[3.12]) AS_IF([test "x$OCAMLATLEAST312" = xno],[AC_MSG_ERROR([OCaml >= 3.12 is required to compile Coccinelle])]) AC_CHECK_OCAMLVERSION([OCAMLATLEAST4020],[4.02]) 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([It seems a few components of the OCaml distribution could nt be found. Make sure the following tools are installed and in your path: ocamlc, ocamldep, ocamldoc, ocamlmklib.]) ]) dnl ocaml tools 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]) 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]) AC_COCCI_INIT_PKG_EMPTY([parmap]) 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([menhirLib]) AC_REQ_COCCI_EXTPKG([parmap]) 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 rm -f parsing_cocci/parser_cocci_menhir.ml parsing_cocci/parser_cocci_menhir.mli AC_MSG_NOTICE([Deleted pre-generated parsers, will be re-built]) ]) 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 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]) ]) ]) 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]) AS_IF([test "x$AS_TR_SH([enable_pycaml])" = xlocal], [dnl AC_PROG_CAMLP4 AS_IF([test "x$CAMLP4O" = xno], [dnl AC_MSG_ERROR([Camlp4 is required to compile the bundled version of pycaml.]) ] ) AC_REQ_COCCI_EXTPKG([camlp4]) ] ) 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(LIBDIR,["${libdir}/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$enable_ocaml" = xyes -a "x$OCAMLOPT" != xno], [dnl AC_SUBST([DYNLINK_IS_NATIVE], [Dynlink.is_native]) ], [dnl AC_SUBST([DYNLINK_IS_NATIVE], [false]) ]) AS_IF([test "x$OCAMLATLEAST4020" = xno ], [dnl AC_SUBST([COMPILE_EMBEDDED_BYTES_MODULE], [yes]) ], [dnl AC_SUBST([COMPILE_EMBEDDED_BYTES_MODULE], [no]) ]) AS_IF([test "x$OCAMLATLEAST4020" = xno ], [dnl AC_SUBST([GET_TEMP_DIR_NAME_EXPR], ["Filename.temp_dir_name"]) ], [dnl AC_SUBST([GET_TEMP_DIR_NAME_EXPR], ["(Filename.get_temp_dir_name ())"]) ]) 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]) ]) ]) 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 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 tools/spgen/scripts/spgen.sh docs/spatch.1 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:$libdir/coccinelle/python EOF fi cat << EOF ------------------------------------------------------------------------------ EOF coccinelle-1.0.4/cocci.mli0000644000175000017500000000441612614153277014404 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 * string list) option (*coccigrep/gitgrep 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 val has_finalize : cocci_info -> bool (* 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 * constant_info * bool (* format information needed for strings? *) val normalize_path : string -> string coccinelle-1.0.4/standard.h0000644000175000017500000005421412614153277014573 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 __initconst #define __page_aligned_data #define __page_aligned_bss #define __always_unused #define __visible #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 __packed #define __rcu #define __percpu #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) // ---------------------------------------------------------------------------- // system calls // ---------------------------------------------------------------------------- #define SYSCALL_DEFINE1(func, t1, a1) \ asmlinkage unsigned long func(t1 a1) #define SYSCALL_DEFINE2(func, t1, a1, t2, a2) \ asmlinkage unsigned long func(t1 a1, t2 a2) #define SYSCALL_DEFINE3(func, t1, a1, t2, a2, t3, a3) \ asmlinkage unsigned long func(t1 a1, t2 a2, t3 a3) #define SYSCALL_DEFINE4(func, t1, a1, t2, a2, t3, a3, t4, a4) \ asmlinkage unsigned long func(t1 a1, t2 a2, t3 a3, t4 a4) #define SYSCALL_DEFINE5(func, t1, a1, t2, a2, t3, a3, t4, a4, t5, a5) \ asmlinkage unsigned long func(t1 a1, t2 a2, t3 a3, t4 a4, t5 a5) #define SYSCALL_DEFINE6(func, t1, a1, t2, a2, t3, a3, t4, a4, t5, a5, t6, a6) \ asmlinkage unsigned long func(t1 a1, t2 a2, t3 a3, t4 a4, t5 a5, t6 a6) coccinelle-1.0.4/configure0000755000175000017500000177757512614155450014553 0ustar eugeneugen#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.69 for coccinelle 1.0.4. # # 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.4' PACKAGE_STRING='coccinelle 1.0.4' 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 MAKETARGET_SPATCH SPATCHNAME enable_opt MAKETARGET_ALL MODULES_profiling enable_release SUBSTITUTED_PDFLATEX with_PDFLATEX PDFLATEX GET_TEMP_DIR_NAME_EXPR COMPILE_EMBEDDED_BYTES_MODULE DYNLINK_IS_NATIVE FEATURE_OCAML FEATURE_PYTHON LIBDIR 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_camlp4 OPTFLAGS_camlp4 enable_camlp4 GLOBAL_camlp4 OCAML_PKG_camlp4 CAMLP4RF CAMLP4R CAMLP4PROF CAMLP4ORF CAMLP4OOF CAMLP4OF CAMLP4O CAMLP4BOOT CAMLP4 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_parmap OPTFLAGS_parmap enable_parmap GLOBAL_parmap OCAML_PKG_parmap MAKE_menhirLib OPTFLAGS_menhirLib enable_menhirLib GLOBAL_menhirLib OCAML_PKG_menhirLib 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_parmap MODULESOPT_parmap MODULES_parmap FLAGS_parmap LOCALLIB_parmap FEATURE_parmap 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_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 OCAMLCORIG OCAMLATLEAST4020 OCAMLATLEAST312 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 enable_dynlink enable_menhirLib enable_parmap with_menhir enable_ocaml enable_python with_python enable_pycaml enable_camlp4 enable_pcre_syntax enable_pcre with_pdflatex enable_release enable_opt ' 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 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.4 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.4:";; 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-menhirLib enable global package menhirLib (yes,no) (default: auto) --enable-parmap enable global package parmap (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-camlp4 enable global package camlp4 (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) 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-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 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.4 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.4, 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.14' # 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.4' 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 -' # POSIX will say in a future version that running "rm -f" with no argument # is OK; and we want to be able to make that assumption in our Makefile # recipes. So use an aggressive probe to check that the usage we want is # actually supported "in the wild" to an acceptable degree. # See automake bug#10828. # To make any issue more visible, cause the running configure to be aborted # by default if the 'rm' program in use doesn't match our expectations; the # user can still override this though. if rm -f && rm -fr && rm -rf; then : OK; else cat >&2 <<'END' Oops! Your 'rm' program seems unable to run without file operands specified on the command line, even when the '-f' option is present. This is contrary to the behaviour of most rm programs out there, and not conforming with the upcoming POSIX standard: Please tell bug-automake@gnu.org about your system, including the value of your $PATH and any error possibly output before this message. This can help us improve future automake versions. END if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then echo 'Configuration will proceed anyway, since you have set the' >&2 echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 echo >&2 else cat >&2 <<'END' Aborting the configuration process, to ensure you take notice of the issue. You can download and install GNU coreutils to get an 'rm' implementation that behaves properly: . If you want to complete the configuration process using your problematic 'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM to "yes", and re-run configure. END as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5 fi fi { $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 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 whether $CC understands -c and -o together" >&5 $as_echo_n "checking whether $CC understands -c and -o together... " >&6; } if ${am_cv_prog_cc_c_o+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF # Make sure it works both with $CC and with simple cc. # Following AC_PROG_CC_C_O, we do the test twice because some # compilers refuse to overwrite an existing .o file with -o, # though they will create one. am_cv_prog_cc_c_o=yes for am_i in 1 2; do if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5 ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } \ && test -f conftest2.$ac_objext; then : OK else am_cv_prog_cc_c_o=no break fi done rm -f core conftest* unset am_i fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5 $as_echo "$am_cv_prog_cc_c_o" >&6; } if test "$am_cv_prog_cc_c_o" != yes; then # Losing compiler, so override with the script. # FIXME: It is wrong to rewrite CC. # But if we don't then we get into trouble of one sort or another. # A longer-term fix would be to have automake use am__CC in this case, # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" CC="$am_aux_dir/compile $CC" 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 { versioncheck=; unset versioncheck;} { $as_echo "$as_me:${as_lineno-$LINENO}: checking that the OCaml version is at least 3.12" >&5 $as_echo_n "checking that the OCaml version is at least 3.12... " >&6; } as_arg_v1=$OCAMLVERSION as_arg_v2=3.12 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; } OCAMLATLEAST312=$versioncheck if test "x$OCAMLATLEAST312" = xno; then : as_fn_error $? "OCaml >= 3.12 is required to compile Coccinelle" "$LINENO" 5 fi { versioncheck=; unset versioncheck;} { $as_echo "$as_me:${as_lineno-$LINENO}: checking that the OCaml version is at least 4.02" >&5 $as_echo_n "checking that the OCaml version is at least 4.02... " >&6; } as_arg_v1=$OCAMLVERSION as_arg_v2=4.02 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; } OCAMLATLEAST4020=$versioncheck OCAMLCORIG="$OCAMLC" if test "x$OCAMLC" = xno -o "x$OCAMLDEP" = xno -o "x$OCAMLDOC" = xno -o "x$OCAMLMKLIB" = xno; then : as_fn_error $? "It seems a few components of the OCaml distribution could nt be found. Make sure the following tools are installed and in your path: ocamlc, ocamldep, ocamldoc, ocamlmklib." "$LINENO" 5 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 { $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= FEATURE_parmap=0 LOCALLIB_parmap=0 FLAGS_parmap= MODULES_parmap= MODULESOPT_parmap= PATH_parmap= { $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 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}: configuring package parmap" >&5 $as_echo "$as_me: configuring package parmap" >&6;} # Check whether --enable-parmap was given. if test "${enable_parmap+set}" = set; then : enableval=$enable_parmap; fi if test "x$enable_parmap" != xno; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package parmap" >&5 $as_echo_n "checking for OCaml findlib package parmap... " >&6; } unset found unset pkg found=no for pkg in parmap ; 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_parmap=$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_parmap=no fi if test "x$OCAML_PKG_parmap" != xno; then : PATH_parmap=`$OCAMLFIND query parmap 2>/dev/null` fi GLOBAL_parmap=$OCAML_PKG_parmap if test "x$GLOBAL_parmap" != xno; then : enable_parmap=yes else if test "x$enable_parmap" = xyes; then : as_fn_error $? "OCaml package parmap is not available but requested explicitly" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: OCaml package parmap is not available" >&5 $as_echo "$as_me: OCaml package parmap is not available" >&6;} enable_parmap=no fi fi if test "x$enable_parmap" = xno; then : { pkgdir=; unset pkgdir;} pkgdir="$COCCI_OCAML_EXTERNAL/parmap/" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a bundled substitute of parmap" >&5 $as_echo_n "checking for a bundled substitute of parmap... " >&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 parmap in $pkgdir" >&5 $as_echo "$as_me: using bundled substitute for parmap in $pkgdir" >&6;} enable_parmap=local PATH_parmap="$pkgdir" else { $as_echo "$as_me:${as_lineno-$LINENO}: result: not available" >&5 $as_echo "not available" >&6; } fi fi if test "x$enable_parmap" != xno; then : FEATURE_parmap=1 FLAGS_parmap='$(FLAGS_parmap)' OPTFLAGS_parmap='$(OPTFLAGS_parmap)' if test "x$enable_parmap" = xlocal; then : LOCALLIB_parmap=1 MODULES_parmap='$(LOCAL_parmap)' MODULESOPT_parmap='$(LOCALOPT_parmap)' if test -f "$PATH_parmap/Makefile"; then : MAKE_parmap=$PATH_parmap else MAKE_parmap= fi else MODULES_parmap='$(GLOBAL_parmap)' MODULESOPT_parmap='$(GLOBALOPT_parmap)' fi fi if test "x$enable_parmap" = xno; then : as_fn_error $? "OCaml package parmap 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;} else rm -f parsing_cocci/parser_cocci_menhir.ml parsing_cocci/parser_cocci_menhir.mli { $as_echo "$as_me:${as_lineno-$LINENO}: Deleted pre-generated parsers, will be re-built" >&5 $as_echo "$as_me: Deleted pre-generated parsers, will be re-built" >&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$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$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 if test "x$enable_pycaml" = xlocal; then : # 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 if test "x$CAMLP4O" = xno; then : as_fn_error $? "Camlp4 is required to compile the bundled version of pycaml." "$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 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 LIBDIR="${libdir}/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$enable_ocaml" = xyes -a "x$OCAMLOPT" != xno; then : DYNLINK_IS_NATIVE=Dynlink.is_native else DYNLINK_IS_NATIVE=false fi if test "x$OCAMLATLEAST4020" = xno ; then : COMPILE_EMBEDDED_BYTES_MODULE=yes else COMPILE_EMBEDDED_BYTES_MODULE=no fi if test "x$OCAMLATLEAST4020" = xno ; then : GET_TEMP_DIR_NAME_EXPR="Filename.temp_dir_name" else GET_TEMP_DIR_NAME_EXPR="(Filename.get_temp_dir_name ())" 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$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 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 tools/spgen/scripts/spgen.sh docs/spatch.1 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.4, 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.4 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" ;; "tools/spgen/scripts/spgen.sh") CONFIG_FILES="$CONFIG_FILES tools/spgen/scripts/spgen.sh" ;; "docs/spatch.1") CONFIG_FILES="$CONFIG_FILES docs/spatch.1" ;; "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:$libdir/coccinelle/python EOF fi cat << EOF ------------------------------------------------------------------------------ EOF coccinelle-1.0.4/install.txt0000644000175000017500000001202112614153277015017 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.11), 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 - libpcre-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.4/empty.iso0000644000175000017500000000000012614153277014454 0ustar eugeneugencoccinelle-1.0.4/license.txt0000644000175000017500000004307012614153277015003 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.4/parsing_c/0000755000175000017500000000000012614156171014555 5ustar eugeneugencoccinelle-1.0.4/parsing_c/control_flow_c.mli0000644000175000017500000000707112614153277020302 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 (* IfdefIteHeader is the header node for Ifdef_Ite selection statements. * Ifdef_Ite is decorated on top of the CFG for an If statement. *) | IfdefIteHeader of il (* ------------------------ *) | 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 * bool (* true for switch *) (* 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 | Exec of statement * exec_code list wrap (* ------------------------ *) | Enter | Exit | Fake | CaseNode of int (* ------------------------ *) (* for ctl: *) | TrueNode of bool ref | FalseNode | InLoopNode | AfterNode of after_type | FallThroughNode | LoopFallThroughNode | ErrorExit and after_type = | RetAfterNode (* after for a block ending in return *) | GotoAfterNode (* after for a block ending in goto *) | BreakAfterNode (* after for a block ending in break *) | ContAfterNode (* after for a block ending in continue *) | SWBreakAfterNode (* after for a block ending in break from switch *) | NormalAfterNode 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.4/parsing_c/sexp_ast_c.mli0000644000175000017500000000035112614153277017413 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.4/parsing_c/parsing_consistency_c.ml0000644000175000017500000001302112614153277021476 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 into a 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 (!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.4/parsing_c/parsing_stat.ml0000644000175000017500000002277512614153277017626 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 string_of_int 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 ^ " " ^ (string_of_int n)); ); pr "\n\n\n---------------------------------------------------------------"; end; pr ( (Printf.sprintf "NB total files = %d; " total) ^ (Printf.sprintf "perfect = %d; " perfect) ^ (Printf.sprintf "pbs = %d; " (statxs +> List.filter (function {have_timeout = b; bad = n} when n > 0 -> true | _ -> false) +> List.length)) ^ (Printf.sprintf "timeout = %d; " (statxs +> List.filter (function {have_timeout = true; bad = n} -> true | _ -> false) +> List.length)) ^ (Printf.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 let total = gf +. badf +. passedf in pr ( (Printf.sprintf "nb good = %d, nb passed = %d " good passed) ^ (Printf.sprintf "=========> %2.2f" (100.0 *. (passedf /. total)) ^ "% passed") ); pr ( (Printf.sprintf "nb good = %d, nb bad = %d " good bad) ^ (Printf.sprintf "=========> %2.2f" (100.0 *. ((gf +. passedf) /. total)) ^ "% good or passed" ) ) (*****************************************************************************) (* 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.4/parsing_c/parsing_hacks.ml0000644000175000017500000024537312614153277017745 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 Ast_c 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 _::TInc _::xs -> true, xs | TCPar _::TDec _::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; danger = ref Ast_c.NoDanger; } in TDefEOL (ii') (* put the TDefEOL at the right place *) let rec define_line_1 acc = function | [] -> List.rev acc | token::tokens -> begin match token with | TDefine ii | TUndef ii | TPragma ii -> let line = Ast_c.line_of_info ii in define_line_2 (token::acc) line ii tokens | TCppEscapedNewline ii -> pr2 ("SUSPICIOUS: a \\ character appears outside of a #define at"); pr2 (Ast_c.strloc_of_info ii); define_line_1 ((TCommentSpace ii) :: acc) tokens | _ -> define_line_1 (token::acc) tokens end and define_line_2 acc line lastinfo = function | [] -> (* should not happened, should meet EOF before *) pr2 "PB: WEIRD"; List.rev ((mark_end_define lastinfo)::acc) | token::tokens as all_tokens -> let line' = TH.line_of_tok token in let info = TH.info_of_tok token in (match token with | EOF ii -> define_line_1 (token::(mark_end_define lastinfo)::acc) tokens | TCppEscapedNewline ii -> if (line' <> line) then pr2 "PB: WEIRD: not same line number"; define_line_2 ((TCommentSpace ii)::acc) (line+1) info tokens | _ -> if line' = line then define_line_2 (token::acc) (end_line_of_tok line' token) info tokens 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))) all_tokens ) (* 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 = function | [] -> List.rev acc | token::tokens -> let acc = token::acc in (match token with | TUndef ii -> (match tokens with TCommentSpace i1::TIdent (s,i2)::xs -> define_ident ((TIdentDefine (s,i2))::(TCommentSpace i1)::acc) xs | _ -> pr2 "WEIRD: weird #undef body"; define_ident acc tokens ) | TDefine ii -> (match tokens 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 -> 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 tokens | _ -> define_ident acc tokens ) 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; danger = ref Ast_c.NoDanger; } 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 ) (* Rules that fix input tokens. *) type fix_tokens_rule = token list (* input tokens *) -> (token list * token list) option (* fixed tokens, remaining tokens *) (* #ifdef A if e S1 else #endif S2 *) let fix_tokens_ifdef_endif :fix_tokens_rule = fun xs -> match TH.match_cpp_simple_ifdef_endif xs with | Some (tok_ifdef,body_ifdef,tok_endif,rest_endif) -> let (whites1,body_ifdef') = span TH.is_just_comment_or_space body_ifdef in begin match (TH.match_simple_if_else body_ifdef') with | Some (tok_if,body_if,tok_else,rest_else) when List.for_all TH.is_just_comment_or_space rest_else -> let tok_ifdefif = TUifdef (TH.info_of_tok tok_ifdef) in let tok_ifendif = TUendif (TH.info_of_tok tok_endif) in let fixed_toks = (tok_ifdefif :: body_ifdef) @ [tok_ifendif] in Some (fixed_toks,rest_endif) | __else__ -> None end | None -> None (* #ifdef A if e S1 else #else S2 #endif S3 *) let fix_tokens_ifdef_else_endif :fix_tokens_rule = fun xs -> match TH.match_cpp_simple_ifdef_else_endif xs with | Some (tok_ifdef,body_ifdef,tok_else,body_else,tok_endif,rest_endif) -> let (whites1,body_ifdef') = span TH.is_just_comment_or_space body_ifdef in begin match (TH.match_simple_if_else body_ifdef') with | Some (tok_if,body_if,tok_if_else,rest_else) when List.for_all TH.is_just_comment_or_space rest_else -> let tok_ifdefif = TUifdef (TH.info_of_tok tok_ifdef) in let tok_elseu = TUelseif (TH.info_of_tok tok_else) in let tok_endifu = TUendif (TH.info_of_tok tok_endif) in let fixed_toks = (tok_ifdefif :: body_ifdef) @ (tok_elseu :: body_else) @ [tok_endifu] in Some (fixed_toks,rest_endif) | __else__ -> None end | None -> None (* Note [Nasty Undisciplined Cpp] * * This function handles variability patterns that cannot be easily handled * by cpp_ifdef_statementize, aka "nasty undisciplined uses of cpp" for the * lay person. These are uses of cpp #ifdef that do not cover a full syntactic * element. Even though the possibilities are infinite, there are maybe a ten * patterns that one sees in practice. * * __Ideally__, we would like to handle these patterns with a AST-to-AST * rewriting pass after parsing, in the same spirit as cpp_ifdef_statementize. * But such nasty uses of cpp are handled by the parser by commenting out the * code, and that makes difficult to handle it after parsing. * * Thus, __pragmatically__, if we find an occurrence of these patterns we mark * it by replacing regular Cpp tokens by undisciplined Cpp tokens, before * parsing. The pattern is finally recognized by the parser. Since we introduce * these new tokens, the new parsing rules do not introduce shift/reduce * conflicts. * * For each new pattern to be supported we need: * - a helper match_cpp_* in Token_helpers, * - a fix_tokens_rule that must be added to fix_tokens_ifdef, and * - a rule in the parser. * * /Iago *) let rec fix_tokens_ifdef (xs :token list) :token list = let skip_tok () = match xs with | [] -> [] | x::xs -> x :: fix_tokens_ifdef xs in match fix_tokens_ifdef_endif xs with | Some (fixed,xs') -> fixed @ fix_tokens_ifdef xs' | None -> match fix_tokens_ifdef_else_endif xs with | Some (fixed,xs') -> fixed @ fix_tokens_ifdef xs' | None -> skip_tok() 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 _ | TMacroString _ -> true | x -> TH.is_comment x in let can_be_string = function TString _ | TMacroString _ -> true | x -> false in let rec skip acc fn = function x :: xs when fn x -> skip (x :: acc) fn xs | xs -> (List.rev acc, xs) (* tail recursive for very large parsing units *) and out_strings acc = function [] -> List.rev acc | a :: rest -> if can_be_string a then let (front,rest) = skip [] comments rest in (match rest with b :: rest when can_be_string b -> let (front2,rest) = skip [] strings_and_comments rest in let new_acc = (List.rev front2) @ b :: (List.rev front) @ a :: acc in out_strings new_acc rest | _ -> (match a with TString(str_isW,info) -> let str = Parse_string_c.parse_string str_isW info in let new_acc = (List.rev front) @ (List.rev str) @ acc in out_strings new_acc rest | _ -> let new_acc = (List.rev front) @ (a :: acc) in out_strings new_acc rest)) else out_strings (a::acc) 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) (* const ident const: ident must be a type *) | (TIdent (s, i1)::Tconst _::_, Tconst _::_) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 38; LP.add_typedef_root s; TypedefIdent (s, 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) (* x ( *const y )(params), function pointer *) (* This means that the function pointer is constant *) | (TIdent (s, i1)::TOPar _::TMul _::Tconst _::TIdent _::TCPar _::TOPar _::_, _) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 36; LP.add_typedef_root s; TypedefIdent (s, i1) (* x* ( *const y )(params), function pointer 2 *) | (TIdent (s, i1)::TMul _::TOPar _::TMul _::Tconst _::TIdent _::TCPar _:: TOPar _::_, _) when not_struct_enum before && ok_typedef s -> msg_typedef s i1 37; 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) (*****************************************************************************) (* Ifdef-statementize *) (*****************************************************************************) (* * 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. *) let is_ifdef_and_same_tag (tag : Ast_c.matching_tag) (x : Ast_c.statement_sequencable) :bool = 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 : Ast_c.matching_tag -> Ast_c.statement_sequencable list -> Ast_c.ifdef_directive list * Ast_c.statement_sequencable list list * Ast_c.statement_sequencable list = fun tag xs -> let (xxs, remaining) = group_by_post (is_ifdef_and_same_tag tag) xs in (* TODO: Should replace this with a proper assert. * - Iago Abal *) xxs +> List.map (fun (_,x) -> match x with | IfdefStmt y -> y | StmtElem _ | CppDirectiveStmt _ | IfdefStmt2 _ -> raise (Impossible 78) ), xxs +> List.map fst, remaining let rec cpp_ifdef_statementize (ast :toplevel list) :toplevel list = Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with Visitor_c.kstatementseq_list_s = (fun (k, bigf) xs -> let rec aux : statement_sequencable list -> statement_sequencable list = function | [] -> [] | 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 ((Ast_c.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 coccinelle-1.0.4/parsing_c/test_parsing_c.mli0000644000175000017500000000126612614153277020275 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.4/parsing_c/comment_annotater_c.ml0000644000175000017500000001104512614153277021133 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.fold_left (* comes out reversed *) (function prev -> function (x,l) -> (x,List.rev l) :: prev) [] (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); List.iter2 (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 = []; }; ) toks_with_before toks_with_after; (* modified via side effect. I return it just to have a * clean signature. *) asts coccinelle-1.0.4/parsing_c/flag_parsing_c.ml0000644000175000017500000002075012614153277020055 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), " " ] (*****************************************************************************) (* 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 ifdef_to_if = ref true(*false*) let disable_multi_pass = ref false let disable_add_typedef = ref false let if0_passing = ref true let add_typedef_root = ref true let exts_ITU = ref false (* ITU.dk extensions *) (* 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 (string_of_int 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 indent = ref 0 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 *) let parsing_header_for_types = ref false coccinelle-1.0.4/parsing_c/type_c.ml0000644000175000017500000004155412614153277016407 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 = [] }}; Ast_c.danger = ref Ast_c.NoDanger;}] 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.4/parsing_c/cpp_analysis_c.ml0000644000175000017500000003411312614153277020104 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" (String.concat " -> " (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 +> String.concat " ")); 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 (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.4/parsing_c/unparse_hrule.ml0000644000175000017500000004716012614153277017777 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.unwrap 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 mcode mcode donothing donothing donothing donothing donothing donothing expression donothing donothing donothing 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.MetaAssignOpVal(_) | Ast_c.MetaBinaryOpVal(_) | 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.MetaStmtListVal(stms,_) -> Visitor_c.vk_statement_sequencable_list bigf stms | Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _ | Ast_c.MetaListlenVal _ -> () | Ast_c.MetaNoVal -> failwith "referencing a metavar with no value") 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.MetaAssignOpVal(_) | Ast_c.MetaBinaryOpVal(_) | Ast_c.MetaLocalFuncVal(_) -> vl | Ast_c.MetaExprVal(exp,c,ty) -> Ast_c.MetaExprVal(Visitor_c.vk_expr_s bigf exp,c,ty) | 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,ty) -> Ast_c.MetaStmtVal(Visitor_c.vk_statement_s bigf stm,ty) | Ast_c.MetaStmtListVal(stm,ty) -> Ast_c.MetaStmtListVal (Visitor_c.vk_statement_sequencable_list_s bigf stm,ty) | Ast_c.MetaPosVal _ | Ast_c.MetaPosValList _ | Ast_c.MetaListlenVal _ -> vl | Ast_c.MetaNoVal -> failwith "referencing a metavar with no value")) 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_len pr len; pp_name name; 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_len pr len; pp_name name; pr ";\n" | Ast.MetaBinaryOperatorDecl(ar, name) -> no_arity ar; pr "binary operator "; pp_name name; pr ";\n" | Ast.MetaAssignmentOperatorDecl(ar, name) -> no_arity ar; pr "assignment operator "; pp_name name; 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.MetaGlobalIdExpDecl(ar, name, types) -> no_arity ar; pr "global idexpression "; print_types pr env types; pp_name name; pr ";\n" | Ast.MetaExpListDecl(ar, name, len) -> no_arity ar; pr "parameter list "; pp_len pr len; pp_name name; 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_len pr len; pp_name name; pr ";\n" | Ast.MetaStmDecl(ar, name) -> no_arity ar; pr "statement "; pp_name name; pr ";\n" | Ast.MetaStmListDecl(ar, name, len) -> no_arity ar; pr "statement list "; pp_len pr len; 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_len pr len; pp_name name; 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" | Ast.MetaScriptDecl(_, name) -> failwith "script metavariable" 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.4/parsing_c/lexer_c.mll0000644000175000017500000012165312614153277016720 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, ... *) (*****************************************************************************) (* * Warning: ocamllex uses side effects on lexbuf. * For instance one must do * * let info = tokinfo lexbuf in * TComment (info +> tok_add_s (comment lexbuf)) * * rather than * * TComment (tokinfo lexbuf +> tok_add_s (comment lexbuf)) * * because of the "weird" 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 eoltok lexbuf = let t = tok lexbuf in Lexing.new_line lexbuf; t let tokinfo lexbuf = let start_pos = Lexing.lexeme_start_p lexbuf in { pinfo = Ast_c.OriginTok { Common.charpos = start_pos.Lexing.pos_cnum; Common.str = Lexing.lexeme lexbuf; Common.line = start_pos.Lexing.pos_lnum; Common.column = start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol; Common.file = start_pos.Lexing.pos_fname; }; (* 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; danger = ref NoDanger; } let eoltokinfo lexbuf = let t = tokinfo lexbuf in Lexing.new_line lexbuf; t let eoftokinfo lexbuf = let start_pos = Lexing.lexeme_start_p lexbuf in let t = { pinfo = Ast_c.OriginTok { Common.charpos = start_pos.Lexing.pos_cnum; Common.str = ""; Common.line = start_pos.Lexing.pos_lnum - 1; Common.column = start_pos.Lexing.pos_cnum - start_pos.Lexing.pos_bol; Common.file = start_pos.Lexing.pos_fname; }; (* 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; danger = ref NoDanger; } in EOF t (* 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 let function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf = let splitted = Str.split_delim (Str.regexp_string "/*") s in let check_continue s = let splitted = Str.split_delim (Str.regexp "\\\\ *") s in match splitted with [_;""] -> let s2 = parse_newline lexbuf in let s3 = cpp_eat_until_nl lexbuf in s2 ^ s3 | _ -> "" in match List.rev splitted with after_comment_start :: before_comment_start :: rest -> let splitted2 = Str.split_delim (Str.regexp_string "*/") after_comment_start in (match splitted2 with [bef;aft] -> check_continue s (* no unclosed comment *) | _ -> let s2 = parse_newline lexbuf in s2^(cpp_in_comment_eat_until_nl lexbuf)) | _ -> check_continue s (* no comment *) (* 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); "EXEC", (fun ii -> Texec 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 generates 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 it 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 *) { let s = Lexing.lexeme lexbuf in let l = String.length s in let t = TCommentNewline (tokinfo lexbuf) in (* Adjust the position manually *) let lcp = lexbuf.Lexing.lex_curr_p in lexbuf.Lexing.lex_curr_p <- { lcp with Lexing.pos_lnum = lcp.Lexing.pos_lnum + 1; Lexing.pos_bol = lcp.Lexing.pos_cnum - (l-1) }; t } | [' ' '\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 (eoltokinfo lexbuf) } | "#" [' ' '\t']* ('\n' | "\r\n") { TCppDirectiveOther (eoltokinfo lexbuf) } (* only after cpp, ex: # 1 "include/linux/module.h" 1 *) | "#" sp pent sp '\"' [^ '\"']* '\"' (spopt pent)* spopt ('\n' | "\r\n") { TCppDirectiveOther (eoltokinfo 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']* { let info = tokinfo lexbuf in let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in TIfdefBool (false, no_ifdef_mark(), info +> tok_add_s rest) } | "#" [' ' '\t']* "if" [' ' '\t']* '1' [^'\n']* { let info = tokinfo lexbuf in let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in TIfdefBool (true, no_ifdef_mark(), info +> tok_add_s rest) } (* DO NOT cherry pick to lexer_cplusplus !!! often used for the extern "C" { *) | "#" [' ' '\t']* "if" sp "defined" sp "(" spopt "__cplusplus" spopt ")" [^'\n' '\r']* { let info = tokinfo lexbuf in let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in TIfdefMisc (false, no_ifdef_mark(), info +> tok_add_s rest) } (* DO NOT cherry pick to lexer_cplusplus !!! *) | "#" [' ' '\t']* "ifdef" [' ' '\t']* "__cplusplus" [^'\n']* (* don't want the final newline *) { let info = tokinfo lexbuf in let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in TIfdefMisc (false, no_ifdef_mark(), info +> tok_add_s rest) } (* in glibc *) | "#" spopt ("ifdef"|"if") sp "__STDC__" [^'\n']* (* hope that there are no comments in the ifdef line... *) { let info = tokinfo lexbuf in let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in TIfdefVersion (true, no_ifdef_mark(), info +> tok_add_s rest) } (* 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 (Gifdef x, 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 (Gifndef x, no_ifdef_mark(), tokinfo lexbuf) } | "#" [' ''\t']* "if" [' ' '\t']+ { let info = tokinfo lexbuf in let str_guard = cpp_eat_until_nl lexbuf in TIfdef (Gif_str str_guard, no_ifdef_mark(), info +> tok_add_s str_guard) } | "#" [' ' '\t']* "if" '(' { let info = tokinfo lexbuf in let str_guard = cpp_eat_until_nl lexbuf in TIfdef (Gif_str str_guard, no_ifdef_mark(), info +> tok_add_s str_guard) } | "#" [' ' '\t']* "elif" [' ' '\t']+ { let info = tokinfo lexbuf in let str_guard = cpp_eat_until_nl lexbuf in TIfdefelif (Gif_str str_guard, no_ifdef_mark(), info +> tok_add_s str_guard ) } | "#" [' ''\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")*) (* don't include trailing \n like for #if, etc doesn't seem needed from crx.cocci, but good to be uniform *) { TIfdefelse (no_ifdef_mark(), tokinfo lexbuf) } (* ---------------------- *) (* #define body *) (* ---------------------- *) (* only in cpp directives normally *) | "\\" ('\n' | "\r\n") { TCppEscapedNewline (eoltokinfo 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 (pr2 ("LEXER: ZARB integer_string, certainly a macro:" ^ tok lexbuf); TIdent (tok lexbuf, tokinfo lexbuf)) } | (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) | _ -> pr2 ("LEXER: " ^ "bad decimal" ^ tok lexbuf); TUnknown (tokinfo lexbuf) } | ['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 { eoftokinfo lexbuf } | _ { if !Flag_parsing_c.verbose_lexing then pr2_once ("LEXER:unrecognised symbol, in token rule:"^tok lexbuf); TUnknown (tokinfo lexbuf) } (*****************************************************************************) and char = parse | "'" { "" } (* allow empty char *) | (_ 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 | "'" { "" } | "\n" { pr2 "LEXER: newline not expected in character"; tok lexbuf } | (_ 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' -> Lexing.new_line lexbuf | _ -> 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 } | ('\n' | "\r\n") { let s = eoltok lexbuf in s ^ comment lexbuf } (* noteopti: *) | [^ '*' '\r' '\n']+ { 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 } *) and parse_newline = parse ('\n' | "\r\n") { eoltok lexbuf } and cpp_in_comment_eat_until_nl = parse [^ '\n']+ { let s = tok lexbuf in let splitted = Str.split_delim (Str.regexp_string "*/") s in let check_continue s = let splitted = Str.split_delim (Str.regexp "\\\\ *") s in match splitted with [_;""] -> let s2 = parse_newline lexbuf in let s3 = cpp_eat_until_nl lexbuf in s ^ s2 ^ s3 | _ -> s in match List.rev splitted with after_comment_start :: before_comment_start :: rest -> let splitted2 = Str.split_delim (Str.regexp_string "/*") after_comment_start in (match splitted2 with [bef;aft] -> let s2 = parse_newline lexbuf in s^s2^(cpp_in_comment_eat_until_nl lexbuf) | _ -> (* no longer in comment *) check_continue s) | _ -> let s2 = parse_newline lexbuf in s^s2^(cpp_in_comment_eat_until_nl lexbuf) (* still in comment *) } and cpp_eat_until_nl = parse [^ '\n']+ { let s = tok lexbuf in let rest = function_cpp_eat_until_nl cpp_eat_until_nl cpp_in_comment_eat_until_nl parse_newline s lexbuf in s^rest } coccinelle-1.0.4/parsing_c/cpp_ast_c.ml0000644000175000017500000002312012614153277017044 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 *) (*****************************************************************************) (* 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 xs <> [] then begin pr2 "-I"; xs +> List.iter pr2 end let (show_cpp_d_opts: string list -> unit) = fun xs -> if 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 +> String.concat "") 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 ? *) (*****************************************************************************) (* 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.4/parsing_c/cpp_token_c.ml0000644000175000017500000004754412614153277017415 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 (String.concat "," xs) in let s2 = match body with | DefineHint hint -> string_of_parsinghack_hint hint | DefineBody xs -> String.concat " " (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.4/parsing_c/compare_c.mli0000644000175000017500000000124112614153277017212 0ustar eugeneugentype compare_result = | Correct | Pb of string | PbOnlyInNotParsedCorrectly of string (* the string list is the output of diff *) 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 exact_compare : (* compare to a res file using diff (check spacing) *) 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.4/parsing_c/type_annoter_c.mli0000644000175000017500000000062512614153277020300 0ustar eugeneugen(* have nested scope, so nested list*) type environment (* can be set with init_env *) val initial_env : environment ref (* ex: config/envos/environment_unix.h, seems to be unused *) (* !!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.4/parsing_c/lexer_parser.ml0000644000175000017500000000771512614153277017620 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 Hug_es Cassé: "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.4/parsing_c/visitor_c.mli0000644000175000017500000002163612614153277017275 0ustar eugeneugenopen Ast_c type visitor_c = { kexpr : (expression -> unit) * visitor_c -> expression -> unit; kassignOp : (assignOp -> unit) * visitor_c -> assignOp -> unit; kbinaryOp : (binaryOp -> unit) * visitor_c -> binaryOp -> 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; kifdefdirective : (ifdef_directive -> unit) * visitor_c -> ifdef_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_assignOp : visitor_c -> assignOp -> unit val vk_binaryOp : visitor_c -> binaryOp -> unit val vk_statement : visitor_c -> statement -> unit val vk_statement_sequencable : visitor_c -> statement_sequencable -> unit val vk_statement_sequencable_list : visitor_c -> statement_sequencable list -> 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 val vk_exec_code_list_splitted : visitor_c -> (exec_code, il) Common.either list -> unit val vk_attrs_splitted : visitor_c -> (attribute, il) Common.either list -> unit (* ------------------------------------------------------------------------ *) type 'a inout = 'a -> 'a type visitor_c_s = { kexpr_s : expression inout * visitor_c_s -> expression inout; kassignOp_s : assignOp inout * visitor_c_s -> assignOp inout; kbinaryOp_s : binaryOp inout * visitor_c_s -> binaryOp 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; kifdefdirective_s : (ifdef_directive inout * visitor_c_s) -> ifdef_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_assignOp_s : visitor_c_s -> assignOp -> assignOp val vk_binaryOp_s : visitor_c_s -> binaryOp -> binaryOp 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_statement_sequencable_list_s : visitor_c_s -> statement_sequencable list -> statement_sequencable list 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_exec_code_list_splitted_s : visitor_c_s -> (exec_code, il) Common.either list -> (exec_code, il) Common.either list val vk_attrs_splitted_s : visitor_c_s -> (attribute, il) Common.either list -> (attribute, il) Common.either list val vk_cst_s : visitor_c_s -> ((constant, string) Common.either wrap) inout coccinelle-1.0.4/parsing_c/control_flow_c_build.ml0000644000175000017500000016376412614153277021324 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 braceinfo = (node * (after_type -> string -> nodei -> unit), node) Common.either type context_info = | NoInfo | LoopInfo of nodei * nodei (* start, end *) * braceinfo list * int list | SwitchInfo of nodei * nodei (* start, end *) * braceinfo 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: braceinfo 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 nodety str = xs +> List.fold_left (fun acc nodeinfo -> (* 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 (node,fn) = match nodeinfo with Common.Left(node,mkafter) -> (node,mkafter) (* statements where after link needed *) | Common.Right node -> (node,fun _ _ _ -> ()) in (* ifdefs *) let newi = !g#add_node node in fn nodety str newi; !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 = "{" ^ string_of_int brace in let s2 = "}" ^ string_of_int 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 *) (* This code makes a link from the top of the block to any } created * by a return from the braces list. It is also called at the end * of treating the block. If there is a non-return way out of the * block, then any link created by a } will be overwritten by a normal * one. This is the desired behavior. *) let ret_afters = ref [] in let mkafter ty str endi = if xi.compound_caller = Statement then (let afteri = !g +> add_node (AfterNode ty) lbl str in let a1 = ((newi, afteri), Direct) in !g#add_arc a1; let a2 = ((afteri, endi), Direct) in !g#add_arc a2; ret_afters := (afteri,a1,a2) :: !ret_afters) in let newxi = { xi_lbl with braces = Common.Left(endnode_dup,mkafter) :: 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 List.iter (function (node,a1,a2) -> !g#del_arc a1; !g#del_arc a2; !g#del_node node) !ret_afters; mkafter NormalAfterNode "[after]" endi; !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 GotoAfterNode "[goto after]" 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 | Ast_c.Exec(code) -> let s = "exec" in let newi = !g +> add_node (Exec (stmt, (code, ii))) lbl s in !g +> add_arc_opt (starti, newi); Some newi (* ------------------------- *) | Selection (Ast_c.If _) -> snd (mk_If starti lbl xi_lbl stmt) (* ------------------------- *) | 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); (* allows multiple case labels to stack up *) let rec contains_default s = match Ast_c.unwrap_st s with Labeled (Ast_c.Default _) -> true | Labeled (Ast_c.Case(e,s)) -> contains_default s | Labeled (Ast_c.CaseRange(e1,e2,s)) -> contains_default s | _ -> false in (* 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 contains_default) 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 NormalAfterNode) 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 NormalAfterNode) 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] " ^ string_of_int 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] " ^ string_of_int 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 (* ------------------------- *) | Selection (Ast_c.Ifdef_Ite _) -> mk_Ifdef_Ite starti lbl xi_lbl stmt | Selection (Ast_c.Ifdef_Ite2 _) -> mk_Ifdef_Ite2 starti lbl xi_lbl stmt (* ------------------------- *) | 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 NormalAfterNode) 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 let from_switch = match context_info with LoopInfo (loopstarti, loopendi, braces, parent_lbl) -> false | SwitchInfo (startbrace, loopendi, braces, parent_lbl) -> true | 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), from_switch), 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,nodety,str) = (match x with | Ast_c.Break -> (loopendi,BreakAfterNode,"[break after]") | Ast_c.Continue -> (* if no loops, then continue behaves like break - just one iteration *) ((if !Flag_parsing_c.no_loops then loopendi else loopstarti), ContAfterNode, "[cont after]") | 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 nodety str 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 SWBreakAfterNode "[swbreak after]" 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 RetAfterNode "[ret after]" 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 mk_If (starti :nodei option) (labels :int list) (xi_lbl :xinfo) (stmt :statement) : nodei (* first node of the else branch *) * nodei option = let ii = Ast_c.get_ii_st_take_care stmt in match Ast_c.unwrap_st stmt with | Selection (Ast_c.If (e, st1, st2)) -> let iist2 = Ast_c.get_ii_st_take_care st2 in begin match Ast_c.unwrap_st st2 with | Ast_c.ExprStatement None when iist2=[] -> (* We could have 'ExprStatement None' as a result of something like * 'if() xx else ;', so we must force to have a [] 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. *) (* starti -> newi *) let newi = !g +> add_node (IfHeader (stmt, (e, ii'))) labels "if" in !g +> add_arc_opt (starti, newi); (* newi ---> newfakethen -> ... -> lasti * | | * |-> newfakeelse ----------->| *) let escapes = ref false in let newfakethen = !g +> add_node (TrueNode escapes) labels "[then]" in let newfakeelse = !g +> add_node FallThroughNode labels "[fallthrough]" in let lasti = !g +> add_node (EndStatement (Some iifakeend)) labels "[endif]" in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newi, newfakeelse), Direct); !g#add_arc ((newfakeelse, lasti), Direct); (* if -> [after] -> [endif] *) let afteri = !g +> add_node (AfterNode NormalAfterNode) labels "[after]" in !g#add_arc ((newi, afteri), Direct); !g#add_arc ((afteri, lasti), Direct); (* for ErrorExit heuristic *) let newxi = { xi_lbl with under_ifthen = true; } in (* [then] -> {st1} -> lasti *) let finalthen = aux_statement (Some newfakethen, newxi) st1 in (match finalthen with None -> escapes := true | _ -> ()); !g +> add_arc_opt (finalthen, lasti); lasti, Some lasti | __else__ -> (* 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 (* starti -> "if" *) let newi = !g +> add_node (IfHeader (stmt, (e, iiheader))) labels "if" in !g +> add_arc_opt (starti, newi); (* if ---> [then] -> ... * | * |-> [else] -> else -> ... *) let escapes = ref false in let newfakethen = !g +> add_node (TrueNode escapes) labels "[then]" in let newfakeelse = !g +> add_node FalseNode labels "[else]" in let elsenode = !g +> add_node (Else iielse) labels "else" in !g#add_arc ((newi, newfakethen), Direct); !g#add_arc ((newi, newfakeelse), Direct); !g#add_arc ((newfakeelse, elsenode), Direct); let endnode = mk_node (EndStatement(Some iifakeend)) labels [] "[endif]" in let endnode_dup = mk_node (EndStatement(Some iifakeend)) labels [] "[endif]" in let ret_afters = ref [] in let mkafter ty str lasti = begin (* if -> [after] -> [endif] *) let afteri = !g +> add_node (AfterNode ty) labels str in let a1 = ((newi, afteri), Direct) in !g#add_arc a1; let a2 = ((afteri, lasti), Direct) in !g#add_arc a2; ret_afters := (afteri,a1,a2) :: !ret_afters end in let newxi = { xi_lbl with braces = Common.Left (endnode_dup,mkafter) :: xi_lbl.braces } in let finalthen = aux_statement (Some newfakethen, newxi) st1 in let finalelse = aux_statement (Some elsenode, newxi) st2 in (match finalthen with None -> escapes := true | _ -> ()); (* find the first node of the 'else' branch *) let elsenode_succ = match finalelse with | Some succ -> succ | None -> elsenode in elsenode_succ, begin match finalthen, finalelse with | (None, None) -> None | __else__ -> let lasti = !g#add_node endnode in !ret_afters +> List.iter (function (node,a1,a2) -> !g#del_arc a1; !g#del_arc a2; !g#del_node node); mkafter NormalAfterNode "[after]" lasti; begin !g +> add_arc_opt (finalthen, lasti); !g +> add_arc_opt (finalelse, lasti); Some lasti end end end | x -> error_cant_have x (* Builds the CFG for an Ifdef_Ite selection statement, i.e. * * #ifdef A if e S1 else #endif S2 * * This function works in fact as a decorator for an If statement: * * 1. We construct the CFG for 'if e S1 else S2', which coincides with * the _true_ branch for the #ifdef. * 2. The _false_ path of is just an edge from the IfdefIteHeader to the * 'else' branch of the if statement. * * Why doing it in this way: * * - Coccinelle cannot match #ifdef's so we can keep the CFG thin by * avoiding all the extra plumbing. We don't need, for instance, an * _after_ node. * - We still want Coccinelle to be able to match the if statement, and * we don't want to replicate (aka copy-paste) code for this purpose. * * /Iago *) and mk_Ifdef_Ite (starti :nodei option) (labels :int list) (xi_lbl :xinfo) (stmt :statement) : nodei option = (* starti -> #ifdef-if ---> if -> ... -> [else] -> ... -> [endif] * | ^ * |_________________________| *) match Ast_c.get_ii_st_take_care stmt, Ast_c.unwrap_st stmt with [i1;i2;i3;i4;i5;i6;i7], Selection (Ast_c.Ifdef_Ite (e, st1, st2)) -> let if_sel = Ast_c.If (e,st1,st2) in let if_stmtbis = Selection if_sel in let if_ii = [i2;i3;i4;i5;i7] in let if_stmt = if_stmtbis, if_ii in (* starti -> #ifdef-if *) let ifdefite = !g +> add_node (IfdefIteHeader [i1;i6]) labels "#ifdef-if" in !g +> add_arc_opt (starti, ifdefite); begin match mk_If (Some ifdefite) labels xi_lbl if_stmt with (elsenode,endnode_opt) -> !g#add_arc ((ifdefite, elsenode), Direct); endnode_opt end | x -> error_cant_have x (* Builds the CFG for an Ifdef_Ite selection statement, i.e. * * #ifdef A if e S1 else #else S2 #endif S3 * * The true path of the #ifdef implies: * * if e S1 else S3 * * See mk_Ifdef_Ite for further details. *) and mk_Ifdef_Ite2 (starti :nodei option) (labels :int list) (xi_lbl :xinfo) (stmt :statement) : nodei option = (* starti -> #ifdef-if ---> if -> {st1} -> [else] -> {st3} -> [endif] * | ^ * |------------> {st2} ----------| *) match Ast_c.get_ii_st_take_care stmt, Ast_c.unwrap_st stmt with [i1;i2;i3;i4;i5;i6;i7;i8], Selection (Ast_c.Ifdef_Ite2 (e, st1, st2, st3)) -> let if_sel = Ast_c.If (e,st1,st3) in let if_stmtbis = Selection if_sel in let if_ii = [i2;i3;i4;i5;i8] in let if_stmt = if_stmtbis, if_ii in (* starti -> #ifdef-if *) let ifdefite = !g +> add_node (IfdefIteHeader [i1;i6;i7]) labels "#ifdef-if" in !g +> add_arc_opt (starti, ifdefite); begin match mk_If (Some ifdefite) labels xi_lbl if_stmt with (elsenode,endnode_opt) -> let finalelse = aux_statement (Some ifdefite, xi_lbl) st2 in begin match finalelse with Some st2_node -> !g#add_arc ((st2_node, elsenode), Direct) | None -> () end; endnode_opt end | x -> error_cant_have x 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); if body = [] then begin let newfakeelse = !g +> add_node FallThroughNode newxi'.labels "[fallthrough]" in !g#add_arc ((newi, newfakeelse), Direct); !g#add_arc ((newfakeelse,taili), Direct); end; 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 = Common.Right 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 NormalAfterNode) 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: orphan 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 (g : cflow) : unit = 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 (Printf.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 (Printf.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 (Printf.sprintf "PB with flow: too much } at }%d " i); print_trace_error trace2; [] | _, xs -> xs ) in if (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.4/parsing_c/comment_annotater_c.mli0000644000175000017500000000032212614153277021300 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.4/parsing_c/test_parsing_c.ml0000644000175000017500000004324712614153277020131 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 = if !Flag.c_plus_plus then (* only C++ files, but contains .h files as that extension is ambiguous *) cmd_to_list (if !Flag.include_headers then "find "^ path ^" -name \"*.cpp\" -o -name \"*.cxx\" -o -name \"*.cc\"" ^"-o name \"*.h\" -o -name \"*.hpp\" -o -name \"*.hxx\"" else "find "^ path ^" -name \"*.cpp\" -o -name \"*.cxx\" -o -name \"*.cc\"") else (* only .c files and .h files *) 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\"")) 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 = Printf.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 !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 = Printf.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 !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 = Flag_parsing_c.ifdef_to_if := true; (* 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 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 = Flag_parsing_c.ifdef_to_if := true; (* 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 () (* 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 !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.4/parsing_c/pretty_print_c.ml0000644000175000017500000014060712614153277020170 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; assignOp : Ast_c.assignOp printer; binaryOp : Ast_c.binaryOp printer; arg_list : (Ast_c.argument Ast_c.wrap2 list) printer; arg : Ast_c.argument printer; statement : Ast_c.statement printer; statement_seq_list : Ast_c.statement_sequencable list 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 +> Common.print_between pr_space 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), [] -> pp_expression e1; pr_space(); pr_assignOp op; 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), [] -> pp_expression e1; pr_space(); pr_binaryOp op; 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 | Defined name, [i1] -> pr_elem i1; (* defined *) pp_name name; | Defined name, [i1;i2;i3] -> pr_elem i1; (* defined *) pr_elem i2; (* ( *) pp_name name; pr_elem i3; (* ) *) | (Ident (_) | Constant _ | StringConstant _ | FunCall (_,_) | CondExpr (_,_,_) | Sequence (_,_) | Assignment (_,_,_) | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_) | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | StatementExpr (_) | Constructor _ | ParenExpr (_) | New (_) | Delete (_) | Defined (_)),_ -> 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 pr_assignOp (_,ii) = let i = Common.tuple_of_list1 ii in pr_elem i and pr_binaryOp (_,ii) = let i = Common.tuple_of_list1 ii in pr_elem i 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_seq_list statxs = statxs +> Common.print_between pr_nl pp_statement_seq 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(); pp_statement_seq_list statxs; 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 -> pp_ifthen e st1 i1 i2 i3; pp_else st2 is | Selection (Ifdef_Ite (e, st1, st2)), i1::i2::i3::i4::is -> pr_elem i1; pp_ifthen e st1 i2 i3 i4; pp_else st2 is | Selection (Ifdef_Ite2 (e, st1, st2, st3)), i1::i2::i3::i4::is -> pr_elem i1; pp_ifthen e st1 i2 i3 i4; (* else #else S #endif *) (match is with [i4;i5;i6;iifakend] -> pr_elem i4; (* else *) pr_elem i5; (* #else *) indent_if_needed st2 (function _ -> pp_statement st2); pr_elem i6; (* #endif *) indent_if_needed st3 (function _ -> pp_statement st3); pr_elem iifakend | _ -> raise (Impossible 90)) | 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 (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 (ii = []); pp_def def | MacroStmt, ii -> ii +> List.iter pr_elem ; | Exec(code), [exec;lang;sem] -> pr_elem exec; pr_space(); pr_elem lang; pr_space(); pp_list2 pp_exec_code code; pr_elem sem | (Labeled (Case (_,_)) | Labeled (CaseRange (_,_,_)) | Labeled (Default _) | Compound _ | ExprStatement _ | Selection (If (_, _, _)) | Selection (Switch (_, _)) | Selection (Ifdef_Ite _) | Selection (Ifdef_Ite2 _) | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) | Iteration (For (_, (_,_), (_, _), _)) | Iteration (MacroIteration (_,_,_)) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) | Jump (GotoComputed _) | Decl _ | Exec _ ), _ -> 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 and pp_ifthen e st1 i1 i2 i3 = (* if () *) pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st1 (function _ -> pp_statement st1); and pp_else st2 is = 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 | _st2, [i4;i5;iifakend] -> (* else #endif S *) pr_elem i4; pr_elem i5; indent_if_needed st2 (function _ -> pp_statement st2); pr_elem iifakend | x -> raise (Impossible 96) (* 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))) )) and pp_exec_code = function ExecEval name, [colon] -> pr_elem colon; pp_expression name | ExecToken, [tok] -> pr_elem tok | _ -> raise (Impossible 101) (* ---------------------- *) (* 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 (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;ifakestart])) -> pr_elem ifakestart; (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 *) pr_elem iiptvirg | DeclarationField(FieldDeclList(onefield_multivars,_)) -> failwith "wrong number of tokens" | 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 ((sto, 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 ((sto, 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 ((sto, 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 (iicomma = []); assert (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; pp_statement_seq_list statxs; 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 (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),fromswitch) -> (* 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.Exec(st,(code,ii)) -> pr2 "XXX" | F.IfdefHeader (info) -> pp_ifdef info | F.IfdefElse (info) -> pp_ifdef info | F.IfdefEndif (info) -> pp_ifdef info | F.IfdefIteHeader _ii -> pr2 "XXX" | 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; assignOp = pr_assignOp; binaryOp = pr_binaryOp; arg_list = pp_arg_list; arg = pp_argument; statement = pp_statement; statement_seq_list = pp_statement_seq_list; 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 (match get_comments_before info with [] -> () | before -> pp "-->"; before +> List.iter (fun (comment_like, pinfo) -> let s = pinfo.Common.str in pp s ); pp "<--"); pp s; if !Flag_parsing_c.pretty_print_comment_info then (match get_comments_after info with [] -> () | before -> pp "==>"; before +> List.iter (fun (comment_like, pinfo) -> let s = pinfo.Common.str in pp s ); pp "<==") 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_assignOp_simple = ppc.assignOp let pp_binaryOp_simple = ppc.binaryOp let pp_decl_simple = ppc.decl let pp_field_simple = ppc.field let pp_statement_simple = ppc.statement let pp_statement_seq_list_simple = ppc.statement_seq_list 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_assignOp_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).assignOp let pp_binaryOp_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).binaryOp 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_statement_seq_list_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).statement_seq_list 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_ifdef_guard = function | Gifdef s -> "defined(" ^ s ^ ")" | Gifndef s -> "!defined(" ^ s ^ ")" | Gif_str s -> s | Gif e -> string_of_expression e | Gnone -> "0" 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.4/parsing_c/cpp_token_c.mli0000644000175000017500000000311712614153277017552 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.4/parsing_c/parsing_recovery_c.mli0000644000175000017500000000021112614153277021141 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.4/parsing_c/license.txt0000644000175000017500000004307512614153277016755 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.4/parsing_c/control_flow_c.ml0000644000175000017500000003275312614153277020136 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 (* ------------------------ *) | IfdefIteHeader of il (* ------------------------ *) | 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 * bool (* true if from switch *) (* 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 | Exec of fullstatement * exec_code list 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 of bool ref | FalseNode | InLoopNode (* almost equivalent to TrueNode but just for loops *) | AfterNode of after_type | FallThroughNode | LoopFallThroughNode | ErrorExit and after_type = | RetAfterNode (* after for a block ending in return *) | GotoAfterNode (* after for a block ending in goto *) | BreakAfterNode (* after for a block ending in break *) | ContAfterNode (* after for a block ending in continue *) | SWBreakAfterNode (* after for a block ending in break from switch *) | NormalAfterNode 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 string_of_int +> String.concat ",") ^ "]") 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 (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 | IfdefIteHeader _ -> 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,_) | Exec (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.4/parsing_c/unparse_cocci.ml0000644000175000017500000015102612614153277017735 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 = function [] -> () | _ -> (*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 stream 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) || (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; (* call mcode to preserve the -+ annotation *) (* This used to only call mcode if generating was true. Not clear how that could work. *) mcode (fun _ _ _ -> fn e) name; pr_barrier line rcol in (* --------------------------------------------------------------------- *) let dots between fn d = param_print_between between fn (Ast.unwrap d) in let dots_before_and_after before fn d = param_print_before_and_after before fn (Ast.unwrap d) in let nest_dots starter ender fn f d = mcode print_string starter; f(); start_block(); let l = Ast.unwrap d in print_between force_newline fn l; end_block l; mcode print_string ender in let print_disj_list fn l sep = print_text "\n(\n"; print_between (function _ -> print_text ("\n"^sep^"\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(_) -> 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 minprio = top in let left_prec_of_c op = let left_prec_of_arith = function Ast_c.Plus | Ast_c.Minus -> addit | Ast_c.Mul | Ast_c.Div | Ast_c.Mod -> mulit | Ast_c.Min | Ast_c.Max -> relat | Ast_c.DecLeft | Ast_c.DecRight -> shift | Ast_c.And -> bit_and | Ast_c.Or -> bit_or | Ast_c.Xor -> bit_xor in let left_prec_of_logical = function Ast_c.Inf | Ast_c.Sup | Ast_c.InfEq | Ast_c.SupEq -> relat | Ast_c.Eq | Ast_c.NotEq -> equal | Ast_c.AndLog -> log_and | Ast_c.OrLog -> log_or in match Ast_c.unwrap op with | Ast_c.Arith op' -> left_prec_of_arith op' | Ast_c.Logical op' -> left_prec_of_logical op' in let right_prec_of_c op = let right_prec_of_arith = function Ast_c.Plus | Ast_c.Minus -> mulit | Ast_c.Mul | Ast_c.Div | Ast_c.Mod -> cast | Ast_c.Min | Ast_c.Max -> shift | Ast_c.DecLeft | Ast_c.DecRight -> addit | Ast_c.And -> equal | Ast_c.Or -> bit_xor | Ast_c.Xor -> bit_and in let right_prec_of_logical = function Ast_c.Inf -> shift | Ast_c.Sup -> shift | Ast_c.InfEq -> shift | Ast_c.SupEq -> shift | Ast_c.Eq -> relat | Ast_c.NotEq -> relat | Ast_c.AndLog -> bit_or | Ast_c.OrLog -> log_and in match Ast_c.unwrap op with Ast_c.Arith op' -> right_prec_of_arith op' | Ast_c.Logical op' -> right_prec_of_logical op' in let left_prec_of op = let left_prec_of_arith op = match Ast.unwrap_mcode op with Ast.Plus | Ast.Minus -> addit | Ast.Mul | Ast.Div | Ast.Mod -> mulit | Ast.Min | Ast.Max -> relat | Ast.DecLeft | Ast.DecRight -> shift | Ast.And -> bit_and | Ast.Or -> bit_or | Ast.Xor -> bit_xor in let left_prec_of_logical op = match Ast.unwrap_mcode op with Ast.Inf | Ast.Sup | Ast.InfEq | Ast.SupEq -> relat | Ast.Eq | Ast.NotEq -> equal | Ast.AndLog -> log_and | Ast.OrLog -> log_or in match Ast.unwrap op with Ast.Arith op' -> left_prec_of_arith op' | Ast.Logical op' -> left_prec_of_logical op' | Ast.MetaBinary (mv,_,_,_) -> let (res,name_string,line,lcol,rcol) = lookup_metavar mv in (match res with None -> if generating then minprio else failwith "unbound MetaBinary" | Some (Ast_c.MetaBinaryOpVal bop) -> left_prec_of_c bop | Some _ -> failwith "bad MetaBinary value") in let rec right_prec_of op = let right_prec_of_arith op = match Ast.unwrap_mcode op with Ast.Plus | Ast.Minus -> mulit | Ast.Mul | Ast.Div | Ast.Mod -> cast | Ast.Min | Ast.Max -> shift | Ast.DecLeft | Ast.DecRight -> addit | Ast.And -> equal | Ast.Or -> bit_xor | Ast.Xor -> bit_and in let right_prec_of_logical op = match Ast.unwrap_mcode op with Ast.Inf -> shift | Ast.Sup -> shift | Ast.InfEq -> shift | Ast.SupEq -> shift | Ast.Eq -> relat | Ast.NotEq -> relat | Ast.AndLog -> bit_or | Ast.OrLog -> log_and in match Ast.unwrap op with Ast.Arith op' -> right_prec_of_arith op' | Ast.Logical op' -> right_prec_of_logical op' | Ast.MetaBinary (mv,_,_,_) -> let (res,name_string,line,lcol,rcol) = lookup_metavar mv in (match res with None -> if generating then minprio else failwith "unbound MetaBinary" | Some (Ast_c.MetaBinaryOpVal bop) -> right_prec_of_c bop | Some _ -> failwith "bad MetaBinary value") 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 | Ast_c.Defined _ -> primary 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(); 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(); 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.AsSExpr(expr,asstm) -> 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.ConjExpr(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) -> if generating then (mcode print_string dots; print_text " when != "; expression whencode) else raise CantBeInPlus | Ast.Edots(dots,None) -> if generating then mcode print_string dots else raise CantBeInPlus | Ast.OptExp(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 op = match Ast.unwrap op with Ast.SimpleAssign op -> mcode print_string op | Ast.OpAssign(aop) -> mcode (arithOp true) aop | Ast.MetaAssign(name,_,_,_) -> handle_metavar name (function Ast_c.MetaAssignOpVal aop -> pretty_print_c.Pretty_print_c.assignOp aop | _ -> raise (Impossible 159)) and fixOp = function Ast.Dec -> print_string "--" | Ast.Inc -> print_string "++" and binaryOp op = match Ast.unwrap op with Ast.Arith(aop) -> mcode (arithOp false) aop | Ast.Logical(lop) -> mcode logicalOp lop | Ast.MetaBinary(name,_,_,_) -> handle_metavar name (function Ast_c.MetaBinaryOpVal bop -> pretty_print_c.Pretty_print_c.binaryOp bop | _ -> raise (Impossible 160)) and arithOp eq op = let print_string s = if eq then print_string (s^"=") else print_string s in match op with 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(_) -> 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_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() 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.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 annotated_decl 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.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.FunProto (fninfo,name,lp1,params,va,rp1,sem) -> List.iter print_fninfo fninfo; ident name; mcode print_string_box lp1; parameter_list params; begin match va with | None -> () | Some (comma, ellipsis) -> mcode print_string comma; mcode print_string ellipsis end; close_box(); mcode print_string rp1; mcode print_string sem | Ast.MacroDecl(stg,name,lp,args,rp,sem) -> print_option (mcode storage) stg; print_option (function _ -> pr_space()) stg; ident name; mcode print_string_box lp; dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp; mcode print_string sem | Ast.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> print_option (mcode storage) stg; print_option (function _ -> pr_space()) stg; 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.OptDecl(decl) -> raise CantBeInPlus and annotated_decl d = match Ast.unwrap d with Ast.DElem(_,_,decl) -> declaration decl | Ast.Ddots(_,_) -> 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.unwrap initlist with [] -> mcode print_string lb; mcode print_string rb | lst -> mcode print_string lb; start_block(); initialiser_list nlcomma lst; end_block lst; mcode print_string rb) | Ast.StrInitList(_,lb,[],rb,[]) -> mcode print_string lb; mcode print_string rb | Ast.StrInitList(_,lb,initlist,rb,[]) -> mcode (print_string_with_hint StartBox) lb; start_block(); initialiser_list nlcomma initlist; end_block initlist; mcode (print_string_with_hint EndBox) 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) -> 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_with_hint (SpaceOrNewline (ref " "))) cm | Ast.Pdots(dots) when generating -> mcode print_string dots | Ast.Pdots(_) -> raise CantBeInPlus | Ast.OptParam(param) -> raise CantBeInPlus and parameter_list l = dots (function _ -> ()) parameterTypeDef 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,va,rp) -> pr_arity arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; begin match va with | None -> () | Some (comma, ellipsis) -> mcode print_string comma; mcode print_string ellipsis end; close_box(); mcode print_string rp; pr_space() | Ast.Decl decl -> pr_arity arity; annotated_decl decl | Ast.SeqStart(brace) -> pr_arity arity; mcode print_string brace; start_block() | Ast.SeqEnd(brace) -> 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.Exec(exec,lang,code,sem) -> pr_arity arity; mcode print_string exec; pr_space(); mcode print_string lang; pr_space(); dots (function _ -> pr_space()) exec_code code; 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.TopId(id) -> pr_arity arity; ident id | 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,_,_,_) -> handle_metavar name (function | Ast_c.MetaStmtListVal(statxs,_) -> pretty_print_c.Pretty_print_c.statement_seq_list statxs | _ -> raise (Impossible 161)) | Ast.AsRe(re,asre) -> rule_elem arity re 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 -> annotated_decl 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.OptDParam(dp) -> print_text "?"; print_define_param dp and exec_code (e : Ast_cocci.exec_code) = match Ast.unwrap e with Ast.ExecEval(colon,id) -> mcode print_string colon; expression id | Ast.ExecToken(tok) -> mcode print_string tok | Ast.ExecDots(dots) -> mcode print_string dots 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; end_block (Ast.unwrap 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; end_block (Ast.unwrap 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]) | Ast.Conj([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.Conj(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,_,_) -> 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) -> 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 "{" | "else" -> 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; false | Ast.SimpleAssignOpTag(x) -> print_string x unknown unknown; false | Ast.OpAssignOpTag(x) -> arithOp true x unknown unknown; false | Ast.FixOpTag(x) -> fixOp x unknown unknown; false | Ast.BinaryOpTag(x) -> binaryOp x; false | Ast.ArithOpTag(x) -> arithOp false 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.StringFragmentTag(x) -> string_fragment 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; true | Ast.Token(x,None) -> print_text x; if_open_brace x | Ast.Token(x,Some info) -> mcode (fun x line lcol -> (* adds a newline before else, but not sure why; not correct after brace in Linux, and normally should not be needed. *) (* (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.AnnDeclDotsTag(x) -> dots force_newline annotated_decl 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.StmtDotsTag _::_) | (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.ParamTag(x) -> (match Ast.unwrap x with Ast.PComma _ -> false (* due to hint *) | _ -> true) | Ast.ExpressionTag(x) -> (match Ast.unwrap x with Ast.EComma _ -> false (* due to hint *) | _ -> 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 let newline_needed = (* tokens don't group into multiline terms, so may need to avoid adding newline *) match List.hd(List.rev x) with Ast.Token(t,_) when List.mem t [";";"{";"}"] -> true | Ast.Token(t,_) -> false | _ -> true in loop newline_needed 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.4/parsing_c/token_helpers.ml0000644000175000017500000006563012614153277017767 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_cpp_else = function | TIfdefelse _ -> true | _ -> false let is_cpp_endif = function | TEndif _ -> true | _ -> false let is_gcc_token = function | Tasm _ | Tinline _ | Tattribute _ | Ttypeof _ -> true | _ -> false let is_escaped_newline = function | TCppEscapedNewline _ -> 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_else = function | Telse _ -> true | _ -> false let is_if_or_else = function | Tif _ | Telse _ -> 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 (*****************************************************************************) (* Matching functions for 'Nasty Undisciplined Cpp' *) (*****************************************************************************) (* matches 'if ... else ...' * where there is no other if the '...'. *) let match_simple_if_else : token list -> (token * token list * token * token list) option = function | (Tif _ as tok_if)::rest_if -> begin try let (body,tok_else,rest_else) = split_when is_else rest_if in if List.exists is_if_or_else body || List.exists is_if_or_else rest_else then None (* no nested if/else wanted *) else Some (tok_if,body,tok_else,rest_else) with Not_found -> None end | _ -> None (* matches '#ifdef ... #endif ...' *) let match_cpp_simple_ifdef_endif_aux : token list -> (token * token list * token * token list) option = function | (TIfdef _ as tok_ifdef)::rest_ifdef -> begin try let (body,tok_endif,rest_endif) = split_when is_cpp_endif rest_ifdef in Some (tok_ifdef,body,tok_endif,rest_endif) with Not_found -> None end | _ -> None (* matches '#ifdef ...1 #endif ...2' * where there is no other #ifdef within '...1' *) let match_cpp_simple_ifdef_endif (xs :token list) : (token * token list * token * token list) option = match match_cpp_simple_ifdef_endif_aux xs with | Some (tok_ifdef,body,tok_endif,rest_endif) when not(List.exists is_cpp_instruction body) (* no nested CPP wanted *) -> Some (tok_ifdef,body,tok_endif,rest_endif) | _ -> None let match_cpp_simple_ifdef_else_endif (xs :token list) : (token * token list * token * token list * token * token list) option = match match_cpp_simple_ifdef_endif_aux xs with | Some (tok_ifdef,body,tok_endif,rest_endif) -> begin try let (body_if,tok_else,body_else) = split_when is_cpp_else body in if List.exists is_cpp_instruction body_if || List.exists is_cpp_instruction body_else then None (* no nested CPP wanted *) else Some (tok_ifdef,body_if,tok_else,body_else,tok_endif,rest_endif) with Not_found -> None end | _ -> None (*****************************************************************************) (* 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, ii) -> Common.tuple_of_list1 ii | 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 | TUifdef (i) -> i | TUelseif (i) -> i | TUendif (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 | Texec (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 | Tdefined (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, ii) -> TAssign (assignOp, List.map f ii) | 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 (c, t, i) -> TIfdef (c, t, f i) | TIfdefelse (t, i) -> TIfdefelse (t, f i) | TIfdefelif (c, t, i) -> TIfdefelif (c, 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) | TUifdef (i) -> TUifdef (f i) | TUelseif (i) -> TUelseif (f i) | TUendif (i) -> TUendif (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) | Texec (i) -> Texec (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) | Tdefined (i) -> Tdefined (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 string_of_token = function | TUnknown _ -> "TUnknown" | TCommentSpace _ -> "TCommentSpace" | TCommentNewline _ -> "TCommentNewline" | TComment _ -> "TComment" | TInt _ -> "TInt" | TFloat _ -> "TFloat" | TChar _ -> "TChar" | TString _ -> "TString" | TQuote _ -> "TQuote" | TPct _ -> "TPct" | TFormat _ -> "TFormat" | TSubString _ -> "TSubString" | TDecimal _ -> "TDecimal" | TIdent _ -> "TIdent" | TKRParam _ -> "TKRParam" | Tconstructorname _ -> "Tconstructorname" | TypedefIdent _ -> "TypedefIdent" | TOPar _ -> "TOPar" | TCPar _ -> "TCPar" | TOBrace _ -> "TOBrace" | TCBrace _ -> "TCBrace" | TOCro _ -> "TOCro" | TCCro _ -> "TCCro" | TDot _ -> "TDot" | TComma _ -> "TComma" | TPtrOp _ -> "TPtrOp" | TInc _ -> "TInc" | TDec _ -> "TDec" | TAssign _ -> "TAssign" | TEq _ -> "TEq" | TWhy _ -> "TWhy" | TTilde _ -> "TTilde" | TBang _ -> "TBang" | TEllipsis _ -> "TEllipsis" | TDotDot _ -> "TDotDot" | TPtVirg _ -> "TPtVirg" | TOrLog _ -> "TOrLog" | TAndLog _ -> "TAndLog" | TOr _ -> "TOr" | TXor _ -> "TXor" | TAnd _ -> "TAnd" | TEqEq _ -> "TEqEq" | TNotEq _ -> "TNotEq" | TInf _ -> "TInf" | TSup _ -> "TSup" | TInfEq _ -> "TInfEq" | TSupEq _ -> "TSupEq" | TShl _ -> "TShl" | TShr _ -> "TShr" | TPlus _ -> "TPlus" | TMinus _ -> "TMinus" | TMul _ -> "TMul" | TDiv _ -> "TDiv" | TMod _ -> "TMod" | TMax _ -> "TMax" | TMin _ -> "TMin" | Tchar _ -> "Tchar" | Tshort _ -> "Tshort" | Tint _ -> "Tint" | Tdouble _ -> "Tdouble" | Tfloat _ -> "Tfloat" | Tlong _ -> "Tlong" | Tunsigned _ -> "Tunsigned" | Tsigned _ -> "Tsigned" | Tvoid _ -> "Tvoid" | Tsize_t _ -> "Tsize_t" | Tssize_t _ -> "Tssize_t" | Tptrdiff_t _ -> "Tptrdiff_t" | Tauto _ -> "Tauto" | Tregister _ -> "Tregister" | Textern _ -> "Textern" | Tstatic _ -> "Tstatic" | Ttypedef _ -> "Ttypedef" | Tconst _ -> "Tconst" | Tvolatile _ -> "Tvolatile" | Tstruct _ -> "Tstruct" | Tunion _ -> "Tunion" | Tenum _ -> "Tenum" | Tdecimal _ -> "Tdecimal" | Texec _ -> "Texec" | Tbreak _ -> "Tbreak" | Telse _ -> "Telse" | Tswitch _ -> "Tswitch" | Tcase _ -> "Tcase" | Tcontinue _ -> "Tcontinue" | Tfor _ -> "Tfor" | Tdo _ -> "Tdo" | Tif _ -> "Tif" | Twhile _ -> "Twhile" | Treturn _ -> "Treturn" | Tgoto _ -> "Tgoto" | Tdefault _ -> "Tdefault" | Tsizeof _ -> "Tsizeof" | Tnew _ -> "Tnew" | Tdelete _ -> "Tdelete" | Tdefined _ -> "Tdefined" | TOParCplusplusInit _ -> "TOParCplusplusInit" | Tnamespace _ -> "Tnamespace" | Trestrict _ -> "Trestrict" | Tasm _ -> "Tasm" | Tattribute _ -> "Tattribute" | TattributeNoarg _ -> "TattributeNoarg" | Tinline _ -> "Tinline" | Ttypeof _ -> "Ttypeof" | TDefine _ -> "TDefine" | TDefParamVariadic _ -> "TDefParamVariadic" | TCppEscapedNewline _ -> "TCppEscapedNewline" | TCppConcatOp _ -> "TCppConcatOp" | TOParDefine _ -> "TOParDefine" | TOBraceDefineInit _ -> "TOBraceDefineInit" | TIdentDefine _ -> "TIdentDefine" | TDefEOL _ -> "TDefEOL" | TInclude _ -> "TInclude" | TIncludeStart _ -> "TIncludeStart" | TIncludeFilename _ -> "TIncludeFilename" | TIfdef _ -> "TIfdef" | TIfdefelif _ -> "TIfdefelif" | TIfdefelse _ -> "TIfdefelse" | TEndif _ -> "TEndif" | TIfdefBool _ -> "TIfdefBool" | TIfdefMisc _ -> "TIfdefMisc" | TIfdefVersion _ -> "TIfdefVersion" | TUifdef _ -> "TUifdef" | TUelseif _ -> "TUelseif" | TUendif _ -> "TUendif" | TUndef _ -> "TUndef" | TPragma _ -> "TPragma" | TCppDirectiveOther _ -> "TCppDirectiveOther" | TMacroAttr _ -> "TMacroAttr" | TMacroStmt _ -> "TMacroStmt" | TMacroIdentBuilder _ -> "TMacroIdentBuilder" | TMacroString _ -> "TMacroString" | TMacroDecl _ -> "TMacroDecl" | TMacroDeclConst _ -> "TMacroDeclConst" | TMacroIterator _ -> "TMacroIterator" | TMacroAttrStorage _ -> "TMacroAttrStorage" | TCommentSkipTagStart _ -> "TCommentSkipTagStart" | TCommentSkipTagEnd _ -> "TCommentSkipTagEnd" | TCParEOL _ -> "TCParEOL" | TAction _ -> "TAction" | TCommentMisc _ -> "TCommentMisc" | TCommentCpp _ -> "TCommentCpp" | EOF _ -> "EOF" 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 (** Filter out CPP backslash-newlines (i.e. "\\\n") from a token stream. * * This helps parsing expressions in CPP directives using * [expression_of_string]. * * E.g. * #if defined(A) || \ * defined(B) * * @author Iago Abal *) let filter_out_escaped_newline = List.filter (fun tok -> not (is_escaped_newline tok)) coccinelle-1.0.4/parsing_c/control_flow_c_build.mli0000644000175000017500000000133012614153277021451 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.4/parsing_c/copyright.txt0000644000175000017500000000114112614153277017327 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.4/parsing_c/cpp_analysis_c.mli0000644000175000017500000000024612614153277020255 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.4/parsing_c/pretty_print_c.mli0000644000175000017500000001102412614153277020327 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; assignOp : Ast_c.assignOp printer; binaryOp : Ast_c.binaryOp printer; arg_list : (Ast_c.argument Ast_c.wrap2 list) printer; arg : Ast_c.argument printer; statement : Ast_c.statement printer; statement_seq_list : Ast_c.statement_sequencable list 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_assignOp_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.assignOp printer val pp_binaryOp_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.binaryOp 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_statement_seq_list_gen: pr_elem:Ast_c.info printer -> pr_space: unit printer -> Ast_c.statement_sequencable list 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_assignOp_simple: Ast_c.assignOp printer val pp_binaryOp_simple: Ast_c.binaryOp 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_statement_seq_list_simple: Ast_c.statement_sequencable list 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 (** Normalized string representation of an [Ifdef] guard. * * Ignored #if conditions (cf. [Gnone]) are treated as 0, which is consistent * with the way Coccinelle handles them. * * @author Iago Abal *) val string_of_ifdef_guard: Ast_c.ifdef_guard -> string val string_of_toplevel: Ast_c.toplevel -> string coccinelle-1.0.4/parsing_c/parse_string_c.ml0000644000175000017500000000764112614153277020125 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; danger = ref Ast_c.NoDanger; } | 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; danger = ref Ast_c.NoDanger; } | 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; danger = ref Ast_c.NoDanger; } 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 offset)],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 let rest_offset = offset + String.length c1 in ((string_to_frag rest info rest_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.4/parsing_c/ast_c.ml0000644000175000017500000013547412614153277016222 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 *) (* for tokens that are shared in the C ast, and thus require care when transforming *) type danger = DangerStart | DangerEnd | Danger | NoDanger 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; danger: danger ref; (* 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 * itself (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 (*; fakestart*) (* 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 (* CPP [defined] operator, e.g. #if defined(A) *) | Defined of name (* 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 assignOpbis = SimpleAssign | OpAssign of arithOp and assignOp = assignOpbis wrap and fixOp = Dec | Inc and binaryOpbis = Arith of arithOp | Logical of logicalOp and binaryOp = binaryOpbis wrap 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 | Exec of exec_code list 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 (* #ifdef A if e S1 else #endif S2 *) | Ifdef_Ite of expression * statement * statement (* #ifdef A if e S1 else #else S2 #endif S3 *) | Ifdef_Ite2 of expression * statement * statement * 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 and exec_code_bis = ExecEval of expression | ExecToken and exec_code = exec_code_bis wrap (* ------------------------------------------------------------------------- *) (* 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 (storagebis * string * argument wrap2 list * bool) wrap (* fakestart *) | MacroDeclInit of (storagebis * 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 of ifdef_guard | IfdefElseif of ifdef_guard | IfdefElse | IfdefEndif (** Guards for #if conditionals * * Having #if guards in the AST is useful for cpp-aware analyses, or to * later add support for matching against #ifS. * * General #if guards are stored as a string in a [Gif_str] constructor. * A traversal of the syntax tree with a parsing function would transform * these into the parsed [Gif] form. * * NOTE that there is no actually guaranteee that a traversal will * eliminate all [Gif_str] constructors, since the parsing function may * fail. * * See [Parsing #if guards] to know why this design choice. * * @author Iago Abal *) and ifdef_guard = Gifdef of macro_symbol (* #ifdef *) | Gifndef of macro_symbol (* #ifndef *) | Gif_str of string (* #if *) | Gif of expression (* #if *) | Gnone (* ignored #if condition: TIfdefBool, * TIfdefMisc, and TIfdefVersion *) and macro_symbol = string (* 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 *)) (* Note [Parsing #if guards] * * What I wanted to do: * The lexer should tokenize the #if guard, we use the TDefEOL-trick to * mark the end of the guard, and finally we add a rule to the ocamlyacc * parser. * * Problem: * The [lookahead] pass in [Parsing_hacks] assumes that an #if header is * a single token. The above solution breaks that assumption. So, when an * #if appears in some weird position, [lookahead] will comment out the #if * token, but not any subsequent token of the guard. It seems doable to * modify [lookahead] to handle this new situation, but this seems a complex * and delicate function to touch, and (who knows) we may break something * else. Also note that [TCommentCpp] only takes one [info], so we would * need to combine all the [info]s of an #if into one. * * What I finally did: * The safest way I found is to save the #if guard in the [TIfdef] token as * a (yet-to-be-parsed) string. This is enough to reason about, or match * against, simple and most-common #ifdef and #ifndef conditionals. (Rough * estimate: 80% of #if conditionals in Linux are #if[n]def.) But the * AST for #if guards can still be easily obtained by traversing the syntax * tree with a parsing function. * * @author Iago Abal *) (* ------------------------------------------------------------------------- *) (* 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 | MetaFuncVal of string | MetaLocalFuncVal of string | MetaExprVal of expression (* a "clean expr" *) * (*subterm constraints, currently exprs*) Ast_cocci.meta_name list * stripped | 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 * stripped | MetaStmtListVal of statement_sequencable list * stripped | MetaFmtVal of string_format | MetaFragListVal of string_fragment list | MetaAssignOpVal of assignOp | MetaBinaryOpVal of binaryOp (* 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 | MetaNoVal (* WITHOUT_TYPES is only for code generated by a script *) and stripped = WITH_TYPES | WITHOUT_TYPES (*****************************************************************************) (* 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; danger = ref NoDanger; } 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; danger = ref NoDanger; } let semi_al_info x = { x with cocci_tag = ref emptyAnnot; comments_tag = ref emptyComments; danger = ref NoDanger; } 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; danger = ref NoDanger; } 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)); danger = ref NoDanger; } 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)); danger = ref NoDanger; } 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)); danger = ref NoDanger; } (*****************************************************************************) (* 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 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 +> String.concat "/" | NonLocal xs -> xs +> String.concat "/" | Weird s -> s let s_of_inc_file_bis inc_file = match inc_file with | Local xs -> "\"" ^ xs +> String.concat "/" ^ "\"" | NonLocal xs -> "<" ^ xs +> String.concat "/" ^ ">" | 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) +> String.concat "," (* ------------------------------------------------------------------------- *) let str_of_name ident = match ident with | RegularName (s,ii) -> s | CppConcatenatedName xs -> xs +> List.map (fun (x,iiop) -> unwrap x) +> String.concat "##" | CppVariadicName (s, ii) -> "##" ^ s | CppIdentBuilder ((s,iis), xs) -> s ^ "(" ^ (xs +> List.map (fun ((x,iix), iicomma) -> x) +> String.concat ",") ^ ")" 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 (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 let get_comments_before info = (!(info.comments_tag)).mbefore let get_comments_after info = (!(info.comments_tag)).mafter let string_of_toplevel = function | Declaration _ -> "declaration" | Definition _ -> "definition" | CppTop _ -> "CppTop" | IfdefTop _ -> "IfdefTop" | MacroTop _ -> "MacroTop" | EmptyDef _ -> "EmptyDef" | NotParsedCorrectly _ -> "NotParsedCorrectly" | FinalDef _ -> "FinalDef" | Namespace _ -> "Namespace" let string_of_inc_file = function | Local lst -> "local://" ^ (String.concat "/" lst) | NonLocal lst -> "nonlocal://" ^ (String.concat "/" lst) | Weird s -> "weird://" ^ s coccinelle-1.0.4/parsing_c/lib_parsing_c.ml0000644000175000017500000003415512614153277017716 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_statement_seq_list x = Visitor_c.vk_statement_sequencable_list_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_statement_seq_list x = Visitor_c.vk_statement_sequencable_list_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_statement_seq_list = Visitor_c.vk_statement_sequencable_list_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_binop x = Visitor_c.vk_binaryOp_s (real_strip_info_visitor()) x let real_al_assignop x = Visitor_c.vk_assignOp_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_statement_seq_list x = Visitor_c.vk_statement_sequencable_list_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_def = extract_info_visitor Visitor_c.vk_def 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_assignOp = extract_info_visitor Visitor_c.vk_assignOp let ii_of_binaryOp = extract_info_visitor Visitor_c.vk_binaryOp let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement let ii_of_stmtseq = extract_info_visitor Visitor_c.vk_statement_sequencable let ii_of_stmtseqlist = extract_info_visitor Visitor_c.vk_statement_sequencable_list 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_exec_code_list = extract_info_visitor Visitor_c.vk_exec_code_list_splitted let ii_of_attrs = extract_info_visitor Visitor_c.vk_attrs_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.4/parsing_c/unparse_c.mli0000644000175000017500000000037712614153277017252 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.4/parsing_c/visitor_c.ml0000644000175000017500000016632412614153277017130 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; vk_asignOp k op; 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; vk_binaryOp k op; 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; kassignOp: (assignOp -> unit) * visitor_c -> assignOp -> unit; kbinaryOp: (binaryOp -> unit) * visitor_c -> binaryOp -> 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; kifdefdirective : (ifdef_directive -> unit) * visitor_c -> ifdef_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); kassignOp = (fun (k,_) op -> k op); kbinaryOp = (fun (k,_) op -> k op); 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); kifdefdirective = (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; vk_assignOp bigf op; exprf e2; | Postfix (e, op) -> exprf e | Infix (e, op) -> exprf e | Unary (e, op) -> exprf e | Binary (e1, op, e2) -> exprf e1; vk_binaryOp bigf op; 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; vk_statement_sequencable_list bigf statxs | 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 | Defined name -> vk_name bigf name in exprf expr and vk_assignOp = fun bigf (_,ii) -> let iif ii = vk_ii bigf ii in iif ii and vk_binaryOp = fun bigf (_,ii) -> let iif ii = vk_ii bigf ii in iif ii (* ------------------------------------------------------------------------ *) 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 -> vk_statement_sequencable_list bigf statxs | ExprStatement (eopt) -> do_option (vk_expr bigf) eopt; | Selection (If (e, st1, st2)) -> vk_expr bigf e; statf st1; statf st2; | Selection (Ifdef_Ite (e, st1, st2)) -> vk_expr bigf e; statf st1; statf st2; | Selection (Ifdef_Ite2 (e, st1, st2, st3)) -> vk_expr bigf e; statf st1; statf st2; statf st3; | 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 -> () | Exec (code) -> List.iter (vk_exec_code bigf) code in statf st and vk_statement_sequencable_list = fun bigf stms -> stms +> List.iter (vk_statement_sequencable bigf) 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 -> vk_statement_sequencable_list bigf xs ) 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_exec_code = fun bigf e -> let iif ii = vk_ii bigf ii in match e with ExecEval name, ii -> iif ii; vk_expr bigf name | ExecToken, 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 ((_stob, s, args, ptvg),ii) -> iif ii; vk_argument_list bigf args | MacroDeclInit ((_stob, 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); ); vk_statement_sequencable_list bigf statxs 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 f = bigf.kifdefdirective in let k d = let iif ii = vk_ii bigf ii in match d with | IfdefDirective ((ifkind,_tag), ii) -> vk_ifdefkind bigf ifkind; iif ii in f (k, bigf) directive and vk_ifdefkind bigf = function | Ifdef ifguard | IfdefElseif ifguard -> vk_ifdef_guard bigf ifguard | x -> () and vk_ifdef_guard bigf = function | Gif e -> vk_expr bigf e | x -> () 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( (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.IfdefIteHeader ii -> iif ii | 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.Exec (st,(code,ii)) -> iif ii; List.iter (vk_exec_code bigf) code | ( 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_exec_code_list_splitted = vk_splitted vk_exec_code let vk_attrs_splitted = vk_splitted vk_attribute (* ------------------------------------------------------------------------ *) 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; kassignOp_s: (assignOp inout * visitor_c_s) -> assignOp inout; kbinaryOp_s: (binaryOp inout * visitor_c_s) -> binaryOp 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; kifdefdirective_s : (ifdef_directive inout * visitor_c_s) -> ifdef_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); kassignOp_s = (fun (k,_) op -> k op); kbinaryOp_s = (fun (k,_) op -> k op); 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); kifdefdirective_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) -> let e1 = exprf e1 in let op = vk_assignOp_s bigf op in let e2 = exprf e2 in Assignment (e1, op, 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) -> let e1 = exprf e1 in let op = vk_binaryOp_s bigf op in let e2 = exprf e2 in Binary (e1, op, 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) | Defined name -> Defined (vk_name_s bigf name) in (e', typ'), (iif ii) in exprf expr and vk_assignOp_s bigf (op,ii) = let iif ii = vk_ii_s bigf ii in (op, iif ii) and vk_binaryOp_s bigf (op,ii) = let iif ii = vk_ii_s bigf ii in (op, iif ii) 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 (Ifdef_Ite (e, st1, st2)) -> Selection (Ifdef_Ite (vk_expr_s bigf e,statf st1,statf st2)) | Selection (Ifdef_Ite2 (e, st1, st2, st3)) -> Selection (Ifdef_Ite2 (vk_expr_s bigf e,statf st1 ,statf st2 ,statf st3)) | 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 | Exec(code) -> Exec(List.map (vk_exec_code_s bigf) code) 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_exec_code_s = fun bigf e -> let iif ii = vk_ii_s bigf ii in match e with ExecEval name, ii -> ExecEval (vk_expr_s bigf name), iif ii | ExecToken, ii -> ExecToken, 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 ((stob, s, args, ptvg),ii) -> MacroDecl ((stob, s, args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii), ptvg), iif ii) | MacroDeclInit ((stob, s, args, ini),ii) -> MacroDeclInit ((stob, 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 : visitor_c_s -> toplevel list -> toplevel list = fun bigf -> 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 bigf ifdef = let f = bigf.kifdefdirective_s in let k d = let iif ii = vk_ii_s bigf ii in match d with | IfdefDirective ((ifkind,tag), ii) -> let ifkind' = vk_ifdefkind_s bigf ifkind in IfdefDirective ((ifkind',tag), iif ii) in f (k, bigf) ifdef and vk_ifdefkind_s bigf = function | Ifdef ifguard -> Ifdef (vk_ifdef_guard_s bigf ifguard) | IfdefElseif ifguard -> IfdefElseif (vk_ifdef_guard_s bigf ifguard) | IfdefElse -> IfdefElse | IfdefEndif -> IfdefEndif and vk_ifdef_guard_s bigf = function | Gif e -> Gif (vk_expr_s bigf e) | x -> x 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 ( (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.Exec(st, (code,ii)) -> F.Exec(st,((List.map (vk_exec_code_s bigf) code),ii)) | F.Break (st,((),ii),fromswitch) -> F.Break (st,((),iif ii),fromswitch) | 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.IfdefIteHeader ii -> F.IfdefIteHeader (iif ii) | ( ( 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 let vk_exec_code_list_splitted_s = vk_splitted_s vk_exec_code_s let vk_attrs_splitted_s = vk_splitted_s vk_attribute_s coccinelle-1.0.4/parsing_c/token_helpers.mli0000644000175000017500000000520212614153277020125 0ustar eugeneugen open Parser_c 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_cpp_endif : Parser_c.token -> bool val is_gcc_token : Parser_c.token -> bool val is_escaped_newline : Parser_c.token -> bool val is_eof : Parser_c.token -> bool val is_eom : Parser_c.token -> bool val is_else : Parser_c.token -> bool val is_if_or_else : 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 match_simple_if_else : token list -> (token * token list * token * token list) option val match_cpp_simple_ifdef_endif : token list -> (token * token list * token * token list) option val match_cpp_simple_ifdef_else_endif : token list -> (token * token list * token * token list * token * token list) option (* ---------------------------------------------------------------------- *) 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 string_of_token: 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 val filter_out_escaped_newline : token list -> token list coccinelle-1.0.4/parsing_c/lexer_parser.mli0000644000175000017500000000204012614153277017753 0ustar eugeneugen 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.4/parsing_c/token_annot.mli0000644000175000017500000000034012614153277017600 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.4/parsing_c/unparse_hrule.mli0000644000175000017500000000032112614153277020134 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.4/parsing_c/parser_c.mly0000644000175000017500000022326512614153277017114 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. *) (** * This grammar has been inspired by: * http://www.lysator.liu.se/c/ANSI-C-grammar-y.html *) 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 = if !Flag_parsing_c.parsing_header_for_types then [] else 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]) (*-------------------------------------------------------------------------- *) (* support for functions with no return type *) (*-------------------------------------------------------------------------- *) let args_are_params l = match l with [Right (ArgAction(ActMisc [x])), ii] when Ast_c.is_fake x -> true | _ -> List.for_all (function Right (ArgType x), ii -> true | _ -> false) l let args_to_params l pb = let pi = match pb with Some pb -> Ast_c.parse_info_of_info pb | None -> fake_pi in match l with [(Right (ArgAction(ActMisc [x])), ii)] when Ast_c.is_fake x -> [] | l -> List.map (function Right (ArgType x), ii -> x, ii | x -> raise (Semantic ("function with no return type must have types in param list", pi))) l %} /*(*****************************************************************************)*/ /*(* 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 Texec Tbreak Telse Tswitch Tcase Tcontinue Tfor Tdo Tif Twhile Treturn Tgoto Tdefault Tsizeof Tnew Tdelete Tdefined 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 <(Ast_c.ifdef_guard * (int * int) option ref * Ast_c.info)> TIfdef TIfdefelif %token <((int * int) option ref * Ast_c.info)> TIfdefelse TEndif %token <(bool * (int * int) option ref * Ast_c.info)> TIfdefBool TIfdefMisc TIfdefVersion /* Note [Nasty Undisciplined Cpp] * * These tokens replace regular Cpp-ifdef tokens for nasty undisciplined * variability patterns. * * Note that these tokens do not have matching_tag. * (TU stands for Token-Undisciplined.) * * /Iago */ %token TUifdef TUelseif TUendif /*(*---------------*)*/ /*(* 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 (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, $2, $3)) []} | cast_expr TEq assign_expr { mk_e (Assignment ($1, (SimpleAssign, [$2]),$3)) []} /*(* 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,[$2]), $3)) [] } | arith_expr TDiv arith_expr { mk_e(Binary ($1, (Arith Div, [$2]), $3)) [] } | arith_expr TMin arith_expr { mk_e(Binary ($1, (Arith Min, [$2]), $3)) [] } | arith_expr TMax arith_expr { mk_e(Binary ($1, (Arith Max, [$2]), $3)) [] } | arith_expr TMod arith_expr { mk_e(Binary ($1, (Arith Mod, [$2]), $3)) [] } | arith_expr TPlus arith_expr { mk_e(Binary ($1, (Arith Plus, [$2]), $3)) [] } | arith_expr TMinus arith_expr { mk_e(Binary ($1, (Arith Minus, [$2]), $3)) [] } | arith_expr TShl arith_expr { mk_e(Binary ($1, (Arith DecLeft, [$2]), $3)) [] } | arith_expr TShr arith_expr { mk_e(Binary ($1, (Arith DecRight, [$2]), $3)) [] } | arith_expr TInf arith_expr { mk_e(Binary ($1, (Logical Inf, [$2]), $3)) [] } | arith_expr TSup arith_expr { mk_e(Binary ($1, (Logical Sup, [$2]), $3)) [] } | arith_expr TInfEq arith_expr { mk_e(Binary ($1, (Logical InfEq, [$2]), $3)) [] } | arith_expr TSupEq arith_expr { mk_e(Binary ($1, (Logical SupEq, [$2]), $3)) [] } | arith_expr TEqEq arith_expr { mk_e(Binary ($1, (Logical Eq, [$2]), $3)) [] } | arith_expr TNotEq arith_expr { mk_e(Binary ($1, (Logical NotEq, [$2]), $3)) [] } | arith_expr TAnd arith_expr { mk_e(Binary ($1, (Arith And, [$2]), $3)) [] } | arith_expr TOr arith_expr { mk_e(Binary ($1, (Arith Or, [$2]), $3)) [] } | arith_expr TXor arith_expr { mk_e(Binary ($1, (Arith Xor, [$2]), $3)) [] } | arith_expr TAndLog arith_expr { mk_e(Binary ($1, (Logical AndLog, [$2]), $3)) [] } | arith_expr TOrLog arith_expr { mk_e(Binary ($1, (Logical OrLog, [$2]), $3)) [] } 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] } | Tdefined identifier_cpp { mk_e(Defined $2) [$1] } | Tdefined TOPar identifier_cpp TCPar { mk_e(Defined $3) [$1;$2;$4] } 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_struct 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 $1=[] then ActMisc [Ast_c.fakeInfo()] else ActMisc $1 } action_higherordermacro: | taction_list { if $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] } | Texec identifier exec_list TPtVirg { Exec($3), [$1;snd $2;$4] } /*(* 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] } /* [Nasty Undisciplined Cpp] #ifdef A if e S1 else #endif S2 */ | TUifdef Tif TOPar expr TCPar statement Telse TUendif statement { Ifdef_Ite ($4,$6,$9), [$1;$2;$3;$5;$7;$8] } /* [Nasty Undisciplined Cpp] #ifdef A if e S1 else #else S2 #endif S3 */ | TUifdef Tif TOPar expr TCPar statement Telse TUelseif statement TUendif statement { Ifdef_Ite2 ($4,$6,$9,$11), [$1;$2;$3;$5;$7;$8;$10] } 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, [] } // IBM C only exec_list: /* empty */ { [] } | TDotDot identifier_cpp exec_ident exec_list { (ExecEval ($3 (mk_e (Ident $2) [])), [$1]) :: $4 } | TIdent exec_ident2 exec_list { (ExecToken, [snd $1]) :: $2 @ $3 } | token exec_list { (ExecToken, [$1]) :: $2 } exec_ident: { function prev -> prev } | TDot TIdent exec_ident { function prev -> let fld = RegularName (mk_string_wrap $2) in $3 (mk_e(RecordAccess (prev,fld)) [$1]) } | TPtrOp TIdent exec_ident { function prev -> let fld = RegularName (mk_string_wrap $2) in $3 (mk_e(RecordPtAccess (prev,fld)) [$1]) } | TOCro expr TCCro exec_ident { function prev -> $4 (mk_e(ArrayAccess (prev,$2)) [$1;$3]) } exec_ident2: { [] } | TDot TIdent exec_ident2 { (ExecToken, [$1]) :: (ExecToken, [snd $2]) :: $3 } asm_expr: assign_expr { $1 } token: TPlus { $1 } | TMinus { $1 } | TMul { $1 } | TDiv { $1 } | TMod { $1 } | TMin { $1 } | TMax { $1 } | TInc { $1 } | TDec { $1 } | TEq { $1 } | TAssign { List.hd (snd $1) } | TEqEq { $1 } | TNotEq { $1 } | TSupEq { $1 } | TInfEq { $1 } | TSup { $1 } | TInf { $1 } | TAndLog { $1 } | TOrLog { $1 } | TShr { $1 } | TShl { $1 } | TAnd { $1 } | TOr { $1 } | TXor { $1 } | TOBrace { $1 } | TCBrace { $1 } /* | TOCro { $1 } | TCCro { $1 }*/ | TOPar { $1 } | TCPar { $1 } /*| TPtrOp { $1 } | TDot { $1 }*/ | TWhy { $1 } | TBang { $1 } | TComma { $1 } /* | TIdent { snd $1 }*/ | TypedefIdent { snd $1 } | Tif { $1 } | Telse { $1 } | TInt { snd $1 } | TFloat { snd $1 } | TString { snd $1 } | TChar { snd $1 } /* other constants needed? */ /*(*************************************************************************)*/ /*(* 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: *)*/ | storage_const_opt TMacroDecl TOPar argument_list TCPar TPtVirg { function _ -> match $1 with Some (sto,stoii) -> MacroDecl ((sto, fst $2, $4, true), (snd $2::$3::$5::$6::fakeInfo()::stoii)) | None -> MacroDecl ((NoSto, fst $2, $4, true), [snd $2;$3;$5;$6;fakeInfo()]) } | storage_const_opt TMacroDecl TOPar argument_list TCPar teq initialize TPtVirg { function _ -> match $1 with Some (sto,stoii) -> MacroDeclInit ((sto, fst $2, $4, $7), (snd $2::$3::$5::$6::$8::fakeInfo()::stoii)) | None -> MacroDeclInit ((NoSto, fst $2, $4, $7), [snd $2;$3;$5;$6;$8;fakeInfo()]) } storage_const_opt: storage_class_spec_nt TMacroDeclConst { Some (fst $1,[snd $1; $2]) } | storage_class_spec_nt { Some (fst $1,[snd $1]) } | { None } /*(*-----------------------------------------------------------------------*)*/ 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_spec_nt: | Tstatic { Sto Static, $1 } | Textern { Sto Extern, $1 } | Tauto { Sto Auto, $1 } | Tregister { Sto Register,$1 } storage_class_spec2: | storage_class_spec_nt { $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"; let iistart = Ast_c.fakeInfo () in (* for parallelism with DeclList *) FieldDeclList ($2 +> (List.map (fun (f, iivirg) -> f returnType, iivirg)) ,[$3;iistart]) (* 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"; let iistart = Ast_c.fakeInfo () in (* for parallelism with DeclList *) FieldDeclList ([(Simple (None, returnType)) , []], [$2;iistart]) } 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 (cond,tag,ii) = $1 in IfdefDirective ((Ifdef cond, IfdefTag (Common.some !tag)), [ii]) } | TIfdefelse { let (tag,ii) = $1 in IfdefDirective ((IfdefElse, IfdefTag (Common.some !tag)), [ii]) } | TIfdefelif { let (cond,tag,ii) = $1 in IfdefDirective ((IfdefElseif cond, 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 Gnone, IfdefTag (Common.some !tag)), [ii]) } | TIfdefMisc { let (_b, tag,ii) = $1 in IfdefDirective ((Ifdef Gnone, IfdefTag (Common.some !tag)), [ii]) } | TIfdefVersion { let (_b, tag,ii) = $1 in IfdefDirective ((Ifdef Gnone, 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 { if args_are_params $3 then (* if all args are params, assume it is a prototype of a function with no return type *) let parameters = args_to_params $3 None in let paramlist = (parameters, (false, [])) in (* no varargs *) let id = RegularName (mk_string_wrap $1) in let ret = warning "type defaults to 'int'" (mk_ty defaultInt [fakeInfo fake_pi]) in let ty = fixOldCDecl (mk_ty (FunctionType (ret, paramlist)) [$2;$4]) in let attrs = Ast_c.noattr in let sto = (NoSto, false), [] in let iistart = Ast_c.fakeInfo () in Declaration( DeclList ([{v_namei = Some (id,NoInit); v_type = ty; v_storage = unwrap sto; v_local = NotLocalDecl; v_attr = attrs; v_type_bis = ref None; },[]], ($5::iistart::snd sto))) else Declaration (MacroDecl((NoSto, fst $1, $3, true), [snd $1;$2;$4;$5;fakeInfo()])) (* old: MacroTop (fst $1, $3, [snd $1;$2;$4;$5]) *) } /* cheap solution for functions with no return type. Not really a cpp_other, but avoids conflicts */ | identifier TOPar argument_list TCPar compound { let parameters = args_to_params $3 (Some (snd $1)) in let paramlist = (parameters, (false, [])) in (* no varargs *) let fninfo = let id = RegularName (mk_string_wrap $1) in let ret = warning "type defaults to 'int'" (mk_ty defaultInt [fakeInfo fake_pi]) in let ty = mk_ty (FunctionType (ret, paramlist)) [$2;$4] in let attrs = Ast_c.noattr in let sto = (NoSto, false), [] in (id, fixOldCDecl ty, sto, attrs) in let fundef = fixFunc (fninfo, $5, None) in Definition fundef } /*(* TCParEOL to fix the end-of-stream bug of ocamlyacc *)*/ | identifier TOPar argument_list TCParEOL { Declaration (MacroDecl ((NoSto, 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 } comma_opt: | TComma { [$1] } | /*(* empty *)*/ { [] } /*(* gcc_opt_virg: | TPtVirg { } | { } *)*/ gcc_opt_expr: | expr { Some $1 } | /*(* empty *)*/ { None } /*(* opt_ptvirg: | TPtVirg { [$1] } | { [] } *)*/ coccinelle-1.0.4/parsing_c/compare_c.ml0000644000175000017500000002504612614153277017052 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 } *) (* I have removed this function as it was not used anywhere. * let compare_ast filename1 filename2 = ... * /Iago *) (*****************************************************************************) (* 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. * * Moreover 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 let get_diff filename1 filename2 bs = let com = match !Flag_parsing_c.diff_lines with None -> Printf.sprintf "diff -u %s %s %s" bs filename1 filename2 | Some n -> Printf.sprintf "diff -U %s %s %s %s" n bs filename1 filename2 in let xs = Common.cmd_to_list com in (* get rid of the --- and +++ lines *) if xs=[] then xs else Common.drop 2 xs (* convention: 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 = get_diff filename1 filename2 "-b -B" in if 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 exact_compare file1 file2 = match get_diff file1 file2 "" with [] -> (Correct, []) | res -> (Pb "files differ", res) 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 +> String.concat "\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 +> String.concat "\n") ^ "\n" let compare_result_to_bool correct = correct = Correct coccinelle-1.0.4/parsing_c/unparse_cocci.mli0000644000175000017500000000125012614153277020077 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.4/parsing_c/parsing_hacks.mli0000644000175000017500000000660112614153277020103 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 (* mark suppported undisciplined uses of #ifdef *) val fix_tokens_ifdef : 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 (* ------------------------------------------------------------------------ *) (* Parsing hack helpers related to #ifdef *) (* ------------------------------------------------------------------------ *) (* #ifdef *) val cpp_ifdef_statementize: Ast_c.program -> Ast_c.program coccinelle-1.0.4/parsing_c/parse_c.mli0000644000175000017500000000675512614153277016715 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: cpp:bool -> tos:bool -> ((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 (* ---------------------------------------------------------------------- *) (* custom error reporting function *) type parse_error_function = int -> Parser_c.token list -> (int * int) -> string array -> int -> unit val set_parse_error_function : parse_error_function -> unit coccinelle-1.0.4/parsing_c/token_c.ml0000644000175000017500000002166212614153277016544 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 let str_of_token t = (info_of_token t).Common.str (*****************************************************************************) (*****************************************************************************) (* 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.4/parsing_c/credits.txt0000644000175000017500000000064112614153277016760 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.4/parsing_c/token_annot.ml0000644000175000017500000000132012614153277017426 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.4/parsing_c/cpp_ast_c.mli0000644000175000017500000000247112614153277017223 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 (* #define *) val cpp_expand_macro_expr: Ast_c.define_kind -> Ast_c.argument Ast_c.wrap2 list -> Ast_c.expression option coccinelle-1.0.4/parsing_c/token_views_c.ml0000644000175000017500000003747112614153277017766 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 = List.rev (List.fold_left (function prev -> function tok -> (mk_token_extended tok.tok) :: List.fold_left (function prev -> function bef -> (mk_token_extended bef)::prev) prev tok.new_tokens_before) [] toks_ext) (* 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 = (* * Example: * * #ifdef A * x++; * #else * x--; * #endif * * is represented as Ifdef ([[x++];[x--]],[#ifdef A;#else;#endif]) * where x++ and x-- are NoIfdefLine. * * /Iago *) | 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.4/parsing_c/authors.txt0000644000175000017500000000002012614153277016777 0ustar eugeneugenYoann Padioleau coccinelle-1.0.4/parsing_c/parsing_recovery_c.ml0000644000175000017500000001211112614153277020772 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 "^string_of_int(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 "^string_of_int (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 "^ string_of_int(TH.line_of_tok v)); already_passed, v::xs | v::xs -> find_next_synchro_orig xs (v::already_passed) coccinelle-1.0.4/parsing_c/parse_c.ml0000644000175000017500000012177212614153277016541 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") type parse_error_function = int -> Parser_c.token list -> (int * int) -> string array -> int -> unit let parse_error_function : parse_error_function option ref = ref None let set_parse_error_function f = parse_error_function := Some f let default_parse_error_function : parse_error_function = fun line_error _tokens (start_line, end_line) filelines pass -> begin pr2 ("badcount: " ^ string_of_int (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 let print_bad line_error tokens (start_line, end_line) filelines pass = let func = match !parse_error_function with | Some f -> f | None -> default_parse_error_function in func line_error tokens (start_line, end_line) filelines pass (*****************************************************************************) (* 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 pr2_no_nl (s ^ " ") else begin if !line = -1 then pr2_no_nl "passed:" else pr2_no_nl "\npassed:"; line := newline; pr2_no_nl (s ^ " "); end | _ -> ()); if ys<>[] then pr2 ""; end (*****************************************************************************) (* Lexing only *) (*****************************************************************************) (* called by parse_print_error_heuristic *) let tokens2 file = let is_abstract_line_tok tok = let ii = TH.info_of_tok tok in match ii.Ast_c.pinfo with | Ast_c.AbstractLineTok _ -> true | _ -> false in Common.with_open_infile file (fun chan -> let lexbuf = Lexing.from_channel chan in let curp = { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = file } in let lexbuf = { lexbuf with Lexing.lex_curr_p = curp } in try let rec tokens_aux acc = let tok = Lexer_c.token lexbuf in if is_abstract_line_tok tok then failwith "should not occur"; 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 ) (* The result of lexing can be large. Just keep the result for the most recent file *) let most_recent_file = ref "" let most_recent_res = ref [] let time_lexing ?(profile=true) a = if profile then Common.profile_code_exclusif "LEXING" (fun () -> tokens2 a) else tokens2 a let tokens ?profile a = if a = !most_recent_file then !most_recent_res else begin most_recent_file := a; most_recent_res := []; let res = time_lexing ?profile a in most_recent_res := res; res end 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 Parser_c.main Lexer_c.token lexbuf 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. *) (** Converts occurrences of the identifier ["defined"] in a token stream, * into the CPP defined operator [Tdefined]. * * @author Iago Abal *) let fix_cpp_defined_operator = List.map (function | Parser_c.TIdent("defined",info) -> Parser_c.Tdefined(info) | x -> x ) (* 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 ~cpp ~tos parsefunc s = let toks = tokens_of_string s +> List.filter TH.is_not_comment in let toks' = if cpp (* We have fix_tokens_define that relaces \\\n by [TCommentSpace] * within #define and other CPP directives, but * a) it's not clear to me where [TCommentSpace] gets removed; * b) TH.filter_out_escaped_newline is simple but enough. * /Iago *) then fix_cpp_defined_operator (TH.filter_out_escaped_newline toks) else toks 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 type_start = ref tos 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 let v = match v with | Parser_c.TIdent (s, ii) -> if (* an id at the start of a type must be a type name *) (LP.is_typedef s || !type_start) && not (!Flag_parsing_c.disable_add_typedef) then Parser_c.TypedefIdent (s, ii) else Parser_c.TIdent (s, ii) | x -> x in type_start := false; 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 (* Please DO NOT remove this code, even though most of it is not used *) let type_of_string = parse_gen ~cpp:false ~tos:true Parser_c.type_name let statement_of_string = parse_gen ~cpp:false ~tos:false Parser_c.statement let expression_of_string = parse_gen ~cpp:false ~tos:false Parser_c.expr let cpp_expression_of_string = parse_gen ~cpp:true ~tos:false 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 (* drops the first complete #define/#undefine - comment like *) let extend_passed_clean v xs = let rec loop = function [] -> [] | (Parser_c.TDefine _| Parser_c.TUndef _) :: rest -> rest | x::xs -> loop xs in match v with Parser_c.TDefEOL _ -> loop xs | v -> v :: xs (* Hacked lex. This function use refs passed by parse_print_error_heuristic * tr means token refs. *) let in_exec = ref false 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); (* ignore exec code *) (match v with Parser_c.Texec _ -> in_exec := true | Parser_c.TPtVirg _ -> if !in_exec then in_exec := false | _ -> ()); (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 <- extend_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 <- extend_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 <- extend_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 = if !in_exec then v else 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 <- extend_passed_clean v tr.passed_clean; v ) end let max_pass = 4 let get_one_elem ~pass tr = 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, pass) ) (* 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 !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) (*****************************************************************************) (* Parsing #if guards *) (*****************************************************************************) (** Traverses the syntax tree parsing #if guard strings * with a given parsing function. * * NOTE that whenever the parsing fails, we keep the ifdef_guard unchanged. * * @author Iago Abal *) let parse_ifdef_guard_visitor (parse :string -> Ast_c.expression) :Visitor_c.visitor_c_s = let v_ifdef_guard = function (* Gif_str --parse--> Gif *) | Ast_c.Gif_str input -> begin try Ast_c.Gif (parse input) with | Parsing.Parse_error -> pr2 ("Unable to parse #if condition: " ^ input); Ast_c.Gif_str input end | x -> x in let v_ifdefkind = function | Ast_c.Ifdef ifguard -> Ast_c.Ifdef (v_ifdef_guard ifguard) | Ast_c.IfdefElseif ifguard -> Ast_c.IfdefElseif (v_ifdef_guard ifguard) | x -> x in { Visitor_c.default_visitor_c_s with Visitor_c.kifdefdirective_s = fun (k,bigf) d -> match d with | Ast_c.IfdefDirective ((ifkind,tag), ii) -> let ifkind' = v_ifdefkind ifkind in Ast_c.IfdefDirective ((ifkind',tag), ii) } (** Traverses the syntax tree parsing #if guard strings with [Parse_c.expr]. * * Known issue: [Parse_c.expr] is invoked through [expression_of_string], * which does not handle backslash-newlines #if guards. Those guards will * be kept unparsed. Possible solution would be to run [fix_tokens_define] * on the token stream before parsing. * * @author Iago Abal *) let parse_ifdef_guards : Ast_c.program -> Ast_c.program = Visitor_c.vk_program_s (parse_ifdef_guard_visitor cpp_expression_of_string) (*****************************************************************************) (* 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 let with_program2_unit f program2 = program2 +> Common.unzip +> (fun (program, infos) -> f program ) (* 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 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 (* 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 = Cpp_token_c.extract_macros toks in local_macros +> List.iter (fun (s, def) -> Hashtbl.replace macros s def; ); ); let toks = if !Flag_parsing_c.exts_ITU then Parsing_hacks.fix_tokens_ifdef toks else toks 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 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 ) 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 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 || 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 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 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, pass) -> 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 let filelines = try Common.cat_array file with _ -> raise (Flag.UnreadableFile file) in print_bad line_error passed_before_error (checkpoint, checkpoint2) filelines pass 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 with_program2_unit Danger.add_danger v; let v = if !Flag_parsing_c.ifdef_to_if then with_program2 Parsing_hacks.cpp_ifdef_statementize v else v in (* We parse #if guards when --ifdef-to-if is enabled, mostly because * I don't see a need (yet) to have yet-another flag. Right now, there * is also little interest in parsing #if guards without --ifdef-to-if. * Review this decision in the future! * / Iago *) let v = if !Flag_parsing_c.ifdef_to_if then with_program2 parse_ifdef_guards v else 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 = let res = Common.profile_code "TOTAL" (fun () -> parse_print_error_heuristic2 a b c d) in most_recent_file := ""; (* remove now useless lexer information *) most_recent_res := []; res 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 *) (*****************************************************************************) (* Please DO NOT remove this code, even though it is not used *) 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.4/parsing_c/Makefile0000644000175000017500000001046512614153277016227 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 \ danger.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 ############################################################################## 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 ############################################################################## # 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 ifeq ($(COMPILE_EMBEDDED_BYTES_MODULE),yes) $(OCAMLDEP_CMD) *.mli *.ml > .depend else $(OCAMLDEP_CMD) *.mli *.ml | sed "s%\.\./commons/bytes\.cm.%%g" > .depend endif ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/parsing_c/type_annoter_c.ml0000644000175000017500000013725612614153277020142 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) module StringMap = Map.Make (String) let singleton k v = StringMap.add k v StringMap.empty (* Maps are used instead of lists in order to guarantee O(log(n)) complexity when doing a lookup. The case of typedefs is a bit different from the others because we may want to do a second search, using the environment as it was when the typedef first searched was declared. *) type typedefs = { defs : (fullType * typedefs * int) StringMap.t } type nameenv = { level : int; var_or_func : Ast_c.exp_type StringMap.t; enum_constant : string option StringMap.t; typedef : typedefs; struct_union_name_def : ((structUnion * structType) wrap) StringMap.t; macro : (define_kind * define_val) StringMap.t } type environment = nameenv list (* ------------------------------------------------------------ *) (* can be modified by the init_env function below, by * the file environment_unix.h *) let empty_frame = { level = 0; var_or_func = StringMap.empty; enum_constant = StringMap.empty; typedef = { defs = StringMap.empty }; struct_union_name_def = StringMap.empty; macro = StringMap.empty; } let initial_env = ref [ { empty_frame with var_or_func = singleton "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 _scoped_env = ref !initial_env let build_env prev level = let rec ret = function | [] -> assert false | hd :: tl -> if hd.level = level then { hd with typedef = prev } else ret tl in [ret !_scoped_env] let typedef_debug = ref false (* ------------------------------------------------------------ *) (* generic, lookup and also return remaining env for further lookup *) let member_env lookupf env = try let _ = lookupf env in true with Not_found -> false (* ------------------------------------------------------------ *) let lookup_var s env = match env with | [] -> raise Not_found | env :: _ -> StringMap.find s env.var_or_func let member_env_lookup_var s env = match env with | [] -> false | env :: _ -> StringMap.mem s env.var_or_func let lookup_typedef (s : string) (env : environment) = if !typedef_debug then pr2 ("looking for: " ^ s); match env with | [] -> raise Not_found | env :: tl -> let typ, prev, level = StringMap.find s env.typedef.defs in let res : fullType * environment = typ, build_env prev level in res let member_env_lookup_typedef (s : string) (env : environment) = match env with | [] -> false | env :: _ -> StringMap.mem s env.typedef.defs let lookup_structunion (_su, s) env = match env with | [] -> raise Not_found | env :: _ -> StringMap.find s env.struct_union_name_def let member_env_lookup_structunion (_su, s) env = match env with | [] -> false | env :: _ -> StringMap.mem s env.struct_union_name_def let lookup_macro s env = match env with | [] -> raise Not_found | env :: _ -> StringMap.find s env.macro let member_env_lookup_macro s env = match env with | [] -> false | env :: _ -> StringMap.mem s env.macro let lookup_enum s env = match env with | [] -> raise Not_found | env :: _ -> StringMap.find s env.enum_constant let member_env_lookup_enum s env = match env with | [] -> false | env :: _ -> StringMap.mem s env.enum_constant (*****************************************************************************) (* "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) = 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 *) (*****************************************************************************) (* memoise unnanoted var, to avoid too much warning messages *) let _notyped_var = ref (Hashtbl.create 101) let new_scope() = match !_scoped_env with | hd :: _ -> _scoped_env := { hd with level = succ hd.level; } :: !_scoped_env | [] -> _scoped_env := [ empty_frame ] 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 (* this is not functional at all, so why not use a hash table? *) let add_in_scope namedef = let (current, older) = Common.uncons !_scoped_env in let current = match namedef with | VarOrFunc (s, typ) -> {current with var_or_func = StringMap.add s typ current.var_or_func} | TypeDef (s, typ) -> let v = typ, current.typedef, current.level in let new_typedef : typedefs = { defs = StringMap.add s v current.typedef.defs } in {current with typedef = new_typedef} | StructUnionNameDef (s, (su, typ)) -> {current with struct_union_name_def = StringMap.add s (su, typ) current.struct_union_name_def} | Macro (s, body) -> {current with macro = StringMap.add s body current.macro} | EnumConstant (s, body) -> {current with enum_constant = StringMap.add s body current.enum_constant} in _scoped_env := 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 (member, s) = let env = [current_scope] in (match namedef with | VarOrFunc (s, typ) -> (* XXX do not define member_env_lookup_var, call "ignore (lookup_var ...)" and return - false if a Not_found exception is raised; - true otherwise *) member_env_lookup_var s env, s | TypeDef (s, typ) -> member_env_lookup_typedef s env, s | StructUnionNameDef (s, (su, typ)) -> member_env_lookup_structunion (su, s) env, s | Macro (s, body) -> member_env_lookup_macro s env, s | EnumConstant (s, body) -> member_env_lookup_enum s env, s ) in if member && 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_env typ = Ast_c.unwrap_typeC (type_unfold_one_step typ !_scoped_env) 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) -> (* 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) -> (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) -> make_info_fix (typ,local) | None -> (match lookup_opt_env lookup_macro s with | Some (defkind, defval) -> (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 _ -> 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 *) | Defined _ -> make_info_def (type_of_s "int") 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) coccinelle-1.0.4/parsing_c/token_views_c.mli0000644000175000017500000000455712614153277020136 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.4/parsing_c/semantic_c.ml0000644000175000017500000000006112614153277017215 0ustar eugeneugenexception Semantic of string * Common.parse_info coccinelle-1.0.4/parsing_c/parse_string_c.mli0000644000175000017500000000023212614153277020263 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.4/parsing_c/danger.mli0000644000175000017500000000004712614153277016525 0ustar eugeneugenval add_danger : Ast_c.program -> unit coccinelle-1.0.4/parsing_c/type_c.mli0000644000175000017500000000266212614153277016555 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.4/parsing_c/unparse_c.ml0000644000175000017500000025506712614153277017111 0ustar eugeneugen(* Yoann Padioleau, Julia Lawall * * Copyright (C) 2012-2015, 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 *) let default_indent = ref "\t" (*****************************************************************************) (* 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 Ast_c.info * min | Cocci2 of string * int (* line *) * int (* lcol *) * int (* rcol *) * Unparse_cocci.nlhint option | C2 of string * Unparse_cocci.nlhint option | 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 (* let d_str = let info = TH.info_of_tok t in match !(info.Ast_c.danger) with Ast_c.DangerStart -> ":DS:" | Ast_c.DangerEnd -> ":DE:" | Ast_c.Danger -> ":D:" | Ast_c.NoDanger -> ":ND:" in *) "T2:"^b_str^t_str(*^d_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,_) -> 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 (!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 starting in column 0 or the last newline, 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_or_noncol0_comment = function | T1(Parser_c.TCommentSpace _) (* patch: cocci *) | T1(Parser_c.TCommentNewline _) -> true | T1(Parser_c.TComment i) -> (* column 0 is the leftmost column. *) Ast_c.col_of_info i > 0 | _ -> false in let is_nonnl_whitespace_or_noncol0_comment = function | T1(Parser_c.TCommentSpace _) -> true (* patch: cocci *) | T1(Parser_c.TComment i) -> (* column 0 is the leftmost column. *) Ast_c.col_of_info i > 0 | _ -> false in let is_whitespace_or_comment = function | T1(Parser_c.TCommentSpace _) | T1(Parser_c.TCommentNewline _) | T1(Parser_c.TComment _) -> true | _ -> false in let all_directives l = List.for_all (List.for_all (function Ast_cocci.Directive _ -> true | _ -> false)) l 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.CONTEXT(_,Ast_cocci.BEFORE (l,_)),_) when all_directives l -> (* move the fake node forwards *) let (whitespace,rest) = span is_whitespace_or_comment aft in bef @ whitespace @ fake :: (loop rest) | (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_or_noncol0_comment aft in bef @ whitespace @ fake :: (loop rest) | (Ast_cocci.MINUS(_,_,_,Ast_cocci.NOREPLACEMENT),_) -> (* move the fake node forwards *) let (whitespace,rest) = span is_nonnl_whitespace_or_noncol0_comment 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_or_noncol0_comment 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,None) | (Token_c.TCommentCpp x,(info : Token_c.info)) -> C2("\n"^info.Common.str^"\n",None) | 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 = "" || isminus then push2 (Fake2 (info,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,None)) toks_out | Ast_c.FakeTok (s,_) -> push2 (C2 (s,None)) toks_out | _ -> Printf.fprintf stderr "line: %s\n" (Dumper.dump info); failwith "not an abstract line" ); (* why nothing for mbefore? *) (Ast_c.get_comments_after info) +> 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 (" ",None)) 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,_) -> (* second argument indicates whether newline is added for statements if a fake token is being replaced, there should be a newline, hence use before *) (match t with Fake1 _ -> unparser any_xxs Unparse_cocci.Before | _ -> 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 (* // is unsafe, because it captures what follows it *) let is_safe_comment_or_space = function | T2(Parser_c.TCommentSpace _,_b,_i,_h) -> true (* only whitespace *) | (T2(Parser_c.TComment _,_b,_i,_h)) as t -> not (Str.string_match (Str.regexp_string "//") (str_of_token2 t) 0) | _ -> false let is_added_space = function | C2(" ",_) -> true (* only whitespace *) | _ -> false let is_added_whitespace = function C2 (" ",_) | C2 ("\n",_) | Cocci2("\n",_,_,_,_) -> true | _ -> false let is_newline_or_comment = function | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | T2(Parser_c.TComment _,_b,_i,_h) -> true (* only whitespace *) | _ -> false let is_newline_space_or_minus = function | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | T2(Parser_c.TComment _,_b,_i,_h) -> true (* only whitespace *) | T2 (_, Min _, _, _) -> true | _ -> false let is_newline = function | T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | _ -> false let contains_newline = List.exists is_newline let generated_newline = function T2((Parser_c.TCommentNewline _),Ctx,_i,_h) -> true | C2("",_) -> false | C2(s,_) -> String.get s 0 = '\n' (* may have whitespace after *) | Cocci2(s,_,_,_,_) -> (try let _ = Str.search_forward (Str.regexp "\n") s 0 in true with Not_found -> false) | _ -> false let is_fake2 = function Fake2 _ -> true | _ -> false let is_whitespace x = is_space x || is_newline_or_comment x let is_whitespace_or_fake x = is_space x || is_newline_or_comment x || is_fake2 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, _) -> true | Parser_c.TCommentCpp (Token_c.CppIfDirective _, _) -> true | Parser_c.TCommentCpp (Token_c.CppDirective, _) -> 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 | _ -> 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 || all_coccis x let set_minus_comment adj = function (T2 (Parser_c.TComment _,Ctx,idx,hint)) as x when !Flag_parsing_c.keep_comments -> x | 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 is_fake2 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_or_fake x = is_minus x || is_minusable_comment x || is_fake2 x in let minus_or_comment_nocpp x = is_minus x || 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 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):: ((T2(_,Min adj1,_,_)) as t1)::xs -> (* don't want to drop newline if - and + code mixed, but do want to drop a trailing newline that is before + code *) let (minus_list,rest) = span_not_context (t1::xs) in let (minus_list,rest) = drop_trailing_plus minus_list rest in let (pre_minus_list,_) = span not_context_newline minus_list in let contains_plus = List.exists is_plus pre_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_or_fake 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 _)) as t0):: (T2(Parser_c.TCommentNewline c,_b,_i,_h) as x):: ((T2(_,Min adj1,_,_)) as t1)::xs -> let (minus_list,rest) = span_not_context (t1::xs) in let (pre_minus_list,_) = span not_context_newline minus_list in let contains_plus = List.exists is_plus pre_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_or_fake minus_list -> set_minus_comment_or_plus adj1 x | _ -> x in t0 :: 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 (pre_minus_list,_) = span not_context_newline minus_list in let contains_plus = List.exists is_plus pre_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 -> let newcp = if List.exists context_newline not_minus_list then let (pre_minus_list,_) = span not_context_newline rest in List.exists is_plus pre_minus_list else cp in if common_adj adj1 adj2 || ((not cp || not newcp) && List.for_all is_whitespace_or_fake not_minus_list) then (List.map (set_minus_comment_or_plus adj1) not_minus_list) @ (adjust_within_minus (cp || newcp) (t2::xs)) else not_minus_list @ (adjust_within_minus (cp || newcp) (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 drop_trailing_plus minus_list rest = let rec loop acc = function x::xs -> if is_plus x then loop (x::acc) xs else if is_newline x then (List.rev (x::xs), acc@rest) else (minus_list,rest) (*do nothing if the + code is not after nl*) | _ -> failwith "not possible - always at least one - token" in loop [] (List.rev minus_list) and span_not_context xs = (* like span not_context xs, but have to parse ifdefs *) let rec loop seen_ifdefs = function [] -> (0,[],[]) | ((T2(Parser_c.TCommentCpp (Token_c.CppIfDirective ifd, _),_,_,_)) as x) ::xs when not_context x -> let fail _ = (0,[],x::xs) in (match ifd with Token_c.IfDef | Token_c.IfDef0 -> let (seen_end,ok,rest) = loop (seen_ifdefs+1) xs in if seen_end > 0 then (seen_end-1,x::ok,rest) else fail() | Token_c.Else -> if seen_ifdefs > 0 then let (seen_end,ok,rest) = loop seen_ifdefs xs in if seen_end > 0 then (seen_end,x::ok,rest) else fail() else fail() | Token_c.Endif -> if seen_ifdefs > 0 then let (seen_end,ok,rest) = loop (seen_ifdefs-1) xs in (seen_end+1,x::ok,rest) else fail() | Token_c.Other -> let (seen_end,ok,rest) = loop seen_ifdefs xs in (seen_end, x :: ok, rest)) | x :: xs -> if not_context x then let (seen_end,ok,rest) = loop seen_ifdefs xs in (seen_end,x::ok, rest) else (0,[],x::xs) in let (_,ok,rest) = loop 0 xs in (ok,rest) and not_context = function | (T2(_,Ctx,_,_) as x) when not (is_minusable_comment x) -> false | _ -> true and not_context_newline = function | T2(Parser_c.TCommentNewline _,Ctx,_,_) -> false | _ -> true and context_newline = function | T2(Parser_c.TCommentNewline _,Ctx,_,_) -> true | _ -> false 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 that are alone on a line. input is reversed *) let rec span_minus_or_comment_nocpp xs = let (pre,rest) = span (function x -> not(is_newline x)) xs in if List.for_all minus_or_comment_nocpp pre then match rest with ((T2 (Parser_c.TCommentNewline _,(Min _|Ctx),_i,_h)) as x)::rest -> let (spaces,rest) = span_minus_or_comment_nocpp rest in (pre@x::spaces,rest) | _ -> ([],xs) else ([],xs) in let rec adjust_before_brace = function | [] -> [] | ((T2(t,Ctx,_,_)) as x)::xs when str_of_token2 x = "}" || is_newline_or_comment 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 (* Danger is related to tokens that are shared between multiple AST representations, in particular for multidecls. This attempts to clean up after any transformations that have been made. It may not work in all cases... *) let check_danger toks = let get_danger = function T2(tok,_,_,_) -> let info = TH.info_of_tok tok in Some !(info.Ast_c.danger) | Fake2(info,_) -> Some !(info.Ast_c.danger) | _ -> None in let isnt_danger_end tok = match get_danger tok with Some Ast_c.DangerEnd -> false | _ -> true in let is_comma tok = (str_of_token2 tok) = "," in let removed_or_comma = function T2(_,Min _,_,_) -> true | (T2(tok,Ctx,_,_)) as x -> TH.str_of_tok tok = "," || is_whitespace x | Fake2(info,Min _) -> true | x -> false in let rec undanger_untouched toks = (* check that each entry before or after a comma contains at least one context token. combined with safe for multi constraints, that means that the rule can only have changed the type *) let ctx = function (T2(_,Ctx,_,_) as t) -> not (is_whitespace t) | _ -> false in let safe = function [] -> true | toks -> List.exists ctx toks in let res = try Some (Common.split_when is_comma toks) with Not_found -> None in match res with Some (bef,_,aft) -> safe bef && undanger_untouched aft | None -> safe toks in let drop_danger_commas toks = (* convert to minus a context comma that is at the end of minused nondangers or spaces, preceded by a danger of any sort *) let isnt_danger_or_end tok = match (get_danger tok) with Some Ast_c.DangerEnd -> false | Some Ast_c.Danger -> false | _ -> is_minus tok || is_comment_or_space tok || is_newline tok in let rec loop = function [] -> [] | x::xs -> match get_danger x with Some Ast_c.Danger -> let (nodanger,rest) = span isnt_danger_or_end xs in (match (nodanger,rest) with (_,[]) -> x::xs | ([],_) -> x:: loop xs (* still in danger region *) | (_,y::ys) -> (match (y,get_danger y) with (T2(tok,Ctx,a,b), Some Ast_c.Danger) when is_comma y -> let rec find_minus = function [] -> None | (T2(_,Min m,_,_)) :: _ | (Fake2(_,Min m)) :: _ -> Some m | x::xs -> find_minus xs in (match find_minus (List.rev nodanger) with Some m -> x::nodanger@(loop(T2(tok,Min m,a,b)::ys)) | None -> failwith "no way to minus") | _ -> x::loop xs)) | _ -> x :: loop xs in loop toks in let drop_last_danger_comma toks = (* avoid comma before ; if not all gone *) let indanger_and_isminus_or_space tok = match (get_danger tok) with Some Ast_c.DangerStart -> false | _ -> is_minus tok || is_comment_or_space tok || is_newline tok in let rec loop = function [] -> [] | x::xs -> (match get_danger x with Some Ast_c.DangerEnd -> let (removed,rest) = span indanger_and_isminus_or_space xs in (match rest with [] -> x::xs | y::ys -> (match (y,get_danger y) with (T2(tok,Ctx,a,b), Some Ast_c.Danger) when is_comma y -> let rec find_minus = function [] -> None | (T2(_,Min m,_,_)) :: _ | (Fake2(_,Min m)) :: _ -> Some m | x::xs -> find_minus xs in (match find_minus removed with Some m -> x :: removed @ (T2(tok,Min m,a,b)) :: loop ys | None -> failwith "no way to minus") | _ -> x::loop xs)) | _ -> x :: loop xs) in (* reverse to find danger end first, and then work backwards *) List.rev (loop (List.rev toks)) in (* the following four functions are for unminusing the type if it is still needed *) let not_danger tok = match get_danger tok with Some Ast_c.Danger -> false | _ -> true in let nonspace_danger tok = match get_danger tok with Some Ast_c.Danger -> true | Some Ast_c.NoDanger -> is_space tok || is_newline_or_comment tok | _ -> false in let unminus tok = match (tok,get_danger tok) with (T2(tok,Min _,a,b),Some Ast_c.Danger) -> T2(tok,Ctx,a,b) | _ -> tok in let rec unminus_initial_danger toks = let (front,rest) = span not_danger toks in let (dangers,rest) = span nonspace_danger rest in front @ (List.map unminus dangers) @ rest in let unminus_danger_end = function T2(tok,Min _,a,b) -> T2(tok,Ctx,a,b) | x -> x in let rec search_danger = function [] -> [] | x::xs -> match get_danger x with Some Ast_c.DangerStart -> let (danger,rest) = span isnt_danger_end (x::xs) in (match rest with de::rest -> (match get_danger de with Some Ast_c.DangerEnd -> if List.for_all removed_or_comma (de::danger) (* everything removed *) || undanger_untouched (danger@[de]) (* nothing removed, type changed *) then danger @ de :: (search_danger rest) else (* some things removed, not others, unminus the type *) drop_last_danger_comma ((unminus_initial_danger danger) @ [(unminus_danger_end de)]) @ (search_danger rest) | _ -> failwith "missing danger end") | _ -> failwith "missing danger end") | _ -> x :: search_danger xs in search_danger (drop_danger_commas toks) (* this is for the case where braces are added around an if branch because of a change inside the branch *) let minusify = function T2(t,_,i,h) -> T2(t,Min([],Ast_cocci.ALLMINUS),i,h) | _ -> failwith "not possible" (* see is_newline, below *) 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_safe_comment_or_space xs in match rest with T2(Parser_c.TComment _,_,_,_)::_ -> (* must be unsafe, ie //, moving brace up puts it under comment *) xs | _ -> let (nls, rest) = span is_newline_space_or_minus rest in let after = match List.rev spaces with [] -> [(C2 (" ",None))] | T2(Parser_c.TComment _,Ctx,_i,_h)::_ -> [(C2 (" ",None))] | _ -> if List.exists (function T2(_,Ctx,_,_) -> true | _ -> false) spaces then [] (* use existing trailing spaces *) else [(C2 (" ",None))] in match rest with (* move the brace up to the previous line *) | ((Cocci2("{",_,_,_,_)) as x) :: ((Cocci2 ("\n",_,_,_,_)) as a) :: rest -> (* use what was there already, if available *) let nls = match nls with [] -> [a] | _ -> nls in spaces @ after @ x :: nls @ 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 (" ",None)) :: (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) ' ', None)::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', None):: C2 (String.make (lcoly-1) ' ', None):: (* -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 || List.mem sy ["="]) then x::C2(" ",None)::(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(" ",None)::(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 = (* drops both space_cell and seen_cocci if there is a newline *) let l = list_of_string s in List.fold_left (function (count,nl) -> function | '\t' -> (count + 8,nl) | '\n' -> (0,true) | c -> (count + 1,nl)) (count,false) 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) let scan_past_define l = let is_newline = function T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | C2 ("\n",_) -> true | _ -> false in let rec loop = function [] -> ([],[]) | x::xs when str_of_token2 x = "\\" -> let (notnewline,nl,after) = xs +> split_when is_newline in let (before,after) = loop after in (notnewline @ nl :: before, after) | x::xs when is_newline x -> ([x],xs) | x::xs -> let (before,after) = loop xs in (x::before,after) in loop l (* This is the last thing that happens, so there is no more minus code at this point. The cases are as follows: 1. Comma then space. 2. Comma then newline. 3. Comma then something else. 4. Newline wth no preceding comma. 5. Start or end token, ie = ( ) { }. 6. Anything else. If the position of anythng has to move, then there can be movement on the rest of the current line. If a newline adds less space than the indentation at the top of the stack, then the space should be adjusted to what is indicated at the top of the stack, unless the next character is ) or }. Indentation is done like on the previous line. An overload at a comma causes the previous space to be replaced by a newline. Stack contains an indentation level and a tabbing unit. *) let add_newlines toks tabbing_unit = let iscomma tok = str_of_token2 tok = "," in let isspace tok = str_of_token2 tok = " " in let isnewline tok = let s = str_of_token2 tok in try let _ = Str.search_forward (Str.regexp "\n") s 0 in true with Not_found -> false in let iscocci = function Cocci2 _ | C2 _ -> true | _ -> false in let nonempty = function [] -> false | _ -> true in (* 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) | None | Some "" -> if !Flag_parsing_c.indent = 0 then ("\t",8) (* not sure why "" case... *) else (!default_indent,!Flag_parsing_c.indent) | Some s -> (* assuming only tabs or spaces *) (s,simple_string_length s 0) in let rec loop seen = if seen + tlen <= n then tu ^ loop (seen + tlen) else String.make (n-seen) ' ' in loop 0 in let update_previous_space stack space_cell count s = let count = count + String.length s in match (stack,space_cell) with ([(indent, tu)], Some (start,space_cell)) -> if count > Flag_parsing_c.max_width then let indent = match tu with Some tu -> space_cell := "\n"^tu; indent | None -> space_cell := "\n"^(create_indent indent); indent in count - start + indent else count | _ -> count in let make_space_cell count sp = let count = count + String.length sp in let sp = ref sp in let a = C2(",",Some (Unparse_cocci.SpaceOrNewline sp)) in (a,Some (count,sp)) in let ender = function [] -> false | Cocci2(s,line,lcol,rcol,Some Unparse_cocci.EndBox)::_ -> true | t::_ -> List.mem (str_of_token2 t) [")";"}"] in let get_indent stack t2 seen_cocci rest_toks = match stack with (indent_count,indent_string)::rest_stack -> let (new_indent,rest) = let rpieces = List.rev (Str.split_delim (Str.regexp "\n") (str_of_token2 t2)) in match rpieces with indent::rest -> (indent,String.concat "\n" (List.rev rest)) | [] -> ("","") (* no indentation seems desired *) in let new_indent_count = simple_string_length new_indent 0 in if new_indent_count = 0 then (* no indentation wanted; leave it that way *) (* false is not ideal, because it means that for subsequent lines we will have forgotten any previous changes. *) (stack,indent_count,t2,false) else if seen_cocci && not (ender rest_toks) then (match indent_string with Some indent_string -> (*if we have picked something, then use it*) (stack,indent_count,C2(rest^"\n"^indent_string,None), not (new_indent_count = indent_count)) | None -> if new_indent_count >= indent_count then ((new_indent_count,Some new_indent)::rest_stack, new_indent_count, t2, false) else let new_indent_string = create_indent indent_count in ((indent_count,Some new_indent_string)::rest_stack, indent_count, C2(rest^"\n"^new_indent_string,None), true)) else ((new_indent_count,Some new_indent)::rest_stack, new_indent_count, t2, false) | _ -> failwith "should not be called with an empty stack" in let start_box stack count s = let inside_count = String.length s + count in (* using 0 should cause it to stay with what there is already *) let stack_count = if s = "(" then inside_count else 0 in (inside_count,(stack_count,None)::stack) 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 *) match stack with [_] -> let newcount = if seen_cocci then update_previous_space stack space_cell count s else count + String.length s in (newcount,[],None,false) | [] -> (count + String.length s, [], None, false) | x::xs -> (count + String.length s, xs, space_cell, seen_cocci) in let rec loop stack space_cell count seen_cocci seeneq = function x -> match x with | [] -> [] | t1::rest when str_of_token2 t1 = "#define" -> (* don't want to add newlines in a #define *) let (def,rest) = scan_past_define rest in let nl = List.hd(List.rev def) in (match stack with [] -> let newcount = simple_string_length (str_of_token2 nl) 0 in t1 :: def @ loop stack space_cell newcount false false rest | _ -> let def = List.rev(List.tl(List.rev def)) in let (stack,newcount,nl,newseencocci) = get_indent stack nl seen_cocci rest in t1 :: def @ nl :: (loop stack space_cell newcount newseencocci false rest)) | ((Cocci2(s,line,lcol,rcol,Some Unparse_cocci.StartBox)) as a)::xs -> let (newcount,newstack) = start_box stack count s in a :: loop newstack space_cell newcount true false xs | ((Cocci2(s,line,lcol,rcol,Some Unparse_cocci.EndBox)) as a)::xs -> let (newcount,newstack,newspacecell,newseencocci) = end_box stack space_cell count seen_cocci s in a :: loop newstack newspacecell newcount newseencocci false xs | ((Cocci2(s,line,lcol,rcol,Some(Unparse_cocci.SpaceOrNewline sp))) as a):: xs -> let xs = match xs with t1::xs when isspace t1 -> xs | _ -> xs in let count = update_previous_space stack space_cell count s in let count_after_space = count + 1 in let space_cell = match stack with [_] -> Some(count_after_space,sp) | _ -> space_cell in a :: loop stack space_cell count_after_space true false xs | t1 :: t2 :: rest when nonempty stack && iscomma t1 && isspace t2 -> let seen_cocci = seen_cocci || iscocci t1 || iscocci t2 in let space_sz = simple_string_length (str_of_token2 t2) 0 in (match stack with [_] -> let count = if seen_cocci then update_previous_space stack space_cell count "," else count+1 in let (t1,space_cell) = make_space_cell count " " in t1:: loop stack space_cell (count+space_sz) seen_cocci false rest | _ -> t1::t2:: loop stack space_cell (count+space_sz+1) seen_cocci false rest) | t1 :: t2 :: rest when nonempty stack && iscomma t1 && isnewline t2 -> let seen_cocci = seen_cocci || iscocci t1 || iscocci t2 in let (stack,newcount,t2,newseencocci) = get_indent stack t2 seen_cocci rest in (match stack with [_] -> let _count = if seen_cocci then update_previous_space stack space_cell count "," else count+1 in t1::t2::loop stack None newcount newseencocci false rest | _ -> t1::t2::loop stack None newcount newseencocci false rest) | t1 :: rest when nonempty stack && iscomma t1 -> let seen_cocci = seen_cocci || iscocci t1 in (match stack with [_] -> let count = if seen_cocci then update_previous_space stack space_cell count "," else count+1 in let (t1,space_cell) = make_space_cell count "" in t1 :: loop stack space_cell (count) seen_cocci false rest | _ -> t1 :: loop stack space_cell (count+1) seen_cocci false rest) | t1 :: rest when nonempty stack && isnewline t1 -> let seen_cocci = seen_cocci || iscocci t1 in let (stack,newcount,t1,newseencocci) = get_indent stack t1 seen_cocci rest in (match stack with [_] -> let _count = if seen_cocci then update_previous_space stack space_cell count "" else count+1 in t1 :: loop stack None newcount newseencocci false rest | _ -> t1 :: loop stack None newcount newseencocci false rest) | (C2(s1,_)) :: (C2(" ",_)) :: (((C2(s2,_)) :: _) as xs) when (not (s1 = "")) && (not (s2 = "")) && (* not perfect, because only finds the string string case *) (String.get s1 0 = '\"') && (String.get s2 0 = '\"') -> let count = update_previous_space stack space_cell count s1 in let sp = ref " " in let a = C2(s1,Some(Unparse_cocci.SpaceOrNewline sp)) in a :: loop stack space_cell ((simple_string_length s1 count)+1) true false xs | Fake2 _ :: _ | Indent_cocci2 :: _ | Unindent_cocci2 _::_ | EatSpace2::_ -> failwith "unexpected fake, indent, unindent, or eatspace" | a::xs -> (match str_of_token2 a with | "=" -> a :: loop stack space_cell (count+1) seen_cocci true xs | "(" as s -> let (newcount,newstack) = start_box stack count s in a :: loop newstack space_cell newcount seen_cocci false xs | ")" as s -> let (newcount,newstack,newspacecell,newseencocci) = end_box stack space_cell count seen_cocci s in a :: loop newstack newspacecell newcount newseencocci false xs | "{" as s when seeneq -> let (spaces_after,_) = span is_whitespace xs in let (newcount,nl) = List.fold_left (function (prev,info) -> function | (T2(tok,_b,_i,_h)) -> string_length (TH.str_of_tok tok) prev | _ -> failwith "not possible") (count,false) spaces_after in let s = if nl then "" else s in let (newcount,newstack) = start_box stack count s in a :: loop newstack space_cell newcount seen_cocci false xs | "{" as s when not (stack = []) -> (* [] case means statement braces *) let (newcount,newstack) = start_box stack count s in a :: loop newstack space_cell newcount seen_cocci false xs | "}" as s when not (stack = []) -> (* [] case means statement braces *) let (newcount,newstack,newspacecell,newseencocci) = end_box stack space_cell count seen_cocci s in a :: loop newstack newspacecell newcount newseencocci false xs | s -> let count = simple_string_length s count in let seeneq = seeneq && is_whitespace a in let seen_cocci = seen_cocci || (iscocci a && nonempty stack) in a :: loop stack space_cell count seen_cocci seeneq xs) in let mkc2 = function "" -> [] | sp -> [C2 (sp,None)] in let redo_spaces prev = function | Cocci2(s,line,lcol,rcol,Some (Unparse_cocci.SpaceOrNewline sp)) -> mkc2 !sp @ Cocci2(s,line,lcol,rcol,None) :: prev | T2(tok,min,idx,Some (Unparse_cocci.SpaceOrNewline sp)) -> mkc2 !sp @ T2(tok,min,idx,None) :: prev | C2(s,Some (Unparse_cocci.SpaceOrNewline sp)) -> mkc2 !sp @ C2(s,None) :: prev | t -> t::prev in (match !Flag_parsing_c.spacing with | Flag_parsing_c.SMPL -> toks | _ -> let preres = loop [] None 0 false false 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 of int | Drop | Unindent | Unindent1 | Label (* label is for a newline that should not be taken into account to compute indentation; it might be befor a label, a #, or just an empty line *) let print_info l = List.iter (function (_,CtxNL _,_) -> Printf.printf "CtxNL\n" | (_,MinNL _,_) -> Printf.printf "MinNL\n" | (_,PlusNL _,_) -> Printf.printf "PlusNL\n" | (_,Other n,t) -> Printf.printf "Other %d |%s|\n" n (str_of_token2 t) | (_,Drop,_) -> Printf.printf "Drop\n" | (_,Unindent,_) -> Printf.printf "Unindent\n" | (_,Unindent1,_) -> Printf.printf "Unindent1\n" | (_,Label,_) -> Printf.printf "Label\n") l (* ------------------------------------------------------------------------- *) (* preparsing *) type op = PlusOnly | MinusOnly | Both | Neither let minplus = function Ctx -> Both | Min _ -> MinusOnly type parsed_tokens = NL of string | Tok of string | Ind of token2 let parse_token tok = match tok with T2((Parser_c.TCommentNewline s) as t,a,_,_) -> let s = TH.str_of_tok t in (match Str.split_delim (Str.regexp "\n") s with [before;after] -> (NL after, minplus a) | _ -> (Tok (str_of_token2 tok), minplus a)) | T2(_,a,_,_) -> (Tok (str_of_token2 tok), minplus a) | C2 (s,_) -> (Tok s, PlusOnly) | Cocci2("\n",_,_,_,_) -> (NL "", PlusOnly) | Cocci2(s,_,_,_,_) -> (Tok s, PlusOnly) | Indent_cocci2 | Unindent_cocci2 _ -> (Ind tok, PlusOnly) | _ -> (Tok (str_of_token2 tok), Neither) (* ------------------------------------------------------------------------- *) let add1 op (am,ap) = match op with PlusOnly -> (am,ap+1) | MinusOnly -> (am+1,ap) | Both -> (am+1,ap+1) | Neither -> (am,ap) let accadd1 op (am,ap) = match op with PlusOnly -> (am,0::ap) | MinusOnly -> (0::am,ap) | Both -> (0::am,0::ap) | Neither -> (am,ap) let add op (am,ap) (bm,bp) = match op with PlusOnly -> (am,ap+bp) | MinusOnly -> (am+bm,ap) | Both -> (am+bm,ap+bp) | Neither -> (am,ap) let sub1 op (am,ap) = let sub1 = function 0 -> 0 | n -> n-1 in match op with PlusOnly -> (am,sub1 ap) | MinusOnly -> (sub1 am,ap) | Both -> (sub1 am,sub1 ap) | Neither -> (am,ap) let accsub1 op (am,ap) = let tl = function x::xs -> xs | [] -> [] in match op with PlusOnly -> (am,tl ap) | MinusOnly -> (tl am,ap) | Both -> (tl am,tl ap) | Neither -> (am,ap) let subtract op (am,ap) (bm,bp) = let subtract a b = max 0 (a - b) in match op with PlusOnly -> (am,subtract ap bp) | MinusOnly -> (subtract am bm,ap) | Both -> (subtract am bm,subtract ap bp) | Neither -> (am,ap) let skip_unlike_me op xs is_whitespace = let rec loop = function [] -> [] | x::xs when is_whitespace x -> loop xs | ((T2 (_,Ctx,_,_)) :: _) as xs -> xs | ((T2 (_,Min _,_,_)) :: _) as xs when op = MinusOnly || op = Both -> xs | (((Cocci2 _)::_) | ((C2 _)::_)) as xs when op = PlusOnly || op = Both -> xs | (Indent_cocci2::_) as xs when op = PlusOnly || op = Both -> xs | (Unindent_cocci2 _::_) as xs when op = PlusOnly || op = Both -> xs | _::xs -> loop xs in loop xs let open_brace op xs = let is_whitespace t = is_whitespace t || is_added_whitespace t in match skip_unlike_me op xs is_whitespace with [] -> false | t::_ -> (str_of_token2 t) = "{" || (str_of_token2 t) = ";" let notelse op xs = not (let is_whitespace t = is_whitespace t || is_added_whitespace t in match skip_unlike_me op xs is_whitespace with [] -> false | t::_ -> (str_of_token2 t) = "else") let close_brace op xs = let is_whitespace t = is_whitespace t || is_added_whitespace t in match skip_unlike_me op xs is_whitespace with [] -> false | t::_ -> (str_of_token2 t) = "}" let is_nl op xs = let is_whitespace t = is_space t || is_added_space t in match skip_unlike_me op xs is_whitespace with [] -> false | T2(Parser_c.TCommentNewline _,_b,_i,_h)::_ -> true | C2 ("\n",_)::_ | Cocci2("\n",_,_,_,_)::_ -> true (*not sure if cocci2 is needed*) | Indent_cocci2 :: _ -> true | Unindent_cocci2 _ :: _ -> true | _ -> false let is_pragma t = let str = str_of_token2 t in match str with "" -> false | _ -> String.get str 0 = '#' let is_label op xs = let is_whitespace t = is_whitespace t || is_added_whitespace t in match skip_unlike_me op xs is_whitespace with [] -> false | t::_ when is_pragma t -> true | _::rest -> (match skip_unlike_me op rest is_whitespace with t::_ when str_of_token2 t = ":" -> true | _ -> false) let adjust_by_function getter op k q vl xs = match op with MinusOnly | PlusOnly -> let fn = if getter op xs then k else q in fn op vl | Both -> let vl1 = let fn = if getter MinusOnly xs then k else q in fn MinusOnly vl in let fn = if getter PlusOnly xs then k else q in fn PlusOnly vl1 | _ -> vl let getval (am,ap) = function PlusOnly -> ap | MinusOnly -> am | Both -> am (* no idea, pick - arbitrarily *) | Neither -> am let adjust_by_op fn (am,ap) = function PlusOnly -> (am,fn ap) | MinusOnly -> (fn am,ap) | Both -> (fn am,fn ap) | Neither -> (am,ap) let drop_zeroes op accumulator xs = let drop_zeroes l = let (_,rest) = span (function x -> x = 0) l in rest in adjust_by_function notelse op (fun o a -> adjust_by_op drop_zeroes a o) accsub1 accumulator xs (*adjust_by_op drop_zeroes accumulator op*) let add1top op accumulator = let add1 = function x::xs -> (x+1)::xs | _ -> [] in adjust_by_op add1 accumulator op let sub1top op accumulator = let sub1 = function x::xs -> (max 0 (x-1))::xs | _ -> [] in adjust_by_op sub1 accumulator op let token_effect tok dmin dplus inparens inassn inbrace accumulator xs = let info = parse_token tok in match info with (Tok ")",op) when getval inparens op <= 1 && getval inassn op = 0 && getval inbrace op > 0 -> let nopen_brace a b = not (open_brace a b) in let do_nothing a b = b in let accumulator = adjust_by_function nopen_brace op accadd1 do_nothing accumulator xs in (Other 1,dmin,dplus,(0,0),(0,0),inbrace,accumulator) | (Tok "else",op) -> (* is_nl is for the case where the next statement is on the same line as the else *) let nopen_brace a b = let res = not (open_brace a b) && (is_nl a b) in res in let do_nothing a b = b in let accumulator = adjust_by_function nopen_brace op accadd1 do_nothing accumulator xs in (Other 1,dmin,dplus,(0,0),(0,0),inbrace,accumulator) | (Tok "{",op) -> let (dmin,dplus) = add1 op (dmin,dplus) in let accumulator = add1top op accumulator in (Other 2,dmin,dplus,inparens,(0,0),add1 op inbrace,accumulator) | (Tok "}",op) -> let (dmin,dplus) = sub1 op (dmin,dplus) in let accumulator = sub1top op accumulator in (Other 3,dmin,dplus,inparens,(0,0),sub1 op inbrace, drop_zeroes op accumulator xs) | (Tok(";"|","),op) when getval inparens op = 0 && getval inassn op <= 1 -> (Other 4,dmin,dplus,inparens,(0,0),inbrace,drop_zeroes op accumulator xs) | (Tok ";",op) -> (Other 5,dmin,dplus,inparens,sub1 op inassn,inbrace,accumulator) | (Tok "=",op) when getval inparens op + getval inassn op = 0 -> (Other 6,dmin,dplus,inparens,add1 op (0,0),inbrace,accumulator) | (Tok "(",op) -> (Other 7,dmin,dplus,add1 op inparens,inassn,inbrace,accumulator) | (Tok ")",op) -> (Other 8,dmin,dplus,sub1 op inparens,inassn,inbrace,accumulator) | (Ind Indent_cocci2,op) -> (Drop,dmin,dplus,inparens,inassn,inbrace,accumulator) | (Ind (Unindent_cocci2 true),op) -> (Drop,dmin,dplus,inparens,inassn,inbrace,accumulator) | (Ind (Unindent_cocci2 false),op) -> (Unindent,dmin,dplus,inparens,inassn,inbrace,accumulator) | (Tok "case",op) -> (Unindent1,dmin,dplus,inparens,inassn,inbrace,accumulator) | (NL after,op) -> if is_label Both xs then (* ignore indentation *) (Label,dmin,dplus,inparens,inassn,inbrace,accumulator) else let inp = getval inparens op in let ina = getval inassn op in let rebuilder min plus = match op with Both -> CtxNL(after,min,plus,inp+ina) | MinusOnly -> MinNL(after,min,plus,inp+ina) | PlusOnly -> PlusNL(plus,inp+ina) | _ -> failwith "not possible" in let numacc = (List.length (fst accumulator), List.length (snd accumulator)) in let (admin,adplus) = adjust_by_function close_brace op (fun op x -> add op (sub1 op x) numacc) (fun op x -> add op x numacc) (dmin,dplus) xs in (rebuilder admin adplus, dmin,dplus,inparens,inassn,inbrace,accumulator) | (_,op) -> (Other 9,dmin,dplus,inparens,inassn,inbrace,accumulator) let parse_indentation xs = let xs = match xs with (Unindent_cocci2 false)::xs -> (* Drop unindent at the very beginning; no need for prior nl *) xs | _ -> xs in let rec loop n dmin dplus inparens inassn inbrace accumulator = 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,inassn,inbrace,accumulator) = token_effect x dmin dplus inparens inassn inbrace accumulator xs in let front = let rec loop n = function [] -> [] | x::xs -> (* Label is better than other, because it is recognized as being like a newline *) (n,Label,x) :: loop (n+1) xs in loop n front in front @ ((n+List.length front),res,x) :: loop (n+1) dmin dplus inparens inassn inbrace accumulator xs in loop 1 0 0 (0,0) (0,0) (0,0) ([],[]) 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,None) | _ -> 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 (* 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 -> !default_indent | Some tu -> tu in let rec loop = function 0 -> before | n -> (loop (n-1)) ^ tabbing_unit in loop n (* adds to the front *) let times_before after n tabbing_unit ctr = (if n < 0 then failwith (Printf.sprintf "n is %d\n" n)); let tabbing_unit = match tabbing_unit with None -> !default_indent | Some tu -> tu in let rec loop = function 0 -> after | n -> tabbing_unit ^ (loop (n-1)) in loop n (* drops from the front *) let untimes_before cur n tabbing_unit ctr = (if n < 0 then failwith (Printf.sprintf "n is %d\n" n)); let tabbing_unit = match tabbing_unit with None -> !default_indent | Some tu -> tu in let len = String.length tabbing_unit in let tabbing_unit = Str.regexp_string tabbing_unit in let rec loop cur = function 0 -> cur | n -> if Str.string_match tabbing_unit cur 0 then loop (String.sub cur len (String.length cur - len)) (n-1) else (* no idea what to do, just drop the first character... *) loop (String.sub cur 1 (String.length cur - 1)) (n-1) in loop cur n (* Probably doesn't do a good job of parens. Code in parens may be aligned by tabbing unit or may have extra space specific to the position of the parentheses. Don't seem inheritable. TODO... *) let plus_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 depth = depth + inparens in 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 context_search_in_maps n depth samedelta inparens past_minmap minmap tu t = let findn map = if not samedelta then None else (* favor just shifing left *) try Some(List.find (function ((_,ip),(n1,_)) -> ip = inparens && n = n1) map) with Not_found -> None in let before = findn past_minmap in let after = findn minmap in (* should be the same... *) (if not (before = after) then failwith "inconsistent maps for ctx info"); match before with Some ((old_depth,_),(_,indent)) -> if depth < old_depth then update_indent t (untimes_before indent (old_depth-depth) tu 1) else if depth > old_depth then update_indent t (times_before indent (depth-old_depth) tu 1) else update_indent t indent | None -> (* parens must have changed, fall back on plus_search *) plus_search_in_maps n depth inparens past_minmap minmap tu t (* Add newlines where needed around unindents. Lets adjust_indentation adjust them if needed. *) let rec newlines_for_unindents xs = let is_ctxnl = function T2(Parser_c.TCommentNewline _,_b,_i,_h) -> true | _ -> false in let is_plusnl = function C2("\n",_) | Cocci2("\n",_,_,_,_) -> true | _ -> false in let is_nl x = is_ctxnl x || is_plusnl x in let rec loop = function [] -> [] | (Unindent_cocci2 false)::x::nl::rest -> x :: loop (nl::rest) | ctxnl::(Unindent_cocci2 false)::x::plusnl::rest when is_ctxnl ctxnl && is_plusnl plusnl -> plusnl::(Unindent_cocci2 false)::x::loop (ctxnl::rest) | ctxnl::(Unindent_cocci2 false)::x::rest when is_ctxnl ctxnl -> (C2("\n",None))::(Unindent_cocci2 false)::x::loop (ctxnl::rest) | plusnl1::(Unindent_cocci2 false)::x::nl2::rest when is_plusnl plusnl1 && is_nl nl2 -> plusnl1::(Unindent_cocci2 false)::x::loop (nl2::rest) | plusnl::(Unindent_cocci2 false)::x::[] when is_plusnl plusnl -> plusnl::(Unindent_cocci2 false)::x::[] | plusnl::(Unindent_cocci2 false)::x::rest when is_plusnl plusnl -> plusnl::(Unindent_cocci2 false)::x::loop (C2("\n",None)::rest) | y::(Unindent_cocci2 false)::x::nl::rest when is_nl nl -> y::C2("\n",None)::(Unindent_cocci2 false)::x::loop (nl::rest) | y::(Unindent_cocci2 false)::x::rest -> y::C2("\n",None)::(Unindent_cocci2 false)::x::C2("\n",None)::rest | x::rest -> x::loop rest in loop xs (* needed because token_effect doesn't see context *) let rec clear_unindent1 = function [] -> [] | (n,PlusNL(depth,inparens),t)::(n1,Unindent1,t1)::rest -> (n,PlusNL(depth-1,inparens),t)::(n1,Other 0,t1)::(clear_unindent1 rest) | (n,CtxNL(spaces,depthmin,depthplus,inparens),t)::(n1,Unindent1,t1)::rest -> (n,CtxNL(spaces,depthmin-1,depthplus-1,inparens),t):: (n1,Other 0,t1)::(clear_unindent1 rest) | (n,MinNL(spaces,depthmin,depthplus,inparens),t)::(n1,Unindent1,t1)::rest -> (n,MinNL(spaces,depthmin-1,depthplus-1,inparens),t):: (n1,Other 0,t1)::(clear_unindent1 rest) | (n,Unindent1,t)::rest -> (n,Other 0,t)::(clear_unindent1 rest) | x::rest -> x :: (clear_unindent1 rest) let adjust_indentation xs = let xs = newlines_for_unindents xs in let toks = parse_indentation xs in let toks = clear_unindent1 toks in let rec loop tabbing_unit past_minmap dmin dplus = function [] -> (tabbing_unit,past_minmap,[]) | (n,PlusNL(depth,inparens),t)::(_,Unindent,_)::(_,_,x)::rest -> let (out_tu,minmap,res) = loop tabbing_unit past_minmap dmin dplus rest in (out_tu,minmap,t::x::res) | (_,Unindent,_)::rest -> loop tabbing_unit past_minmap dmin dplus rest | (_,Unindent1,_)::rest -> failwith "removed by clear_unindent1" | (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 depthmin depthplus 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 context_search_in_maps n depthplus ((depthmin - depthplus) = (dmin - dplus)) inparens past_minmap minmap tabbing_unit (C2("\n",None)) 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 depthmin depthplus 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 depth rest in let newtok = plus_search_in_maps n depth inparens past_minmap minmap tabbing_unit t in (out_tu, minmap, newtok::res) | (n,(Other _|Label),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),(0,""))] in let (out_tu,_,res) = loop None nulmap 0 0 toks in (res,out_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 *) | {tok2 = C2(" ",_)} -> true (* added by redo_spaces *) | _ -> 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 = Bytes.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' -> () | _ -> Bytes.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 || 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 = check_danger toks in 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 = fix_tokens toks in let toks = add_newlines toks tu 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 = (if !Flag_parsing_c.indent > 0 then default_indent := String.make !Flag_parsing_c.indent ' '); profile_code "C unparsing" (fun () -> pp_program2 a b) let pp_program_default xs outfile = (if !Flag_parsing_c.indent > 0 then default_indent := String.make !Flag_parsing_c.indent ' '); let xs' = xs +> List.map (fun x -> x, PPnormal) in pp_program xs' outfile coccinelle-1.0.4/parsing_c/parsing_consistency_c.mli0000644000175000017500000000026412614153277021654 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.4/parsing_c/danger.ml0000644000175000017500000000572412614153277016363 0ustar eugeneugen(* This puts danger annotations on tokens that are duplicated in the AST, namely in multi declarations. There is an assumption that such dangerous regions are not nested. Indeed, a declaration cannot be within another declaration. *) open Common let danger_start x = x.Ast_c.danger := Ast_c.DangerStart let danger_end x = x.Ast_c.danger := Ast_c.DangerEnd let danger x = x.Ast_c.danger := Ast_c.Danger let nodanger x = x.Ast_c.danger := Ast_c.NoDanger let update_danger danger = let ii_function (k,bigf) ii = danger ii in { Visitor_c.default_visitor_c with Visitor_c.kinfo =ii_function } let undanger = update_danger nodanger let undanger_type = function (* undanger the right bits *) (tq,(Ast_c.Array (sz,ty),ii)) -> List.iter (Visitor_c.vk_info undanger) ii; Common.do_option (Visitor_c.vk_expr undanger) sz | (tq,(Ast_c.Pointer _,ii)) -> List.iter (Visitor_c.vk_info undanger) ii | (tq,(Ast_c.FunctionType(ret,(params,(dots,dotsii))),ii)) -> List.iter (Visitor_c.vk_info undanger) ii; List.iter (Visitor_c.vk_info undanger) dotsii; Visitor_c.vk_param_list undanger params | _ -> () let undanger_onedecl (onedecl,_ii) = match onedecl.Ast_c.v_namei with Some (name,iniopt) -> Visitor_c.vk_name undanger name; (match iniopt with Ast_c.NoInit -> () | Ast_c.ValInit(iini,init) -> nodanger iini; Visitor_c.vk_ini undanger init | Ast_c.ConstrInit((init,(ii : Ast_c.info list))) -> List.iter (Visitor_c.vk_info undanger) ii; Visitor_c.vk_argument_list undanger init); undanger_type onedecl.Ast_c.v_type; | None -> () let undanger_fieldkind (fieldkind,_ii) = match fieldkind with Ast_c.Simple(None,_) | Ast_c.BitField(None,_,_,_) -> (* no name implies nothing to do *) () | Ast_c.Simple(Some name,ft) -> Visitor_c.vk_name undanger name; undanger_type ft | Ast_c.BitField(Some name,ft,ii,ce) -> Visitor_c.vk_name undanger name; undanger_type ft; Visitor_c.vk_info undanger ii; Visitor_c.vk_expr undanger ce let add_danger xs = let decl_function (k,bigf) decl = match decl with Ast_c.DeclList (((_::_::_) as xs), ii) -> Visitor_c.vk_decl (update_danger danger) decl; xs +> List.iter undanger_onedecl; let (max,min) = Lib_parsing_c.max_min_ii_by_pos(Lib_parsing_c.ii_of_decl decl) in danger_start min; danger_end max | _ -> k decl in let struct_field_function (k,bigf) field = match field with Ast_c.DeclarationField (Ast_c.FieldDeclList (((_::_::_) as xs), iiptvirg)) -> Visitor_c.vk_struct_field (update_danger danger) field; xs +> List.iter undanger_fieldkind; let (max,min) = Lib_parsing_c.max_min_ii_by_pos(Lib_parsing_c.ii_of_field field) in danger_start min; danger_end max | _ -> k field in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kdecl = decl_function; Visitor_c.kfield = struct_field_function } in xs +> List.iter (fun p -> Visitor_c.vk_toplevel bigf p); coccinelle-1.0.4/engine/0000755000175000017500000000000012614156171014055 5ustar eugeneugencoccinelle-1.0.4/engine/check_reachability.ml0000644000175000017500000001557712614153277020227 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ---------------------------------------------------------------- *) (* 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 preproc _ = true 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,preproc,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.4/engine/lib_engine.ml0000644000175000017500000000522012614153277016505 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) open Ograph_extended (*****************************************************************************) (* the different ctl formula related types *) (*****************************************************************************) type mvar = Ast_cocci.meta_name type predicate = InLoop | TrueBranch | EscTrueBranch | FalseBranch | After (* pointer to the code after a block, 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 quicklabel_ctlcocci = predicate -> bool type model = Control_flow_c.cflow * label_ctlcocci * quicklabel_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.4/engine/pattern_c.mli0000644000175000017500000000065612614153277016552 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/c_vs_c.mli0000644000175000017500000000066412614153277016026 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/pretty_print_engine.mli0000644000175000017500000000157712614153277020666 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/engine/ctltotex.ml0000644000175000017500000002461312614153277016267 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.EscTrueBranch -> ("\\msf{EscTrueBranch}",13) | 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.4/engine/transformation_c.ml0000644000175000017500000007335312614153277017776 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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; optional_attributes_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 optional_attributes_flag f = fun tin -> f (tin.extra.optional_attributes_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,ty) -> (v,Ast_c.MetaExprVal(Lib_parsing_c.real_al_expr e,ml,ty)) | 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,ty) -> (v,Ast_c.MetaStmtVal(Lib_parsing_c.real_al_statement s,ty)) (* These don't contain local variables, but the cocci_tag field causes problems too. Why is this not needd for other metavars? *) | Ast_c.MetaAssignOpVal(b) -> (v,Ast_c.MetaAssignOpVal(Lib_parsing_c.real_al_assignop b)) | Ast_c.MetaBinaryOpVal(b) -> (v,Ast_c.MetaBinaryOpVal(Lib_parsing_c.real_al_binop b)) | _ -> (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 cocciId = fun expf expa node -> fun tin -> let bigf = { Visitor_c.default_visitor_c_s with Visitor_c.kname_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 mcode mcode donothing donothing donothing donothing donothing ident expression donothing donothing donothing 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)) (* Now put no constraints on double remove. This is needed for tests/multidecl2: - T i; with int *i, i[12], k; (for symbol i) The positions of the two matches are different because the types end in different places (on * and then on ]) *) (*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 _ -> Printf.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_assignOp (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_assignOp_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_binaryOp (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_binaryOp_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 distribute_mck_exec_code_list (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_exec_code_list_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x let distribute_mck_attrs (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> Visitor_c.vk_attrs_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_assignOp = distrf (Lib_parsing_c.ii_of_assignOp, distribute_mck_assignOp) let distrf_binaryOp = distrf (Lib_parsing_c.ii_of_binaryOp, distribute_mck_binaryOp) 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) let distrf_exec_code_list = distrf (Lib_parsing_c.ii_of_exec_code_list,distribute_mck_exec_code_list) let distrf_attrs = distrf (Lib_parsing_c.ii_of_attrs,distribute_mck_attrs) (* ------------------------------------------------------------------------*) (* 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 (Printf.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_constraints 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); optional_attributes_iso = not(List.mem "optional_attributes" 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 don't 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.4/engine/pattern_c.ml0000644000175000017500000005073312614153277016402 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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; optional_attributes_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 if res2 = [] (*try to avoid a trivial @*) then res1 else res1 @ (res2 +> List.filter (fun (x, binding) -> not (res1 +> 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 l1 @ l2 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 cocciId = fun expf expa node -> fun tin -> (* This is not correct. It should not match type names, ie name defined by a typedef, and it should match struct and enum names, which are currently not names. TODO *) let globals = ref [] in let bigf = { Visitor_c.default_visitor_c with Visitor_c.kname = (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_assignOp = distrf Lib_parsing_c.ii_of_assignOp let distrf_binaryOp = distrf Lib_parsing_c.ii_of_binaryOp 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 let distrf_exec_code_list = distrf Lib_parsing_c.ii_of_exec_code_list let distrf_attrs = distrf Lib_parsing_c.ii_of_attrs (* ------------------------------------------------------------------------*) (* Constraints on metavariable values *) (* ------------------------------------------------------------------------*) 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_constraints matcher constraints term = fun f tin -> if matcher constraints term (function id -> tin.binding0 +> List.assoc id) then f () tin (* success *) else fail tin (* failure *) 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) -> success(Ast_c.MetaIdVal(a)) | Ast_c.MetaAssignOpVal op -> success(Ast_c.MetaAssignOpVal op) | Ast_c.MetaBinaryOpVal op -> success(Ast_c.MetaBinaryOpVal op) | Ast_c.MetaFuncVal a -> success(Ast_c.MetaFuncVal a) | Ast_c.MetaLocalFuncVal a -> success(Ast_c.MetaLocalFuncVal a) (*more?*) | Ast_c.MetaExprVal (a,c,ty) -> (* 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,[],ty)) | 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,ty) -> let stripped = if strip then Lib_parsing_c.al_statement a else Lib_parsing_c.semi_al_statement a in success(Ast_c.MetaStmtVal(stripped,ty)) | Ast_c.MetaStmtListVal(a,ty) -> let stripped = if strip then Lib_parsing_c.al_statement_seq_list a else Lib_parsing_c.semi_al_statement_seq_list a in success(Ast_c.MetaStmtListVal(stripped,ty)) | 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) | Ast_c.MetaNoVal -> None) 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 let optional_attributes_flag f = fun tin -> f (tin.extra.optional_attributes_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); optional_attributes_iso = not(List.mem "optional_attributes" 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.4/engine/cocci_vs_c.ml0000644000175000017500000052675312614153277016527 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 = Ordered 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.whitespace=""}, (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.unwrap_mcode 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.unwrap_mcode 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_fixOp a b = match a, b with | A.Dec, B.Dec -> true | A.Inc, B.Inc -> true | _, (B.Inc|B.Dec) -> 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.MetaAssignOpVal a, Ast_c.MetaAssignOpVal b -> a = b | Ast_c.MetaBinaryOpVal a, Ast_c.MetaBinaryOpVal 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.MetaStmtListVal(a,_), Ast_c.MetaStmtListVal(b,_) -> Lib_parsing_c.al_statement_seq_list a = Lib_parsing_c.al_statement_seq_list 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 | (Ast_c.MetaNoVal, _) | (_, Ast_c.MetaNoVal) -> false | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ |B.MetaStmtListVal _ |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.MetaAssignOpVal _ | B.MetaBinaryOpVal _ |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.MetaAssignOpVal a, Ast_c.MetaAssignOpVal b -> a = b | Ast_c.MetaBinaryOpVal a, Ast_c.MetaBinaryOpVal 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,_,ty1), Ast_c.MetaExprVal (b,_,ty2) -> if ty1 = Ast_c.WITHOUT_TYPES || ty2 = Ast_c.WITHOUT_TYPES then Lib_parsing_c.real_al_expr a = Lib_parsing_c.real_al_expr b else 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,ty1), Ast_c.MetaStmtVal(b,ty2) -> if ty1 = Ast_c.WITHOUT_TYPES || ty2 = Ast_c.WITHOUT_TYPES then Lib_parsing_c.real_al_statement a = Lib_parsing_c.real_al_statement b else Lib_parsing_c.al_inh_statement a = Lib_parsing_c.al_inh_statement b | Ast_c.MetaStmtListVal(a,ty1), Ast_c.MetaStmtListVal(b,ty2) -> if ty1 = Ast_c.WITHOUT_TYPES || ty2 = Ast_c.WITHOUT_TYPES then Lib_parsing_c.real_al_statement_seq_list a = Lib_parsing_c.real_al_statement_seq_list b else Lib_parsing_c.al_inh_statement_seq_list a = Lib_parsing_c.al_inh_statement_seq_list 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 | (Ast_c.MetaNoVal, _) | (_, Ast_c.MetaNoVal) -> false | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _ |B.MetaStmtListVal _ |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.MetaAssignOpVal _ | B.MetaBinaryOpVal _ |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, [iini]), e)) [] 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_assignOp : (A.meta_name A.mcode, B.assignOp) matcher val distrf_binaryOp : (A.meta_name A.mcode, B.binaryOp) 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, F.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_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 distrf_ident_list : (A.meta_name A.mcode, (Ast_c.name, Ast_c.il) either list) matcher val distrf_exec_code_list : (A.meta_name A.mcode, (Ast_c.exec_code, Ast_c.il) either list) matcher val distrf_attrs : (A.meta_name A.mcode, (Ast_c.attribute, Ast_c.il) either list) 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 cocciId : (A.ident, Ast_c.name) matcher -> (A.ident, 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_constraints : ('a -> 'b -> (A.meta_name -> B.metavar_binding_kind) -> 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) val optional_attributes_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 (strs,metas) id env : bool = List.mem id strs || (List.exists (function meta -> match Common.optionise (fun () -> env meta) with Some (Ast_c.MetaIdVal(valu)) -> id = valu | _ -> false) metas) let satisfies_niconstraint (strs,metas) id env : bool = not (List.mem id strs) && (List.for_all (function meta -> match Common.optionise (fun () -> env meta) with Some (Ast_c.MetaIdVal(valu)) -> not(id = valu) | _ -> true) metas) let satisfies_econstraint c exp env : 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) env | 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 env | Ast_c.MultiString strlist -> warning "Unable to apply a constraint on a multistring constant!" | Ast_c.Char (char , _) -> satisfies_regexpconstraint c char env | Ast_c.Int (int , _) -> satisfies_regexpconstraint c int env | Ast_c.Float (float, _) -> satisfies_regexpconstraint c float env | 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 env | _ -> warning "Unable to apply a constraint on an expression!" (* ------------------------------------------------------------------------- *) (* This has to be up here to allow adequate polymorphism *) let match_len infos leninfo = 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()) 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 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 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 -> match_len infos leninfo) (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 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 arithA_of_arithB = function | B.Plus -> A.Plus | B.Minus -> A.Minus | B.Mul -> A.Mul | B.Div -> A.Div | B.Mod -> A.Mod | B.DecLeft -> A.DecLeft | B.DecRight -> A.DecRight | B.And -> A.And | B.Or -> A.Or | B.Xor -> A.Xor | B.Min -> A.Min | B.Max -> A.Max let logicalA_of_logicalB = function | B.Inf -> A.Inf | B.Sup -> A.Sup | B.InfEq -> A.InfEq | B.SupEq -> A.SupEq | B.Eq -> A.Eq | B.NotEq -> A.NotEq | B.AndLog -> A.AndLog | B.OrLog -> A.OrLog let assignOpA_of_assignOpB = function | B.SimpleAssign -> A.SimpleAssign (A.make_mcode "=") | B.OpAssign op -> A.OpAssign (A.make_mcode (arithA_of_arithB op)) let binaryOpA_of_binaryOpB = function | B.Arith op -> A.Arith (A.make_mcode (arithA_of_arithB op)) | B.Logical op -> A.Logical (A.make_mcode (logicalA_of_logicalB op)) let assignOp_eq op1 op2 = match (op1, op2) with | A.SimpleAssign _, A.SimpleAssign _ -> true | A.OpAssign o1, A.OpAssign o2 -> (A.unwrap_mcode o1) = (A.unwrap_mcode o2) | _ -> false let check_assignOp_constraint (opb',ii) = function | A.AssignOpNoConstraint -> true | A.AssignOpInSet ops -> let opb'' = (assignOpA_of_assignOpB opb') in List.exists (assignOp_eq opb'') (List.map A.unwrap ops) let binaryOp_eq op1 op2 = match (op1, op2) with | A.Arith o1, A.Arith o2 -> (A.unwrap_mcode o1) = (A.unwrap_mcode o2) | A.Logical o1, A.Logical o2 -> (A.unwrap_mcode o1) = (A.unwrap_mcode o2) | _ -> false let check_binaryOp_constraint (opb',ii) = function | A.BinaryOpNoConstraint -> true | A.BinaryOpInSet ops -> let opb'' = (binaryOpA_of_binaryOpB opb') in List.exists (binaryOp_eq opb'') (List.map A.unwrap ops) (*---------------------------------------------------------------------------*) let rec (rule_elem_node: (A.rule_elem, F.node) matcher) = fun re 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.GlobalID,e) -> (matches_id e) && (match !opttypb with (Some (_,Ast_c.LocalVar _),_) -> false | _ -> true) | (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 () () -> (* wraps on C code, so has types *) let meta_expr_val l x = Ast_c.MetaExprVal(x,l,Ast_c.WITH_TYPES) in match constraints with Ast_cocci.NoConstraint -> return (meta_expr_val [],()) | Ast_cocci.NotIdCstrt cstrt -> X.check_constraints 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)))) | A.AsSExpr(exp,asstm), expb -> expression exp expb >>= (fun exp expb -> rule_elem_node asstm node >>= (fun asstm _node -> return( ((A.AsSExpr(exp,asstm)) +> 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 (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.unwrap frags1) (B.split_nocomma frags2) >>= (fun frags1unwrap frags2splitted -> let frags1 = A.rewrap frags1 frags1unwrap 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap 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) -> if ii<>[] then failwith "In cocci_vs_c, ii for Assign should be empty." else ( expression ea1 eb1 >>= (fun ea1 eb1 -> assignOp opa opb >>= (fun opa opb -> expression ea2 eb2 >>= (fun ea2 eb2 -> return ( (A.Assignment (ea1, opa, ea2, simple)) +> wa, ((B.Assignment (eb1, opb, eb2), typ), []) ))))) | 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) -> if ii <> [] then failwith "cocci_vs_c: ii should be empty for binary operators." else expression ea1 eb1 >>= (fun ea1 eb1 -> binaryOp opa opb >>= (fun opa opb -> expression ea2 eb2 >>= (fun ea2 eb2 -> return ( ((A.Binary (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[] ))))) | A.Nested (ea1, opa, ea2), eb -> let rec loop eb = expression ea1 eb >|+|> (match eb with ((B.Binary (eb1, opb, eb2), typ),ii) -> if ii<>[] then failwith "cocci_vs_c: ii should be empty for nested operators." else let left_to_right = expression ea1 eb1 >>= (fun ea1 eb1 -> binaryOp opa opb >>= (fun opa opb -> expression ea2 eb2 >>= (fun ea2 eb2 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[] ))))) in let right_to_left = expression ea2 eb1 >>= (fun ea2 eb1 -> binaryOp opa opb >>= (fun opa opb -> expression ea1 eb2 >>= (fun ea1 eb2 -> return ( ((A.Nested (ea1, opa, ea2))) +> wa, ((B.Binary (eb1, opb, eb2), typ),[] ))))) in let in_left = expression ea2 eb2 >>= (fun ea2 eb2 -> binaryOp opa opb >>= (fun opa opb -> (* 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),[] ))))) in let in_right = expression ea2 eb1 >>= (fun ea2 eb1 -> binaryOp opa opb >>= (fun opa opb -> (* 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),[] ))))) 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 [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 [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 _, _ -> raise (Impossible 24) | A.DisjExpr eas, eb -> (* remains inside nests, not sure if this is necessary *) eas +> List.fold_left (fun acc ea -> acc >|+|> (expression ea eb)) fail | A.ConjExpr eas, eb -> let rec loop acc_exp eb = function [] -> return (A.ConjExpr (List.rev acc_exp) +> wa, eb) | e::es -> expression e eb >>= (fun exp eb -> loop (exp::acc_exp) eb es) in loop [] eb eas | A.OptExp e,_ -> Pretty_print_cocci.expression e; Format.print_newline(); failwith (Printf.sprintf "not handling Opt/Multi on expr on line %d" (A.get_line e)) (* 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 _,_),_) | _, ((B.Defined _,_),_) -> 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 (* Allow ... to match nothing. Useful in for loop headers and in array declarations. Put a metavariable to require it to match something. *) and (eoption: (A.expression,B.expression) matcher -> (A.expression option,B.expression option) matcher) = fun f t1 t2 -> match (t1,t2) with (Some t, None) -> (match A.unwrap t with A.Edots(edots,None) -> return (t1,t2) | _ -> option f t1 t2) | _ -> option f t1 t2 and assignOp opa opb = match (A.unwrap opa), opb with A.SimpleAssign a, (B.SimpleAssign, opb') -> let opbi = tuple_of_list1 opb' in tokenf a opbi >>= (fun a opbi -> return (A.rewrap opa (A.SimpleAssign a), (B.SimpleAssign, [opbi]))) | A.OpAssign oa, (B.OpAssign ob,opb') -> if equal_arithOp oa ob then let opbi = tuple_of_list1 opb' in tokenf oa opbi >>= (fun oa opbi_ -> return (A.rewrap opa (A.OpAssign oa), (B.OpAssign ob,[opbi]))) else fail | A.MetaAssign (mv, c, keep, inherited), _ -> if check_assignOp_constraint opb c then begin let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_assignOp opb) in X.envf keep inherited (mv,Ast_c.MetaAssignOpVal opb,max_min) (fun () -> X.distrf_assignOp mv opb) >>= (fun mv opb -> return (A.MetaAssign(mv,c,keep,inherited)+> A.rewrap opa,opb)) end else fail | _ -> fail and binaryOp opa opb = match (A.unwrap opa), opb with A.Arith oa, (B.Arith ob,opb') -> if equal_arithOp oa ob then let opbi = tuple_of_list1 opb' in tokenf oa opbi >>= (fun oa opbi -> return (A.rewrap opa (A.Arith oa), (B.Arith ob,[opbi]))) else fail | A.Logical oa, (B.Logical ob,opb') -> if equal_logicalOp oa ob then let opbi = tuple_of_list1 opb' in tokenf oa opbi >>= (fun oa opbi -> return (A.rewrap opa (A.Logical oa), (B.Logical ob,[opbi]))) else fail | A.MetaBinary (mv, c, keep, inherited), _ -> if check_binaryOp_constraint opb c then begin let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_binaryOp opb) in X.envf keep inherited (mv,Ast_c.MetaBinaryOpVal opb,max_min) (fun () -> X.distrf_binaryOp mv opb) >>= (fun mv opb -> return (A.MetaBinary(mv,c,keep,inherited)+> A.rewrap opa,opb)) end else fail | _ -> 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_constraints 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 if A.unwrap_mcode str1 = str2 then tokenf str1 ib1 >>= (fun str1 ib1 -> return (A.ConstantFormat(str1) +> wa, (B.ConstantFormat(str2),[ib1]))) else fail | 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 exec_code_list eas ebs = let match_dots ea = match A.unwrap ea with A.ExecDots(mcode) -> Some (mcode, None) | _ -> None in let build_dots (mcode,_) = A.ExecDots(mcode) in let match_comma ea = None in let build_comma _ = failwith "no commas" in let match_metalist ea = None in let build_metalist ea (ida,leninfo,keep,inherited) = failwith "no metalist" in let mktermval v = failwith "no metavariables" 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 exec_code X.distrf_exec_code_list B.split_nocomma B.unsplit_nocomma Lib_parsing_c.ii_of_exec_code_list (function x -> Some x) eas ebs and exec_code 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.ExecEval(colon1,id1),B.ExecEval(id2) -> let colon2 = tuple_of_list1 ii in tokenf colon1 colon2 >>= (fun colon1 colon2 -> expression id1 id2 >>= (fun id1 id2 -> return( A.ExecEval(colon1,id1) +> wa, (B.ExecEval(id2),[colon2])))) | A.ExecToken(tok1),B.ExecToken -> let tok2 = tuple_of_list1 ii in tokenf tok1 tok2 >>= (fun tok1 tok2 -> return( A.ExecToken(tok1) +> wa, (B.ExecToken,[tok2]))) | A.ExecDots(dots), eb -> failwith "not possible" | _,_ -> fail (* ------------------------------------------------------------------------- *) 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 = match constraints with A.IdNoConstraint -> return ((),()) | A.IdPosIdSet (str,meta) -> X.check_constraints satisfies_iconstraint (str,meta) idb (fun () -> return ((),())) | A.IdNegIdSet (str,meta) -> X.check_constraints satisfies_niconstraint (str,meta) idb (fun () -> return ((),())) | A.IdRegExpConstraint re -> X.check_constraints satisfies_regexpconstraint re idb (fun () -> return ((),())) 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 () () -> 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, Ast_c.MetaIdVal 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 -> failwith "DisjId should not arise" (* ias +> List.fold_left (fun acc ia -> acc >|+|> (ident infoidb ia ib)) fail *) | A.OptIdent _ -> failwith "not handling Opt 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 _, _ -> failwith "not handling Opt for Param" | _ -> 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 let doit _ = (indexify xs) +> List.fold_left (fun acc (n,var) -> (* consider all possible matches *) acc >||> (function tin -> ( onedecl allminus decla (var, iiptvirgb, iisto) >>= (fun decla (var, iiptvirgb, iisto) -> (* tokenf has to be after the onedecl, because ondecl detects whether there is actually a match and the tokenf should be done *) X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> return ( (mckstart, allminus, decla), (* adjust the variable that was chosen *) (B.DeclList (repln n var 0 xs, iiptvirgb::iifakestart::iisto)) )))) tin)) fail in if !Flag.sgrep_mode2(*X.mode = PatternMode *) || A.get_safe_decl decla then doit() 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 mcode mcode donothing donothing donothing 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 xs +> List.fold_left (fun acc var -> (* consider all possible matches *) (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 (stoa,sa,lpa,eas,rpa,enda), B.MacroDecl ((stob,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 storage_optional_allminus allminus stoa ((stob, false), iistob) >>= (fun stoa ((stob, _), 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap in return ( (mckstart, allminus, (A.MacroDecl (stoa,sa,lpa,eas,rpa,enda)) +> A.rewrap decla), (B.MacroDecl ((stob,sb,ebs,true), [iisb;lpb;rpb;iiendb;iifakestart] @ iistob)) )))))))) | A.MacroDecl (None,sa,lpa,eas,rpa,enda), B.MacroDecl ((B.NoSto,sb,ebs,false),ii) -> (* This is for macrodecls with no semicolons, which come from a parsing rule that deals with function prototypes with no return type. That parsing rule would have a conflict if there were storage, so there is no point to treat the possibility of storage here. *) 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) = (match ii with | [iisb;lpb;rpb;iifakestart] -> (iisb,lpb,rpb,iifakestart) | _ -> raise (Impossible 27)) in 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap in return ( (mckstart, allminus, (A.MacroDecl (None,sa,lpa,eas,rpa,enda)) +> A.rewrap decla), (B.MacroDecl ((B.NoSto,sb,ebs,false), [iisb;lpb;rpb;iifakestart])) )))))) | _ -> fail) | A.MacroDeclInit (stoa,sa,lpa,eas,rpa,weqa,inia,enda), B.MacroDeclInit ((stob,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 storage_optional_allminus allminus stoa ((stob, false), iistob) >>= (fun stoa ((stob, _), 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.unwrap eas) ebs >>= (fun easunwrap ebs -> initialiser inia inib >>= (fun inia inib -> let eas = A.rewrap eas easunwrap in return ( (mckstart, allminus, (A.MacroDeclInit(stoa,sa,lpa,eas,rpa,weqa,inia,enda)) +> A.rewrap decla), (B.MacroDeclInit ((stob,sb,ebs,inib), [iisb;lpb;rpb;iiendb;iifakestart] @ iistob)) )))))))))) | A.MacroDeclInit (stoa,sa,lpa,eas,rpa,weqa,inia,enda), _ -> fail | _, (B.MacroDecl _ |B.MacroDeclInit _ |B.DeclList _) -> fail and annotated_decl decla declb = match A.unwrap decla with A.Ddots _ -> failwith "not possible" | A.DElem(mckstart, allminus, decl) -> declaration (mckstart, allminus, decl) declb >>= fun (mckstart, allminus, decl) declb -> return (A.DElem(mckstart, allminus, decl) +> A.rewrap decla, declb) 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 (Printf.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.unwrap declsa) declsb >>= (fun undeclsa declsb -> let declsa = A.rewrap 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 *) | A.FunProto(fninfoa,ida,lpa,paramsa,va,rpa,sema), ({B.v_namei = Some (idb, B.NoInit); B.v_type = ((({B.const = false; B.volatile = false},[]) as q), (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), ii)); B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg) -> (match (va,isvaargs) with | (None,false) -> return (va,(isvaargs, iidotsb)) | (Some (commaa, dotsa), true) -> let (commab, dotsb) = tuple_of_list2 iidotsb in tokenf commaa commab >>= (fun commaa commab -> tokenf dotsa dotsb >>= (fun dotsa dotsb -> return (Some(commaa,dotsa), (true,[commab;dotsb])) )) | _ -> fail ) >>= (fun va (isvaargs, iidotsb) -> let (lpb, rpb) = tuple_of_list2 ii in tokenf lpa lpb >>= (fun lpa lpb -> tokenf rpa rpb >>= (fun rpa rpb -> tokenf sema iiptvirgb >>= (fun sema iiptvirgb -> ident_cpp DontKnow ida idb >>= (fun ida idb -> let (stoa,tya,inla,attras) = get_fninfo fninfoa in inline_optional_allminus allminus inla (stob, iistob) >>= (fun inla (stob, iistob) -> storage_optional_allminus allminus stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> attribute_list attras attrs >>= (fun attras attrs -> fullType_optional_allminus allminus tya tyb >>= (fun tya tyb -> let fninfoa = put_fninfo stoa tya inla attras in parameters (seqstyle paramsa) (A.unwrap paramsa) paramsb >>= (fun paramsaunwrap paramsb -> let paramsa = A.rewrap paramsa paramsaunwrap in return ( (A.FunProto(fninfoa,ida,lpa,paramsa,va,rpa,sema) +> A.rewrap decla, (({B.v_namei = Some (idb, B.NoInit); B.v_type = (q, (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), [lpb; rpb])); B.v_storage = stob; B.v_local = local; B.v_attr = attrs; B.v_type_bis = typbbis; }, iivirg), iiptvirgb, iistob)))) ))))))))) (* 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 -> failwith "DisjDecl should not arise" (* declas +> List.fold_left (fun acc decla -> acc >|+|> (* (declaration (mckstart, allminus, decla) declb) *) (onedecl allminus decla (declb,iiptvirgb, iistob)) ) fail *) | A.OptDecl _, _ -> failwith "not handling Opt Decl" | _, ({B.v_namei=Some _}, _) -> fail and get_fninfo fninfoa = (* 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 let attras = match List.filter (function A.FAttr(a) -> true | _ -> false) fninfoa with [] -> None | _ -> failwith "matching of attributes not supported" (* The following provides matching of one attribute against one attribute. But the problem is that in the C ast there are no attributes in the attr field. The attributes are all comments. So there is nothing to match against. *) (* [A.FAttr(a)] -> Some [A.FAttr(a)] | [] -> None | _ -> failwith "only one attr match allowed" *) in (stoa,tya,inla,attras) and put_fninfo stoa tya inla attras = (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 -> []) @ (match attras with Some a -> a | None -> []) (* ------------------------------------------------------------------------- *) 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 (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.unwrap ias) (ibs, iicommaopt) >>= (fun iasunwrap (ibs,iicommaopt) -> return ( (A.ArInitList (ia1, A.rewrap ias iasunwrap, 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.OptIni _,_ -> failwith "not handling Opt 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 (* need unordered is to check if an expensive computation is useful, but if ias is null, then the computation is not expensive *) if ias = [] || 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.annotated_decl 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.DElem(mckstart,allminus,d) -> (match A.unwrap d with A.MetaFieldList(ida,leninfo,keep,inherited) -> Some(ida,leninfo,keep,inherited,None) | _ -> None) | _ -> None in let build_metalist ea (ida,leninfo,keep,inherited) = match A.unwrap ea with A.DElem(mckstart,allminus,d) -> A.DElem(mckstart,allminus, (A.rewrap ea (A.MetaFieldList(ida,leninfo,keep,inherited)))) | _ -> failwith "not possible" 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.annotated_decl, B.field) matcher) = fun fa fb -> match A.unwrap fa with A.Ddots _ -> failwith "dots should be treated otherwise" | A.DElem(mckstart,allminus,ifa) -> (match A.unwrap ifa,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.DElem (mckstart,allminus, (A.MetaField (ida, keep, inherited))+> A.rewrap ifa) +> A.rewrap fa, fb)) | _,B.DeclarationField (B.FieldDeclList ([onevar,iivirg],iiptvirg)) -> (* no modif possible on iistartb; included for parallelism with DeclList *) let (iiptvirgb,iifakestart) = tuple_of_list2 iiptvirg in assert (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) -> X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> (* build a declaration from a struct field *) let (fake_var,iisto) = build_decl nameidb typb iivirg in onedecl allminus ifa (fake_var,iiptvirgb,iisto) >>= (fun ifa (fake_var,iiptvirgb,iisto) -> let (onevar,iivirg) = unbuild_decl fake_var in return ( (A.DElem(mckstart,allminus,ifa) +> A.rewrap fa), ((B.DeclarationField (B.FieldDeclList([onevar, iivirg], [iiptvirgb;iifakestart])))))))) | _,B.DeclarationField (B.FieldDeclList (xs,iiptvirg)) -> let (iiptvirgb,iifakestart) = tuple_of_list2 iiptvirg in 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 let doit _ = (indexify xs) +> List.fold_left (fun acc (n,(onevar,iivirg)) -> (* consider all possible matches *) acc >||> (X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart -> (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 (fake_var,iisto) = build_decl nameidb typb iivirg in onedecl allminus ifa (fake_var,iiptvirgb,iisto) >>= (fun ifa (fake_var,iiptvirgb,iisto) -> let (onevar,iivirg) = unbuild_decl fake_var in return ( (A.DElem(mckstart,allminus,ifa) +> A.rewrap fa), ((B.DeclarationField (B.FieldDeclList (repln n (onevar,iivirg) 0 xs, [iiptvirgb;iifakestart])))))))))) fail in if !Flag.sgrep_mode2(*X.mode = PatternMode *) || A.get_safe_decl ifa then doit() else begin (* unambitious version of the DeclList case... *) pr2_once "PB: More that one variable in decl. Have to split"; fail end | _,B.EmptyField _iifield -> fail | A.MacroDecl (stoa,bsa,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 build_decl nameidb typb iivirg = 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 (fake_var,iisto) and unbuild_decl = function ({B.v_namei = Some (nameidb, B.NoInit); B.v_type = typb; B.v_storage = stob; }, iivirg) -> let onevar = B.Simple (Some nameidb, typb) in (onevar,iivirg) | _ -> raise (Impossible 40) (* ---------------------------------------------------------------------- *) 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) -> let assignOp opa0 opbi = match A.unwrap opa0 with A.SimpleAssign oa -> tokenf oa opbi >>= fun oa opbi -> return (A.rewrap opa (A.SimpleAssign oa), opbi) | _ -> failwith "only simple assignment possible here" in ident_cpp DontKnow id nameidb >>= (fun id nameidb -> expression ea2 eb2 >>= (fun ea2 eb2 -> assignOp 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(_), _ -> failwith "not handling Opt 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.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.unwrap paramsa) paramsb >>= (fun paramsaunwrap paramsb -> let paramsa = A.rewrap paramsa paramsaunwrap 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 -> eoption 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.unwrap declsa) declsb >>=(fun undeclsa declsb -> let declsa = A.rewrap 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 (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.unwrap idsa) idsb >>= (fun unidsa idsb -> let idsa = A.rewrap 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) ) (* Works for many attributes, but assumes order will be preserved. Looks for an exact match. Actually the call site only allows a list of length one to come through. Makes no requirement if attributes not present. *) (* The following is the intended version, on lists. Unfortunately, this requires SmPL attributes to be wrapped. Which they are not, for some reason. *) (* and attribute_list attras attrbs = X.optional_attributes_flag (fun optional_attributes -> match attras with None -> return (None, attrbs) | Some attras -> let match_dots ea = None in let build_dots (mcode, optexpr) = failwith "not possible" in let match_comma ea = None in let build_comma ia1 = failwith "not posible" 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 attribute X.distrf_attrs B.split_nocomma B.unsplit_nocomma no_ii (function x -> Some x) attras attrbs >>= (fun attras attrbs -> return (Some attras, attrbs))) *) (* The cheap hackish version. No wrapping requires... *) and attribute_list attras attrbs = X.optional_attributes_flag (fun optional_attributes -> match attras,attrbs with None, _ -> return (None, attrbs) | Some [attra], [attrb] -> attribute attra attrb >>= (fun attra attrb -> return (Some [attra], [attrb]) ) | Some [attra], attrb -> fail | _ -> failwith "only one attribute allowed in SmPL") and attribute = fun ea eb -> match ea, eb with (A.FAttr attra), (B.Attribute attrb, ii) when (A.unwrap_mcode attra) = attrb -> let ib1 = tuple_of_list1 ii in tokenf attra ib1 >>= (fun attra ib1 -> return ( A.FAttr attra, (B.Attribute attrb, [ib1]) )) | _ -> fail (*---------------------------------------------------------------------------*) 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 _, _ -> failwith "handling Opt for define parameters" | _ -> fail in (*****************************************************************************) (* 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, F.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 F.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,Ast_c.WITH_TYPES), 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 ) | A.MetaStmtList (ida,leninfo,keep,inherited), unwrap_node -> (* todo: should not happen in transform mode *) (match F.extract_fullstatement node with | Some (B.Compound stb,_) -> match_len stb leninfo (fun _ -> let max_min _ = Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_stmtseqlist stb) in X.envf keep inherited (ida, Ast_c.MetaStmtListVal(stb,Ast_c.WITH_TYPES), max_min) (fun () -> (* no need tag ida, we can't be called in transform-mode *) return ( A.MetaStmtList (ida, leninfo, keep, inherited), unwrap_node ))) | _ -> fail ) | 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.TopId id, nodeb -> X.cocciId (ident_cpp DontKnow) id node >>= (fun id node -> return ( A.TopId id, 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, va, 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 (body = []); if oldstyle <> None then pr2 "OLD STYLE DECL NOT WELL SUPPORTED"; let (stoa,tya,inla,attras) = get_fninfo fninfoa in (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.unwrap paramsa) paramsb >>= (fun paramsaunwrap paramsb -> let paramsa = A.rewrap paramsa paramsaunwrap in inline_optional_allminus allminus inla (stob, iistob) >>= (fun inla (stob, iistob) -> storage_optional_allminus allminus stoa (stob, iistob) >>= (fun stoa (stob, iistob) -> attribute_list attras attrs >>= (fun attras attrs -> ( 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 = put_fninfo stoa tya inla attras in return ( A.FunHeader(mckstart,allminus,fninfoa,ida,oparen, paramsa,va,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 decla, F.Decl declb -> annotated_decl decla declb >>= (fun decla declb -> return ( A.Decl 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, [ib1])) -> (* ia1/ib1 represents a ; *) tokenf ia1 ib1 >>= (fun ia1 ib1 -> return ( A.ExprStatement (None, ia1), F.ExprStatement (st, (None, [ib1])) ) ) | _, F.ExprStatement (st, (None, [])) -> (* This case occurs when we have eg nothing after a switch label and so there is no semicolon. Indeed, there is no match, so any match against this fails. *) fail | 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap 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 (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 -> eoption expression ea1opt eb1opt >>= (fun ea1opt eb1opt -> return (A.ForExp(ea1opt, ia3),B.ForExp(eb1opt,[ib3])))) | (A.ForDecl decla,B.ForDecl declb) -> annotated_decl decla declb >>= (fun decla declb -> return ( A.ForDecl 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 -> eoption expression ea2opt eb2opt >>= (fun ea2opt eb2opt -> eoption 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),fromswitch) -> 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]), fromswitch) ))) | 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap 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.unwrap eas) ebs >>= (fun easunwrap ebs -> let eas = A.rewrap eas easunwrap in return ( A.PragmaTuple(lp,eas,rp) +> wp, B.PragmaTuple(ebs,[ib1; ib2]) )))) | A.PragmaIdList(idsa), B.PragmaIdList(idsb) -> ident_list (A.unwrap idsa) idsb >>= (fun idsaunwrap idsb -> let idsa = A.rewrap idsa idsaunwrap 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])) )))) | A.Exec(exec,lang,code,sem), F.Exec(st,(code2,ii)) -> let (exec2,lang2,sem2) = tuple_of_list3 ii in tokenf exec exec2 >>= (fun exec exec2 -> tokenf lang lang2 >>= (fun lang lang2 -> tokenf sem sem2 >>= (fun sem sem2 -> exec_code_list (A.unwrap code) (B.split_nocomma code2) >>= (fun code_unwrap code2_splitted -> let code = A.rewrap code code_unwrap in let code2 = Ast_c.unsplit_nocomma code2_splitted in return( A.Exec(exec,lang,code,sem), F.Exec(st,(code2,[exec2;lang2;sem2]))))))) | (A.AsRe(re,asre), b) -> rule_elem_node re node >>= (fun re _node -> rule_elem_node asre node >>= (fun asre _node -> return( (A.AsRe(re,asre),b)))) (* 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.IfdefIteHeader _ -> 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.Exec _| 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.4/engine/cocci_vs_c.mli0000644000175000017500000002133512614153277016662 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (*****************************************************************************) (* 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_assignOp : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.assignOp) matcher val distrf_binaryOp : (Ast_cocci.meta_name Ast_cocci.mcode, Ast_c.binaryOp) 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_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 val distrf_ident_list : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.name, Ast_c.il) Common.either list) matcher val distrf_exec_code_list : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.exec_code, Ast_c.il) Common.either list) matcher val distrf_attrs : (Ast_cocci.meta_name Ast_cocci.mcode, (Ast_c.attribute, Ast_c.il) Common.either list) 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 cocciId : (Ast_cocci.ident, Ast_c.name) matcher -> (Ast_cocci.ident, 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_constraints : ('a -> 'b -> (Ast_cocci.meta_name -> Ast_c.metavar_binding_kind) -> 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) val optional_attributes_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 (* there are far more functions in this functor but they do not have * to be exported *) end coccinelle-1.0.4/engine/ctlcocci_integration.mli0000644000175000017500000000174112614153277020755 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/flag_engine.ml0000644000175000017500000000112512614153277016650 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/asttoctl2.mli0000644000175000017500000000143412614153277016505 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/transformation_c.mli0000644000175000017500000000104512614153277020134 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/engine/externalanalysis.mli0000644000175000017500000000270312614153277020154 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/postprocess_transinfo.mli0000644000175000017500000000140712614153277021235 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/ctlcocci_integration.ml0000644000175000017500000004725512614153277020616 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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);; type vp = SUCCESS_POS | FAIL_POS | NOPOS let valid_positions binding = function Lib_engine.Match re -> let vars = re.Ast_cocci.positive_inherited_positions in (match vars with [] -> NOPOS | _ -> let res = List.for_all (function v -> try let b = List.assoc v binding in match b with Ast_c.MetaPosValList l -> List.exists (function (_,elem,_,_) -> !Flag.current_element = elem) l | _ -> failwith "position variable should have a position binding" with Not_found -> false) vars in if res then SUCCESS_POS else FAIL_POS) | _ -> NOPOS (* 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 loop_nodes p check nodes = List.fold_left (fun prev (nodei,node) -> if check node then (nodei, (p,[])) :: prev else prev) [] nodes let labels_for_ctl (dropped_isos : string list) (nodes : (nodei * F.node) list) (binding : Lib_engine.metavars_binding) p = show_or_not_predicate p; let nodes' = nodes +> match p with | Lib_engine.Match (re) -> List.fold_left (fun prev (nodei,node) -> Pattern_c.match_re_node dropped_isos re node binding +> List.fold_left (fun prev (re', subst) -> let p' = Lib_engine.Match (re') in (nodei, (p', subst +> List.map (fun (s, meta) -> s --> Lib_engine.NormalMetaVal meta))) :: prev) prev) [] | Lib_engine.Paren s -> List.fold_left (fun prev (nodei,node) -> match F.unwrap node with F.SeqStart (_, bracelevel, _) -> let make_var x = ("",string_of_int x) in let vl = Lib_engine.ParenVal (make_var bracelevel) in (nodei, (p,[(s --> vl)])) :: prev | F.SeqEnd (bracelevel, _) -> let make_var x = ("",string_of_int x) in let vl = Lib_engine.ParenVal (make_var bracelevel) in (nodei, (p,[(s --> vl)])) :: prev | _ -> prev) [] | Lib_engine.Label s -> List.map (function (nodei,node) -> let labels = F.extract_labels node in let vl = Lib_engine.LabelVal (Lib_engine.Absolute labels) in (nodei, (p,[(s --> vl)]))) | Lib_engine.BCLabel s -> List.fold_left (fun prev (nodei,node) -> match F.extract_bclabels node with [] -> (* null for all nodes that are not break or continue *) prev | labels -> let vl = Lib_engine.LabelVal (Lib_engine.Absolute labels) in (nodei, (p,[(s --> vl)]))::prev) [] | Lib_engine.PrefixLabel s -> List.map (function (nodei,node) -> let labels = F.extract_labels node in let vl = Lib_engine.LabelVal (Lib_engine.Prefix labels) in (nodei, (p,[(s --> vl)]))) | Lib_engine.InLoop -> loop_nodes p (function node -> match F.unwrap node with F.InLoopNode -> true | _ -> false) | Lib_engine.TrueBranch -> loop_nodes p (function node -> match F.unwrap node with F.TrueNode _ -> true | _ -> false) | Lib_engine.EscTrueBranch -> loop_nodes p (function node -> match F.unwrap node with F.TrueNode esc when !esc -> true | _ -> false) | Lib_engine.FalseBranch -> loop_nodes p (function node -> match F.unwrap node with F.FalseNode -> true | _ -> false) | Lib_engine.After -> loop_nodes p (function node -> match F.unwrap node with F.AfterNode _ -> true | _ -> false) | Lib_engine.FallThrough -> loop_nodes p (function node -> match F.unwrap node with F.FallThroughNode -> true | _ -> false) | Lib_engine.LoopFallThrough -> loop_nodes p (function node -> match F.unwrap node with F.LoopFallThroughNode -> true | _ -> false) | Lib_engine.FunHeader -> loop_nodes p (function node -> match F.unwrap node with F.FunHeader _ -> true | _ -> false) | Lib_engine.Top -> loop_nodes p (function node -> match F.unwrap node with F.TopNode -> true | _ -> false) | Lib_engine.Exit -> loop_nodes p (function node -> match F.unwrap node with F.Exit -> true | _ -> false) | Lib_engine.ErrorExit -> loop_nodes p (function node -> match F.unwrap node with F.ErrorExit -> true | _ -> false) | Lib_engine.Goto -> loop_nodes p (function node -> match F.unwrap node with F.Goto _ -> true | _ -> false) | Lib_engine.Return -> loop_nodes p (function node -> (* todo? should match the Exit code ? * todo: one day try also to match the special function * such as panic(); *) match F.unwrap node with | F.Return _ -> true | F.ReturnExpr _ -> true | _ -> false) | Lib_engine.FakeBrace -> loop_nodes p F.extract_is_fake | Lib_engine.BindGood s -> List.map (function (nodei,_) -> (nodei, (p,[(s --> Lib_engine.GoodVal)]))) | Lib_engine.BindBad s -> List.map (function (nodei,_) -> (nodei, (p,[(s --> Lib_engine.BadVal)]))) | Lib_engine.UnsafeBrace -> (* cases where it it not safe to put something on the outer side of braces *) List.fold_left (fun prev (nodei,node) -> match F.unwrap node with F.FunHeader _ | F.DoHeader _ | F.TrueNode _ | F.Else _ | F.InLoopNode (* while, for *) | F.SwitchHeader _ -> (nodei, (p,[])) :: prev | _ -> prev) [] in show_or_not_nodes nodes'; nodes' let quick_labels_for_ctl dropped_isos nodes binding p = show_or_not_predicate p; match valid_positions binding p with SUCCESS_POS -> true | FAIL_POS -> false | NOPOS -> (match p with Lib_engine.Match (re) -> List.exists (function (_,node) -> not (Pattern_c.match_re_node dropped_isos re node binding = [])) nodes | _ -> true) (*****************************************************************************) (* 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 has 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 (flow : F.cflow) : F.cflow = 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 ((!g#successors errornodei)#tolist) = [] && ((!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 quicklabels = quick_labels_for_ctl dropped_isos (newflow#nodes#tolist) binding in let states = List.map fst newflow#nodes#tolist in newflow, labels, quicklabels, 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)) || ((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 (string_of_int 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.fold_left (function prev -> function (_,Ast_c.MetaPosValList l) -> l@prev | _ -> 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,ty) -> Ast_c.MetaExprVal(Lib_parsing_c.al_inh_expr a,c,ty) | Ast_c.MetaExprListVal a -> Ast_c.MetaExprListVal(Lib_parsing_c.al_inh_arguments a) | Ast_c.MetaStmtVal(a,ty) -> Ast_c.MetaStmtVal(Lib_parsing_c.al_inh_statement a,ty) | 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 (*****************************************************************************) (* 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, preproc, states) as m) 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 m ctl (used_after, binding2) 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.nub (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 = Common.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.4/engine/isomorphisms_c_c.ml0000644000175000017500000000320012614153277017746 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/ctltotex.mli0000644000175000017500000000052012614153277016427 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val totex : string -> Ast_cocci.rule list -> (Lib_engine.ctlcocci * 'a) list list -> unit coccinelle-1.0.4/engine/asttoctl.mli0000644000175000017500000000105612614153277016423 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/flag_matcher.ml0000644000175000017500000000141012614153277017023 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/check_exhaustive_pattern.ml0000644000175000017500000001342412614153277021476 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.TopId id -> () | A.TopInit init -> () | A.FunHeader (bef,allminus, fninfo, ida, _, paramsa, _, _) -> () | A.Decl decl -> () | 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.Exec(_,_,_,_) -> () | A.DefineHeader _ -> () | A.Undef _ -> () | A.Pragma _ -> () | A.Include _ -> () | A.Default _ -> () | A.Case _ -> () | A.AsRe _ -> () | 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.FunProto _ -> () | A.TyDecl (typa, _) -> () | A.MacroDecl(stg, fn, _, eas, _, _) -> () | A.MacroDeclInit(stg, fn, _, eas, _, _, _, _) -> () | A.MetaDecl _ -> () | A.MetaField _ -> () | A.MetaFieldList _ -> () | A.AsDecl _ -> () | A.Typedef(d,ty1,ty2,pv) -> () | A.DisjDecl xs -> () | A.OptDecl _ -> () 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.FunProto _ -> () | A.MacroDecl(_, fn, _, eas, _, _) -> () | A.MacroDeclInit(_, fn, _, eas, _, _, _, _) -> () | A.TyDecl(ty,sem) -> () | A.Typedef(d,ty1,ty2,pv) -> () | A.DisjDecl(decls) -> () | A.MetaDecl(name,_,_) -> () | A.MetaField(name,_,_) -> () | A.MetaFieldList(name,_,_,_) -> () | A.AsDecl(_,_) -> () | A.OptDecl(decl) -> () let dumb_astcocci_expr = function | A.MetaExpr (ida,_,_, opttypa, _, _) -> () | A.AsExpr (_,_) -> () | A.AsSExpr (_,_) -> () | 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.DisjExpr eas -> () | A.ConjExpr eas -> () | A.OptExp _ -> () let dumb_astcocci_fulltype = function A.Type(_,cv,ty) -> () | A.AsType(_,_) -> () | A.DisjType(types) -> () | A.OptType(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.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.4/engine/pretty_print_engine.ml0000644000175000017500000001231212614153277020502 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.MetaAssignOpVal op -> pp "meta assign op "; Pretty_print_c.pp_assignOp_simple op | Ast_c.MetaBinaryOpVal op -> pp "meta binary op "; Pretty_print_c.pp_binaryOp_simple op | 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.MetaStmtListVal (statxs,_) -> Pretty_print_c.pp_statement_seq_list_simple statxs | 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 (Printf.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2)) | Ast_c.MetaPosValList l -> pp (Printf.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))) | Ast_c.MetaNoVal -> pp "no value" 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" | EscTrueBranch -> pp "EscTrueBranch" | 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.4/engine/asttoctl2.ml0000644000175000017500000030515312614153277016341 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 esctruepred = predmaker false (Lib_engine.EscTrueBranch, 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 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 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 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 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 [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 [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(_,_,_,w,_,_,_);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 "...",w,[],[]) in [d1;rw(Ast.Disj [rwd [stm]; {(Ast.make_term [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 let l = Ast.unwrap d in Ast.rewrap d (dots_list (List.map Ast.unwrap l) l) in V.rebuilder mcode mcode 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 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 n d fvinfo = let nm = fresh_metavar() in Ast.make_meta_rule_elem (nm^n) 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 || 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 annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,va,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl decl -> bind (mcode r ((),(),annotated_decl decl,[])) res | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (mcode r ((),(),annotated_decl decl,[])) res | _ -> res in let init r k i = let res = k i in match Ast.unwrap i with Ast.StrInitList(allminus,_,_,_,_) -> allminus || res | _ -> res in let recursor = V.combiner bind option_default mcode 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 init do_nothing 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 || 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 annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,va,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl decl -> bind (mcode r ((),(),annotated_decl decl,[])) res | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (mcode r ((),(),annotated_decl decl,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode 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 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 mcode mcode donothing donothing donothing 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 = let x = Ast.unwrap sl in 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 l,a) 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 [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.Conj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_before e a) stmt_dots_list) in (Ast.rewrap s (Ast.Conj(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,aft) -> let (bd,_) = get_before body [] in (Ast.rewrap s (Ast.FunDecl(header,lbrace,bd,rbrace,aft)),[]) | _ -> Pretty_print_cocci.statement "" s; Format.print_newline(); failwith "get_before_e: not supported" let rec get_after sl a = let x = Ast.unwrap sl in 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 l,a) 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 [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.Conj(stmt_dots_list) -> let (dsl,dsla) = List.split (List.map (function e -> get_after e a) stmt_dots_list) in (Ast.rewrap s (Ast.Conj(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.unwrap 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,aft) -> let (bd,_) = get_after body [] in (Ast.rewrap s (Ast.FunDecl(header,lbrace,bd,rbrace,aft)),[]) | _ -> 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_bis preok stmt_list = let l = Ast.unwrap stmt_list in let contains_dots l = List.exists (function s -> (* doesn't do anything for dots in disj; not sure that makes sense *) match Ast.unwrap s with Ast.Nest _ | Ast.Dots _ -> true | _ -> false) l in let preok = preok || contains_dots l in match List.rev l 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 preok && loop x | Ast.Disj(disjs) -> List.for_all (ends_in_return_bis preok) disjs | Ast.Conj(disjs) -> List.exists (ends_in_return_bis preok) disjs | _ -> false) | _ -> false let ends_in_return stmt_list = ends_in_return_bis false stmt_list (* --------------------------------------------------------------------- *) (* 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 | Ast.TopId(i)::rest -> exptymatch res make_match make_guard_match | all -> if List.exists (function Ast.Exp(_) | Ast.Ty(_) | Ast.TopId(_) -> 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 "1" 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 || after = End || 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 "2" 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 "3" 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 (esctruepred 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 (aftpred None) (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 get_quantifier whencodes = let check_quantifier whencodes 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 if check_quantifier whencodes Ast.WhenExists Ast.WhenForall then Exists else if check_quantifier whencodes Ast.WhenForall Ast.WhenExists then Forall else !exists 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 quantifier = get_quantifier whencodes 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 let exists_without_after = if quantifier = Exists then (ctl_not (aftpred None)) else CTL.True in plus_modifier (dots_au is_strict ((after = Tail) || (after = VeryEnd)) label (guard_to_strict guard) wrapcode just_nest (ctl_and_ns exists_without_after (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 _ | Ast.Conj _ -> true | _ -> false in let compute_label l e db = if db || isdots e then l else None in let x = Ast.unwrap stmt_list in 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) (* 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(_) | Ast.TopId(_) -> 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.unwrap 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 let real_code = (* takes into account whencode (A/E) *) (quantify guard b2fvs (statement_list body NotTop Tail new_quantified2 new_mquantified2 None(*no label because past the goto*) llabel slabel false guard)) in let switch_needed = (* if real code starts with ... with eg when forall, will need to switch the quantifier chosen by make_seq *) match find_xx real_code with Some _ -> fun phi -> CTL.XX phi | None -> fun phi -> phi in quantify true [pv;lv] (quantify guard b1fvs (make_seq [start_brace; switch_needed (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))))) real_code)])) 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.Conj(stmt_dots_list) -> (* list shouldn't be empty *) (*ctl_and seems pointless, disjuncts see label too (label_pred_maker label)*) let allfvs = List.map Ast.get_fvs stmt_dots_list in let sharedfvs = List.concat (List.map snd (seq_fvs quantified allfvs)) in let quantified = Common.union_set sharedfvs quantified in 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 quantify guard sharedfvs (List.fold_left ctl_and CTL.True 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 "4" 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 "5" 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.unwrap 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.unwrap 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.unwrap 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,(afvs,afresh,ainh,aft)) -> (* what to do with afvs??? *) let (aafvs,ahfvs,hfvs,b1fvs,lbfvs,b2fvs,b3fvs,rbfvs) = match seq_fvs quantified [afvs;Ast.get_fvs header;Ast.get_fvs lbrace; Ast.get_fvs body;Ast.get_fvs rbrace] with [(afvs,ahfvs);(hfvs,b1fvs);(lbfvs,b2fvs);(_,b3fvs);(rbfvs,_)] -> (afvs,ahfvs,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. see 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.unwrap body, contains_modif rbrace || 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 quantifier = get_quantifier whencode in let op = if quantifier = !exists then ctl_au else ctl_anti_au CTL.NONSTRICT in 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 let leftarg = if quantifier = Exists then ctl_and (ctl_not (aftpred None)) leftarg else leftarg in op leftarg (ctl_and (make_match stripped_rbrace) paren_pred)])) | _ -> None) | _ -> None in let optim2 = (* function body is all minus, no whencode *) match Ast.unwrap 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 "6" 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 let function_header = match aft with Ast.CONTEXT(_,Ast.NOTHING) -> function_header | _ -> let match_ender = quantify guard aafvs (* vars needed only for ender *) (ctl_and (endpred label) (ctl_back_ex (make_match (make_meta_rule_elem "7" aft (afvs,afresh,ainh))))) in CTL.AndAny(CTL.FORWARD,CTL.NONSTRICT,function_header, ctl_or (ctl_not (endpred label)) match_ender) in quantify guard ahfvs (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" | _ -> failwith "not supported" in if guard || !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.unwrap stmt_dots with d::ds -> (match Ast.unwrap d with Ast.Dots(_,_,_,_) -> 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.unwrap stmt_dots with d::ds -> (match Ast.unwrap d with Ast.Seq(before,body,after) -> let rec beforemc before = match Ast.unwrap before with Ast.SeqStart(obr) -> Ast.get_mcodekind obr | Ast.AsRe(before,_) -> beforemc before | _ -> failwith "bad seq" in let rec aftermc after = match Ast.unwrap after with Ast.SeqEnd(cbr) -> Ast.get_mcodekind cbr | Ast.AsRe(after,_) -> aftermc after | _ -> failwith "bad seq"in (match (beforemc before,aftermc after) 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.unwrap 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 mcode mcode donothing donothing donothing 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 and find_xx = function CTL.Exists(keep,v,phi) -> (match find_xx phi with Some(k,phi1) -> Some((fun phi -> CTL.Exists(keep,v,k phi)),phi1) | None -> None) | CTL.XX(phi) -> Some((fun phi -> phi),phi) | _ -> None (* --------------------------------------------------------------------- *) (* 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,phi1) -> (match find_xx phi1 with Some _ -> CTL.EX(dir,cleanup phi1) | None -> CTL.AX(dir,s,cleanup phi1)) | CTL.EX(dir,phi) -> (match find_xx phi with Some (k,phi) -> let phi = cleanup phi in (match phi with CTL.AU(_,s,_,_) -> CTL.AX(dir,s,k phi) | CTL.AF(_,s,_) -> CTL.AX(dir,s,k phi) | CTL.And(s,_,_) -> CTL.AX(dir,s,k phi) (* branches must be AU/AF *) | _ -> failwith "not possible") | None -> CTL.EX(dir,cleanup phi)) | CTL.XX(phi) -> failwith "bad XX" | CTL.AG(dir,s,phi1) -> CTL.AG(dir,s,cleanup phi1) | CTL.EF(dir,phi1) -> CTL.EF(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.4/engine/check_reachability.mli0000644000175000017500000000131712614153277020363 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/asttomember.mli0000644000175000017500000000057612614153277017116 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/main.ml0000644000175000017500000000155412614153277015344 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ----------------------------------------------------------------------- *) (* 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.4/engine/externalanalysis.ml0000644000175000017500000002122512614153277020003 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/engine/tests/0000755000175000017500000000000012614153277015223 5ustar eugeneugencoccinelle-1.0.4/engine/tests/test10000644000175000017500000000411012614153277016202 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.4/engine/tests/Makefile0000644000175000017500000000025612614153277016666 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.4/engine/tests/test1.tex0000644000175000017500000004777212614153277017026 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.4/engine/c_vs_c.ml0000644000175000017500000002315212614153277015652 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/engine/Makefile0000644000175000017500000000605312614153277015525 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr ############################################################################## # 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) $(INCLUDES) OCAMLMKTOP_CMD=$(OCAMLMKTOP) -g -custom $(INCLUDES) OBJS = $(SRC:.ml=.cmo) OPTOBJS = $(SRC:.ml=.cmx) ############################################################################## # Top rules ############################################################################## 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 ############################################################################## # 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 .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/engine/postprocess_transinfo.ml0000644000175000017500000001243512614153277021067 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/engine/asttomember.ml0000644000175000017500000002756312614153277016752 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 || y in let option_default = false in let do_nothing r k e = k e in let annotated_decl_bef decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,va,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl decl -> bind (mcode r ((),(),annotated_decl_bef decl,[])) res | Ast.ForHeader(fr,lp,Ast.ForDecl decl,e2,sem2,e3,rp) -> bind (mcode r ((),(),annotated_decl_bef decl,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode 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 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 || 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 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 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" (Dumper.dump thing.Ast.positive_inherited_positions); 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 let inh_pos = Ast.get_inherited_pos e in Ast.make_inherited_term (Ast.unwrap (k e)) inh inh_pos 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 annotated_decl no_mcode decl = match Ast.unwrap decl with Ast.DElem(bef,allminus,d) -> Ast.rewrap decl (Ast.DElem(no_mcode,allminus,d)) | _ -> failwith "not possible" 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,va,rp) -> Ast.rewrap res (Ast.FunHeader(no_mcode,b,fninfo,name,lp,params,va,rp)) | Ast.Decl decl -> Ast.rewrap res (Ast.Decl(annotated_decl no_mcode decl)) | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> Ast.rewrap res (Ast.ForHeader(fr,lp,Ast.ForDecl(annotated_decl no_mcode decl), e2,sem2,e3,rp)) | _ -> res in let recursor = V.rebuilder mcode 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 do_nothing do_nothing decl do_absolutely_nothing 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 let inhs_poss = Ast.get_inherited_pos re in (* already intersection *) Ast.make_inherited_term (Ast.unwrap re) inhs inhs_poss 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 List.rev (Ast.unwrap stmt_list) 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 || 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 || 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 || testfn lb || 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 || 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.Conj(stmt_dots_list) -> let processed = List.map (statement_list testfn mcode tail) stmt_dots_list in Common.inter_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,(_,_,_,aft)) -> let body_info = statement_list testfn mcode true body in if testfn header || testfn lbrace || testfn rbrace || mcode () ((),(),aft,[]) 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) -> [] | _ -> 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 let info = let (with_pos,without_pos) = (* put cases with inherited positions first *) List.partition (function (_,thing) -> not (thing.Ast.positive_inherited_positions = [])) info in with_pos @ without_pos 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.4/version.ml.in0000644000175000017500000000011512614153277015235 0ustar eugeneugenlet version_date = "@CONFVERSION@" let configure_flags = "@CONFIGURE_FLAGS@" coccinelle-1.0.4/Makefile.dev0000644000175000017500000000460512614153277015036 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr ############################################################################## # Website targets ############################################################################## 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 $(MAKE) -C docs/manual WEBBASE=$(WEBBASE) install @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) ############################################################################## # Targets to update PPA ############################################################################## # precise - 12.04 # saucy - 13.10 # trusty - 14.04 BRANCH=$(shell git symbolic-ref --short -q HEAD | sed 's|ubuntu/||') RELEASE=$(shell echo $(BRANCH) | cut -f1 -d'-') CODENAME=$(shell echo $(BRANCH) | cut -f2 -d'-') IDX?=1 .PHONY:: ubuntu ubuntu: @echo "Preparing package for Ubuntu $(CODENAME) - $(RELEASE)" if [ ! -f debian/changelog ] ; then \ debchange --create -c debian/changelog -D $(CODENAME) --package $(PRJNAME) \ -v $(VERSION)~$(RELEASE)npalix$(IDX) "New release $(VERSION)"; \ else \ debchange -c debian/changelog -D $(CODENAME) \ -v $(VERSION)~$(RELEASE)npalix$(IDX) "New release $(VERSION)"; \ fi @echo "\nYou can now build the Ubuntu source package with\n" @echo "\tmake packsrc\n" coccinelle-1.0.4/standard.iso0000644000175000017500000003546712614153277015147 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; context identifier Z; @@ T Z; => T Z = C; Declaration @ const_decl_init_null @ type T; identifier Z; @@ T Z; => T Z = NULL; 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.4/ocaml/0000755000175000017500000000000012614156171013703 5ustar eugeneugencoccinelle-1.0.4/ocaml/no_prepare_ocamlcocci.ml0000644000175000017500000000140312614153277020545 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,mvs,code) -> code :: prev | Ast_cocci.FinalScriptRule (name,"ocaml",deps,mvs,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 prepare_simple _ = 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.4/ocaml/prepare_ocamlcocci.mli0000644000175000017500000000037712614153277020233 0ustar eugeneugen exception CompileFailure of string exception LinkFailure of string val prepare : string -> Ast_cocci.rule list -> string option val prepare_simple : string -> string val load_file : string -> unit val clean_file : string -> unit val test : unit -> unit coccinelle-1.0.4/ocaml/exposed_modules.ml0000644000175000017500000000172712614153277017447 0ustar eugeneugen(* Modules accessible by the ocaml scripts. *) module Ast_c = Ast_c (* parsing_c/ast_c.ml *) module Parse_c = Parse_c (* parsing_c/parse_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 *) module Dumper = Dumper coccinelle-1.0.4/ocaml/html.odocl0000644000175000017500000000007412614153277015676 0ustar eugeneugenCommon Ast_c Visitor_c Lib_parsing_c Iteration Flag Coccilibcoccinelle-1.0.4/ocaml/coccilib.ml0000644000175000017500000002331412614153277016013 0ustar eugeneugenopen Common (** 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 | AssignOp of Ast_c.assignOp | BinaryOp of Ast_c.binaryOp | 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 | StmtList of Ast_c.statement_sequencable list (* Function table management *) (**/**) (** For internal use only. *) let fcts : (string, param_type list -> Ast_c.metavar_binding_kind ref list -> unit) Hashtbl.t = Hashtbl.create 11 (* Use prime number *) (**/**) (* This code needs to be here because we need to call the type annotater *) 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 *) (* The env argument makes it possible to add some variable declarations to create a type environment. This could be exploited for other things, but not clear why that would be useful. *) let (cstatement_of_string: string -> string -> Ast_c.statement) = fun env s -> assert (no_format s); let tmpfile = Common.new_temp_file "cocci_stmt_of_s" "c" in Common.write_file tmpfile (Printf.sprintf "void main() {\n%s\n%s\n}" env s); let program = Parse_c.parse_c_and_cpp false tmpfile +> fst in let _ = Type_annoter_c.annotate_program !Type_annoter_c.initial_env (List.map fst program) in program +> Common.find_some (fun (e,_) -> match e with | Ast_c.Definition ({Ast_c.f_body = l},_) -> (match List.rev l with (Ast_c.StmtElem st) :: _ -> Some st | _ -> None) | _ -> None ) let (cexpression_of_string: string -> string -> Ast_c.expression) = fun env s -> assert (no_format s); let tmpfile = Common.new_temp_file "cocci_expr_of_s" "c" in Common.write_file tmpfile (Printf.sprintf "void main() {\n%s\n%s;\n}" env s); let program = Parse_c.parse_c_and_cpp false tmpfile +> fst in let _ = Type_annoter_c.annotate_program !Type_annoter_c.initial_env (List.map fst program) in program +> Common.find_some (fun (e,_) -> match e with | Ast_c.Definition ({Ast_c.f_body = compound},_) -> (match List.rev compound with | Ast_c.StmtElem st :: _ -> (match Ast_c.unwrap_st st with | Ast_c.ExprStatement (Some e) -> Some e | _ -> None) | _ -> None) | _ -> None) let make_ident s = Ast_c.MetaIdVal(s) let make_expr s = Ast_c.MetaExprVal(Lib_parsing_c.al_expr(cexpression_of_string "" s), [], Ast_c.WITHOUT_TYPES) let make_expr_with_env env s = Ast_c.MetaExprVal(Lib_parsing_c.al_expr(cexpression_of_string env s), [], Ast_c.WITH_TYPES) let make_stmt s = Ast_c.MetaStmtVal(Lib_parsing_c.al_statement(cstatement_of_string "" s), Ast_c.WITHOUT_TYPES) let make_stmt_with_env env s = Ast_c.MetaStmtVal(Lib_parsing_c.al_statement(cstatement_of_string env s), Ast_c.WITH_TYPES) let make_type s = Ast_c.MetaTypeVal(Lib_parsing_c.al_type(Parse_c.type_of_string s)) let make_listlen i = Ast_c.MetaListlenVal i let make_position fl fn startl startc endl endc = Ast_c.MetaPosValList [(fl, fn, (startl, startc), (endl,endc))] (* ---------------------------------------------------------------------- *) (* 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 let file () = match !Flag.currentfile with Some f -> f | None -> failwith "no file" (* ---------------------------------------------------------------------- *) (* 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.4/ocaml/ocamlcocci_aux.mli0000644000175000017500000000013512614153277017362 0ustar eugeneugenval exprrep : Ast_c.expression -> string val stringrep : Ast_c.metavar_binding_kind ->string coccinelle-1.0.4/ocaml/yes_prepare_ocamlcocci.ml0000644000175000017500000004405412614153277020742 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.MetaBinaryOperatorDecl _) -> failwith (Printf.sprintf "%s: No AST representation for operator variables" nm) | (Some nm,Ast.MetaAssignmentOperatorDecl _) -> failwith (Printf.sprintf "%s: No AST representation for operator variables" nm) | (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.MetaGlobalIdExpDecl _) -> 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" | (Some nm,Ast.MetaScriptDecl _) -> failwith "script metavariable" | (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) val mutable extend_virtual_ids = false method set_files f = files <- Some f method extend_virtual_identifiers (x : unit) = extend_virtual_ids <- true %s%s method register () = Iteration.add_pending_instance (files,virtual_rules,virtual_identifiers,extend_virtual_ids) end\n\n" add_virt_rules_method add_virt_ids_method (* ---------------------------------------------------------------------- *) let prepare_mvs o str = function [] -> true | metavars -> let fn _ = List.map (function ((Some nm,None),("virtual",vname),_,init) -> let vl = try List.assoc vname !Flag.defined_virtual_env with Not_found -> (match init with Ast.NoMVInit -> Common.pr2 (str^": required variable "^nm^" not found, "^ str^" ignored"); raise Not_found | Ast.MVInitString s -> s | Ast.MVInitPosList -> failwith "no virt positions") in (nm,vl) | _ -> failwith "invalid metavar in initialize or finalize") metavars in try List.iter (function (nm,vl) -> Printf.fprintf o "let %s = \"%s\"\n" nm vl) (fn()); Printf.fprintf o "\n"; true with Not_found -> false 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_mvs,sub_final_mvs,all_final_mvs) = let (init,final) = List.fold_left (function ((init,final) as prev) -> function Ast_cocci.InitialScriptRule (name,"ocaml",deps,mvs,code) -> (Common.union_set mvs init,final) | Ast_cocci.FinalScriptRule (name,"ocaml",deps,mvs,code) -> (init,Common.union_set mvs final) | _ -> prev) ([],[]) code in (* minus_set because actually init declarations are global... *) (init, Common.minus_set final init, final) in let init_rules = List.fold_left (function prev -> function Ast_cocci.InitialScriptRule (name,"ocaml",deps,mvs,code) -> code :: prev | _ -> prev) [] code in let init_rules = List.rev init_rules in let final_rules = List.fold_left (function prev -> function Ast_cocci.FinalScriptRule (name,"ocaml",deps,mvs,code) -> (name,[],[],code) :: prev | _ -> prev) [] code in let final_rules = List.rev final_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 | _ -> prev) [] code in let other_rules = List.rev other_rules in if init_rules = [] && other_rules = [] then None else begin let (file,o) = Filename.open_temp_file "ocaml_cocci_" ".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; (* Virtual metavariables for initialize and finalize rules *) let generate_init = prepare_mvs o "initialize" init_mvs in let generate_final = prepare_mvs o "finalize" (if generate_init then sub_final_mvs else all_final_mvs) in (* Semantic patch specific initialization *) (if generate_init then Printf.fprintf o "%s" (String.concat "\n\n" init_rules)); (* Semantic patch rules *) let rule_code = List.map prepare_rule other_rules in Printf.fprintf o "%s" (String.concat "\n\n" rule_code); (* finalizer *) (if generate_final then let rule_code = List.map prepare_rule final_rules in Printf.fprintf o "%s" (String.concat "\n\n" rule_code)); close_out o; check_runtime (); Some file end let prepare_simple ml_file = let in_chan = open_in ml_file in let file_name, out_chan = Filename.open_temp_file "ocaml_cocci_" ".ml" in output_string out_chan (init_ocamlcocci ()); output_string out_chan "\n"; try while true do let line = input_line in_chan in output_string out_chan line; output_string out_chan "\n" done; assert false with End_of_file -> close_in_noerr in_chan; close_out_noerr out_chan; file_name (* 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 Bytes.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.4/ocaml/coccilib/0000755000175000017500000000000012614153277015456 5ustar eugeneugencoccinelle-1.0.4/ocaml/prepare_ocamlcocci.ml.in0000644000175000017500000000003412614153277020455 0ustar eugeneugeninclude @OCAMLCOCCI_MODULE@ coccinelle-1.0.4/ocaml/run_ocamlcocci.ml0000644000175000017500000000555012614153277017226 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.MetaAssignOpVal op -> Coccilib.AssignOp op | Ast_c.MetaBinaryOpVal op -> Coccilib.BinaryOp op | 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.MetaStmtListVal(stm,_) -> Coccilib.StmtList stm | Ast_c.MetaFragListVal frags -> Coccilib.FragList frags | Ast_c.MetaFmtVal fmt -> Coccilib.Fmt fmt | Ast_c.MetaNoVal -> failwith "no value for script metavariable" | 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),_,init) -> match find_binding (r,m) with None -> (match init with Ast_cocci.NoMVInit -> failwith "no value for ocaml metavars" | Ast_cocci.MVInitString s -> [Coccilib.Str s] | Ast_cocci.MVInitPosList -> [Coccilib.Pos []]) | Some (_,vl) -> (string_binding vl str_name) @ (ast_binding vl ast_name)) mv) in let script_args = List.map (function _ -> ref Ast_c.MetaNoVal) 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.4/ocaml/Makefile0000644000175000017500000000554212614153277015355 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 ############################################################################## all: $(TARGET).cma all.opt: @$(MAKE) $(TARGET).cmxa BUILD_OPT=yes $(TARGET).cma: $(OBJS) $(OCAMLC_CMD) -a -o $(TARGET).cma $(OBJS) for i in `grep " (\*" exposed_modules.ml | sed "s/^.*(\* //" | sed "s/\..* \*)$$//"`; do cp ../$$i.cmi .; done $(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 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: ifeq ($(COMPILE_EMBEDDED_BYTES_MODULE),yes) $(OCAMLDEP_CMD) *.mli *.ml > .depend else $(OCAMLDEP_CMD) *.mli *.ml | sed 's/bytes\.cm[a-z]\{1,\}//g' > .depend endif ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) ifneq ($(MAKECMDGOALS),cleandoc) -include .depend endif endif endif include ../Makefile.common coccinelle-1.0.4/ocaml/run_ocamlcocci.mli0000644000175000017500000000050712614153277017374 0ustar eugeneugenval run : (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar * Ast_cocci.mvinit) list -> Ast_c.metavars_binding (*virts*) -> Ast_cocci.meta_name list (*fresh vars*) -> string (*rule name*) -> string (*code*) -> Ast_c.metavar_binding_kind list (* final values of script vars *) coccinelle-1.0.4/ocaml/man.odocl0000644000175000017500000000007412614153277015505 0ustar eugeneugenCommon Ast_c Visitor_c Lib_parsing_c Iteration Flag Coccilibcoccinelle-1.0.4/ocaml/Makefile.doc0000644000175000017500000000137212614153277016116 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 $(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 cleandoc: @if test -z "${KEEP_GENERATED}"; then \ rm -rf $(DEST)/html $(DEST)/man; fi coccinelle-1.0.4/ocaml/ocamlcocci_aux.ml0000644000175000017500000000437312614153277017221 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.MetaAssignOpVal op -> call_pretty Pretty_print_c.pp_assignOp_gen op | Ast_c.MetaBinaryOpVal op -> call_pretty Pretty_print_c.pp_binaryOp_gen op | 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.MetaStmtListVal (statxs,_) -> call_pretty Pretty_print_c.pp_statement_seq_list_gen statxs | 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 Printf.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2) | Ast_c.MetaPosValList positions -> "TODO: <>" | Ast_c.MetaNoVal -> failwith "no value" coccinelle-1.0.4/copyright.txt0000644000175000017500000000202212614153277015361 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.4/demos/0000755000175000017500000000000012614153277013723 5ustar eugeneugencoccinelle-1.0.4/demos/platform_ifdef.c0000644000175000017500000000024312614153277017047 0ustar eugeneugenvoid main() { buf = alloca(3 #ifdef PLATFORM_A +5 #endif #ifdef PLATFORM_B +2 #endif ); } coccinelle-1.0.4/demos/orgmode.cocci0000644000175000017500000000152212614153277016361 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.4/demos/first.cocci0000644000175000017500000000050412614153277016053 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.4/demos/itimer.cocci0000644000175000017500000000036112614153277016216 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.4/demos/iso-kzalloc.cocci0000644000175000017500000000024512614153277017155 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.4/demos/printloc.cocci0000644000175000017500000000123612614153277016561 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.4/demos/launch.sh0000755000175000017500000000030712614153277015534 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.4/demos/pythontococci.cocci0000644000175000017500000000033112614153277017607 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.4/demos/virt.c0000644000175000017500000000001712614153277015051 0ustar eugeneugenint main () {} coccinelle-1.0.4/demos/external_ana.cocci0000644000175000017500000000237312614153277017373 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.4/demos/pycocci.c0000644000175000017500000000041012614153277015513 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.4/demos/manual/0000755000175000017500000000000012614153277015200 5ustar eugeneugencoccinelle-1.0.4/demos/manual/already_tagged.c0000644000175000017500000000015212614153277020276 0ustar eugeneugen/* diamond example */ void main(int i) { foo(); if(1) bar(1); else bar(2); foobar(); } coccinelle-1.0.4/demos/manual/get_put_full.cocci0000644000175000017500000000010312614153277020665 0ustar eugeneugen@@ identifier fn; @@ fn(...) { ... get(); ... put(); ... } coccinelle-1.0.4/demos/manual/get_put_ver1.c0000644000175000017500000000011712614153277017747 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); return 0; } put(); } coccinelle-1.0.4/demos/manual/get_put.c0000644000175000017500000000010112614153277017003 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); } put(); } coccinelle-1.0.4/demos/manual/get_put_full.c0000644000175000017500000000010112614153277020025 0ustar eugeneugenvoid main(int i) { get(); if(1) { put(); } put(); } coccinelle-1.0.4/demos/manual/get_put.cocci0000644000175000017500000000004612614153277017651 0ustar eugeneugen@@ @@ get(); ... -put(); +putput(); coccinelle-1.0.4/demos/manual/already_tagged.cocci0000644000175000017500000000011112614153277021127 0ustar eugeneugen@@ expression x; @@ foo(); ... bar(x); ... - foobar(); + foobar(x); coccinelle-1.0.4/demos/ioctl_multiple_rules.cocci0000644000175000017500000000033712614153277021167 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.4/demos/check_region.cocci0000644000175000017500000000027112614153277017345 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.4/demos/assignment_matching.cocci0000644000175000017500000000124112614153277020745 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.4/demos/headers.cocci0000644000175000017500000000223112614153277016336 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.4/demos/interprocedural_adhoc.c0000644000175000017500000000026112614153277020426 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.4/demos/ctr_unit_test.c0000644000175000017500000000060612614153277016757 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.4/demos/ctr_unit_test.cocci0000644000175000017500000000250212614153277017612 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; @@ struct foo C(int i) { ... if(UnitTest()) { struct foo c; ... + c = C(); + Console.WriteLine("invoking test", name); + c.TestMethod(); } } coccinelle-1.0.4/demos/itimer.res0000644000175000017500000000207112614153277015727 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.4/demos/posmult.c0000644000175000017500000000017212614153277015572 0ustar eugeneugenint main() { int *x = NULL; int *y = NULL; if (r) x = ALLOC(); y = ALLOC(); if (!x) return; if (!y) return; } coccinelle-1.0.4/demos/check_region.c0000644000175000017500000000051112614153277016504 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.4/demos/macro_fix_standard.h0000644000175000017500000000026612614153277017727 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.4/demos/defaultscript.c0000644000175000017500000000012612614153277016737 0ustar eugeneugenint main () { one(12); one(nothing); other(nothing); other(12); return x; } coccinelle-1.0.4/demos/foobar.c0000644000175000017500000000023212614153277015334 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.4/demos/type_fields.cocci0000644000175000017500000000007312614153277017234 0ustar eugeneugen@@ struct file_operations x; @@ - x.ioctl + x.new_ioctl coccinelle-1.0.4/demos/conjunction.cocci0000644000175000017500000000021012614153277017247 0ustar eugeneugen@@ identifier f; @@ ( - f + m (...,3,...); ... g(...,3,...); & f(..., - 8 + 80 ,...); ... g(...,8,...); ) coccinelle-1.0.4/demos/depend.cocci0000644000175000017500000000056512614153277016172 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.4/demos/janitorings/0000755000175000017500000000000012614153277016252 5ustar eugeneugencoccinelle-1.0.4/demos/janitorings/is_power_of_2.cocci0000644000175000017500000000511112614153277022006 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.4/demos/janitorings/kzalloc-orig.cocci0000644000175000017500000001311312614153277021650 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.4/demos/janitorings/netdev_find_allocfunc.c0000644000175000017500000000017012614153277022727 0ustar eugeneugenstruct net_device *alloc_etherdev(int sizeof_priv) { return alloc_netdev(sizeof_priv, "eth%d", ether_setup); } coccinelle-1.0.4/demos/janitorings/kzalloc-fix.cocci0000644000175000017500000000021212614153277021472 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.4/demos/janitorings/list_for_each.cocci0000644000175000017500000000136612614153277022063 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.4/demos/janitorings/useless_cast.cocci0000644000175000017500000000052712614153277021755 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.4/demos/janitorings/list_for_each_safe.sgrep0000644000175000017500000000015012614153277023107 0ustar eugeneugen@@ iterator list_for_each_safe; statement S; expression a, b, c; @@ - list_for_each_safe(a, b, c) - S coccinelle-1.0.4/demos/janitorings/BUG_ON.cocci0000644000175000017500000000042212614153277020263 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.4/demos/janitorings/netdev_find_allocfunc.sgrep0000644000175000017500000000027612614153277023634 0ustar eugeneugen@@ identifier fn; identifier sizeof_priv; @@ - fn(...,int sizeof_priv, ...) { <... ( alloc_netdev(sizeof_priv, ...) | alloc_netdev_mq(sizeof_priv, ...) ) ...> } coccinelle-1.0.4/demos/janitorings/bad_zero.cocci0000644000175000017500000000056212614153277021044 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.4/demos/janitorings/bad_zero.c0000644000175000017500000000017612614153277020207 0ustar eugeneugenvoid main(int i) { struct netdev *bc; if ((bc = ch->brdchan) == 0) { tty->driver_data = NULL; return -ENODEV; } } coccinelle-1.0.4/demos/janitorings/static_initfunc.cocci0000644000175000017500000000224312614153277022443 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.4/demos/janitorings/kcalloc_un.cocci0000644000175000017500000000014412614153277021365 0ustar eugeneugen// Based on request from Michael D. Day @@ expression X, Y; @@ - kcalloc(1, X, Y) + kmalloc(X, Y) coccinelle-1.0.4/demos/janitorings/list_for_each_safe.c0000644000175000017500000000012512614153277022213 0ustar eugeneugenvoid main(int i) { list_for_each_safe(a,b,c) i++; list_for_each(a,b) i++; } coccinelle-1.0.4/demos/janitorings/string-array-decl-opti.cocci0000644000175000017500000000027512614153277023560 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.4/demos/janitorings/netdev_priv.c0000644000175000017500000000034012614153277020740 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.4/demos/janitorings/static_initfunc.c0000644000175000017500000000023412614153277021603 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.4/demos/janitorings/ARRAY_SIZE.cocci0000644000175000017500000000310412614153277020762 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.4/demos/janitorings/empty.iso0000644000175000017500000000000012614153277020112 0ustar eugeneugencoccinelle-1.0.4/demos/janitorings/list_for_each.c0000644000175000017500000000021112614153277021211 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.4/demos/janitorings/string-array-decl-opti.c0000644000175000017500000000035712614153277022723 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.4/demos/janitorings/clear_page.cocci0000644000175000017500000000164612614153277021345 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.4/demos/janitorings/netdev_priv2.cocci0000644000175000017500000000011212614153277021655 0ustar eugeneugen@@ struct net_device *dev; type T; @@ - (T) dev->priv + netdev_priv(dev) coccinelle-1.0.4/demos/janitorings/netdev_priv_dangerous.sgrep0000644000175000017500000000117512614153277023714 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.4/demos/janitorings/bad_zero-orig.cocci0000644000175000017500000000024512614153277022000 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.4/demos/janitorings/useless_cast.c0000644000175000017500000000077212614153277021121 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.4/demos/janitorings/BUG_ON.sgrep0000644000175000017500000000001612614153277020322 0ustar eugeneugen@@ @@ - BUG() coccinelle-1.0.4/demos/janitorings/netdev_priv.cocci0000644000175000017500000000301712614153277021602 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.4/demos/janitorings/bad_zero_affect.cocci0000644000175000017500000000005212614153277022346 0ustar eugeneugen @@ expression *E; @@ E = - 0 + NULL coccinelle-1.0.4/demos/janitorings/set_current_state.cocci0000644000175000017500000000010212614153277023002 0ustar eugeneugen@@ expression E; @@ - current->state = E; + set_current_state(E);coccinelle-1.0.4/demos/janitorings/kzalloc.cocci0000644000175000017500000001302212614153277020711 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.4/demos/janitorings/remove_cast_kmalloc.cocci0000644000175000017500000000130312614153277023262 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.4/demos/janitorings/alloc_page.cocci0000644000175000017500000000201112614153277021334 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.4/demos/regexp.cocci0000644000175000017500000000122612614153277016220 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.4/demos/camltococci.cocci0000644000175000017500000000031312614153277017202 0ustar eugeneugen@a@ identifier x; @@ foo(x); @script:ocaml b@ x << a.x; y; z; @@ y := make_ident x; z := make_ident "something" @c@ identifier b.y; identifier b.z; identifier a.x; @@ - bar(); + matched_bar(y,z,x); coccinelle-1.0.4/demos/regexp2.c0000644000175000017500000000003712614153277015443 0ustar eugeneugen void foo() { WINE_ERR(0); } coccinelle-1.0.4/demos/pythontococci.c0000644000175000017500000000004412614153277016752 0ustar eugeneugenint main () { foo(a0); bar(); } coccinelle-1.0.4/demos/regexp.c0000644000175000017500000000021112614153277015353 0ustar eugeneugenint foo () { return 0; } int bar () { return 0; } int foobar () { return 0; } int barfoobar () { return 0; } int barfoo () { return 0; } coccinelle-1.0.4/demos/macro_parsing_problem.c0000644000175000017500000001125012614153277020432 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.4/demos/usb_submit_urb.c0000644000175000017500000001131212614153277017111 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.4/demos/vm.cocci0000644000175000017500000000043112614153277015345 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.4/demos/assignment_matching.c0000644000175000017500000000071212614153277020111 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.4/demos/format.c0000644000175000017500000000025412614153277015360 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.4/demos/python_regexp.cocci0000644000175000017500000000066512614153277017627 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.4/demos/video_usercopy.c0000644000175000017500000000112512614153277017125 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.4/demos/format.cocci0000644000175000017500000000122012614153277016210 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.4/demos/vm.c0000644000175000017500000000006712614153277014514 0ustar eugeneugenint main () { x = kmalloc(); r = 15; kfree(x); } coccinelle-1.0.4/demos/unsigned.txt0000644000175000017500000001005412614153277016300 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.4/demos/format.res0000644000175000017500000000025412614153277015727 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.4/demos/hello/0000755000175000017500000000000012614153277015026 5ustar eugeneugencoccinelle-1.0.4/demos/hello/helloworld.c0000644000175000017500000000006512614153277017346 0ustar eugeneugenint main() { printf("Hello world!"); return 0; } coccinelle-1.0.4/demos/hello/hello-regexp.cocci0000644000175000017500000000024012614153277020417 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.4/demos/hello/hello-python.cocci0000644000175000017500000000026612614153277020456 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.4/demos/hello/hello-smpl.cocci0000644000175000017500000000022512614153277020103 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.4/demos/hello/hello-ocaml.cocci0000644000175000017500000000031112614153277020217 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.4/demos/itimer.patch0000644000175000017500000000235112614153277016236 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.4/demos/ocaml2.c0000644000175000017500000000013312614153277015241 0ustar eugeneugenint main () { if (f(3)) goto l; if (f(x)) x = 2; if (f(x+y)) return; l: return; } coccinelle-1.0.4/demos/depend.c0000644000175000017500000000003612614153277015325 0ustar eugeneugenint main() { aa(); c(); } coccinelle-1.0.4/demos/initvirt.c0000644000175000017500000000002012614153277015727 0ustar eugeneugenint main () { } coccinelle-1.0.4/demos/video_usercopy.cocci0000644000175000017500000000063112614153277017764 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.4/demos/demo_rule9/0000755000175000017500000000000012614153277015767 5ustar eugeneugencoccinelle-1.0.4/demos/demo_rule9/rule9_4.cocci0000644000175000017500000000142212614153277020253 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.4/demos/demo_rule9/rule9_1.cocci0000644000175000017500000000071512614153277020254 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.4/demos/demo_rule9/README0000644000175000017500000000774612614153277016665 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.4/demos/demo_rule9/g_NCR5380.c0000644000175000017500000006253412614153277017415 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.4/demos/demo_rule9/g_NCR5380.res0000644000175000017500000006242012614153277017756 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.4/demos/demo_rule9/scsiglue.res0000644000175000017500000005667112614153277020337 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.4/demos/demo_rule9/rule9_3.cocci0000644000175000017500000000114212614153277020251 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.4/demos/demo_rule9/rule9_5.cocci0000644000175000017500000000210412614153277020252 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.4/demos/demo_rule9/nsp_cs.res0000644000175000017500000014377612614153277020011 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.4/demos/demo_rule9/rule9_2.cocci0000644000175000017500000000071512614153277020255 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.4/demos/demo_rule9/rule9.cocci0000644000175000017500000000224012614153277020027 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.4/demos/demo_rule9/sym53c8xx.res0000644000175000017500000134102512614153277020303 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.4/demos/demo_rule9/sym53c8xx.c0000644000175000017500000134115112614153277017734 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.4/demos/demo_rule9/nsp_cs.c0000644000175000017500000014450712614153277017433 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.4/demos/demo_rule9/scsiglue.c0000644000175000017500000005743412614153277017766 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.4/demos/external_ana.c0000644000175000017500000000063012614153277016527 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.4/demos/foo.cocci0000644000175000017500000000001712614153277015506 0ustar eugeneugen@@ @@ - foo();coccinelle-1.0.4/demos/pcre.c0000644000175000017500000000003712614153277015020 0ustar eugeneugen void foo() { WINE_ERR(0); } coccinelle-1.0.4/demos/type_fields.c0000644000175000017500000000023412614153277016375 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.4/demos/itimer.c0000644000175000017500000000166312614153277015366 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.4/demos/ocaml2.cocci0000644000175000017500000000221112614153277016076 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.4/demos/iso-kzalloc.c0000644000175000017500000000014512614153277016316 0ustar eugeneugenvoid main(int i) { kzalloc(2 * sizeof(int), GFP_KERNEL); kzalloc(sizeof(int) * 2, GFP_KERNEL); } coccinelle-1.0.4/demos/printloc.c0000644000175000017500000000004512614153277015720 0ustar eugeneugenint main() { f(12); x = f(12); } coccinelle-1.0.4/demos/usb_submit_urb.cocci0000644000175000017500000000041612614153277017752 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.4/demos/python_identifier.cocci0000644000175000017500000000034412614153277020451 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.4/demos/pcre.cocci0000644000175000017500000000010112614153277015646 0ustar eugeneugen@@ identifier SPAM =~ "(WINE_)?(ERR|FIXME|WARN)"; @@ -SPAM +bar coccinelle-1.0.4/demos/platform_ifdef.cocci0000644000175000017500000000011112614153277017677 0ustar eugeneugen@@ expression E; @@ //-alloca(E) //+malloc(E) - alloca + malloc (E) coccinelle-1.0.4/demos/ioctl_multiple_rules.c0000644000175000017500000000023512614153277020326 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.4/demos/initvirt.cocci0000644000175000017500000000073212614153277016577 0ustar eugeneugen@initialize:ocaml@ x << virtual.x; @@ let _ = Printf.printf "ocaml start: x is %s\n" x @initialize:python@ x << virtual.x; @@ print "python start: x is %s" % (x) @@ @@ foo(); @script:ocaml@ @@ () @finalize:ocaml@ x << virtual.x; y << virtual.y; @@ Printf.printf "ocaml end: x is %s\n" x; Printf.printf "ocaml end: y is %s\n" y @finalize:python@ x << virtual.x; y << virtual.y; z << virtual.z; @@ print "python end: x is %s" % (x) print "python end: y is %s" % (y) coccinelle-1.0.4/demos/simple.c0000644000175000017500000000006712614153277015363 0ustar eugeneugenint main(int i) { f("ca va"); f(g("ca va pas")); } coccinelle-1.0.4/demos/headers.iso0000644000175000017500000000006212614153277016050 0ustar eugeneugenExpression @ one @ expression E; @@ f(E) => g(E) coccinelle-1.0.4/demos/ocaml/0000755000175000017500000000000012614153277015016 5ustar eugeneugencoccinelle-1.0.4/demos/ocaml/README0000644000175000017500000000016512614153277015700 0ustar eugeneugen** Demo dbm.cocci ** Requires package: ocaml-nox ** Demo pg.cocci ** Requires package: libpostgresql-ocaml-dev coccinelle-1.0.4/demos/ocaml/pg.c0000644000175000017500000000012112614153277015562 0ustar eugeneugenint main() { foo(12,120); foobar(23,230); barfoo(34,340); bar(45,450); } coccinelle-1.0.4/demos/ocaml/pg.cocci0000644000175000017500000000064312614153277016431 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.4/demos/ocaml/dbm.c0000644000175000017500000000012112614153277015716 0ustar eugeneugenint main() { foo(12,120); foobar(23,230); barfoo(34,340); bar(45,450); } coccinelle-1.0.4/demos/ocaml/dbm.cocci0000644000175000017500000000115412614153277016563 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.4/demos/simple.cocci0000644000175000017500000000005012614153277016211 0ustar eugeneugen@@ expression E; @@ - f(E); + f(E,3); coccinelle-1.0.4/demos/iteration.cocci0000644000175000017500000000364712614153277016735 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.4/demos/ifdef_skip_tag.c0000644000175000017500000000042412614153277017025 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.4/demos/ocaml1.c0000644000175000017500000000005112614153277015237 0ustar eugeneugenint main() { f(12,120); f(27,270); } coccinelle-1.0.4/demos/not.c0000644000175000017500000000015312614153277014666 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.4/demos/interprocedural_adhoc.cocci0000644000175000017500000000041512614153277021265 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.4/demos/initial_final.cocci0000644000175000017500000000031612614153277017527 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.4/demos/ocaml.cocci0000644000175000017500000000127112614153277016021 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.4/demos/xxx_info.c0000644000175000017500000000032212614153277015726 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.4/demos/pcre2.cocci0000644000175000017500000000055512614153277015745 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.4/demos/proc_info.c0000644000175000017500000000605612614153277016054 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.4/demos/proc_info.cocci0000644000175000017500000000222012614153277016677 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.4/demos/headers2.iso0000644000175000017500000000014712614153277016136 0ustar eugeneugenExpression @ two @ expression E; @@ x(E) => y(E) Expression @ three @ expression E; @@ m(E) => n(E) coccinelle-1.0.4/demos/pcre2.c0000644000175000017500000000006712614153277015105 0ustar eugeneugen void foo() { bar(0); WINE_ERR(0); WINE_WARN(0); } coccinelle-1.0.4/demos/xxx_info.cocci0000644000175000017500000000033412614153277016567 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.4/demos/virt.cocci0000644000175000017500000000062212614153277015711 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.4/demos/itimerfullfunc.sgrep0000644000175000017500000000200012614153277020005 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.4/demos/camltococci.c0000644000175000017500000000004412614153277016345 0ustar eugeneugenint main () { foo(a0); bar(); } coccinelle-1.0.4/demos/assignment_matching.res0000644000175000017500000000103512614153277020457 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.4/demos/change_all_param.cocci0000644000175000017500000000110312614153277020155 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.4/demos/orgmode2.cocci0000644000175000017500000000101512614153277016440 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.4/demos/camltococci.res0000644000175000017500000000007512614153277016720 0ustar eugeneugenint main () { foo(a0); matched_bar(a0, something, a0); } coccinelle-1.0.4/demos/change_all_param.c0000644000175000017500000000025712614153277017330 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.4/demos/regexp2.cocci0000644000175000017500000000010612614153277016276 0ustar eugeneugen@@ identifier SPAM =~ "\(WINE_\)?\(ERR\|FIXME\|WARN\)"; @@ -SPAM +barcoccinelle-1.0.4/demos/pythontococci.res0000644000175000017500000000007512614153277017325 0ustar eugeneugenint main () { foo(a0); matched_bar(a0, something, a0); } coccinelle-1.0.4/demos/orgmode.c0000644000175000017500000000003012614153277015514 0ustar eugeneugenint main() { f(12); } coccinelle-1.0.4/demos/defaultscript.cocci0000644000175000017500000000227712614153277017606 0ustar eugeneugen@r@ identifier f; expression e; position p; @@ ( other | f@p ) ( ( nothing | e ) ); @script:ocaml@ f << r.f; e << r.e; p << r.p; @@ Printf.printf "all matched: %s %s %s %d\n" f e (List.hd p).file (List.hd p).line @script:ocaml@ f << r.f = "no function"; e << r.e = "no argument"; p << r.p = []; @@ match p with [] -> Printf.printf "no pos: %s %s\n" f e | p::_ -> Printf.printf "all matched: %s %s %s %d\n" f e p.file p.line @script:ocaml@ f << r.f; e << r.e = "no argument"; p << r.p = []; @@ match p with [] -> Printf.printf "fn required: no pos: %s %s\n" f e | p::_ -> Printf.printf "fn required: all matched: %s %s %s %d\n" f e p.file p.line @script:python@ f << r.f; e << r.e; p << r.p; @@ print "py: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) @script:python@ f << r.f = "no function"; e << r.e = "no argument"; p << r.p = []; @@ if not p: print "py: no pos: %s %s" % (f,e) else: print "py: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) @script:python@ f << r.f; e << r.e = "no argument"; p << r.p = []; @@ if not p: print "py: fun required: no pos: %s %s" % (f,e) else: print "py: fun required: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) coccinelle-1.0.4/demos/conjunction.c0000644000175000017500000000016512614153277016422 0ustar eugeneugenint main () { f(1,2,3,4); f(3,4,8,9); g(8,9,3,4); } int main () { f(1,2,3,4); g(8,9,3,4); f(3,4,8,9); } coccinelle-1.0.4/demos/not.cocci0000644000175000017500000000013012614153277015517 0ustar eugeneugen@@ expression x != foo; identifier y != {foo,bar}; expression a; @@ - y(x,a); + f(20); coccinelle-1.0.4/demos/sgrep/0000755000175000017500000000000012614153277015043 5ustar eugeneugencoccinelle-1.0.4/demos/sgrep/double_cast.sgrep0000644000175000017500000000010212614153277020362 0ustar eugeneugen@@ type T1; type T2; expression E1,E2; @@ - E1 = (T1) (T2) E2; coccinelle-1.0.4/demos/sgrep/README0000644000175000017500000000025512614153277015725 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.4/demos/sgrep/intr4.sgrep0000644000175000017500000000043212614153277017144 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.4/demos/sgrep/run.sh0000644000175000017500000000046012614153277016203 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.4/demos/sgrep/dangerous_arith_pointer_cast.sgrep0000644000175000017500000000011612614153277024033 0ustar eugeneugen @@ type T; expression E1, E2; @@ // safer is ((T) E1) + E2 - (T *) E1 + E2 coccinelle-1.0.4/demos/sgrep/device_id.sgrep0000644000175000017500000000112712614153277020021 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.4/demos/sgrep/null.sgrep0000644000175000017500000000307112614153277017060 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.4/demos/sgrep/a_and_b.sgrep0000644000175000017500000000023612614153277017451 0ustar eugeneugen@ rule1 @ identifier fn; @@ fn(...) { <... \+ foo(); ...> } @ rule2 depends on rule1 @ identifier rule1.fn; @@ - fn(...) { - <... -\+ bar(); - ...> - } coccinelle-1.0.4/demos/sgrep/simple.c0000644000175000017500000000013712614153277016501 0ustar eugeneugenvoid main(int i) { foo(f(1),2); f(2); g(3); } void notmain(int i) { f(3); f(4); } coccinelle-1.0.4/demos/sgrep/dangerous_GFP_KERNEL2.sgrep0000644000175000017500000000021112614153277021704 0ustar eugeneugen@@ identifier fn; @@ spin_lock_irqsave(...) ... when != spin_unlock_irqrestore(...) fn(..., - GFP_KERNEL + GFP_ATOMIC ,... ) coccinelle-1.0.4/demos/sgrep/a_and_b.c0000644000175000017500000000023612614153277016553 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.4/demos/sgrep/free.sgrep0000644000175000017500000000377312614153277017040 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.4/demos/sgrep/dangerous_GFP_KERNEL.sgrep0000644000175000017500000000200712614153277021627 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.4/demos/sgrep/simple.sgrep0000644000175000017500000000017612614153277017402 0ustar eugeneugen@@ expression X; @@ void main(...) { <... - f(X) ...> } @@ expression X; @@ void main(...) { <... - g(X) ...> } coccinelle-1.0.4/demos/python_regexp.c0000644000175000017500000000010012614153277016751 0ustar eugeneugenint main() { int x; x = foo(); x = foo_new(); x = bar(); } coccinelle-1.0.4/autogen0000755000175000017500000000022712614153277014205 0ustar eugeneugen#!/bin/sh if [ "$1" = "--ignore_localversion" ]; then export MAKE_COCCI_RELEASE="y" else unset MAKE_COCCI_RELEASE fi aclocal -I setup autoconf -Wall coccinelle-1.0.4/setup/0000755000175000017500000000000012614156171013750 5ustar eugeneugencoccinelle-1.0.4/setup/ocaml.m40000644000175000017500000001356012614153277015316 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]) ]) 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.4/setup/fake-menhir.sh0000755000175000017500000000365612614153277016513 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.4/setup/cocci.m40000644000175000017500000002421212614153277015277 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.4/setup/missing0000755000175000017500000001533012614153277015355 0ustar eugeneugen#! /bin/sh # Common wrapper for a few potentially missing GNU programs. scriptversion=2013-10-28.13; # UTC # Copyright (C) 1996-2014 Free Software Foundation, Inc. # Originally written 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 case $1 in --is-lightweight) # Used by our autoconf macros to check whether the available missing # script is modern enough. exit 0 ;; --run) # Back-compat with the calling convention used by older automake. shift ;; -h|--h|--he|--hel|--help) echo "\ $0 [OPTION]... PROGRAM [ARGUMENT]... Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due to PROGRAM being missing or too old. Options: -h, --help display this help and exit -v, --version output version information and exit Supported PROGRAM values: aclocal autoconf autoheader autom4te automake makeinfo bison yacc flex lex help2man 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 # Run the given program, remember its exit status. "$@"; st=$? # If it succeeded, we are done. test $st -eq 0 && exit 0 # Also exit now if we it failed (or wasn't found), and '--version' was # passed; such an option is passed most likely to detect whether the # program is present and works. case $2 in --version|--help) exit $st;; esac # Exit code 63 means version mismatch. This often happens when the user # tries to use an ancient version of a tool on a file that requires a # minimum version. if test $st -eq 63; then msg="probably too old" elif test $st -eq 127; then # Program was missing. msg="missing on your system" else # Program was found and executed, but failed. Give up. exit $st fi perl_URL=http://www.perl.org/ flex_URL=http://flex.sourceforge.net/ gnu_software_URL=http://www.gnu.org/software program_details () { case $1 in aclocal|automake) echo "The '$1' program is part of the GNU Automake package:" echo "<$gnu_software_URL/automake>" echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:" echo "<$gnu_software_URL/autoconf>" echo "<$gnu_software_URL/m4/>" echo "<$perl_URL>" ;; autoconf|autom4te|autoheader) echo "The '$1' program is part of the GNU Autoconf package:" echo "<$gnu_software_URL/autoconf/>" echo "It also requires GNU m4 and Perl in order to run:" echo "<$gnu_software_URL/m4/>" echo "<$perl_URL>" ;; esac } give_advice () { # Normalize program name to check for. normalized_program=`echo "$1" | sed ' s/^gnu-//; t s/^gnu//; t s/^g//; t'` printf '%s\n' "'$1' is $msg." configure_deps="'configure.ac' or m4 files included by 'configure.ac'" case $normalized_program in autoconf*) echo "You should only need it if you modified 'configure.ac'," echo "or m4 files included by it." program_details 'autoconf' ;; autoheader*) echo "You should only need it if you modified 'acconfig.h' or" echo "$configure_deps." program_details 'autoheader' ;; automake*) echo "You should only need it if you modified 'Makefile.am' or" echo "$configure_deps." program_details 'automake' ;; aclocal*) echo "You should only need it if you modified 'acinclude.m4' or" echo "$configure_deps." program_details 'aclocal' ;; autom4te*) echo "You might have modified some maintainer files that require" echo "the 'autom4te' program to be rebuilt." program_details 'autom4te' ;; bison*|yacc*) echo "You should only need it if you modified a '.y' file." echo "You may want to install the GNU Bison package:" echo "<$gnu_software_URL/bison/>" ;; lex*|flex*) echo "You should only need it if you modified a '.l' file." echo "You may want to install the Fast Lexical Analyzer package:" echo "<$flex_URL>" ;; help2man*) echo "You should only need it if you modified a dependency" \ "of a man page." echo "You may want to install the GNU Help2man package:" echo "<$gnu_software_URL/help2man/>" ;; makeinfo*) echo "You should only need it if you modified a '.texi' file, or" echo "any other file indirectly affecting the aspect of the manual." echo "You might want to install the Texinfo package:" echo "<$gnu_software_URL/texinfo/>" echo "The spurious makeinfo call might also be the consequence of" echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might" echo "want to install GNU make:" echo "<$gnu_software_URL/make/>" ;; *) echo "You might have modified some files without having the proper" echo "tools for further handling them. Check the 'README' file, it" echo "often tells you about the needed prerequisites for installing" echo "this package. You may also peek at any GNU archive site, in" echo "case some other package contains this missing '$1' program." ;; esac } give_advice "$1" | sed -e '1s/^/WARNING: /' \ -e '2,$s/^/ /' >&2 # Propagate the correct exit status (expected to be 127 for a program # not found, 63 for a program that failed due to version mismatch). exit $st # 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.4/setup/install-sh0000755000175000017500000003452312614153277015767 0ustar eugeneugen#!/bin/sh # install - install a program, script, or datafile scriptversion=2013-12-25.23; # 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. tab=' ' nl=' ' IFS=" $tab$nl" # Set DOITPROG to "echo" to test this script. doit=${DOITPROG-} doit_exec=${doit:-exec} # 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_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 is_target_a_directory=possibly 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 *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) echo "$0: invalid mode: $mode" >&2 exit 1;; esac shift;; -o) chowncmd="$chownprog $2" shift;; -s) stripcmd=$stripprog;; -t) is_target_a_directory=always dst_arg=$2 # Protect names problematic for 'test' and other utilities. case $dst_arg in -* | [=\(\)!]) dst_arg=./$dst_arg;; esac shift;; -T) is_target_a_directory=never;; --version) echo "$0 $scriptversion"; exit $?;; --) shift break;; -*) echo "$0: invalid option: $1" >&2 exit 1;; *) break;; esac shift done # We allow the use of options -d and -T together, by making -d # take the precedence; this is for compatibility with GNU install. if test -n "$dir_arg"; then if test -n "$dst_arg"; then echo "$0: target directory not allowed when installing a directory." >&2 exit 1 fi fi 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 if test $# -gt 1 || test "$is_target_a_directory" = always; then if test ! -d "$dst_arg"; then echo "$0: $dst_arg: Is not a directory." >&2 exit 1 fi fi 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 "$is_target_a_directory" = never; then echo "$0: $dst_arg: Is a directory" >&2 exit 1 fi dstdir=$dst dst=$dstdir/`basename "$src"` dstdir_status=0 else dstdir=`dirname "$dst"` 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 oIFS=$IFS IFS=/ set -f set fnord $dstdir shift 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` && set -f && set X $old && old=:$2:$4:$5:$6 && set X $new && new=:$2:$4:$5:$6 && 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.4/setup/wrapper-ocamlcp.sh0000755000175000017500000000115412614153277017410 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.4/setup/pkg.m40000644000175000017500000001302112614153277014774 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.4/setup/echo.sh0000755000175000017500000000002312614153277015224 0ustar eugeneugen#!/bin/sh echo $* coccinelle-1.0.4/setup/fake-pdflatex.sh0000755000175000017500000000103412614153277017024 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.4/setup/wrapper-ocamlyacc.sh0000644000175000017500000000056312614153277017725 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.4/setup/log_ocamlfind.sh0000644000175000017500000000023512614153277017105 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.4/setup/replies.txt0000644000175000017500000000170512614153277016163 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.4/setup/Makefile.in0000644000175000017500000004157312614153277016033 0ustar eugeneugen# Makefile.in generated by automake 1.15 from Makefile.am. # @configure_input@ # Copyright (C) 1994-2014 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 = { \ if test -z '$(MAKELEVEL)'; then \ false; \ elif test -n '$(MAKE_HOST)'; then \ true; \ elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ true; \ else \ false; \ fi; \ } 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 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) DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) 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) am__DIST_COMMON = $(srcdir)/Makefile.in compile install-sh missing 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@ COMPILE_EMBEDDED_BYTES_MODULE = @COMPILE_EMBEDDED_BYTES_MODULE@ 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_PYTHON = @FEATURE_PYTHON@ FEATURE_camlp4 = @FEATURE_camlp4@ FEATURE_dynlink = @FEATURE_dynlink@ FEATURE_menhirLib = @FEATURE_menhirLib@ FEATURE_parmap = @FEATURE_parmap@ FEATURE_pcre = @FEATURE_pcre@ FEATURE_pycaml = @FEATURE_pycaml@ FLAGS_camlp4 = @FLAGS_camlp4@ FLAGS_dynlink = @FLAGS_dynlink@ FLAGS_menhirLib = @FLAGS_menhirLib@ FLAGS_parmap = @FLAGS_parmap@ FLAGS_pcre = @FLAGS_pcre@ FLAGS_pycaml = @FLAGS_pycaml@ GET_TEMP_DIR_NAME_EXPR = @GET_TEMP_DIR_NAME_EXPR@ GIT = @GIT@ GLOBAL_camlp4 = @GLOBAL_camlp4@ GLOBAL_dynlink = @GLOBAL_dynlink@ GLOBAL_menhirLib = @GLOBAL_menhirLib@ GLOBAL_parmap = @GLOBAL_parmap@ 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@ LIBDIR = @LIBDIR@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LOCALLIB_camlp4 = @LOCALLIB_camlp4@ LOCALLIB_dynlink = @LOCALLIB_dynlink@ LOCALLIB_menhirLib = @LOCALLIB_menhirLib@ LOCALLIB_parmap = @LOCALLIB_parmap@ 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_parmap = @MAKE_parmap@ 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_parmap = @MODULESOPT_parmap@ MODULESOPT_pcre = @MODULESOPT_pcre@ MODULESOPT_pycaml = @MODULESOPT_pycaml@ MODULES_camlp4 = @MODULES_camlp4@ MODULES_dynlink = @MODULES_dynlink@ MODULES_menhirLib = @MODULES_menhirLib@ MODULES_parmap = @MODULES_parmap@ MODULES_pcre = @MODULES_pcre@ MODULES_profiling = @MODULES_profiling@ MODULES_pycaml = @MODULES_pycaml@ OBJEXT = @OBJEXT@ OCAML = @OCAML@ OCAMLATLEAST312 = @OCAMLATLEAST312@ OCAMLATLEAST4020 = @OCAMLATLEAST4020@ OCAMLBEST = @OCAMLBEST@ 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_parmap = @OCAML_PKG_parmap@ 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_parmap = @OPTFLAGS_parmap@ 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_parmap = @PATH_parmap@ 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@ 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_parmap = @enable_parmap@ 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 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 .PRECIOUS: Makefile 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.4/setup/compile0000755000175000017500000001624512614153277015342 0ustar eugeneugen#! /bin/sh # Wrapper for compilers which do not understand '-c -o'. scriptversion=2012-10-14.11; # UTC # Copyright (C) 1999-2014 Free Software Foundation, Inc. # Written by Tom Tromey . # # 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. # This file is maintained in Automake, please report # bugs to or send patches to # . nl=' ' # We need space, tab and new line, in precisely that order. Quoting is # there to prevent tools from complaining about whitespace usage. IFS=" "" $nl" file_conv= # func_file_conv build_file lazy # Convert a $build file to $host form and store it in $file # Currently only supports Windows hosts. If the determined conversion # type is listed in (the comma separated) LAZY, no conversion will # take place. func_file_conv () { file=$1 case $file in / | /[!/]*) # absolute file, and not a UNC file if test -z "$file_conv"; then # lazily determine how to convert abs files case `uname -s` in MINGW*) file_conv=mingw ;; CYGWIN*) file_conv=cygwin ;; *) file_conv=wine ;; esac fi case $file_conv/,$2, in *,$file_conv,*) ;; mingw/*) file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` ;; cygwin/*) file=`cygpath -m "$file" || echo "$file"` ;; wine/*) file=`winepath -w "$file" || echo "$file"` ;; esac ;; esac } # func_cl_dashL linkdir # Make cl look for libraries in LINKDIR func_cl_dashL () { func_file_conv "$1" if test -z "$lib_path"; then lib_path=$file else lib_path="$lib_path;$file" fi linker_opts="$linker_opts -LIBPATH:$file" } # func_cl_dashl library # Do a library search-path lookup for cl func_cl_dashl () { lib=$1 found=no save_IFS=$IFS IFS=';' for dir in $lib_path $LIB do IFS=$save_IFS if $shared && test -f "$dir/$lib.dll.lib"; then found=yes lib=$dir/$lib.dll.lib break fi if test -f "$dir/$lib.lib"; then found=yes lib=$dir/$lib.lib break fi if test -f "$dir/lib$lib.a"; then found=yes lib=$dir/lib$lib.a break fi done IFS=$save_IFS if test "$found" != yes; then lib=$lib.lib fi } # func_cl_wrapper cl arg... # Adjust compile command to suit cl func_cl_wrapper () { # Assume a capable shell lib_path= shared=: linker_opts= for arg do if test -n "$eat"; then eat= else case $1 in -o) # configure might choose to run compile as 'compile cc -o foo foo.c'. eat=1 case $2 in *.o | *.[oO][bB][jJ]) func_file_conv "$2" set x "$@" -Fo"$file" shift ;; *) func_file_conv "$2" set x "$@" -Fe"$file" shift ;; esac ;; -I) eat=1 func_file_conv "$2" mingw set x "$@" -I"$file" shift ;; -I*) func_file_conv "${1#-I}" mingw set x "$@" -I"$file" shift ;; -l) eat=1 func_cl_dashl "$2" set x "$@" "$lib" shift ;; -l*) func_cl_dashl "${1#-l}" set x "$@" "$lib" shift ;; -L) eat=1 func_cl_dashL "$2" ;; -L*) func_cl_dashL "${1#-L}" ;; -static) shared=false ;; -Wl,*) arg=${1#-Wl,} save_ifs="$IFS"; IFS=',' for flag in $arg; do IFS="$save_ifs" linker_opts="$linker_opts $flag" done IFS="$save_ifs" ;; -Xlinker) eat=1 linker_opts="$linker_opts $2" ;; -*) set x "$@" "$1" shift ;; *.cc | *.CC | *.cxx | *.CXX | *.[cC]++) func_file_conv "$1" set x "$@" -Tp"$file" shift ;; *.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO]) func_file_conv "$1" mingw set x "$@" "$file" shift ;; *) set x "$@" "$1" shift ;; esac fi shift done if test -n "$linker_opts"; then linker_opts="-link$linker_opts" fi exec "$@" $linker_opts exit 1 } eat= case $1 in '') echo "$0: No command. Try '$0 --help' for more information." 1>&2 exit 1; ;; -h | --h*) cat <<\EOF Usage: compile [--help] [--version] PROGRAM [ARGS] Wrapper for compilers which do not understand '-c -o'. Remove '-o dest.o' from ARGS, run PROGRAM with the remaining arguments, and rename the output as expected. If you are trying to build a whole package this is not the right script to run: please start by reading the file 'INSTALL'. Report bugs to . EOF exit $? ;; -v | --v*) echo "compile $scriptversion" exit $? ;; cl | *[/\\]cl | cl.exe | *[/\\]cl.exe ) func_cl_wrapper "$@" # Doesn't return... ;; esac ofile= cfile= for arg do if test -n "$eat"; then eat= else case $1 in -o) # configure might choose to run compile as 'compile cc -o foo foo.c'. # So we strip '-o arg' only if arg is an object. eat=1 case $2 in *.o | *.obj) ofile=$2 ;; *) set x "$@" -o "$2" shift ;; esac ;; *.c) cfile=$1 set x "$@" "$1" shift ;; *) set x "$@" "$1" shift ;; esac fi shift done if test -z "$ofile" || test -z "$cfile"; then # If no '-o' option was seen then we might have been invoked from a # pattern rule where we don't need one. That is ok -- this is a # normal compilation that the losing compiler can handle. If no # '.c' file was seen then we are probably linking. That is also # ok. exec "$@" fi # Name of file we expect compiler to create. cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` # Create the lock directory. # Note: use '[/\\:.-]' here to ensure that we don't use the same name # that we are using for the .o file. Also, base the name on the expected # object file name, since that is what matters with a parallel build. lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d while true; do if mkdir "$lockdir" >/dev/null 2>&1; then break fi sleep 1 done # FIXME: race condition here if user kills between mkdir and trap. trap "rmdir '$lockdir'; exit 1" 1 2 15 # Run the compile. "$@" ret=$? if test -f "$cofile"; then test "$cofile" = "$ofile" || mv "$cofile" "$ofile" elif test -f "${cofile}bj"; then test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" fi rmdir "$lockdir" exit $ret # Local Variables: # mode: shell-script # sh-indentation: 2 # 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.4/commons/0000755000175000017500000000000012614156171014263 5ustar eugeneugencoccinelle-1.0.4/commons/objet.ml0000644000175000017500000000115712614153277015730 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.4/commons/ograph_extended.ml0000644000175000017500000002037312614153277017766 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 (Printf.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 (Printf.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 (Printf.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 (Printf.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.4/commons/oarray.ml0000644000175000017500000000166312614153277016124 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.4/commons/bytes.ml0000644000175000017500000001663312614153277015760 0ustar eugeneugen(***********************************************************************) (* *) (* OCaml *) (* *) (* 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. *) (* *) (***********************************************************************) (* Byte sequence operations *) type bytes = string external length : bytes -> int = "%string_length" external string_length : string -> int = "%string_length" external get : bytes -> int -> char = "%string_safe_get" external set : bytes -> int -> char -> unit = "%string_safe_set" external create : int -> bytes = "caml_create_string" external unsafe_get : bytes -> int -> char = "%string_unsafe_get" external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set" external unsafe_fill : bytes -> int -> int -> char -> unit = "caml_fill_string" "noalloc" external unsafe_to_string : bytes -> string = "%identity" external unsafe_of_string : string -> bytes = "%identity" external unsafe_blit : bytes -> int -> bytes -> int -> int -> unit = "caml_blit_string" "noalloc" external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit = "caml_blit_string" "noalloc" let make n c = let s = create n in unsafe_fill s 0 n c; s let init n f = let s = create n in for i = 0 to n - 1 do unsafe_set s i (f i) done; s let empty = create 0;; let copy s = let len = length s in let r = create len in unsafe_blit s 0 r 0 len; r let to_string b = unsafe_to_string (copy b) let of_string s = copy (unsafe_of_string s) let sub s ofs len = if ofs < 0 || len < 0 || ofs > length s - len then invalid_arg "Bytes.sub" else begin let r = create len in unsafe_blit s ofs r 0 len; r end let sub_string b ofs len = unsafe_to_string (sub b ofs len) let extend s left right = let len = length s + left + right in let r = create len in let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in let cpylen = min (length s - srcoff) (len - dstoff) in if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen; r let fill s ofs len c = if ofs < 0 || len < 0 || ofs > length s - len then invalid_arg "Bytes.fill" else unsafe_fill s ofs len c let blit s1 ofs1 s2 ofs2 len = if len < 0 || ofs1 < 0 || ofs1 > length s1 - len || ofs2 < 0 || ofs2 > length s2 - len then invalid_arg "Bytes.blit" else unsafe_blit s1 ofs1 s2 ofs2 len let blit_string s1 ofs1 s2 ofs2 len = if len < 0 || ofs1 < 0 || ofs1 > string_length s1 - len || ofs2 < 0 || ofs2 > length s2 - len then invalid_arg "Bytes.blit_string" else unsafe_blit_string s1 ofs1 s2 ofs2 len let iter f a = for i = 0 to length a - 1 do f(unsafe_get a i) done let iteri f a = for i = 0 to length a - 1 do f i (unsafe_get a i) done let concat sep l = match l with [] -> empty | hd :: tl -> let num = ref 0 and len = ref 0 in List.iter (fun s -> incr num; len := !len + length s) l; let r = create (!len + length sep * (!num - 1)) in unsafe_blit hd 0 r 0 (length hd); let pos = ref(length hd) in List.iter (fun s -> unsafe_blit sep 0 r !pos (length sep); pos := !pos + length sep; unsafe_blit s 0 r !pos (length s); pos := !pos + length s) tl; r let cat s1 s2 = let l1 = length s1 in let l2 = length s2 in let r = create (l1 + l2) in unsafe_blit s1 0 r 0 l1; unsafe_blit s2 0 r l1 l2; r ;; external is_printable: char -> bool = "caml_is_printable" external char_code: char -> int = "%identity" external char_chr: int -> char = "%identity" let is_space = function | ' ' | '\012' | '\n' | '\r' | '\t' -> true | _ -> false let trim s = let len = length s in let i = ref 0 in while !i < len && is_space (unsafe_get s !i) do incr i done; let j = ref (len - 1) in while !j >= !i && is_space (unsafe_get s !j) do decr j done; if !j >= !i then sub s !i (!j - !i + 1) else empty let escaped s = let n = ref 0 in for i = 0 to length s - 1 do n := !n + (match unsafe_get s i with | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 | c -> if is_printable c then 1 else 4) done; if !n = length s then copy s else begin let s' = create !n in n := 0; for i = 0 to length s - 1 do begin match unsafe_get s i with | ('"' | '\\') as c -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c | '\n' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n' | '\t' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't' | '\r' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r' | '\b' -> unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b' | c -> if is_printable c then unsafe_set s' !n c else begin let a = char_code c in unsafe_set s' !n '\\'; incr n; unsafe_set s' !n (char_chr (48 + a / 100)); incr n; unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); incr n; unsafe_set s' !n (char_chr (48 + a mod 10)) end end; incr n done; s' end let map f s = let l = length s in if l = 0 then s else begin let r = create l in for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done; r end let mapi f s = let l = length s in if l = 0 then s else begin let r = create l in for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done; r end let uppercase s = map Char.uppercase s let lowercase s = map Char.lowercase s let apply1 f s = if length s = 0 then s else begin let r = copy s in unsafe_set r 0 (f(unsafe_get s 0)); r end let capitalize s = apply1 Char.uppercase s let uncapitalize s = apply1 Char.lowercase s let rec index_rec s lim i c = if i >= lim then raise Not_found else if unsafe_get s i = c then i else index_rec s lim (i + 1) c;; let index s c = index_rec s (length s) 0 c;; let index_from s i c = let l = length s in if i < 0 || i > l then invalid_arg "Bytes.index_from" else index_rec s l i c;; let rec rindex_rec s i c = if i < 0 then raise Not_found else if unsafe_get s i = c then i else rindex_rec s (i - 1) c;; let rindex s c = rindex_rec s (length s - 1) c;; let rindex_from s i c = if i < -1 || i >= length s then invalid_arg "Bytes.rindex_from" else rindex_rec s i c;; let contains_from s i c = let l = length s in if i < 0 || i > l then invalid_arg "Bytes.contains_from" else try ignore (index_rec s l i c); true with Not_found -> false;; let contains s c = contains_from s 0 c;; let rcontains_from s i c = if i < 0 || i >= length s then invalid_arg "Bytes.rcontains_from" else try ignore (rindex_rec s i c); true with Not_found -> false;; type t = bytes let compare (x: t) (y: t) = Pervasives.compare x y coccinelle-1.0.4/commons/parser_combinators.ml0000644000175000017500000002246112614153277020522 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.4/commons/objet.mli0000644000175000017500000000113612614153277016076 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.4/commons/ocollection.ml0000644000175000017500000000771712614153277017147 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.4/commons/glimpse.ml0000644000175000017500000001172712614153277016271 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 null_string s = (s = "") in let xs = Common.cmd_to_list ("glimpse -V") +> Common.exclude 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 +> String.concat " " (*****************************************************************************) (* 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.4/commons/bytes.mli0000644000175000017500000004025512614153277016126 0ustar eugeneugen(***********************************************************************) (* *) (* OCaml *) (* *) (* 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. *) (* *) (***********************************************************************) (** Byte sequence operations. A byte sequence is a mutable data structure that contains a fixed-length sequence of bytes. Each byte can be indexed in constant time for reading or writing. Given a byte sequence [s] of length [l], we can access each of the [l] bytes of [s] via its index in the sequence. Indexes start at [0], and we will call an index valid in [s] if it falls within the range [[0...l-1]] (inclusive). A position is the point between two bytes or at the beginning or end of the sequence. We call a position valid in [s] if it falls within the range [[0...l]] (inclusive). Note that the byte at index [n] is between positions [n] and [n+1]. Two parameters [start] and [len] are said to designate a valid range of [s] if [len >= 0] and [start] and [start+len] are valid positions in [s]. Byte sequences can be modified in place, for instance via the [set] and [blit] functions described below. See also strings (module {!String}), which are almost the same data structure, but cannot be modified in place. Bytes are represented by the OCaml type [char]. @since 4.02.0 *) (* Since this module is only here as a compatibility layer to let the code compile with versions of OCaml < 4.02, we simply define the bytes type to be string. *) type bytes = string external length : bytes -> int = "%string_length" (** Return the length (number of bytes) of the argument. *) external get : bytes -> int -> char = "%string_safe_get" (** [get s n] returns the byte at index [n] in argument [s]. Raise [Invalid_argument] if [n] not a valid index in [s]. *) external set : bytes -> int -> char -> unit = "%string_safe_set" (** [set s n c] modifies [s] in place, replacing the byte at index [n] with [c]. Raise [Invalid_argument] if [n] is not a valid index in [s]. *) external create : int -> bytes = "caml_create_string" (** [create n] returns a new byte sequence of length [n]. The sequence is uninitialized and contains arbitrary bytes. Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) val make : int -> char -> bytes (** [make n c] returns a new byte sequence of length [n], filled with the byte [c]. Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) val init : int -> (int -> char) -> bytes (** [Bytes.init n f] returns a fresh byte sequence of length [n], with character [i] initialized to the result of [f i] (in increasing index order). Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) val empty : bytes (** A byte sequence of size 0. *) val copy : bytes -> bytes (** Return a new byte sequence that contains the same bytes as the argument. *) val of_string : string -> bytes (** Return a new byte sequence that contains the same bytes as the given string. *) val to_string : bytes -> string (** Return a new string that contains the same bytes as the given byte sequence. *) val sub : bytes -> int -> int -> bytes (** [sub s start len] returns a new byte sequence of length [len], containing the subsequence of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not designate a valid range of [s]. *) val sub_string : bytes -> int -> int -> string (** Same as [sub] but return a string instead of a byte sequence. *) val extend : bytes -> int -> int -> bytes (** [extend s left right] returns a new byte sequence that contains the bytes of [s], with [left] uninitialized bytes prepended and [right] uninitialized bytes appended to it. If [left] or [right] is negative, then bytes are removed (instead of appended) from the corresponding side of [s]. Raise [Invalid_argument] if the result length is negative or longer than {!Sys.max_string_length} bytes. *) val fill : bytes -> int -> int -> char -> unit (** [fill s start len c] modifies [s] in place, replacing [len] characters with [c], starting at [start]. Raise [Invalid_argument] if [start] and [len] do not designate a valid range of [s]. *) val blit : bytes -> int -> bytes -> int -> int -> unit (** [blit src srcoff dst dstoff len] copies [len] bytes from sequence [src], starting at index [srcoff], to sequence [dst], starting at index [dstoff]. It works correctly even if [src] and [dst] are the same byte sequence, and the source and destination intervals overlap. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] do not designate a valid range of [dst]. *) val blit_string : string -> int -> bytes -> int -> int -> unit (** [blit src srcoff dst dstoff len] copies [len] bytes from string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] do not designate a valid range of [dst]. *) val concat : bytes -> bytes list -> bytes (** [concat sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and returns the result as a new byte sequence. Raise [Invalid_argument] if the result is longer than {!Sys.max_string_length} bytes. *) val cat : bytes -> bytes -> bytes (** [cat s1 s2] concatenates [s1] and [s2] and returns the result as new byte sequence. Raise [Invalid_argument] if the result is longer than {!Sys.max_string_length} bytes. *) val iter : (char -> unit) -> bytes -> unit (** [iter f s] applies function [f] in turn to all the bytes of [s]. It is equivalent to [f (get s 0); f (get s 1); ...; f (get s (length s - 1)); ()]. *) val iteri : (int -> char -> unit) -> bytes -> unit (** Same as {!Bytes.iter}, but the function is applied to the index of the byte as first argument and the byte itself as second argument. *) val map : (char -> char) -> bytes -> bytes (** [map f s] applies function [f] in turn to all the bytes of [s] (in increasing index order) and stores the resulting bytes in a new sequence that is returned as the result. *) val mapi : (int -> char -> char) -> bytes -> bytes (** [mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the resulting bytes in a new sequence that is returned as the result. *) val trim : bytes -> bytes (** Return a copy of the argument, without leading and trailing whitespace. The bytes regarded as whitespace are the ASCII characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *) val escaped : bytes -> bytes (** Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. Raise [Invalid_argument] if the result is longer than {!Sys.max_string_length} bytes. *) val index : bytes -> char -> int (** [index s c] returns the index of the first occurrence of byte [c] in [s]. Raise [Not_found] if [c] does not occur in [s]. *) val rindex : bytes -> char -> int (** [rindex s c] returns the index of the last occurrence of byte [c] in [s]. Raise [Not_found] if [c] does not occur in [s]. *) val index_from : bytes -> int -> char -> int (** [index_from s i c] returns the index of the first occurrence of byte [c] in [s] after position [i]. [Bytes.index s c] is equivalent to [Bytes.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. Raise [Not_found] if [c] does not occur in [s] after position [i]. *) val rindex_from : bytes -> int -> char -> int (** [rindex_from s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1]. [rindex s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) val contains : bytes -> char -> bool (** [contains s c] tests if byte [c] appears in [s]. *) val contains_from : bytes -> int -> char -> bool (** [contains_from s start c] tests if byte [c] appears in [s] after position [start]. [contains s c] is equivalent to [contains_from s 0 c]. Raise [Invalid_argument] if [start] is not a valid position in [s]. *) val rcontains_from : bytes -> int -> char -> bool (** [rcontains_from s stop c] tests if byte [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid position in [s]. *) val uppercase : bytes -> bytes (** Return a copy of the argument, with all lowercase letters translated to uppercase, including accented letters of the ISO Latin-1 (8859-1) character set. *) val lowercase : bytes -> bytes (** Return a copy of the argument, with all uppercase letters translated to lowercase, including accented letters of the ISO Latin-1 (8859-1) character set. *) val capitalize : bytes -> bytes (** Return a copy of the argument, with the first byte set to uppercase. *) val uncapitalize : bytes -> bytes (** Return a copy of the argument, with the first byte set to lowercase. *) type t = bytes (** An alias for the type of byte sequences. *) val compare: t -> t -> int (** The comparison function for byte sequences, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as argument to the functors {!Set.Make} and {!Map.Make}. *) (** {4 Unsafe conversions (for advanced users)} This section describes unsafe, low-level conversion functions between [bytes] and [string]. They do not copy the internal data; used improperly, they can break the immutability invariant on strings provided by the [-safe-string] option. They are available for expert library authors, but for most purposes you should use the always-correct {!Bytes.to_string} and {!Bytes.of_string} instead. *) val unsafe_to_string : bytes -> string (** Unsafely convert a byte sequence into a string. To reason about the use of [unsafe_to_string], it is convenient to consider an "ownership" discipline. A piece of code that manipulates some data "owns" it; there are several disjoint ownership modes, including: - Unique ownership: the data may be accessed and mutated - Shared ownership: the data has several owners, that may only access it, not mutate it. Unique ownership is linear: passing the data to another piece of code means giving up ownership (we cannot write the data again). A unique owner may decide to make the data shared (giving up mutation rights on it), but shared data may not become uniquely-owned again. [unsafe_to_string s] can only be used when the caller owns the byte sequence [s] -- either uniquely or as shared immutable data. The caller gives up ownership of [s], and gains ownership of the returned string. There are two valid use-cases that respect this ownership discipline: 1. Creating a string by initializing and mutating a byte sequence that is never changed after initialization is performed. {[ let string_init len f : string = let s = Bytes.create len in for i = 0 to len - 1 do Bytes.set s i (f i) done; Bytes.unsafe_to_string s ]} This function is safe because the byte sequence [s] will never be accessed or mutated after [unsafe_to_string] is called. The [string_init] code gives up ownership of [s], and returns the ownership of the resulting string to its caller. Note that it would be unsafe if [s] was passed as an additional parameter to the function [f] as it could escape this way and be mutated in the future -- [string_init] would give up ownership of [s] to pass it to [f], and could not call [unsafe_to_string] safely. We have provided the {!String.init}, {!String.map} and {!String.mapi} functions to cover most cases of building new strings. You should prefer those over [to_string] or [unsafe_to_string] whenever applicable. 2. Temporarily giving ownership of a byte sequence to a function that expects a uniquely owned string and returns ownership back, so that we can mutate the sequence again after the call ended. {[ let bytes_length (s : bytes) = String.length (Bytes.unsafe_to_string s) ]} In this use-case, we do not promise that [s] will never be mutated after the call to [bytes_length s]. The {!String.length} function temporarily borrows unique ownership of the byte sequence (and sees it as a [string]), but returns this ownership back to the caller, which may assume that [s] is still a valid byte sequence after the call. Note that this is only correct because we know that {!String.length} does not capture its argument -- it could escape by a side-channel such as a memoization combinator. The caller may not mutate [s] while the string is borrowed (it has temporarily given up ownership). This affects concurrent programs, but also higher-order functions: if [String.length] returned a closure to be called later, [s] should not be mutated until this closure is fully applied and returns ownership. *) val unsafe_of_string : string -> bytes (** Unsafely convert a shared string to a byte sequence that should not be mutated. The same ownership discipline that makes [unsafe_to_string] correct applies to [unsafe_of_string]: you may use it if you were the owner of the [string] value, and you will own the return [bytes] in the same mode. In practice, unique ownership of string values is extremely difficult to reason about correctly. You should always assume strings are shared, never uniquely owned. For example, string literals are implicitly shared by the compiler, so you never uniquely own them. {[ let incorrect = Bytes.unsafe_of_string "hello" let s = Bytes.of_string "hello" ]} The first declaration is incorrect, because the string literal ["hello"] could be shared by the compiler with other parts of the program, and mutating [incorrect] is a bug. You must always use the second version, which performs a copy and is thus correct. Assuming unique ownership of strings that are not string literals, but are (partly) built from string literals, is also incorrect. For example, mutating [unsafe_of_string ("foo" ^ s)] could mutate the shared string ["foo"] -- assuming a rope-like representation of strings. More generally, functions operating on strings will assume shared ownership, they do not preserve unique ownership. It is thus incorrect to assume unique ownership of the result of [unsafe_of_string]. The only case we have reasonable confidence is safe is if the produced [bytes] is shared -- used as an immutable byte sequence. This is possibly useful for incremental migration of low-level programs that manipulate immutable sequences of bytes (for example {!Marshal.from_bytes}) and previously used the [string] type for this purpose. *) (**/**) (* The following is for system use only. Do not call directly. *) external unsafe_get : bytes -> int -> char = "%string_unsafe_get" external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set" external unsafe_blit : bytes -> int -> bytes -> int -> int -> unit = "caml_blit_string" "noalloc" external unsafe_fill : bytes -> int -> int -> char -> unit = "caml_fill_string" "noalloc" coccinelle-1.0.4/commons/ocollection/0000755000175000017500000000000012614155375016602 5ustar eugeneugencoccinelle-1.0.4/commons/ocollection/osetb.ml0000644000175000017500000000166012614153277020252 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.4/commons/ocollection/oassocb.ml0000644000175000017500000000117612614153277020571 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.4/commons/common.ml0000644000175000017500000050426612614153277016126 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 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 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 = *) let spf = Printf.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 *) (*****************************************************************************) 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 (Printf.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 (Printf.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 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 = ... *) (*****************************************************************************) (* 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 ( \B0 ) 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 = ... *) (* 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 -> Printf.eprintf "%s" msg; exit 2 | Arg.Help msg -> Printf.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 (*###########################################################################*) (* 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 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 *) (*****************************************************************************) (* 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 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.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 Printf.sprintf "%dMo%dKo" mo ko else Printf.sprintf "%dKo" ko ) let size_ko i = let ko = i / 1024 in Printf.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 *) (*****************************************************************************) 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 if Sys.file_exists filename then filename else begin pr2 ("Warning: extending nonstandard filename: "^filename); filename ^ ext end else filename let db_of_filename file = Filename.dirname file, Filename.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 (String.concat "/" 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/%3s/%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 = int_of_string 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 = int_of_string sday; Unix.tm_hour = int_of_string shour; Unix.tm_min = int_of_string smin; Unix.tm_sec = int_of_string 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/%3s/%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)) let this_year() = let time = Unix.gmtime (Unix.time()) in time.Unix.tm_year + 1900 (*****************************************************************************) (* 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 (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.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 let file_to_stdout file = let i = open_in file in let rec loop _ = Printf.printf "%s\n" (input_line i); loop() in try loop() with End_of_file -> close_in i let file_to_stderr file = let i = open_in file in let rec loop _ = Printf.eprintf "%s\n" (input_line i); loop() in try loop() with End_of_file -> close_in i (* 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 = Bytes.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 ( try ignore(Unix.getitimer Unix.ITIMER_VIRTUAL); true with Unix.Unix_error(_, _, _) -> false) 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 = string_of_int (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 combine4 : 'a list -> 'b list -> 'c list -> 'd list -> ('a * 'b * 'c * 'd) list = fun a b c d -> match (a,b,c,d) with | ([],[],[],[]) -> [] | (w::ws,x::xs,y::ys,z::zs) -> (w,x,y,z)::combine4 ws xs ys zs | ___else___ -> invalid_arg "combine4: not same length" 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 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 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 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 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) (* 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 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 inter_all = function [] -> [] | x::xs -> List.fold_left inter_set x xs 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 l = let l = List.sort compare l in let rec loop = function [] -> [] | x::((y::_) as xs) when x = y -> loop xs | x::xs -> x :: loop xs in loop l (*****************************************************************************) (* 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 (x : int) (y : int) = Pervasives.compare x y 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 ((x1, y1) : int * int) ((x2, y2) : int * int) = let cmp_x = Pervasives.compare x1 x2 in if cmp_x <> 0 then cmp_x else Pervasives.compare y1 y2 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 -> string_of_int 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) = []) 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 sort = List.sort let length = List.length 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 let slength = String.length s in if (!posl + slength > charpos) then begin close_in chan; (!linen, charpos - !posl, s) end else begin posl := !posl + slength; 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.make 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 *) let slength = String.length s in for i = 0 to (slength - 1) + 1 do arr.(!charpos + i) <- (!line, i); done; charpos := !charpos + slength + 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)); } (*---------------------------------------------------------------------------*) (* 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 Printf.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 " ^ string_of_int 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 Printf.sprintf "File \"%s\", line %d" filename line with End_of_file -> begin ("PB in Common.error_message, position " ^ string_of_int 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 (Printf.sprintf "good = %d/%d" good total) let print_score score = score +> hash_to_list +> List.iter (fun (k, v) -> pr2 (Printf.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 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_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.4/commons/osequence.mli0000644000175000017500000000025212614153277016760 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.4/commons/parser_combinators.mli0000644000175000017500000001065612614153277020676 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.4/commons/oset.ml0000644000175000017500000000270612614153277015600 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.4/commons/oassoc.mli0000644000175000017500000000112112614153277016254 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.4/commons/ograph.ml0000644000175000017500000000142712614153277016105 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.4/commons/ograph_simple.mli0000644000175000017500000000162612614153277017630 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.4/commons/license.txt0000644000175000017500000006546712614153277016474 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.4/commons/ocollection.mli0000644000175000017500000000141512614153277017305 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.4/commons/oassoc.ml0000644000175000017500000000234712614153277016116 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.4/commons/copyright.txt0000644000175000017500000000143412614153277017042 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.4/commons/ograph_simple.ml0000644000175000017500000000636612614153277017465 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.4/commons/readme.txt0000644000175000017500000000322412614153277016266 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.4/commons/oarray.mli0000644000175000017500000000127212614153277016271 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.4/commons/commands.ml.in0000644000175000017500000000032112614153277017023 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@" coccinelle-1.0.4/commons/oset.mli0000644000175000017500000000145412614153277015750 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.4/commons/credits.txt0000644000175000017500000000037512614153277016472 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.4/commons/authors.txt0000644000175000017500000000022212614153277016511 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.4/commons/ocamlextra/0000755000175000017500000000000012614155375016427 5ustar eugeneugencoccinelle-1.0.4/commons/ocamlextra/mapb.ml0000644000175000017500000001112012614153277017672 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.4/commons/ocamlextra/setPt.ml0000644000175000017500000002711312614153277020063 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.4/commons/ocamlextra/setb.mli0000644000175000017500000001425312614153277020073 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.4/commons/ocamlextra/suffix_tree_ext.ml0000644000175000017500000003045312614153277022170 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 || 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.4/commons/ocamlextra/suffix_tree_ext.mli0000644000175000017500000001107412614153277022337 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.4/commons/ocamlextra/enum.ml0000644000175000017500000001554312614153277017734 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.4/commons/ocamlextra/enum.mli0000644000175000017500000001741612614153277020106 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.4/commons/ocamlextra/suffix_tree.mli0000644000175000017500000001050212614153277021452 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.4/commons/ocamlextra/dumper.ml0000644000175000017500000000506712614153277020264 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 failwith ("dump: impossible tag (" ^ string_of_int t ^ ")") ) let dump v = dump (repr v) coccinelle-1.0.4/commons/ocamlextra/dynArray.mli0000644000175000017500000002634012614153277020727 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.4/commons/ocamlextra/suffix_tree.ml0000644000175000017500000002676312614153277021321 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 || 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.4/commons/ocamlextra/dumper.mli0000644000175000017500000000025112614153277020423 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.4/commons/ocamlextra/setb.ml0000644000175000017500000002346512614153277017727 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.4/commons/ocamlextra/dynArray.ml0000644000175000017500000002454212614153277020560 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.4/commons/Makefile0000644000175000017500000001636512614153277015742 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 \ interfaces.ml objet.ml \ ocollection.ml \ seti.ml \ oset.ml oassoc.ml osequence.ml ograph.ml \ ocollection/osetb.ml \ ocollection/oassocb.ml \ oarray.ml \ ograph_simple.ml ograph_extended.ml \ glimpse.ml parser_combinators.ml MLI_FILES=\ common.mli \ oarray.mli \ oassoc.mli \ objet.mli \ ocollection.mli \ ograph_extended.mli \ ograph.mli \ ograph_simple.mli \ osequence.mli \ oset.mli \ parser_combinators.mli ifeq ($(COMPILE_EMBEDDED_BYTES_MODULE),yes) MYSRC+=bytes.ml MLI_FILES+=bytes.mli endif # src from other authors, got from the web or caml hump SRC=ocamlextra/dumper.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 #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 #----------------------------------------------------------------------------- ############################################################################## # 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) 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 ############################################################################## # Other commons libs target ############################################################################## all_libs: bdb gui mpi backtrace #----------------------------------------------------------------------------- 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 $@ $^ #----------------------------------------------------------------------------- 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 $@ $^ ############################################################################## # 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 .PHONY: depend .depend depend: ifeq ($(COMPILE_EMBEDDED_BYTES_MODULE),yes) $(OCAMLDEP_CMD) $(MLI_FILES) $(MYSRC) > .depend else $(OCAMLDEP_CMD) $(MLI_FILES) $(MYSRC) | sed 's/bytes\.cm[a-z]\{1,\}//g' > .depend endif for i in $(SUBDIRS); do $(OCAMLDEP_CMD) $$i/*.ml $$i/*.mli >> .depend; done ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/commons/common.mli0000644000175000017500000017135112614153277016272 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 (* 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) *) (*****************************************************************************) (* 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) (*****************************************************************************) (* 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 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 (*###########################################################################*) (* 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 *) (*****************************************************************************) (* 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 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 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 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 val this_year : unit -> int (*****************************************************************************) (* 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 file_to_stdout : string -> unit val file_to_stderr : string -> unit 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 combine4 : 'a list -> 'b list -> 'c list -> 'd list -> ('a * 'b * 'c * 'd) 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 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 inter_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 mem : key -> 'a t -> bool val add : key -> 'a -> 'a t -> 'a t val singleton : key -> 'a -> 'a t val find : key -> 'a t -> 'a val remove : key -> 'a t -> 'a t val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val for_all : (key -> 'a -> bool) -> 'a t -> bool val exists : (key -> 'a -> bool) -> 'a t -> bool val filter : (key -> 'a -> bool) -> 'a t -> 'a t val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t val cardinal : 'a t -> int val bindings : 'a t -> (key * 'a) list val min_binding : 'a t -> key * 'a val max_binding : 'a t -> key * 'a val choose : 'a t -> key * 'a val split : key -> 'a t -> 'a t * 'a option * 'a t val find : key -> 'a t -> 'a val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t 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 mem : key -> 'a t -> bool val add : key -> 'a -> 'a t -> 'a t val singleton : key -> 'a -> 'a t val find : key -> 'a t -> 'a val remove : key -> 'a t -> 'a t val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val iter : (key -> 'a -> unit) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val for_all : (key -> 'a -> bool) -> 'a t -> bool val exists : (key -> 'a -> bool) -> 'a t -> bool val filter : (key -> 'a -> bool) -> 'a t -> 'a t val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t val cardinal : 'a t -> int val bindings : 'a t -> (key * 'a) list val min_binding : 'a t -> key * 'a val max_binding : 'a t -> key * 'a val choose : 'a t -> key * 'a val split : key -> 'a t -> 'a t * 'a option * 'a t val find : key -> 'a t -> 'a val map : ('a -> 'b) -> 'a t -> 'b t val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t 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 val sort : ('a -> 'a -> int) -> 'a list -> 'a list val length : 'a list -> int val head : 'a list -> 'a val tail : 'a list -> 'a list val is_singleton : 'a list -> bool (*###########################################################################*) (* And now misc functions *) (*###########################################################################*) (*****************************************************************************) (* 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 (* 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.4/commons/ograph_extended.mli0000644000175000017500000000452712614153277020142 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.4/commons/ograph.mli0000644000175000017500000000107512614153277016255 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.4/commons/seti.ml0000644000175000017500000003033512614153277015571 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 (Printf.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 = "[" ^ String.concat "," (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 *) (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 = 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 (Printf.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.4/commons/osequence.ml0000644000175000017500000000037112614153277016611 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.4/commons/interfaces.ml0000644000175000017500000001176712614153277016760 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.4/testing.mli0000644000175000017500000000600312614153277014773 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) open Common (*****************************************************************************) (* work with tests/ *) (*****************************************************************************) val testone : string (*prefix*) -> string (*test*) -> bool (*compare_expected*) -> unit val testall : string -> bool -> unit val test_spacing : 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 val test_rule_dependencies : 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 * string 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.4/readme.txt0000644000175000017500000000671712614153277014625 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.4/Makefile.release0000644000175000017500000002532512614153277015702 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr ############################################################################## # 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. extra_configure_flags := # 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 # # 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 ./autogen --ignore_localversion" @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 ./autogen ./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)" $(GIT) add ./version $(GIT) add setup/Makefile.in $(GIT) commit -m "Release $(VERSION)" $(GIT) tag -a -m "Release $(VERSION)" $(VERSION) $(GIT) push origin $(VERSION) master:master @echo "\n\tDo 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: if [ ! -f ./configure ]; then ./autogen; fi ./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 ./autogen ./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 ./autogen ./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. # # 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 -fa ./* "$(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 # 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 "tests" \ --exclude "TODO" \ --cvs-exclude packsrc: prepack $(MAKE) -C $(TMP)/$(PACKAGE)/debian $(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) 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) 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.4/popl/0000755000175000017500000000000012614153277013566 5ustar eugeneugencoccinelle-1.0.4/popl/asttopopl.mli0000644000175000017500000000043412614153277016317 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val top : Ast_cocci.top_level -> Ast_popl.sequence coccinelle-1.0.4/popl/insert_befaft.ml0000644000175000017500000000632012614153277016734 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/insert_quantifiers.ml0000644000175000017500000000554112614153277020043 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/insert_quantifiers.mli0000644000175000017500000000045112614153277020207 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val insert_quantifiers : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.4/popl/insert_befaft.mli0000644000175000017500000000044412614153277017106 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val insert_befaft : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.4/popl/popltoctl.ml0000644000175000017500000001422712614153277016146 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/asttopopl.ml0000644000175000017500000000372712614153277016156 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 = List.fold_right (function cur -> function rest -> Past.Seq(stm cur, rest)) (Ast.unwrap s) Past.Empty let top s = match Ast.unwrap s with Ast.CODE(stmt_dots) -> stm_list stmt_dots | _ -> failwith "only CODE handled" coccinelle-1.0.4/popl/pretty_print_popl.mli0000644000175000017500000000050412614153277020065 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val pretty_print : Ast_popl.sequence -> unit val pretty_print_e : Ast_popl.element -> unit coccinelle-1.0.4/popl/pretty_print_popl.ml0000644000175000017500000000400012614153277017707 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/ast_popl.ml0000644000175000017500000000120212614153277015734 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/popl.mli0000644000175000017500000000072112614153277015243 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/popl.ml0000644000175000017500000000140112614153277015066 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl/Makefile0000644000175000017500000000362512614153277015234 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr #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 .PHONY: depend .depend depend: $(OCAMLDEP_CMD) $(INCLUDE_PATH) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/popl/popltoctl.mli0000644000175000017500000000072012614153277016310 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/0000755000175000017500000000000012614156171013733 5ustar eugeneugencoccinelle-1.0.4/popl09/asttopopl.mli0000644000175000017500000000043412614153277016470 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val top : Ast_cocci.top_level -> Ast_popl.sequence coccinelle-1.0.4/popl09/insert_quantifiers.ml0000644000175000017500000000673212614153277020217 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/insert_quantifiers.mli0000644000175000017500000000045112614153277020360 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val insert_quantifiers : Ast_popl.sequence -> Ast_popl.sequence coccinelle-1.0.4/popl09/popltoctl.ml0000644000175000017500000001703512614153277016317 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 || 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 annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k re = let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,va,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl decl -> bind (mcode r ((),(),annotated_decl decl,[])) res | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (mcode r ((),(),annotated_decl decl,[])) res | _ -> res in let recursor = V.combiner bind option_default mcode 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 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 || keep_wit,v,x) let predmaker keep_wit term = if (!Flag_popl.keep_all_wits || keep_wit) && (!Flag_popl.mark_all || 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.4/popl09/asttopopl.ml0000644000175000017500000000510312614153277016315 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 = List.fold_right (function cur -> function rest -> Past.Seq(stm cur, rest)) (Ast.unwrap s) Past.Empty let top s = match Ast.unwrap s with Ast.CODE(stmt_dots) -> stm_list stmt_dots | _ -> failwith "only CODE handled" coccinelle-1.0.4/popl09/pretty_print_popl.mli0000644000175000017500000000050412614153277020236 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val pretty_print : Ast_popl.sequence -> unit val pretty_print_e : Ast_popl.element -> unit coccinelle-1.0.4/popl09/pretty_print_popl.ml0000644000175000017500000000557612614153277020103 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/ast_popl.ml0000644000175000017500000000147312614153277016117 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/popl.mli0000644000175000017500000000072112614153277015414 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/popl.ml0000644000175000017500000000134212614153277015243 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/popl09/Makefile0000644000175000017500000000356012614153277015403 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr #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) 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) -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 .PHONY: depend .depend depend: $(OCAMLDEP_CMD) *.mli *.ml > .depend ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/popl09/flag_popl.ml0000644000175000017500000000044012614153277016232 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) let mark_all = ref false let keep_all_wits = ref false coccinelle-1.0.4/popl09/popltoctl.mli0000644000175000017500000000072012614153277016461 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/0000755000175000017500000000000012616742627015424 5ustar eugeneugencoccinelle-1.0.4/parsing_cocci/adjacency.mli0000644000175000017500000000044412614153277020045 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val compute_adjacency : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/insert_plus.ml0000644000175000017500000012376212614153277020333 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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) | 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,[]) | 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 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.assignOp) (donothing Ast0.binaryOp) (donothing Ast0.typeC) initialiser (donothing Ast0.param) (donothing Ast0.decl) statement (donothing Ast0.forinfo) (donothing Ast0.case_line) (donothing Ast0.string_fragment) 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 rec key n = match n 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.AssignOpTag d -> Ast0.get_index d | Ast0.BinaryOpTag 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.StringFragmentTag(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" | Ast0.WhenTag(_,_,w) -> key w in Hashtbl.add root_token_table (key node) 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 unfavored_mcode (x,_,info,mcodekind,_,_) = [(Unfavored,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) -> (* was unfavored, not sure 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 checklast = let multibind l = let rec loop = function [] -> option_default | [x] -> x | x::xs -> bind x (loop xs) in loop l in let l = Ast0.unwrap d in match checklast with None -> multibind (List.map f l) | Some checklast -> match List.rev l with last::others -> multibind ((List.map f (List.rev others)) @ [checklast last]) | [] -> multibind [] in (* have to unfavor a trailing comme because it might not match anything *) let edots r k d = dots r.VT0.combiner_rec_expression k d (Some (function e -> match Ast0.unwrap e with Ast0.EComma(comma) -> unfavored_mcode comma | _ -> r.VT0.combiner_rec_expression e)) in let idots r k d = dots r.VT0.combiner_rec_initialiser k d (Some (function i -> match Ast0.unwrap i with Ast0.IComma(comma) -> unfavored_mcode comma | _ -> r.VT0.combiner_rec_initialiser i)) in let pdots r k d = dots r.VT0.combiner_rec_parameter k d (Some (function p -> match Ast0.unwrap p with Ast0.PComma(comma) -> unfavored_mcode comma | _ -> r.VT0.combiner_rec_parameter p)) in let sdots r k d = dots r.VT0.combiner_rec_statement k d None in let ddots r k d = dots r.VT0.combiner_rec_declaration k d None in let cdots r k d = dots r.VT0.combiner_rec_case_line k d None 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,va,rp,lbrace,body,rbrace, (aftinfo,aft)) -> (Toplevel,info,bef)::(k s)@[(Toplevel,aftinfo,aft)] | 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) -> mcode d (* ignore whencode *) | Ast0.OptStm 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) -> mcode d (* ignore whencode *) | Ast0.OptExp 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 -> (* 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 -> (* 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 -> (* 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 -> (* 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 -> (* 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 mcode mcode edots idots pdots sdots ddots cdots ident expression do_nothing do_nothing typeC initialiser param decl statement forinfo case_line do_nothing do_top let call_collect_minus context_nodes : (int * (minus_join_point * Ast0.info * Ast0.mcodekind) list) list = List.map (function e -> let rec f' = (function 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.AssignOpTag op -> (Ast0.get_index op, (collect_minus_join_points op).VT0.combiner_rec_assignOp op) | Ast0.BinaryOpTag op -> (Ast0.get_index op, (collect_minus_join_points op).VT0.combiner_rec_binaryOp op) | 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.StringFragmentTag(e) -> (Ast0.get_index e, (collect_minus_join_points e).VT0.combiner_rec_string_fragment 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" | Ast0.WhenTag(_,_,w) -> f' w) in f' e) 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 (Ast0toast.assignOp x) let mk_simpleAssignOp x = Ast.SimpleAssignOpTag x let mk_opAssignOp x = Ast.OpAssignOpTag x let mk_fixOp x = Ast.FixOpTag x let mk_binaryOp x = Ast.BinaryOpTag (Ast0toast.binaryOp x) let mk_arithOp x = Ast.ArithOpTag x let mk_logicalOp x = Ast.LogicalOpTag 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_string_fragment x = Ast.StringFragmentTag (Ast0toast.string_fragment 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.AnnDeclDotsTag (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_extra bef aft 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)] | _ -> bef@(k e)@aft in let do_nothing fn r k e = do_nothing_extra [] [] fn r 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.TopId(id) -> r.VT0.combiner_rec_ident id | Ast0.TopInit(init) -> r.VT0.combiner_rec_initialiser init | Ast0.Decl(bef,decl) -> do_nothing_extra (pre_info bef) [] mk_statement r k e | Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft) -> do_nothing_extra (pre_info bef) (pre_info aft) mk_statement r k e | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> do_nothing_extra [] (info aft) mk_statement r k e | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> do_nothing_extra [] (info aft) mk_statement r k e | Ast0.While(whl,lp,exp,rp,body,aft) -> do_nothing_extra [] (info aft) mk_statement r k e | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> do_nothing_extra [] (info aft)mk_statement r k e | Ast0.Iterator(nm,lp,args,rp,body,aft) -> do_nothing_extra [] (info aft) mk_statement r k e | _ -> 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 [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_simpleAssignOp) (mcode mk_opAssignOp) (mcode mk_fixOp) (mcode mk_unaryOp) (mcode mk_arithOp) (mcode mk_logicalOp) (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_assignOp) (do_nothing mk_binaryOp) (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) (do_nothing mk_string_fragment) toplevel let call_collect_plus context_nodes : (int * (Ast0.info * Ast.count * Ast.anything) list) list = List.map (function e -> let rec f' = (function 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.AssignOpTag(op) -> (Ast0.get_index op, (collect_plus_nodes op).VT0.combiner_rec_assignOp op) | Ast0.BinaryOpTag(op) -> (Ast0.get_index op, (collect_plus_nodes op).VT0.combiner_rec_binaryOp op) | 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.StringFragmentTag(e) -> (Ast0.get_index e, (collect_plus_nodes e).VT0.combiner_rec_string_fragment 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" | Ast0.WhenTag(_,_,w) -> f' w) in f' e) 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 || (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 || is_minus m1 || !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; Printf.printf "end of plus code\n"; *) 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_extra extra r k e = match Ast0.get_mcodekind e with Ast0.CONTEXT(mc) -> let updates = extra @ (k e) in if List.exists (function Ast.NOTHING -> false | _ -> true) updates then Ast0.set_mcodekind e (Ast0.MIXED(mc)); [] | _ -> let _ = k e in [] in let donothing r k e = donothing_extra [] r k e in (* a case for everything with bef or aft *) let stmt r k e = match Ast0.unwrap e with Ast0.Decl(bef,decl) -> donothing_extra (pre_info bef) r k e | Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft) -> donothing_extra ((pre_info bef) @ (pre_info aft)) r k e | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> donothing_extra (info aft) r k e | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> donothing_extra (info aft) r k e | Ast0.While(whl,lp,exp,rp,body,aft) -> donothing_extra (info aft) r k e | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> donothing_extra (info aft) r k e | Ast0.Iterator(nm,lp,args,rp,body,aft) -> donothing_extra (info aft) r k e | _ -> 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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing stmt donothing 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.4/parsing_cocci/lexer_cli.mll0000644000175000017500000000172112614153277020074 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/arity.ml0000644000175000017500000013252212614153277017106 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 optfn 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.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 mcodeassignOp2line op = match Ast0.unwrap op with Ast0.SimpleAssign op -> mcode2line op | Ast0.OpAssign op -> mcode2line op | Ast0.MetaAssign(mv,_,_) -> mcode2line mv let mcodeassignOp2arity op = match Ast0.unwrap op with Ast0.SimpleAssign op -> mcode2arity op | Ast0.OpAssign op -> mcode2arity op | Ast0.MetaAssign(mv,_,_) -> mcode2arity mv let mcodebinaryOp2line op = match Ast0.unwrap op with Ast0.Arith op -> mcode2line op | Ast0.Logical op -> mcode2line op | Ast0.MetaBinary(mv,_,_) -> mcode2line mv let mcodebinaryOp2arity op = match Ast0.unwrap op with Ast0.Arith op -> mcode2arity op | Ast0.Logical op -> mcode2arity op | Ast0.MetaBinary(mv,_,_) -> mcode2arity mv let mcode x = x (* nothing to do ... *) (* --------------------------------------------------------------------- *) (* Dots *) let dots fn d = Ast0.rewrap d (List.map fn (Ast0.unwrap d)) (* --------------------------------------------------------------------- *) (* Identifier *) let make_id = make_opt (function x -> Ast0.OptIdent 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.AsIdent _ -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Expression *) let make_exp = make_opt (function x -> Ast0.OptExp 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.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 (mcodeassignOp2line op) [mcodeassignOp2arity 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 (mcodebinaryOp2line op) [mcodebinaryOp2arity 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.ConjExpr(starter,exps,mids,ender) -> (match exps with e::es -> let e = top_expression opt_allowed tgt e in let arity = match Ast0.unwrap e with Ast0.OptExp _ -> Ast0.OPT | _ -> Ast0.NONE in let es = List.map (expression arity) es in make_exp expr tgt arity (Ast0.ConjExpr(starter,e::es,mids,ender)) | _ -> expr) | 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 (fun (a,e,b) -> (a,e,expression Ast0.NONE b)) whencode in make_exp expr tgt arity (Ast0.Edots(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.AsExpr _ | Ast0.AsSExpr _ -> failwith "unexpected code" and expression tgt exp = top_expression false tgt exp and make_fragment = make_opt (function x -> failwith "opt 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 (function x -> failwith "opt 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 (function x -> Ast0.OptType 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.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.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 (function x -> Ast0.OptDecl 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.FunProto(fi,name,lp1,params,va,rp1,sem) -> let tokens = match va with | None -> [lp1;rp1;sem] | Some (c1,e1) -> [lp1;c1;e1;rp1;sem] in let arity = all_same true tgt (mcode2line lp1) (List.map mcode2arity tokens) in let fi = List.map (fninfo arity) fi in let name = ident false arity name in let lp1 = mcode lp1 in let params = parameter_list tgt params in let va = match va with | None -> None | Some (c1, e1) -> Some (mcode c1, mcode e1) in let rp1 = mcode rp1 in let sem = mcode sem in make_decl decl tgt arity (Ast0.FunProto(fi,name,lp1,params,va,rp1,sem)) | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> let arity = all_same true tgt (mcode2line lp) ((match stg with None -> [] | Some x -> [mcode2arity x]) @ (List.map mcode2arity [lp;rp;sem])) in let stg = get_option mcode stg 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(stg,name,lp,args,rp,sem)) | Ast0.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> let arity = all_same true tgt (mcode2line lp) ((match stg with None -> [] | Some x -> [mcode2arity x]) @ (List.map mcode2arity [lp;rp;eq;sem])) in let stg = get_option mcode stg 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(stg,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 (fun (a,e,b) -> (a,e,declaration Ast0.NONE b)) whencode in make_decl decl tgt arity (Ast0.Ddots(dots,whencode)) | Ast0.OptDecl(_) | Ast0.AsDecl _ -> failwith "unexpected code" (* --------------------------------------------------------------------- *) (* Initializer *) and make_init = make_opt (function x -> Ast0.OptIni 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 (fun (a,e,b) -> (a,e,initialiser Ast0.NONE b)) whencode in make_init i tgt arity (Ast0.Idots(dots,whencode)) | Ast0.OptIni(_) | 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 (function x -> Ast0.OptParam 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.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.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.OptParam(_) | Ast0.AsParam _ -> failwith "unexpected code" and parameter_list tgt = dots (parameterTypeDef tgt) (* --------------------------------------------------------------------- *) (* Top-level code *) and make_rule_elem x = make_opt (function x -> Ast0.OptStm 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.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.Exec(exec,lang,code,sem) -> let arity = stm_same (mcode2line exec) (List.map mcode2arity [exec;lang;sem]) in let exec = mcode exec in let lang = mcode lang in let code = dots (exec_code arity) code in let sem = mcode sem in make_rule_elem stm tgt arity (Ast0.Exec(exec,lang,code,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,lenname,pure) -> let arity = stm_same (mcode2line name) [mcode2arity name] in let name = mcode name in make_rule_elem stm tgt arity (Ast0.MetaStmtList(name,lenname,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.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.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.Ty(new_ty)) | Ast0.TopId(id) -> (* opt makes no sense alone at top level *) let new_id = ident false tgt id in Ast0.rewrap stm (match Ast0.unwrap new_id with Ast0.OptIdent(id) -> Ast0.OptStm(Ast0.rewrap stm (Ast0.TopId(id))) | _ -> Ast0.TopId(new_id)) | 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.TopInit(new_init)) | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) -> let stms = List.map (function x -> 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) = (Ast0.unwrap x, function l -> Ast0.rewrap x 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.Conj(starter,rule_elem_dots_list,mids,ender) -> let stms = List.map (function x -> 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) = (Ast0.unwrap x, function l -> Ast0.rewrap x l) in let (fo,l) = rebuild l in (found_opt && fo,(k l)::lines)) (true,[]) 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.Conj(starter,stms,mids,ender)) | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) -> let new_rule_elem_dots = dots (statement Ast0.NONE) rule_elem_dots in let whn = List.map (whencode (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(d,whn) -> let arity = stm_same (mcode2line d) [mcode2arity d] in let d = mcode d in let whn = List.map (whencode (dots (statement Ast0.NONE)) (statement Ast0.NONE) (expression Ast0.NONE)) whn in make_rule_elem stm tgt arity (Ast0.Dots(d,whn)) | Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft) -> 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 newva = match va with | None -> None | Some (comma, ellipsis) -> Some (mcode comma, mcode ellipsis) 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,newva,rp,lbrace,body,rbrace,aft)) | 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.AsStmt _ -> failwith "unexpected code" and make_pragma = make_opt (function x -> failwith "opt 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 (function x -> Ast0.OptDParam 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.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.OptDParam(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 (w,e,a) -> Ast0.WhenNot (w,e,notfn a) | Ast0.WhenAlways (w,e,a) -> Ast0.WhenAlways (w,e,alwaysfn a) | Ast0.WhenModifier(w,x) -> Ast0.WhenModifier(w,x) | Ast0.WhenNotTrue (w,e,a) -> Ast0.WhenNotTrue (w,e,expression a) | Ast0.WhenNotFalse (w,e,a) -> Ast0.WhenNotFalse (w,e,expression a) and make_case_line = make_opt (function x -> Ast0.OptCase x) 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" and make_exec_code = make_opt (function x -> failwith "opt not allowed for exec code") and exec_code tgt e = match Ast0.unwrap e with Ast0.ExecEval(colon,id) -> let arity = all_same false tgt (mcode2line colon) [mcode2arity colon] in let colon = mcode colon in let id = expression tgt id in make_exec_code e tgt arity (Ast0.ExecEval(colon,id)) | Ast0.ExecToken(tok) -> let arity = all_same false tgt (mcode2line tok) [mcode2arity tok] in let tok = mcode tok in make_exec_code e tgt arity (Ast0.ExecToken(tok)) | Ast0.ExecDots(dots) -> let arity = all_same false tgt (mcode2line dots) [mcode2arity dots] in let dots = mcode dots in make_exec_code e tgt arity (Ast0.ExecDots(dots)) (* --------------------------------------------------------------------- *) (* 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(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.4/parsing_cocci/comm_assoc.ml0000644000175000017500000000460212614153277020076 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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_arith = [Ast.Plus; Ast.Mul; Ast.And; Ast.Or] let comm_assoc_logical = [Ast.AndLog; Ast.OrLog] let is_comm_assoc op0 = match Ast0.unwrap op0 with | Ast0.Arith op -> List.mem (Ast0.unwrap_mcode op) comm_assoc_arith | Ast0.Logical op -> List.mem (Ast0.unwrap_mcode op) comm_assoc_logical | Ast0.MetaBinary _ -> false let is_minus e = match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false let is_context e = !Flag.sgrep_mode2 || (* everything is context for sgrep *) (match Ast0.get_mcodekind e with Ast0.CONTEXT(cell) -> true | _ -> false) let nopos mc = (Ast0.get_pos mc) = [] let nopos_op op0 = match Ast0.unwrap op0 with | Ast0.Arith op -> nopos op | Ast0.Logical op -> nopos op | Ast0.MetaBinary(mv,_,_) -> nopos mv 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 is_comm_assoc op -> (match Ast0.unwrap right with Ast0.Edots(d,None) -> if (is_minus e || (is_context e && is_context right)) && nopos_op 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.4/parsing_cocci/plus.mli0000644000175000017500000000051412614153277017105 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val plus : Ast_cocci.rule -> (Ast_cocci.anything * int * int * int * int) list list list coccinelle-1.0.4/parsing_cocci/visitor_ast0_types.ml0000644000175000017500000002474612614153277021640 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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; assignOp : (Ast0.assignOp,'n) inout; binaryOp : (Ast0.binaryOp,'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; string_fragment : (Ast0.string_fragment,'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_assignOp : (Ast0.assignOp,'n) combiner_inout; combiner_rec_binaryOp : (Ast0.binaryOp,'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_string_fragment : (Ast0.string_fragment,'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_simpleAssign_mcode : (Ast0.simpleAssignOp,'n) cmcode; combiner_opAssign_mcode : (Ast.arithOp,'n) cmcode; combiner_fix_mcode : (Ast.fixOp,'n) cmcode; combiner_unary_mcode : (Ast.unaryOp,'n) cmcode; combiner_arithOp_mcode : (Ast.arithOp,'n) cmcode; combiner_logicalOp_mcode : (Ast.logicalOp,'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_assignOpfn : (Ast0.assignOp,'n) ccode; combiner_binaryOpfn : (Ast0.binaryOp,'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_string_fragmentfn : (Ast0.string_fragment,'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_assignOp : Ast0.assignOp rebuilder_inout; rebuilder_rec_binaryOp : Ast0.binaryOp 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_string_fragment : Ast0.string_fragment 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_simpleAssign_mcode : Ast0.simpleAssignOp rmcode; rebuilder_opAssign_mcode : Ast.arithOp rmcode; rebuilder_fix_mcode : Ast.fixOp rmcode; rebuilder_unary_mcode : Ast.unaryOp rmcode; rebuilder_arithOp_mcode : Ast.arithOp rmcode; rebuilder_logicalOp_mcode : Ast.logicalOp 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_assignOpfn : Ast0.assignOp rcode; rebuilder_binaryOpfn : Ast0.binaryOp 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_string_fragmentfn : Ast0.string_fragment 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_simpleAssign_mcode : (Ast0.simpleAssignOp,'n) rcmcode; combiner_rebuilder_opAssign_mcode : (Ast.arithOp,'n) rcmcode; combiner_rebuilder_fix_mcode : (Ast.fixOp,'n) rcmcode; combiner_rebuilder_unary_mcode : (Ast.unaryOp,'n) rcmcode; combiner_rebuilder_arithOp_mcode : (Ast.arithOp,'n) rcmcode; combiner_rebuilder_logicalOp_mcode : (Ast.logicalOp,'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_assignOpfn : (Ast0.assignOp,'n) rccode; combiner_rebuilder_binaryOpfn : (Ast0.binaryOp,'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_string_fragmentfn : (Ast0.string_fragment,'n) rccode; combiner_rebuilder_topfn : (Ast0.top_level,'n) rccode} coccinelle-1.0.4/parsing_cocci/README0000644000175000017500000000130112614153277016272 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.4/parsing_cocci/visitor_ast0.ml0000644000175000017500000017726412614153277020420 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* 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 simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn binaryOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn 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 = (* disj and conj *) let (starter_n,starter) = string_mcode starter in (* slightly ugly but ensures correct evaluation order. *) let (first_n, first) = processor (List.hd lst) in let rest = List.map2 (fun m l -> let m1 = string_mcode m in let p1 = processor l in (m1, p1)) mids (List.tl lst) in let bind_value = first_n :: List.rev( List.fold_left (fun acc ((m1,_),(p1,_)) -> p1 :: m1 :: acc) [] rest) in let lst = first :: (List.map (fun (_,(_,n)) -> n) rest) in let mids = List.map (fun ((_,n),_) -> n) rest in let (ender_n,ender) = string_mcode ender in (multibind [starter_n; multibind bind_value;ender_n], rebuilder starter lst mids ender) in let dotsfn param default all_functions arg = let k d = rewrap d (map_split_bind default (Ast0.unwrap d)) 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 ecdotsfn 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 exec_code_dots d = dotsfn ecdotsfn exec_code 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.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) = assignOp 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 (op_n,op) = fix_mcode op in let (exp_n,exp) = expression exp in (bind op_n exp_n, Ast0.Infix(exp,op)) | Ast0.Unary(exp,op) -> let (op_n,op) = unary_mcode op in let (exp_n,exp) = expression exp 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) = binaryOp 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) = binaryOp 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.ConjExpr(starter,expr_list,mids,ender) -> do_disj starter expr_list mids ender expression (fun starter expr_list mids ender -> Ast0.ConjExpr(starter,expr_list,mids,ender)) | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> let (starter_n,starter) = string_mcode starter in let (whencode_n, whencode) = whencode_option expression whencode in let (expr_dots_n,expr_dots) = expression_dots expr_dots in let (ender_n,ender) = string_mcode ender 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) = whencode_option expression whencode in (bind dots_n whencode_n,Ast0.Edots(dots,whencode)) | Ast0.OptExp(exp) -> let (exp_n,exp) = expression exp in (exp_n,Ast0.OptExp(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)) | Ast0.AsSExpr(exp,asstm) -> let (exp_n,exp) = expression exp in let (asstm_n,asstm) = statement asstm in (bind exp_n asstm_n, Ast0.AsSExpr(exp,asstm))) 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 string_fragmentfn all_functions 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 assignOp e = let k e = rewrap e (match Ast0.unwrap e with Ast0.SimpleAssign o -> let (o_n,o) = simpleAssign_mcode o in (o_n, Ast0.SimpleAssign o) | Ast0.OpAssign o -> let (o_n,o) = opAssign_mcode o in (o_n, Ast0.OpAssign o) | Ast0.MetaAssign (name, c, pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaAssign(name,c, pure))) in assignOpfn all_functions k e and binaryOp e = let k e = rewrap e (match Ast0.unwrap e with Ast0.Arith o -> let (o_n,o) = arithOp_mcode o in (o_n,Ast0.Arith o) | Ast0.Logical o -> let (o_n, o) = logicalOp_mcode o in (o_n, Ast0.Logical o) | Ast0.MetaBinary (name, c, pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaBinary(name, c, pure))) in binaryOpfn all_functions 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) -> let (t,id) = function_pointer (ty,lp1,star,None,rp1,lp2,params,rp2) in t | Ast0.Array(ty,lb,size,rb) -> let (t,id) = array_type (ty,None,lb,size,rb) in t | 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.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 (* returns ((bind value,original value),id) since id may have been updated*) and function_pointer (ty,lp1,star,(id : Ast0.ident option),rp1,lp2,params,rp2) = let (ty_n,ty) = typeC ty in let (lp1_n,lp1) = string_mcode lp1 in let (star_n,star) = string_mcode star in let (idl,idu) = (match id with | Some a -> let (b,c) = ident a in ([b],Some c) | None -> ([],None)) 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] @ idl @ [rp1_n;lp2_n;params_n;rp2_n]), Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2)), idu) (* returns ((bind value,original value),id) since id may have been updated*) and array_type (ty,(id : Ast0.ident option),lb,size,rb) = let (ty_n,ty) = typeC ty in let (idl,idu) = (match id with | Some a -> let (b,c) = ident a in ([b],Some c) | None -> ([],None)) 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] @ idl @ [lb_n;size_n;rb_n]), Ast0.Array(ty,lb,size,rb)), idu) and named_type ty id = match Ast0.unwrap ty with Ast0.FunctionPointer(rty,lp1,star,rp1,lp2,params,rp2) -> let (tyres, idn) = function_pointer (rty,lp1,star,Some id,rp1,lp2,params,rp2) in let idn = match idn with Some i -> i | None -> failwith "Impossible" in (rewrap ty tyres, idn) | Ast0.Array(rty,lb,size,rb) -> let (tyres, idn) = array_type (rty,Some id,lb,size,rb) in let idn = match idn with Some i -> i | None -> failwith "Impossible" in (rewrap ty tyres, idn) | _ -> let (ty_n,ty) = typeC ty in let (id_n,id) = ident id 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.FunProto(fi,name,lp1,params,va,rp1,sem) -> let (fi_n,fi) = map_split_bind fninfo fi in let (name_n,name) = ident name in let (lp1_n,lp1) = string_mcode lp1 in let (params_n,params) = parameter_dots params in let (va_n,va) = begin match va with | None -> (option_default, None) | Some (comma, ellipsis) -> let (comma_n,comma) = string_mcode comma in let (ellipsis_n,ellipsis) = string_mcode ellipsis in (multibind [comma_n; ellipsis_n],Some(comma,ellipsis)) end in let (rp1_n,rp1) = string_mcode rp1 in let (sem_n,sem) = string_mcode sem in (multibind [fi_n;name_n;lp1_n;params_n;va_n;rp1_n;sem_n], Ast0.FunProto(fi,name,lp1,params,va,rp1,sem)) | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> let (stg_n,stg) = get_option storage_mcode stg in 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 [stg_n;name_n;lp_n;args_n;rp_n;sem_n], Ast0.MacroDecl(stg,name,lp,args,rp,sem)) | Ast0.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> let (stg_n,stg) = get_option storage_mcode stg in 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 [stg_n;name_n;lp_n;args_n;rp_n;eq_n;ini_n;sem_n], Ast0.MacroDeclInit(stg,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) = match whencode with | Some (a,b,c) -> let (_,a2) = string_mcode a in let (_,b2) = string_mcode b in let (c1,c2) = declaration c in (c1, Some (a2,b2,c2)) | None -> (option_default, None) in (bind dots_n whencode_n, Ast0.Ddots(dots,whencode)) | Ast0.OptDecl(decl) -> let (n,decl) = declaration decl in (n,Ast0.OptDecl(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) = match whencode with | Some (a,b,c) -> let (_,a2) = string_mcode a in let (_,b2) = string_mcode b in let (c1,c2) = initialiser c in (c1, Some (a2,b2,c2)) | None -> (option_default, None) in (bind d_n whencode_n, Ast0.Idots(d,whencode)) | Ast0.OptIni(i) -> let (n,i) = initialiser i in (n,Ast0.OptIni(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.OptParam(param) -> let (n,param) = parameterTypeDef param in (n,Ast0.OptParam(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,va,rp,lbrace,body,rbrace,aft) -> 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 (va_n,va) = match va with | None -> (option_default, None) | Some (comma,ellipsis) -> let (comma_n, comma) = string_mcode comma in let (ellipsis_n, ellipsis) = string_mcode ellipsis in (multibind [comma_n;ellipsis_n],Some(comma,ellipsis)) 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;va_n;rp_n;lbrace_n;body_n;rbrace_n], Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft)) | 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.Exec(exec,lang,code,sem) -> let (exec_n,exec) = string_mcode exec in let (lang_n,lang) = string_mcode lang in let (code_n,code) = exec_code_dots code in let (sem_n,sem) = string_mcode sem in (multibind [exec_n;lang_n;code_n;sem_n], Ast0.Exec(exec,lang,code,sem)) | Ast0.MetaStmt(name,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,lenname,pure) -> let (name_n,name) = meta_mcode name in (name_n,Ast0.MetaStmtList(name,lenname,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.Conj(starter,statement_dots_list,mids,ender) -> do_disj starter statement_dots_list mids ender statement_dots (fun starter statement_dots_list mids ender -> Ast0.Conj(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 (whn_n,whn) = map_split_bind (whencode statement_dots statement) whn in let (ender_n,ender) = string_mcode ender 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.TopId(id) -> let (id_n,id) = ident id in (id_n,Ast0.TopId(id)) | 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.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.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 = rewrap d (map_split_bind define_param (Ast0.unwrap 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.OptDParam(dp) -> let (n,dp) = define_param dp in (n,Ast0.OptDParam(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)) (* we only include the when string mcode w because the parameterised string_mcodefn function might have side-effects *) and whencode notfn alwaysfn = function Ast0.WhenNot (w,e,a) -> let (_,w) = string_mcode w in let (_,e) = string_mcode e in let (n,a) = notfn a in (n,Ast0.WhenNot(w,e,a)) | Ast0.WhenAlways (w,e,a) -> let (_,w) = string_mcode w in let (_,e) = string_mcode e in let (n,a) = alwaysfn a in (n,Ast0.WhenAlways(w,e,a)) | Ast0.WhenModifier(w,x) -> let (_,w) = string_mcode w in (option_default,Ast0.WhenModifier(w,x)) | Ast0.WhenNotTrue(w,ee,e) -> let (_,w) = string_mcode w in let (_,ee) = string_mcode ee in let (n,e) = expression e in (n,Ast0.WhenNotTrue(w,ee,e)) | Ast0.WhenNotFalse(w,ee,e) -> let (_,w) = string_mcode w in let (_,ee) = string_mcode ee in let (n,e) = expression e in (n,Ast0.WhenNotFalse(w,ee,e)) (* for whencodes that do not have any of the above modifiers * returns (the new whencode expression, the updated whencode) *) and whencode_option cfn = function | Some (a,b,c) -> let (_,a2) = string_mcode a in let (_,b2) = string_mcode b in let (c1,c2) = cfn c in (c1, Some (a2,b2,c2)) | None -> (option_default, None) 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 exec_code e = (* not configurable *) rewrap e (match Ast0.unwrap e with Ast0.ExecEval(colon,id) -> let (colon_n,colon) = string_mcode colon in let (id_n,id) = expression id in (bind colon_n id_n,Ast0.ExecEval(colon,id)) | Ast0.ExecToken(tok) -> let (tok_n,tok) = string_mcode tok in (tok_n,Ast0.ExecToken(tok)) | Ast0.ExecDots(dots) -> let (dots_n,dots) = string_mcode dots in (dots_n,Ast0.ExecDots(dots))) 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.AssignOpTag(op) -> let (op_n,op) = assignOp op in (op_n,Ast0.AssignOpTag(op)) | Ast0.BinaryOpTag(op) -> let (op_n,op) = binaryOp op in (op_n,Ast0.BinaryOpTag(op)) | 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.StringFragmentTag(f) -> let (f_n,f) = string_fragment f in (f_n,Ast0.StringFragmentTag(f)) | 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" | Ast0.WhenTag(a,e,b) -> anything b 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.assignOp = assignOp; VT0.binaryOp = binaryOp; 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.string_fragment = string_fragment; 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_simpleAssign_mcode = (fun opt_default mc -> opt_default); VT0.combiner_opAssign_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_arithOp_mcode = (fun opt_default mc -> opt_default); VT0.combiner_logicalOp_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_assignOpfn = (fun r k e -> k e); VT0.combiner_binaryOpfn = (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_string_fragmentfn = (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_assignOp = (function e -> let (n,_) = r.VT0.assignOp e in n); VT0.combiner_rec_binaryOp = (function e -> let (n,_) = r.VT0.binaryOp 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_string_fragment = (function e -> let (n,_) = r.VT0.string_fragment 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_simpleAssign_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_opAssign_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_arithOp_mcode option_default mc,mc)) (function mc -> (functions.VT0.combiner_logicalOp_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_assignOpfn (dz r) (xk k) e, e)) (fun r k e -> (functions.VT0.combiner_binaryOpfn (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_string_fragmentfn (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 simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn binaryOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn 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 -> (simpleAssign_mcode mc,mc)) (function mc -> (opAssign_mcode mc,mc)) (function mc -> (fix_mcode mc,mc)) (function mc -> (unary_mcode mc,mc)) (function mc -> (arithOp_mcode mc,mc)) (function mc -> (logicalOp_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 -> (assignOpfn (dz r) (xk k) e, e)) (fun r k e -> (binaryOpfn (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 -> (string_fragmentfn (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_simpleAssign_mcode = (fun mc -> mc); VT0.rebuilder_opAssign_mcode = (fun mc -> mc); VT0.rebuilder_fix_mcode = (fun mc -> mc); VT0.rebuilder_unary_mcode = (fun mc -> mc); VT0.rebuilder_arithOp_mcode = (fun mc -> mc); VT0.rebuilder_logicalOp_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_assignOpfn = (fun r k e -> k e); VT0.rebuilder_binaryOpfn = (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_string_fragmentfn = (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_assignOp = (function e -> let (_,e) = r.VT0.assignOp e in e); VT0.rebuilder_rec_binaryOp = (function e -> let (_,e) = r.VT0.binaryOp 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_string_fragment = (function e -> let (_,e) = r.VT0.string_fragment 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_simpleAssign_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_opAssign_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_fix_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_unary_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_arithOp_mcode mc)) (function mc -> ((),functions.VT0.rebuilder_logicalOp_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_assignOpfn (dz r) (xk k) e)) (fun r k e -> ((),functions.VT0.rebuilder_binaryOpfn (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_string_fragmentfn (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 simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn arithOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn 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 -> ((),simpleAssign_mcode mc)) (function mc -> ((),opAssign_mcode mc)) (function mc -> ((),fix_mcode mc)) (function mc -> ((),unary_mcode mc)) (function mc -> ((),arithOp_mcode mc)) (function mc -> ((),logicalOp_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 -> ((),assignOpfn (dz r) (xk k) e)) (fun r k e -> ((),arithOpfn (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 -> ((),string_fragmentfn (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_simpleAssign_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_opAssign_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_arithOp_mcode = (fun opt_default mc -> (opt_default,mc)); VT0.combiner_rebuilder_logicalOp_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_assignOpfn = (fun r k e -> k e); VT0.combiner_rebuilder_binaryOpfn = (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_string_fragmentfn = (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_simpleAssign_mcode option_default) (functions.VT0.combiner_rebuilder_opAssign_mcode option_default) (functions.VT0.combiner_rebuilder_fix_mcode option_default) (functions.VT0.combiner_rebuilder_unary_mcode option_default) (functions.VT0.combiner_rebuilder_arithOp_mcode option_default) (functions.VT0.combiner_rebuilder_logicalOp_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_assignOpfn functions.VT0.combiner_rebuilder_binaryOpfn 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_string_fragmentfn functions.VT0.combiner_rebuilder_topfn coccinelle-1.0.4/parsing_cocci/test.cocci0000644000175000017500000000174612614153277017410 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @@ 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.4/parsing_cocci/data.mli0000644000175000017500000001240112614153277017031 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 * 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 *) * string (* whitespace before *) (* ---------------------------------------------------------------------- *) and line_type = MINUS | OPTMINUS | PLUS | PLUSPLUS | CONTEXT | 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_global_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 -> Ast_cocci.list_len -> 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_assignOp_meta: (Ast_cocci.meta_name -> Ast0_cocci.assignOpconstraint -> Ast0_cocci.pure -> unit) ref val add_binaryOp_meta: (Ast_cocci.meta_name -> Ast0_cocci.binaryOpconstraint -> Ast0_cocci.pure -> unit) ref val add_type_name: (string -> unit) ref val add_attribute: (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.4/parsing_cocci/dpll.mli0000644000175000017500000000043512614153277017057 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val dpll : (string list * string list) list -> bool coccinelle-1.0.4/parsing_cocci/type_cocci.ml0000644000175000017500000001032712614153277020075 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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) let rec meta_names = function ConstVol(_,ty) -> meta_names ty | SignedT(_,Some ty) -> meta_names ty | Pointer(ty) -> meta_names ty | FunctionPointer(ty) -> meta_names ty | Array(ty) -> meta_names ty | MetaType(nm,_,_) -> [nm] | _ -> [] coccinelle-1.0.4/parsing_cocci/top_level.ml0000644000175000017500000000550312614153277017745 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 = Ast0.wrap l let rec is_decl s = match Ast0.unwrap s with Ast0.Decl(_,e) -> true | _ -> false let isonly f l = match Ast0.unwrap 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.4/parsing_cocci/visitor_ast0.mli0000644000175000017500000001172112614153277020552 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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) -> ((Ast0_cocci.simpleAssignOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.arithOp,'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.arithOp,'a) Visitor_ast0_types.flat_cmcode) -> ((Ast_cocci.logicalOp,'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.assignOp,'a) Visitor_ast0_types.ccode) -> ((Ast0_cocci.binaryOp,'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.string_fragment,'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) -> (Ast0_cocci.simpleAssignOp Visitor_ast0_types.rmcode) -> (Ast_cocci.arithOp Visitor_ast0_types.rmcode) -> (Ast_cocci.fixOp Visitor_ast0_types.rmcode) -> (Ast_cocci.unaryOp Visitor_ast0_types.rmcode) -> (Ast_cocci.arithOp Visitor_ast0_types.rmcode) -> (Ast_cocci.logicalOp 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.assignOp Visitor_ast0_types.rcode) -> (Ast0_cocci.binaryOp 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.string_fragment 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.4/parsing_cocci/get_constants2.mli0000644000175000017500000000151612614153277021062 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Not is never used in the result. A bit ugly, but avoids reimplementing some operators in get_constants2 *) type combine = And of combine list | Or of combine list | Not of combine | 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 * string list) option (* cocci-grep result, string list used for git *) * combine option (* raw non-grep result, if any *)) coccinelle-1.0.4/parsing_cocci/ast_cocci.ml0000644000175000017500000010534212614153277017705 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* 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; whitespace : string } 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*) positive_inherited_positions : meta_name list; 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 *) | MetaBinaryOperatorDecl of arity * meta_name | MetaAssignmentOperatorDecl of arity * meta_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 | MetaGlobalIdExpDecl 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 *) * list_len (*len*) | 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 *) | MetaScriptDecl of metavar option ref * 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 dots = 'a list 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 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 * 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 * expression | Nested of expression * binaryOp * 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 *) | AsSExpr of expression * rule_elem (* as expr, always metavar *) | EComma of string mcode (* only in arg lists *) | DisjExpr of expression list | ConjExpr 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 | OptExp 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 | IdPosIdSet of string list * meta_name list | IdNegIdSet of string list * meta_name list | IdRegExpConstraint of reconstraint and reconstraint = | IdRegExp of string * Regexp.regexp | IdNotRegExp of string * Regexp.regexp and assignOpconstraint = AssignOpNoConstraint | AssignOpInSet of assignOp list and binaryOpconstraint = BinaryOpNoConstraint | BinaryOpInSet of binaryOp list (* ANY = int E; ID = idexpression int X; CONST = constant int X; *) and form = ANY | ID | LocalID | GlobalID | 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 base_assignOp = SimpleAssign of simpleAssignOp mcode | OpAssign of arithOp mcode | MetaAssign of meta_name mcode * assignOpconstraint * keep_binding * inherited and simpleAssignOp = string and assignOp = base_assignOp wrap and fixOp = Dec | Inc and base_binaryOp = Arith of arithOp mcode | Logical of logicalOp mcode | MetaBinary of meta_name mcode * binaryOpconstraint * keep_binding * inherited and binaryOp = base_binaryOp wrap 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 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(* ) *) | 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 (* { *) * annotated_decl 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 (* ; *) | FunProto of fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* ; *) | TyDecl of fullType * string mcode (* ; *) | MacroDecl of storage mcode option * ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of storage mcode option * 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 | 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 and declaration = base_declaration wrap and base_annotated_decl = DElem of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration (* Ddots is for a structure declaration *) | Ddots of string mcode (* ... *) * declaration option (* whencode *) and annotated_decl = base_annotated_decl 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 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 (* ... *) | OptParam 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 (* ... *) | OptDParam 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 (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) | Decl of annotated_decl | 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 (* ; *) | Exec of string mcode (* EXEC *) * string mcode (* language *) * exec_code dots * string mcode (* ; *) | MetaRuleElem of meta_name mcode * keep_binding * inherited | MetaStmt of meta_name mcode * keep_binding * metaStmtInfo * inherited | MetaStmtList of meta_name mcode * listlen * 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 *) | TopId of ident (* 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 (*:*) | AsRe of rule_elem * rule_elem (* always { and MetaStmtList *) | 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 annotated_decl 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 | Conj 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 (* } *) * end_info (*exit*) | 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 | OptStm 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 base_exec_code = ExecEval of string mcode (* : *) * expression | ExecToken of string mcode | ExecDots of string mcode (* ... *) and exec_code = base_exec_code 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 | IdP | TyP | AnyP and rulename = CocciRulename of string option * dependency * string list (*isos to add*) * string list (*isos to drop*) * 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 (*language*) * dependency * (script_meta_name * meta_name * metavar * mvinit) list (*inherited vars*) * meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string (*language*) * dependency * (script_meta_name * meta_name * metavar * mvinit) list (*virtual vars*) * string (*code*) | FinalScriptRule of string (* name *) * string (*language*) * dependency * (script_meta_name * meta_name * metavar * mvinit) list (*virtual vars*) * string (*code*) and script_meta_name = string option (*string*) * string option (*ast*) and mvinit = NoMVInit | MVInitString of string | MVInitPosList 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 | SimpleAssignOpTag of simpleAssignOp | OpAssignOpTag of arithOp | 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 | StringFragmentTag of string_fragment | 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 | AnnDeclDotsTag of annotated_decl 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_inherited_pos x = x.positive_inherited_positions 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 | MetaBinaryOperatorDecl(_,name) -> name | MetaAssignmentOperatorDecl(_,name) -> name | MetaConstDecl(ar,nm,ty) -> nm | MetaErrDecl(ar,nm) -> nm | MetaExpDecl(ar,nm,ty) -> nm | MetaIdExpDecl(ar,nm,ty) -> nm | MetaLocalIdExpDecl(ar,nm,ty) -> nm | MetaGlobalIdExpDecl(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,nm1) -> 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 | MetaScriptDecl(ar,nm) -> nm (* --------------------------------------------------------------------- *) and tag2c = function FullTypeTag _ -> "FullTypeTag" | BaseTypeTag _ -> "BaseTypeTag" | StructUnionTag _ -> "StructUnionTag" | SignTag _ -> "SignTag" | IdentTag _ -> "IdentTag" | ExpressionTag _ -> "ExpressionTag" | ConstantTag _ -> "ConstantTag" | UnaryOpTag _ -> "UnaryOpTag" | AssignOpTag _ -> "AssignOpTag" | SimpleAssignOpTag _ -> "SimpleAssignOpTag" | OpAssignOpTag _ -> "OpAssignOpTag" | 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" | StringFragmentTag _ -> "StringFragmentTag" | ConstVolTag _ -> "ConstVolTag" | Token _ -> "Token" | Directive _ -> "Directive" | Code _ -> "Code" | ExprDotsTag _ -> "ExprDotsTag" | ParamDotsTag _ -> "ParamDotsTag" | StmtDotsTag _ -> "StmtDotsTag" | AnnDeclDotsTag _ -> "AnnDeclDotsTag" | TypeCTag _ -> "TypeCTag" | ParamTag _ -> "ParamTag" | SgrepStartTag _ -> "SgrepStartTag" | SgrepEndTag _ -> "SgrepEndTag" (* --------------------------------------------------------------------- *) let no_info = { line = 0; column = -1; strbef = []; straft = []; whitespace = "" } let make_term x = {node = x; node_line = 0; free_vars = []; minus_free_vars = []; fresh_vars = []; inherited = []; positive_inherited_positions = []; 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 inh_pos = {node = x; node_line = 0; free_vars = []; minus_free_vars = []; fresh_vars = []; inherited = inherited; positive_inherited_positions = inh_pos; 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 string_of_arithOp = function | Plus -> "+" | Minus -> "-" | Mul -> "*" | Div -> "/" | Mod -> "%" | DecLeft -> "<<" | DecRight -> ">>" | And -> "&" | Or -> "|" | Xor -> "^" | Min -> " ">?" let string_of_logicalOp = function | Eq -> "==" | NotEq -> "!=" | InfEq -> "<=" | SupEq -> ">=" | Sup -> ">" | Inf -> "<" | AndLog -> "&&" | OrLog -> "||" let string_of_binaryOp op = match (unwrap op) with | Arith arithOp -> string_of_arithOp (unwrap_mcode arithOp) | Logical logicalOp -> string_of_logicalOp (unwrap_mcode logicalOp) | MetaBinary _ -> "MetaBinary" let string_of_assignOp op = match (unwrap op) with | SimpleAssign _ -> "=" | OpAssign op' -> let s = string_of_arithOp (unwrap_mcode op') in s ^ "=" | MetaAssign _ -> "MetaAssign" coccinelle-1.0.4/parsing_cocci/stmtlist.mli0000644000175000017500000000043112614153277020003 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val stmtlist : Ast_cocci.rule -> Ast_cocci.rule coccinelle-1.0.4/parsing_cocci/iso_compile.ml0000644000175000017500000000715412614153277020262 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 mcode mcode donothing donothing donothing 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 new_previously_used = 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::previously_used else let all = r @ List.concat xs in let rec find_first_available a previously_used = function [] -> raise Not_found | (str,pos)::xs -> if str = a && Common.inter_set previously_used !pos = [] then pos else find_first_available a previously_used 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 prev) 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) previously_used f in loop new_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.4/parsing_cocci/test_exps.mli0000644000175000017500000000053512614153277020143 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val process : Ast0_cocci.rule -> Ast0_cocci.rule val process_anything : Ast0_cocci.anything -> Ast0_cocci.anything coccinelle-1.0.4/parsing_cocci/type_cocci.mli0000644000175000017500000000303712614153277020246 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 val meta_names : typeC -> meta_name list coccinelle-1.0.4/parsing_cocci/single_statement.mli0000644000175000017500000000044312614153277021470 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val single_statement : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/iso_compile.mli0000644000175000017500000000042712614153277020427 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val process : Iso_pattern.isomorphism -> unit coccinelle-1.0.4/parsing_cocci/command_line.ml0000644000175000017500000001062712614153277020404 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ---------------------------------------------------------------------- *) (* 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.4/parsing_cocci/unparse_ast0.mli0000644000175000017500000000163712614153277020535 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 val show_cocci_parse_tree : string -> Ast0_cocci.top_level -> unit coccinelle-1.0.4/parsing_cocci/id_utils.ml0000644000175000017500000000277412614153277017577 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/unparse_ast0.ml0000644000175000017500000007214112614153277020362 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 _ -> print_between between fn (Ast0.unwrap d)) (* --------------------------------------------------------------------- *) (* Disjunctions *) let do_disj lst processor sep = print_string "\n("; force_newline(); print_between (function _ -> print_string ("\n"^sep); 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.AsIdent(id,asid) -> ident id; print_string "@"; ident asid) (* --------------------------------------------------------------------- *) (* Expression *) let print_string_box s = print_string s; open_box 0 let assignOp op = print_context op (function _ -> match Ast0.unwrap op with | Ast0.SimpleAssign op' -> mcode U.simpleAssignOp op' | Ast0.OpAssign op' -> mcode U.opAssignOp op' | Ast0.MetaAssign(name,_,_) -> mcode print_meta name) let binaryOp op = print_context op (function _ -> match Ast0.unwrap op with | Ast0.Arith op' -> mcode U.arithOp op' | Ast0.Logical op' -> mcode U.logicalOp op' | Ast0.MetaBinary(name,_,_) -> mcode print_meta name) 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 " "; 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 " "; binaryOp op; print_string " "; expression right; print_string ")" | Ast0.Nested(left,op,right) -> print_string "("; expression left; print_string " "; 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.ConjExpr(_,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)) -> mcode print_string dots; print_string " WHEN != "; expression whencode | Ast0.Edots(dots,None) -> mcode print_string dots | Ast0.OptExp(exp) -> print_string "?"; expression exp | Ast0.AsExpr(exp,asexp) -> expression exp; print_string "@"; expression asexp | Ast0.AsSExpr(exp,asstm) -> expression exp; print_string "@"; statement "" asstm) 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 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.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.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.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.FunProto(fninfo,name,lp1,params,va,rp1,sem) -> List.iter print_fninfo fninfo; ident name; mcode print_string_box lp1; parameter_list params; varargs va; close_box(); mcode print_string rp1; mcode print_string sem | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> print_option (mcode U.storage) stg; 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(stg,name,lp,args,rp,eq,ini,sem) -> print_option (mcode U.storage) stg; 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,_,_) -> do_disj decls declaration "|" | 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.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.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.OptParam(param) -> print_string "?"; parameterTypeDef param | Ast0.AsParam(p,asexp) -> parameterTypeDef p; print_string "@"; expression asexp) and parameter_list l = dots (function _ -> ()) parameterTypeDef l and varargs va = match va with | None -> () | Some (comma, ellipsis) -> mcode print_string comma; mcode print_string ellipsis (* --------------------------------------------------------------------- *) (* Top-level code *) and statement arity s = print_context s (function _ -> match Ast0.unwrap s with Ast0.FunDecl(_,fninfo,name,lp,params,va,rp,lbrace,body,rbrace,_) -> print_string arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; varargs va; 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.Exec(exec,lang,code,sem) -> print_string arity; mcode print_string exec; print_string " "; mcode print_string lang; print_string " "; dots (function _ -> print_string " ") exec_code code; 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.Conj(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.TopId(id) -> print_string arity; ident id | Ast0.TopInit(init) -> initialiser init | Ast0.Dots(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.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.OptDParam(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) -> do_disj case_lines (case_line arity) "|" | Ast0.OptCase(case) -> case_line "?" case) and statement_dots l = dots (function _ -> ()) (statement "") l and case_dots l = dots (function _ -> ()) (case_line "") l and exec_code e = match Ast0.unwrap e with Ast0.ExecEval(colon,id) -> mcode print_string colon; expression id | Ast0.ExecToken(tok) -> mcode print_string tok | Ast0.ExecDots(dots) -> mcode print_string dots (* --------------------------------------------------------------------- *) (* 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 rec 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.AssignOpTag(d) -> print_string ("AssignOp: " ^ (Ast0.string_of_assignOp d)); force_newline(); | Ast0.BinaryOpTag(d) -> print_string ("BinaryOp: " ^ (Ast0.string_of_binaryOp d)); force_newline(); | 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.StringFragmentTag(d) -> string_fragment 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" | Ast0.WhenTag(w,e,a) -> unparse_anything a); 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) let show_cocci_parse_tree comment parse_tree = Printf.printf "%s\n" comment; top_level parse_tree; Format.print_newline() coccinelle-1.0.4/parsing_cocci/insert_plus.mli0000644000175000017500000000051412614153277020471 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val insert_plus : Ast0_cocci.rule -> Ast0_cocci.rule -> bool -> unit (* bool is true if no isos *) coccinelle-1.0.4/parsing_cocci/stmtlist.ml0000644000175000017500000000434712614153277017644 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Goal: Move a MetaStmtList, if any, up into { and replace by ... *) (* Only applied to - code *) module Ast = Ast_cocci module V = Visitor_ast let adjust_brace_and_body lbrace body = let body_element = match Ast.unwrap body with [x] -> (match Ast.unwrap x with Ast.Atomic(y) -> (match Ast.unwrap y with Ast.MetaStmtList(name,lenname,keep,inherited) -> Some(name,lenname,keep,inherited,body,x,y) | _ -> None) | _ -> None) | _ -> None in match body_element with Some(name,lenname,keep,inherited,body,x,y) -> let newbody = (* dropping x *) Ast.rewrap y (Ast.Dots(Ast.rewrap_mcode name "...",[],[],[])) in let name = Ast.make_mcode(Ast.unwrap_mcode(name)) in let meta = Ast.make_term (Ast.MetaStmtList(name,lenname,keep,inherited)) in let body = Ast.rewrap body [newbody] in (Ast.make_term(Ast.AsRe(lbrace,meta)),body) | None -> (lbrace,body) let statement r k s = let s = k s in match Ast.unwrap s with Ast.Seq(lbrace,body,rbrace) -> let (lbrace,body) = adjust_brace_and_body lbrace body in Ast.rewrap s (Ast.Seq(lbrace,body,rbrace)) | Ast.FunDecl(header,lbrace,body,rbrace,endinfo) -> let (lbrace,body) = adjust_brace_and_body lbrace body in Ast.rewrap s (Ast.FunDecl(header,lbrace,body,rbrace,endinfo)) | _ -> s let mcode mc = mc let donothing r k e = k e let stmtlist_rebuilder = V.rebuilder mcode mcode 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 statement donothing donothing donothing let stmtlist rule = match rule with Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> rule | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) -> let r = List.map stmtlist_rebuilder.V.rebuilder_top_level r in Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) coccinelle-1.0.4/parsing_cocci/data.ml0000644000175000017500000001464312614153277016672 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 * 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 *) * string (* whitespace before *) (* ---------------------------------------------------------------------- *) (* Things that need to be seen by the lexer and parser. *) and line_type = MINUS | OPTMINUS | PLUS | PLUSPLUS | CONTEXT | 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 uninitialized_add_meta = fun _ -> failwith "uninitialized add_meta" let clear_meta: (unit -> unit) ref = ref uninitialized_add_meta let add_meta_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_id_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_virt_id_meta_found: (string -> string -> unit) ref = ref uninitialized_add_meta let add_virt_id_meta_not_found: (Ast_cocci.meta_name -> Ast0_cocci.pure -> unit) ref = ref uninitialized_add_meta let add_fresh_id_meta: (Ast.meta_name -> Ast.seed -> unit) ref = ref uninitialized_add_meta let add_type_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_init_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_initlist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_param_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_paramlist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_const_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_err_meta: (Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_exp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_idexp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_local_idexp_meta: (Type_cocci.typeC list option -> Ast.meta_name -> econstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_global_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 uninitialized_add_meta let add_decl_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_field_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_field_list_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_symbol_meta: (string -> unit) ref = ref uninitialized_add_meta let add_stm_meta: (Ast.meta_name -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_stmlist_meta: (Ast.meta_name -> Ast.list_len -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_func_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_local_func_meta: (Ast.meta_name -> iconstraints -> Ast0.pure -> unit) ref = ref 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 uninitialized_add_meta let add_fmt_meta: (Ast.meta_name -> iconstraints -> unit) ref = ref uninitialized_add_meta let add_fmtlist_meta: (Ast.meta_name -> Ast.list_len -> unit) ref = ref uninitialized_add_meta let add_assignOp_meta: (Ast.meta_name -> Ast0.assignOpconstraint -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_binaryOp_meta: (Ast.meta_name -> Ast0.binaryOpconstraint -> Ast0.pure -> unit) ref = ref uninitialized_add_meta let add_type_name: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_type") let add_attribute: (string -> unit) ref = ref (fun _ -> failwith "uninitialized add_attribute") 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 uninitialized_install_bindings = fun _ -> failwith "uninitialized install_bindings" let init_rule: (unit -> unit) ref = ref uninitialized_install_bindings let install_bindings: (string -> unit) ref = ref 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.4/parsing_cocci/test2.cocci0000644000175000017500000000152612614153277017466 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @@ 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.4/parsing_cocci/ast0toast.mli0000644000175000017500000000343312614153277020047 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 assignOp : Ast0_cocci.assignOp -> Ast_cocci.assignOp val binaryOp : Ast0_cocci.binaryOp -> Ast_cocci.binaryOp 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.annotated_decl Ast_cocci.dots val case_line : Ast0_cocci.case_line -> Ast_cocci.case_line val string_fragment : Ast0_cocci.string_fragment -> Ast_cocci.string_fragment 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.4/parsing_cocci/git_grep.ml0000644000175000017500000000137212614153277017554 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) exception Failed let interpret dir query suffixes = let collect query = let cmd = Printf.sprintf "cd %s; git grep -l -w %s -- %s" dir query suffixes in let (res,code) = Common.cmd_to_list_and_status cmd in if code = Unix.WEXITED 0 || code = Unix.WEXITED 1 then res else raise Failed in try match List.map collect query with [] -> failwith "not possible" | x::xs -> let res = List.fold_left Common.inter_set x xs in Some(List.map (function x -> dir^"/"^x) res) with Failed -> None coccinelle-1.0.4/parsing_cocci/visitor_ast.mli0000644000175000017500000001423112614153277020471 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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_assignOp : Ast_cocci.assignOp -> 'a; combiner_binaryOp : Ast_cocci.binaryOp -> '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_anndecl_dots : Ast_cocci.annotated_decl 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.simpleAssignOp,'a) cmcode) -> ((Ast_cocci.arithOp,'a) cmcode) -> ((Ast_cocci.fixOp,'a) cmcode) -> ((Ast_cocci.unaryOp,'a) cmcode) -> ((Ast_cocci.arithOp,'a) cmcode) -> ((Ast_cocci.logicalOp,'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.annotated_decl 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.assignOp,'a) ccode) -> ((Ast_cocci.binaryOp,'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.annotated_decl,'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_assignOp : Ast_cocci.assignOp inout; rebuilder_binaryOp : Ast_cocci.binaryOp 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_anndecl_dots : Ast_cocci.annotated_decl 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.simpleAssignOp rmcode) -> (Ast_cocci.arithOp rmcode) -> (Ast_cocci.fixOp rmcode) -> (Ast_cocci.unaryOp rmcode) -> (Ast_cocci.arithOp rmcode) -> (Ast_cocci.logicalOp 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.annotated_decl 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.assignOp rcode) -> (Ast_cocci.binaryOp rcode) -> (Ast_cocci.fullType rcode) -> (Ast_cocci.typeC rcode) -> (Ast_cocci.initialiser rcode) -> (Ast_cocci.parameterTypeDef rcode) -> (Ast_cocci.declaration rcode) -> (Ast_cocci.annotated_decl 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.4/parsing_cocci/ast0_cocci.mli0000644000175000017500000006111012614153277020130 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* Modified code *) type arity = OPT | 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; whitespace : string; 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 dots = 'a list 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 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 * assignOp * 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 * binaryOp * expression | Nested of expression * binaryOp * 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 *) | AsSExpr of expression * statement (* as expr, always metavar *) | EComma of string mcode (* only in arglists *) | DisjExpr of string mcode * expression list * string mcode list * string mcode | ConjExpr of string mcode * expression list * string mcode list * string mcode | NestExpr of string mcode * expression dots * string mcode * (string mcode * string mcode * expression) option (* whencode *) * Ast_cocci.multi | Edots of string mcode (* ... *) * (string mcode * string mcode * expression) option (* whencode *) | OptExp 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 (* --------------------------------------------------------------------- *) (* First class operators *) and base_assignOp = SimpleAssign of simpleAssignOp mcode | OpAssign of Ast_cocci.arithOp mcode | MetaAssign of Ast_cocci.meta_name mcode * assignOpconstraint * pure and simpleAssignOp = string and assignOp = base_assignOp wrap and base_binaryOp = Arith of Ast_cocci.arithOp mcode | Logical of Ast_cocci.logicalOp mcode | MetaBinary of Ast_cocci.meta_name mcode * binaryOpconstraint * pure and binaryOp = base_binaryOp wrap and assignOpconstraint = AssignOpNoConstraint | AssignOpInSet of assignOp list and binaryOpconstraint = BinaryOpNoConstraint | BinaryOpInSet of binaryOp list (* --------------------------------------------------------------------- *) (* 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(* ) *) | 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 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 (* ; *) | FunProto of fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* ; *) | TyDecl of typeC * string mcode (* ; *) | MacroDecl of Ast_cocci.storage mcode option * ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of Ast_cocci.storage mcode option * 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 (* ... *) * (string mcode * string mcode * declaration) option (* whencode *) | OptDecl 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 (* ... *) * (string mcode * string mcode * initialiser) option (* whencode *) | OptIni 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 (* ... *) | OptParam 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 (* ... *) | OptDParam 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 (* ; *) | Exec of string mcode (* EXEC *) * string mcode (* language *) * exec_code dots * string mcode (* ; *) | MetaStmt of Ast_cocci.meta_name mcode * pure | MetaStmtList of Ast_cocci.meta_name mcode (*only in statement lists*) * listlen * 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 *) | TopId of ident (* only at top level *) | TopInit of initialiser (* only at top level *) | Disj of string mcode * statement dots list * string mcode list * string mcode | Conj 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 | FunDecl of (info * mcodekind) (* before the function decl *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* { *) * statement dots * string mcode (* } *) * (info * mcodekind) (* after the function decl *) | 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 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 string mcode (* when *) * string mcode (* != *) * 'a | WhenAlways of string mcode (* when *) * string mcode (* = *) * 'b | WhenModifier of string mcode (* when *) * Ast_cocci.when_modifier | WhenNotTrue of string mcode (* when *) * string mcode (* != *) * expression | WhenNotFalse of string mcode (* when *) * string mcode (* != *) * 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 and base_exec_code = ExecEval of string mcode (* : *) * expression | ExecToken of string mcode | ExecDots of string mcode (* ... *) and exec_code = base_exec_code 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 * Ast_cocci.mvinit) list (*inherited vars*) * Ast_cocci.meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string * Ast_cocci.dependency * (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar * Ast_cocci.mvinit) list (*virtual vars*) * string | FinalScriptRule of string (* name *) * string * Ast_cocci.dependency * (Ast_cocci.script_meta_name * Ast_cocci.meta_name * Ast_cocci.metavar * Ast_cocci.mvinit) list (*virtual vars*) * 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 | AssignOpTag of assignOp | BinaryOpTag of binaryOp | 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 | StringFragmentTag of string_fragment | 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 *) | WhenTag of string mcode (* when *) * string mcode option * anything (* iso pattern *) 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 assignOp : assignOp -> anything val binaryOp : binaryOp -> 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 string_fragment : string_fragment -> anything val top : top_level -> anything (* --------------------------------------------------------------------- *) (* 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_mcode_line : 'a mcode -> 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 get_rule_name : parsed_rule -> string val meta_pos_name : anything -> Ast_cocci.meta_name mcode val meta_pos_constraint_names : anything -> Ast_cocci.meta_name list val ast0_type_to_type : bool -> 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 *) val string_of_assignOp : assignOp -> string val string_of_binaryOp : binaryOp -> string coccinelle-1.0.4/parsing_cocci/disjdistr.ml0000644000175000017500000004455412614153277017764 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 rec disjtwoelems fstart frest (start,rest) = let cur = fstart start in let rest = 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 = List.map (function l -> Ast.rewrap d l) (disjmult f (Ast.unwrap d)) 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 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.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(enum,name) -> let name = disjoption disjident name in List.map (function name -> Ast.rewrap bty (Ast.EnumName(enum,name))) name | Ast.StructUnionName(su,name) -> let name = disjoption disjident name in List.map (function name -> Ast.rewrap bty (Ast.StructUnionName(su,name))) name | 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 anndisjdecl decls) (function ty -> function decls -> Ast.rewrap bty (Ast.StructUnionDef(ty,lb,decls,rb))) | Ast.TypeName(_) | Ast.MetaType(_,_,_) -> [bty] and anndisjdecl d = match Ast.unwrap d with Ast.DElem(bef,allminus,decls) -> List.map (function decl -> Ast.rewrap d (Ast.DElem(bef,allminus,decl))) (disjdecl decls) | Ast.Ddots(_,_) -> [d] 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 | _ -> [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) -> disjmult2 (disjexp exp) (disjident field) (fun exp field -> Ast.rewrap e (Ast.RecordAccess(exp,pt,field))) | Ast.RecordPtAccess(exp,ar,field) -> disjmult2 (disjexp exp) (disjident field) (fun exp field -> Ast.rewrap e (Ast.RecordPtAccess(exp,ar,field))) | 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.AsSExpr(exp,asstm) -> (* as exp doesn't contain disj *) let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.AsSExpr(exp,asstm))) exp | Ast.DisjExpr(exp_list) -> List.concat (List.map disjexp exp_list) | Ast.ConjExpr(exp_list) -> let exp_list = disjmult disjexp exp_list in List.map (function exp_list -> Ast.rewrap e (Ast.ConjExpr(exp_list))) exp_list | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) -> (* not sure what to do here, so ambiguities still possible *) [e] | Ast.Edots(dots,_) -> [e] | Ast.OptExp(exp) -> let exp = disjexp exp in List.map (function exp -> Ast.rewrap e (Ast.OptExp(exp))) exp and disjparam p = match Ast.unwrap p with Ast.VoidParam(ty) -> [p] (* void is the only possible value *) | Ast.Param(ty,id) -> disjmult2 (disjty ty) (disjoption disjident id) (fun ty id -> Ast.rewrap p (Ast.Param(ty,id))) | 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) -> [p] | Ast.OptParam(param) -> let param = disjparam param in List.map (function param -> Ast.rewrap p (Ast.OptParam(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 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 disjfninfo = function | Ast.FType(ty) -> List.map (function ty -> Ast.FType(ty)) (disjty ty) | fi -> [fi] 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.FunProto(fninfo,name,lp1,params,va,rp1,sem) -> let fninfo = disjmult disjfninfo fninfo in List.map (function fninfo -> Ast.rewrap d (Ast.FunProto(fninfo,name,lp1,params,va,rp1,sem))) fninfo | Ast.MacroDecl(stg,name,lp,args,rp,sem) -> List.map (function args -> Ast.rewrap d (Ast.MacroDecl(stg,name,lp,args,rp,sem))) (disjdots disjexp args) | Ast.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> disjmult2 (disjdots disjexp args) (disjini ini) (function args -> function ini -> Ast.rewrap d (Ast.MacroDeclInit(stg,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.OptDecl(decl) -> let decl = disjdecl decl in List.map (function decl -> Ast.rewrap d (Ast.OptDecl(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_id = generic_orify_rule_elem disjident let orify_rule_elem_param = generic_orify_rule_elem disjparam let orify_rule_elem_decl = generic_orify_rule_elem disjdecl let orify_rule_elem_anndecl = generic_orify_rule_elem anndisjdecl 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,va,rp) -> generic_orify_rule_elem (disjtwoelems disjident (disjdots disjparam)) re (name,params) (fun (name,params) -> Ast.rewrap re (Ast.FunHeader(bef,allminus,fninfo,name,lp,params,va,rp))) | Ast.Decl decl -> orify_rule_elem_anndecl re decl (function decl -> Ast.rewrap re (Ast.Decl 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 decl -> List.map (function decl -> Ast.ForDecl decl) (anndisjdecl 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.Exec _ -> re (* no ors possible *) | 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.TopId(id) -> orify_rule_elem_id re id (function id -> Ast.rewrap id (Ast.TopId(id))) | 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.AsRe(rre,asre) -> (* as re doesn't contain disj *) let rre = disj_rule_elem r k rre in Ast.rewrap re (Ast.AsRe(rre,asre)) | 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 mcode mcode donothing donothing donothing 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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing doanything 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 mcode mcode donothing donothing donothing 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.4/parsing_cocci/commas_on_lists.ml0000644000175000017500000000470512614153277021150 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 List.rev (Ast0.unwrap itemlist) 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 (List.rev (Ast0.rewrap e (make_comma comma) :: (e::es))) 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.4/parsing_cocci/check_meta.ml0000644000175000017500000006355612614153277020053 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 = List.iter fn (Ast0.unwrap d) (* --------------------------------------------------------------------- *) (* 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(_) -> 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 (* --------------------------------------------------------------------- *) (* Operators *) let assignOp context old_metas table minus op = match Ast0.unwrap op with | Ast0.SimpleAssign _ -> () | Ast0.OpAssign _ -> () | Ast0.MetaAssign (name,_,_) -> check_table table minus name let binaryOp context old_metas table minus op = match Ast0.unwrap op with | Ast0.Arith _ -> () | Ast0.Logical _ -> () | Ast0.MetaBinary (name,_,_) -> check_table table minus name (* --------------------------------------------------------------------- *) (* 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; assignOp context old_metas table minus op; 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; binaryOp context old_metas table minus op; expression ID old_metas table minus right | Ast0.Nested(left,op,right) -> expression ID old_metas table minus left; binaryOp context old_metas table minus op; 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.AsSExpr(exp,asstm) -> failwith "not generated yet" | Ast0.DisjExpr(_,exps,_,_) | Ast0.ConjExpr(_,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 (function (_,_,x) -> expression ID old_metas table minus x) w | Ast0.Edots(_,Some (_,_,x)) -> expression ID old_metas table minus x | Ast0.OptExp(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.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) -> 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.FunProto(fi,name,lp1,params,va,rp1,sem) -> ident FN old_metas table minus name; List.iter (fninfo old_metas table minus) fi; parameter_list old_metas table minus params | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> ident GLOBAL old_metas table minus name; dots (expression ID old_metas table minus) args | Ast0.MacroDeclInit(stg,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(_) -> 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(_) -> 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.Exec(exec,lang,code,sem) -> dots (exec_code ID old_metas table minus) code | Ast0.MetaStmt(name,_) -> check_table table minus name | Ast0.MetaStmtList(name,Ast0.MetaListLen lenname,_) -> check_table table minus name; check_table table minus lenname | 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.TopId(id) -> ident ID old_metas table minus id | Ast0.TopInit(init) -> initialiser old_metas table minus init | Ast0.Disj(_,rule_elem_dots_list,_,_) | Ast0.Conj(_,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) -> 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,va,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(_) -> () (* no metavariable subterms *) | Ast0.OptDParam(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" and exec_code context old_metas table minus e = match Ast0.unwrap e with Ast0.ExecEval(colon,id) -> expression context old_metas table minus id | Ast0.ExecToken(tok) -> () | Ast0.ExecDots(dots) -> () (* --------------------------------------------------------------------- *) (* 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 rname table rules = let do_tynames var = let tynames = Ast0.meta_pos_constraint_names var in List.iter (function name -> (* only needed if the name is a local variable, not an inherited one *) if fst name = rname then (find_loop table name) := true) tynames in 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; do_tynames var) (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; do_tynames var) (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 mcode mcode donothing donothing donothing 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,_,_) | Ast0.ConjExpr(_,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,_,_) | Ast0.Conj(_,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 mcode mcode donothing donothing donothing donothing donothing donothing donothing expression donothing donothing typeC donothing donothing declaration statement donothing 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 rname [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.4/parsing_cocci/get_constants.mli0000644000175000017500000000044512614153277021000 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val get_constants : Ast_cocci.rule list -> string list list coccinelle-1.0.4/parsing_cocci/semantic_cocci.ml0000644000175000017500000000040612614153277020714 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) exception Semantic of string coccinelle-1.0.4/parsing_cocci/merge.mli0000644000175000017500000000060612614153277017223 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/compute_lines.mli0000644000175000017500000000100312614153277020762 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/type_infer.ml0000644000175000017500000003677712614153277020141 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 let ast0_type_to_type = Ast0.ast0_type_to_type false 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 op with Ast0.Arith(op) -> same_type (ty1, ty2) | Ast0.MetaBinary _ -> same_type (ty1, ty2) | Ast0.Logical(op') when (let op''=Ast0.unwrap_mcode op' in op''=Ast.AndLog || op''=Ast.OrLog) -> Some(bool_type) | Ast0.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_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_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,_,_) | Ast0.ConjExpr(_,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) -> None | Ast0.Edots(_,Some (_,_,e)) -> let _ = r.VT0.combiner_rec_expression e in None | Ast0.OptExp(exp) -> Ast0.get_type exp | Ast0.AsExpr _ | Ast0.AsSExpr _ -> 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.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,_,_) | Ast0.Conj(_,statement_dots_list,_,_) -> let new_acc = lub_envs (List.map (function x -> process_statement_list r acc (Ast0.unwrap 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_type_to_type ty in List.map (function i -> (i,ty)) (strip id) | Ast0.UnInit(_,ty,id,_) -> let ty = ast0_type_to_type ty in List.map (function i -> (i,ty)) (strip id) | Ast0.FunProto(fi,nm,lp,params,va,rp,sem) -> [] | 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.AsDecl _ -> failwith "not possible" in let statement_dots r k d = let _ = process_statement_list r env (Ast0.unwrap d) 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,va,rp,lbrace,body,rbrace,_) -> let rec get_binding p = match Ast0.unwrap p with Ast0.Param(ty,Some id) -> let ty = 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.unwrap 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.unwrap 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.4/parsing_cocci/dpll.ml0000644000175000017500000000562612614153277016715 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* A simple implementation of the DPLL algorithm: http://en.wikipedia.org/wiki/DPLL_algorithm A formula is in cnf. This is not currently used, but please don't get rid of it. *) type positive_literal = string type negative_literal = string type clause = positive_literal * negative_literal (*represents a disjunction*) type formula = clause list (* represents a conjunction *) (* The formula ((a v !b) & (c v !d v !e)) would be [[([a],[b])];[([c],[d;e])]] *) (* ----------------------------------------------------------------------- *) (* evaluation *) let rec evaluate var vl = function [] -> [] | (pos,neg)::rest -> match vl with true -> if List.mem var pos then evaluate var vl rest else (pos,Common.minus_set neg [var]) :: evaluate var vl rest | false -> if List.mem var neg then evaluate var vl rest else (Common.minus_set pos [var],neg) :: evaluate var vl rest (* ----------------------------------------------------------------------- *) (* Unit propagation *) let unit_propagation formula = let rec loop changed prev = function [] -> (changed,prev) | ([x],[])::rest -> loop true (evaluate x true prev) (evaluate x true rest) | ([],[x])::rest -> loop true (evaluate x false prev) (evaluate x false rest) | cl::rest -> loop changed (cl::prev) rest in let rec oloop formula = let (changed,formula) = loop false [] formula in if changed then oloop formula else formula in oloop formula (* ----------------------------------------------------------------------- *) (* Pure literal elimination *) let pure_literals formula = let rec loop pos neg = function [] -> (pos,neg) | (cpos,cneg)::rest -> let pos = Common.minus_set pos cneg in let neg = Common.minus_set neg cpos in let cpos = Common.minus_set cpos neg in let cneg = Common.minus_set cneg pos in let pos = Common.union_set pos cpos in let neg = Common.union_set neg cneg in loop pos neg rest in let (pos,neg) = loop [] [] formula in let formula = List.fold_left (fun formula pos -> evaluate pos true formula) formula pos in let formula = List.fold_left (fun formula neg -> evaluate neg false formula) formula neg in formula (* ----------------------------------------------------------------------- *) (* Main loop *) let rec dpll formula = let formula = unit_propagation formula in let formula = pure_literals formula in match formula with [] -> true | ((pos,neg) :: _) as formula -> if List.mem ([],[]) formula then false else match pos@neg with x::_ -> (dpll (evaluate x true formula)) || (dpll (evaluate x false formula)) | _ -> failwith "at least one of pos and neg must be nonempty" coccinelle-1.0.4/parsing_cocci/unitary_ast0.mli0000644000175000017500000000117412614153277020547 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* '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.4/parsing_cocci/arity.mli0000644000175000017500000000043612614153277017255 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val minus_arity : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/adjacency.ml0000644000175000017500000000564012614153277017677 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types (* Negate counter of open brace when that is minus and preceding ) is context. In that case, the brace should somehow be like the preceding ) (from an if, while, etc) rather than like the rest of the statement. *) let redo (_,_,_,mc,_,_) stm = match mc with Ast0.CONTEXT _ -> (match Ast0.unwrap stm with Ast0.Seq((a,b,c,mc_lbrace,d,ctr),body,rbrace) -> (match mc_lbrace with Ast0.MINUS _ -> (* subtract 1 in case -1 is used for some unknown values *) let ctr = -1 * ctr - 1 in Ast0.rewrap stm (Ast0.Seq((a,b,c,mc_lbrace,d,ctr),body,rbrace)) | _ -> stm) | _ -> stm) | _ -> stm 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,_)) -> let branch = redo rp branch in Ast0.IfThen(iff,lp,exp,rp,branch,(info,mc,!counter)) | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,mc,_)) -> let branch1 = redo rp branch1 in let branch2 = redo els branch2 in Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,mc,!counter)) | Ast0.While(wh,lp,exp,rp,body,(info,mc,_)) -> let body = redo rp body in Ast0.While(wh,lp,exp,rp,body,(info,mc,!counter)) | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(info,mc,_)) -> let body = redo rp body in Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(info,mc,!counter)) | Ast0.Iterator(nm,lp,args,rp,body,(info,mc,_)) -> let body = redo rp body in 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_simpleAssign_mcode = mcode; VT0.rebuilder_opAssign_mcode = mcode; VT0.rebuilder_fix_mcode = mcode; VT0.rebuilder_unary_mcode = mcode; VT0.rebuilder_arithOp_mcode = mcode; VT0.rebuilder_logicalOp_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.4/parsing_cocci/safe_for_multi_decls.ml0000644000175000017500000001057412614153277022130 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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. This also now allows complete removal of a declaration, with no changes inside. This is related to the danger data type and the code in parsing_c/danger.ml *) module Ast = Ast_cocci module V = Visitor_ast (* ------------------------------------------------------------------------- *) (* check if everything is removed, with no additions allowed *) let all_removed = let bind x y = x && y in let option_default = true in let do_nothing r k e = k e in let mcode _ (_,_,kind,_) = match kind with Ast.MINUS(_,_,_,Ast.NOREPLACEMENT) -> true | Ast.MINUS(_,_,_,_) -> false | Ast.PLUS _ -> failwith "not possible" | Ast.CONTEXT(_,info) -> false in let recursor = V.combiner bind option_default mcode 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 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in recursor.V.combiner_declaration (* ------------------------------------------------------------------------- *) 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 || y in let option_default = false in let do_nothing r k e = k e in let annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k re = (* Very obscure how this could arise. Array type contains an expression and the expression could contain a statement. *) let res = k re in match Ast.unwrap re with Ast.FunHeader(bef,_,fninfo,name,lp,params,va,rp) -> bind (mcode r ((),(),bef,[])) res | Ast.Decl decl -> bind (mcode r ((),(),annotated_decl decl,[])) res | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (mcode r ((),(),annotated_decl decl,[])) res | _ -> res in let init r k i = let res = k i in match Ast.unwrap i with Ast.StrInitList(allminus,_,_,_,_) -> allminus || res | _ -> res in let recursor = V.combiner bind option_default mcode 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 init do_nothing 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 if all_removed e then {e with Ast.safe_for_multi_decls = true} else 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 || ft_modif || 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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing decl donothing 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.4/parsing_cocci/iso_pattern.mli0000644000175000017500000000107412614153277020453 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 val verbose_iso : bool ref coccinelle-1.0.4/parsing_cocci/top_level.mli0000644000175000017500000000056312614153277020117 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/type_infer.mli0000644000175000017500000000042212614153277020264 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val type_infer : Ast0_cocci.rule -> unit coccinelle-1.0.4/parsing_cocci/parse_printf.ml0000644000175000017500000000614412614153277020452 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* %[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 || 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) | 'D' when !Flag.ibm -> (match safe_get s 1 with '(' -> (try let final = Str.search_forward (Str.regexp_string ")") s 2 in let len = final + 1 in (String.sub s 0 len, suffix s len) with _ -> raise Not_format_string) | _ -> raise Not_format_string) | _ -> 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.4/parsing_cocci/compute_lines.ml0000644000175000017500000014352712614153277020633 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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; Ast0.whitespace = lstart.Ast0.whitespace; (* 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.whitespace = lstart.Ast0.whitespace; 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 set_mcode_info (a,b,_,c,d,e) info = (a,b,info,c,d,e) 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 ({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; Ast0.strings_after = []}, Ast0.set_info stm {info with Ast0.strings_before = []}) let promote_to_statement_end 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; Ast0.strings_before = []} in (new_info, {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}, Ast0.set_info stm {info with Ast0.strings_after = []}) let promote_to_statement_end_mcode (a,ar,info,mc,al,adj) mcodekind = 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; Ast0.strings_before = []} in (new_info, {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}, (a,ar,{info with Ast0.strings_after = []},mc,al,adj)) (* 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,[]) -> mkres d [] prev prev | (None,[]) -> Ast0.set_info d {(Ast0.get_info d) with Ast0.attachable_start = check_attachable false; Ast0.attachable_end = check_attachable false} | (_,x) -> let (l,lstart,lend) = dot_list is_dots fn x in mkres d 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.AsIdent(id,asid) -> let (id,r) = full_ident id in mkidres i (Ast0.AsIdent(id,asid)) id id r and ident i = let (id,_) = full_ident i in id (* --------------------------------------------------------------------- *) (* Expression *) let is_exp_dots e = match Ast0.unwrap e with Ast0.Edots(_,_) -> true | _ -> false let is_str_dots e = match Ast0.unwrap e with Ast0.Strdots(_) -> true | _ -> false let assignOp op = let (newop, promoted) = match Ast0.unwrap op with | Ast0.SimpleAssign op0 -> let op1 = normal_mcode op0 in let op2 = promote_mcode op1 in ( (Ast0.SimpleAssign op1), op2) | Ast0.OpAssign op0 -> let op1 = normal_mcode op0 in let op2 = promote_mcode op1 in ( (Ast0.OpAssign op1), op2) | Ast0.MetaAssign (mv0, c, pure) -> let mv1 = normal_mcode mv0 in let mv2 = promote_mcode mv1 in ( Ast0.MetaAssign(mv1, c, pure), mv2) in mkres op newop promoted promoted let binaryOp op = let (newop, promoted) = match Ast0.unwrap op with | Ast0.Arith op0 -> let op1 = normal_mcode op0 in let op2 = promote_mcode op1 in ( (Ast0.Arith op1), op2) | Ast0.Logical op0 -> let op1 = normal_mcode op0 in let op2 = promote_mcode op1 in ( (Ast0.Logical op1), op2) | Ast0.MetaBinary (mv0, c, pure) -> let mv1 = normal_mcode mv0 in let mv2 = promote_mcode mv1 in ( Ast0.MetaBinary(mv1, c, pure), mv2) in mkres op newop promoted promoted 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 = assignOp 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 = binaryOp 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 = binaryOp 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.ConjExpr(starter,exps,mids,ender) -> do_disj e starter exps mids ender expression (fun starter exps mids ender -> Ast0.ConjExpr(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.OptExp(exp) -> let exp = expression exp in mkres e (Ast0.OptExp(exp)) exp exp | Ast0.AsExpr(exp,asexp) -> let exp = expression exp in mkres e (Ast0.AsExpr(exp,asexp)) exp exp | Ast0.AsSExpr(exp,asexp) -> let exp = expression exp in mkres e (Ast0.AsSExpr(exp,asexp)) exp exp and expression_dots x = dots is_exp_dots None expression x and string_fragment e = match Ast0.unwrap e with Ast0.ConstantFragment(str) -> let str = normal_mcode str in let ln = promote_mcode str in mkres e (Ast0.ConstantFragment(str)) ln ln | Ast0.FormatFragment(pct,fmt) -> let pct = normal_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 = normal_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.Strdots dots) ln ln | Ast0.MetaFormatList(pct,name,lenname) -> (* not sure what to do about the following comment... *) (* 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 = normal_mcode pct in let ln1 = promote_mcode pct in let name = normal_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 = normal_mcode str in let ln = promote_mcode str in mkres e (Ast0.ConstantFormat str) ln ln | Ast0.MetaFormat(name,constraints) -> let name = normal_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.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.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.FunProto(fninfo,name,lp1,params,va1,rp1,sem) -> let fninfo = List.map (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x) fninfo in let name = ident name in let lp1 = normal_mcode lp1 in let params = parameter_list (Some(promote_mcode lp1)) params in let va1 = match va1 with | None -> None | Some (c1,e1) -> Some (normal_mcode c1, normal_mcode e1) in let rp1 = normal_mcode rp1 in let sem = normal_mcode sem in let res = Ast0.FunProto(fninfo,name,lp1,params,va1,rp1,sem) in let right = promote_mcode sem in (match fninfo with [] -> mkres d res name right | Ast0.FStorage(stg)::_ -> mkres d res (promote_mcode stg) right | Ast0.FType(ty)::_ -> mkres d res ty right | Ast0.FInline(inline)::_ -> mkres d res (promote_mcode inline) right | Ast0.FAttr(attr)::_ -> mkres d res (promote_mcode attr) right) | Ast0.MacroDecl(stg,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 (match stg with None -> mkres d (Ast0.MacroDecl(None,name,lp,args,rp,sem)) name (promote_mcode sem) | Some x -> let stg = Some (normal_mcode x) in mkres d (Ast0.MacroDecl(stg,name,lp,args,rp,sem)) (promote_mcode x) (promote_mcode sem)) | Ast0.MacroDeclInit(stg,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 (match stg with None -> mkres d (Ast0.MacroDeclInit(None,name,lp,args,rp,eq,ini,sem)) name (promote_mcode sem) | Some x -> let stg = Some (normal_mcode x) in mkres d (Ast0.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem)) (promote_mcode x) (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.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.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(_) -> 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.OptParam(param) -> let res = parameterTypeDef param in mkres p (Ast0.OptParam(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(_) -> 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.OptDParam(dp) -> let res = define_param dp in mkres p (Ast0.OptDParam(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(_,_) -> true | _ -> false let is_ec_dots e = match Ast0.unwrap e with Ast0.ExecDots(_) -> true | _ -> false let rec statement s = let res = match Ast0.unwrap s with Ast0.Decl((info,bef),decl) -> let decl = declaration decl in let (leftinfo,decl) = promote_to_statement_start decl bef in let leftinfo = (* for function prototypes, which may have information placed here before calling Compute_lines *) {leftinfo with Ast0.strings_before = info.Ast0.strings_before} in mkres s (Ast0.Decl((leftinfo,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 (rightinfo,right,branch) = promote_to_statement_end branch aft in mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(rightinfo,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 (rightinfo,right,branch2) = promote_to_statement_end branch2 aft in mkres s (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2, (rightinfo,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 (rightinfo,right,body) = promote_to_statement_end body aft in mkres s (Ast0.While(wh,lp,exp,rp,body,(rightinfo,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 (leftinfo,decl) = promote_to_statement_start decl bef in mkres first (Ast0.ForDecl ((leftinfo,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 (rightinfo,right,body) = promote_to_statement_end body aft in mkres s (Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body, (rightinfo,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 (rightinfo,right,body) = promote_to_statement_end body aft in mkres s (Ast0.Iterator(nm,lp,args,rp,body,(rightinfo,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.unwrap 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.Exec(exec,lang,code,sem) -> let exec = normal_mcode exec in let lang = normal_mcode lang in let code = dots is_ec_dots (Some(promote_mcode lang)) exec_code code in let sem = normal_mcode sem in mkres s (Ast0.Exec(exec,lang,code,sem)) (promote_mcode exec) (promote_mcode sem) | Ast0.MetaStmt(name,a) -> let name = normal_mcode name in let ln = promote_mcode name in mkres s (Ast0.MetaStmt(name,a)) ln ln | Ast0.MetaStmtList(name,a,b) -> (* This becomes ..., which becomes a metavar. The metavar, with any attachments that this has, is then iterated over the code. If we attach anything here, then it will be duplicated for each statement in the list. *) let name = bad_mcode name in let ln = promote_mcode name in mkres s (Ast0.MetaStmtList(name,a,b)) 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.TopId(id) -> let id = ident id in mkres s (Ast0.TopId(id)) id id | 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.Conj(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.Conj(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.FunDecl((_,bef),fninfo,name,lp,params,va,rp,lbrace,body,rbrace, (_,aft)) -> 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 (leftinfo,fninfo,name) = leftfninfo fninfo name bef in let (rightinfo,right,rbrace) = promote_to_statement_end_mcode rbrace aft 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((leftinfo,bef),fninfo,name,lp,params,va,rp,lbrace, body,rbrace,(rightinfo,aft)) 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 right | Ast0.FStorage(stg)::_ -> mkres s res (promote_mcode stg) right | Ast0.FType(ty)::_ -> mkres s res ty right | Ast0.FInline(inline)::_ -> mkres s res (promote_mcode inline) right | Ast0.FAttr(attr)::_ -> mkres s res (promote_mcode attr) right) | 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.AsStmt(stm,asstm) -> let stm = statement stm in mkres s (Ast0.AsStmt(stm,asstm)) stm stm 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 leftfninfo fninfo name bef = (* cases on what is leftmost *) match fninfo with [] -> let (leftinfo,name) = promote_to_statement_start name bef in (leftinfo,[],name) | Ast0.FStorage(stg)::rest -> let (leftinfo,stginfo) = promote_to_statement_start (promote_mcode stg) bef in (leftinfo, Ast0.FStorage(set_mcode_info stg (Ast0.get_info stginfo))::rest, name) | Ast0.FType(ty)::rest -> let (leftinfo,ty) = promote_to_statement_start ty bef in (leftinfo,Ast0.FType(ty)::rest,name) | Ast0.FInline(inline)::rest -> let (leftinfo,inlinfo) = promote_to_statement_start (promote_mcode inline) bef in (leftinfo, Ast0.FInline(set_mcode_info inline (Ast0.get_info inlinfo))::rest, name) | Ast0.FAttr(attr)::rest -> let (leftinfo,attrinfo) = promote_to_statement_start (promote_mcode attr) bef in (leftinfo, Ast0.FAttr(set_mcode_info attr (Ast0.get_info attrinfo))::rest, name) 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 exec_code e = match Ast0.unwrap e with Ast0.ExecEval(colon,id) -> let colon = normal_mcode colon in let id = expression id in mkres e (Ast0.ExecEval(colon,id)) (promote_mcode colon) id | Ast0.ExecToken(tok) -> let tok = normal_mcode tok in let ln = promote_mcode tok in mkres e (Ast0.ExecToken tok) ln ln | Ast0.ExecDots(dots) -> let dots = bad_mcode dots in let ln = promote_mcode dots in mkres e (Ast0.ExecDots dots) ln ln 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.4/parsing_cocci/pretty_print_cocci.ml0000644000175000017500000012717412614153277021670 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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) || (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 x let print_pos l = List.iter (function Ast.MetaPos(name,_,_,_,_) -> let name = Ast.unwrap_mcode name in print_string "@"; print_meta name; print_space()) 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 = print_between between fn (Ast.unwrap d) let nest_dots starter ender fn f d = mcode print_string starter; f(); start_block(); print_between force_newline fn (Ast.unwrap d); end_block(); mcode print_string ender (* --------------------------------------------------------------------- *) (* Disjunctions *) let print_disj_list fn l sep = 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 sep; force_newline()) else print_string (" "^sep^" ")) 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 "/* notype ";(* 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.IdPosIdSet (str,meta) -> print_string " ="; List.iter (function s -> print_string (" "^s)) str; List.iter (function (r,n) -> print_string " "; print_meta(r,n)) meta | Ast.IdNegIdSet (str,meta) -> print_string " !="; 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 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 " "; 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 " "; binaryOp op; print_string " "; expression right | Ast.Nested(left,op,right) -> expression left; print_string " "; 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.AsSExpr(exp,asstm) -> expression exp; print_string "@"; rule_elem "" asstm | Ast.EComma(cm) -> mcode print_string cm; print_space() | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list "|" | Ast.ConjExpr(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) -> mcode print_string dots; print_string " when != "; expression whencode | Ast.Edots(dots,None) -> mcode print_string dots | Ast.OptExp(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 op = match Ast.unwrap op with Ast.SimpleAssign op -> mcode print_string op | Ast.OpAssign(aop) -> mcode arithOp aop; print_string "=" | Ast.MetaAssign(metavar,_,_,_) -> mcode print_meta metavar and simpleAssignOp op = print_string "=" and opAssignOp aop = arithOp aop; print_string "=" and fixOp = function Ast.Dec -> print_string "--" | Ast.Inc -> print_string "++" and binaryOp op = match Ast.unwrap op with Ast.Arith(aop) -> mcode arithOp aop | Ast.Logical(lop) -> mcode logicalOp lop | Ast.MetaBinary(metavar,_,_,_) -> mcode print_meta metavar 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 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 varargs = function | None -> () | Some (comma, ellipsis) -> mcode print_string comma; mcode print_string ellipsis 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.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 (annotated_decl "") 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.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.FunProto (fninfo,name,lp1,params,va,rp1,sem) -> List.iter print_fninfo fninfo; ident name; mcode print_string_box lp1; parameter_list params; varargs va; close_box(); mcode print_string rp1; mcode print_string sem | Ast.MacroDecl(stg,name,lp,args,rp,sem) -> print_option (mcode storage) stg; ident name; mcode print_string_box lp; dots (function _ -> ()) expression args; close_box(); mcode print_string rp; mcode print_string sem | Ast.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> print_option (mcode storage) stg; 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.OptDecl(decl) -> print_string "?"; declaration decl and annotated_decl arity d = match Ast.unwrap d with Ast.DElem(bef,allminus,decl) -> mcode (function _ -> ()) ((),Ast.no_info,bef,[]); print_string arity; declaration decl | Ast.Ddots(dots,Some whencode) -> mcode print_string dots; print_string " when != "; declaration whencode | Ast.Ddots(dots,None) -> mcode print_string dots (* --------------------------------------------------------------------- *) (* 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 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.OptParam(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 *) and rule_elem arity re = match Ast.unwrap re with Ast.FunHeader(bef,allminus,fninfo,name,lp,params,va,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; begin match va with | None -> () | Some (comma,ellipsis) -> mcode print_string comma; mcode print_string ellipsis end; close_box(); mcode print_string rp; print_string " " | Ast.Decl(ann_decl) -> annotated_decl arity ann_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.Exec(exec,lang,code,sem) -> print_string arity; mcode print_string exec; print_string " "; mcode print_string lang; print_string " "; dots (function _ -> print_string " ") exec_code code; 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.TopId(id) -> print_string arity; ident id | 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.AsRe(re,asre) -> rule_elem arity re; print_string "@"; rule_elem arity asre | 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(ann_decl) -> annotated_decl "" ann_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.OptDParam(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,(_,_,_,aft)) -> rule_elem arity header; rule_elem arity lbrace; dots force_newline (statement arity) body; rule_elem arity rbrace; mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Disj([stmt_dots]) (* useful why? *) | Ast.Conj([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.Conj(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,_,_) -> 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 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 and exec_code e = match Ast.unwrap e with Ast.ExecEval(colon,id) -> mcode print_string colon; expression id | Ast.ExecToken(tok) -> mcode print_string tok | Ast.ExecDots(dots) -> mcode print_string dots (* --------------------------------------------------------------------- *) (* 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 (* --------------------------------------------------------------------- *) (* metavars *) let print_name rule r n = if rule = r then print_string n else print_string (Printf.sprintf "%s.%s" r n) let print_listlen rule = function Ast.MetaLen(r,n) -> print_string "["; print_name rule r n; print_string "] " | Ast.CstLen(n) -> print_string "["; print_string (string_of_int n); print_string "] " | Ast.AnyLen -> print_string " " let print_types = function None -> () | Some [ty] -> print_string (Type_cocci.type2c ty); print_string " " | Some l -> print_string "{"; print_between (fun _ -> print_string ",") (fun ty -> print_string (Type_cocci.type2c ty)) l; print_string "} " let print_seed_elem rule = function Ast.SeedString(s) -> print_string (Printf.sprintf "\"%s\"" s) | Ast.SeedId(r,n) -> print_name rule r n let print_seed rule = function Ast.NoVal -> () | Ast.StringSeed(s) -> print_string " = "; print_string s | Ast.ListSeed(ss) -> print_string " = "; print_between (fun _ -> print_string " ## ") (print_seed_elem rule) ss let rec unparse_cocci_mv rule = function Ast.MetaMetaDecl _ -> failwith "should be removed" | Ast.MetaIdDecl(_,(r,n)) -> print_string "identifier "; print_name rule r n; print_string ";" | Ast.MetaFreshIdDecl((r,n),seed) -> print_string "fresh identifier "; print_name rule r n; print_string " = "; print_seed rule seed; print_string ";" | Ast.MetaTypeDecl(_,(r,n)) -> print_string "type "; print_name rule r n; print_string ";" | Ast.MetaInitDecl(_,(r,n)) -> print_string "initializer "; print_name rule r n; print_string ";" | Ast.MetaInitListDecl(_,(r,n),len) -> print_string "initializer list"; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaListlenDecl(r,n) -> print_name rule r n | Ast.MetaParamDecl(_,(r,n)) -> print_string "parameter "; print_name rule r n; print_string ";" | Ast.MetaBinaryOperatorDecl(_,(r,n)) -> (* missing constraints *) print_string "binary operator "; print_name rule r n; print_string ";" | Ast.MetaAssignmentOperatorDecl(_,(r,n)) -> (* missing constraints *) print_string "assignment operator "; print_name rule r n; print_string ";" | Ast.MetaParamListDecl(_,(r,n),len) -> print_string "parameter list"; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaConstDecl(_,(r,n),ty) -> print_string "constant "; print_types ty; print_name rule r n; print_string ";" | Ast.MetaErrDecl(_,(r,n)) -> print_string "error "; print_name rule r n; print_string ";" | Ast.MetaExpDecl(_,(r,n),None) -> print_string "expression "; print_name rule r n; print_string ";" | Ast.MetaExpDecl(_,(r,n),ty) -> print_types ty; print_name rule r n; print_string ";" | Ast.MetaIdExpDecl(_,(r,n),ty) -> print_string "idexpression "; print_types ty; print_name rule r n; print_string ";" | Ast.MetaLocalIdExpDecl(_,(r,n),ty) -> print_string "local idexpression "; print_types ty; print_name rule r n; print_string ";" | Ast.MetaGlobalIdExpDecl(_,(r,n),ty) -> print_string "global idexpression "; print_types ty; print_name rule r n; print_string ";" | Ast.MetaExpListDecl(_,(r,n),len) -> print_string "expression list"; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaDeclDecl(_,(r,n)) -> print_string "declaration "; print_name rule r n; print_string ";" | Ast.MetaFieldDecl(_,(r,n)) -> print_string "field "; print_name rule r n; print_string ";" | Ast.MetaFieldListDecl(_,(r,n),len) -> print_string "field list"; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaStmDecl(_,(r,n)) -> print_string "statement "; print_name rule r n; print_string ";" | Ast.MetaStmListDecl(_,(r,n),len) -> print_string "statement list "; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaFuncDecl(_,(r,n)) -> print_string "function "; print_name rule r n; print_string ";" | Ast.MetaLocalFuncDecl(_,(r,n)) -> print_string "local function "; print_name rule r n; print_string ";" | Ast.MetaPosDecl(_,(r,n)) -> (* constraints missing! *) print_string "position "; print_name rule r n; print_string ";" | Ast.MetaFmtDecl(_,(r,n)) -> print_string "format "; print_name rule r n; print_string ";" | Ast.MetaFragListDecl(_,(r,n),len) -> print_string "fragment list"; print_listlen rule len; print_name rule r n; print_string ";" | Ast.MetaAnalysisDecl(analyzer,(r,n)) -> failwith "analyzer not supported" | Ast.MetaDeclarerDecl(_,(r,n)) -> print_string "declarer "; print_name rule r n; print_string ";" | Ast.MetaIteratorDecl(_,(r,n)) -> print_string "iterator "; print_name rule r n; print_string ";" | Ast.MetaScriptDecl _ -> failwith "not a cocci decl" (* --------------------------------------------------------------------- *) 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.SimpleAssignOpTag(x) -> simpleAssignOp (Ast.make_mcode x) | Ast.OpAssignOpTag(x) -> opAssignOp 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.StringFragmentTag(x) -> string_fragment 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.AnnDeclDotsTag(x) -> dots (function _ -> ()) (annotated_decl "") 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 mv code = print_string (Printf.sprintf "@%s:%s" str lang); (match deps with Ast.NoDep -> () | _ -> print_string " depends on "; dep true deps); print_string "@"; force_newline(); List.iter (function (script_name,inh_name,_ty,init) -> (match script_name with (None,None) -> print_string "(_,_)" | (Some x,None) -> print_string x | (None,Some a) -> print_string (Printf.sprintf "(_,%s)" a) | (Some x,Some a) -> print_string (Printf.sprintf "(%s,%s)" x a)); print_string " << "; print_string (Printf.sprintf "%s.%s" (fst inh_name) (snd inh_name)); (match init with Ast.NoMVInit -> () | Ast.MVInitString s -> print_space(); print_string "="; print_space(); print_string "\""; print_string s; print_string "\"" | Ast.MVInitPosList -> print_space(); print_string "="; print_space(); print_string "[]"); print_string ";"; force_newline()) mv; 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 mvs z = match z with Ast.InitialScriptRule (name,lang,deps,mv,code) -> script_header "initialize" lang deps mv code | Ast.FinalScriptRule (name,lang,deps,mv,code) -> script_header "finalize" lang deps mv code | Ast.ScriptRule (name,lang,deps,bindings,script_vars,code) -> script_header "script" lang deps bindings code | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) -> print_string "@"; print_string nm; (match deps with Ast.NoDep -> () | _ -> print_string " depends on "; dep true deps); (match drops with [] -> () | _ -> print_string " disable "; print_string (String.concat "," drops)); (match exists with Ast.Exists -> print_string " exists" | Ast.Forall -> print_string " forall" | Ast.Undetermined -> ()); print_string "@"; force_newline(); List.iter (fun mv -> unparse_cocci_mv nm mv; force_newline()) mvs; print_string "@@"; print_newlines_disj := true; force_newline(); force_newline(); rule x; force_newline(); 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.4/parsing_cocci/single_statement.ml0000644000175000017500000006155512614153277021332 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.unwrap l with [] -> false | x::xs -> f x let right_dots f l = match List.rev (Ast0.unwrap 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.AnnDeclDotsTag(_) -> 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 || 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.AsIdent _ -> failwith "not possible" let rec right_ident i = modif_after i || 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.AsIdent _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Expression *) let rec left_expression e = modif_before e || 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.ConjExpr(_,exp_list,_,_) -> List.exists left_expression exp_list | Ast0.NestExpr(starter,expr_dots,ender,_,multi) -> left_dots left_expression expr_dots | Ast0.Edots(dots,_) -> false | Ast0.OptExp(exp) -> left_expression exp | Ast0.AsExpr _ | Ast0.AsSExpr _ -> failwith "not possible" (* --------------------------------------------------------------------- *) (* Types *) and left_typeC t = modif_before t || 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.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.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 || 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.FunProto(fninfo,name,lp1,params,va,rp1,sem) -> (* should not be nested in anything anyway *) false | Ast0.MacroDecl(Some stg,name,lp,args,rp,sem) -> modif_before_mcode stg | Ast0.MacroDecl(None,name,lp,args,rp,sem) -> left_ident name | Ast0.MacroDeclInit(Some stg,name,lp,args,rp,eq,ini,sem) -> modif_before_mcode stg | Ast0.MacroDeclInit(None,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.AsDecl _ -> failwith "not possible" and right_declaration d = modif_before d || 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.FunProto(fninfo,name,lp1,params,va,rp1,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.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.Exec(exec,lang,code,sem) -> modif_before_mcode exec | 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.TopId(id) -> false (* can only be replaced by an ident *) | Ast0.TopInit(init) -> false (* can only be replaced by an init *) | Ast0.Dots(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.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.Exec(exec,lang,code,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.TopId(id) -> false (* can only be replaced by a type *) | Ast0.TopInit(init) -> false (* can only be replaced by an init *) | Ast0.Dots(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.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 [] -> 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) | Ast0.ConjExpr(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 mcode mcode dots dots dots dots dots dots identifier expression donothing donothing typeC donothing donothing declaration statement donothing case_line donothing 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.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 [s] -> Ast0.rewrap s [do_branch s] | _ -> s) 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,va,rp,lbrace,body,rbrace,y) -> (* 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,va,rp,lbrace, statement_dots false true body, rbrace,y)) | 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 (List.map case_line (Ast0.unwrap 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.Exec(exec,lang,code,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.Conj(starter,statement_dots_list,mids,ender) -> (match statement_dots_list with s1::ss -> Ast0.rewrap s (Ast0.Conj(starter, (statement_dots dots_before dots_after s1) :: (List.map (statement_dots false false) ss), mids,ender)) | _ -> s) | 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.TopId(id) -> s | Ast0.TopInit(init) -> s | Ast0.Dots(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.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 (do_statement_dots dots_before dots_after (Ast0.unwrap d)) 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.4/parsing_cocci/get_metas.mli0000644000175000017500000000053512614153277020075 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val process : Ast0_cocci.rule -> Ast0_cocci.rule val process_anything : Ast0_cocci.anything -> Ast0_cocci.anything coccinelle-1.0.4/parsing_cocci/free_vars.ml0000644000175000017500000013115412614153277017732 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 | Ast.IdPosIdSet (_,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 rec collect_assign_names aop = match Ast.unwrap aop with Ast.MetaAssign(name,Ast.AssignOpNoConstraint,_,_) -> [metaid name] | Ast.MetaAssign(name,Ast.AssignOpInSet l,_,_) -> if include_constraints then List.fold_left (fun prev a -> bind (collect_assign_names a) prev) [metaid name] l else [metaid name] | _ -> option_default in let astfvassignop recursor k bop = bind (k bop) (collect_assign_names bop) in let rec collect_binary_names bop = match Ast.unwrap bop with Ast.MetaBinary(name,Ast.BinaryOpNoConstraint,_,_) -> [metaid name] | Ast.MetaBinary(name,Ast.BinaryOpInSet l,_,_) -> if include_constraints then List.fold_left (fun prev a -> bind (collect_binary_names a) prev) [metaid name] l else [metaid name] | _ -> option_default in let astfvbinaryop recursor k bop = bind (k bop) (collect_binary_names bop) 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,_,_,_) -> [metaid name] | Ast.MetaStmtList(name,Ast.MetaListLen(lenname,_,_),_,_) -> [metaid name;metaid lenname] | 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)::(if include_constraints then constraints else [])) (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 mcode mcode donothing donothing donothing donothing donothing astfvident astfvexpr astfvfrag astfvfmt astfvassignop astfvbinaryop astfvfullType astfvtypeC astfvinit astfvparam astfvdecls donothing 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_pos_positions = 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 metaid (x,_,_,_) = x in let mcode r mc = List.concat (List.map (function Ast.MetaPos(name,constraints,_,_,_) -> [metaid name]) (Ast.get_pos_var mc)) in let cprule_elem recursor k re = match Ast.unwrap re with Ast.DisjRuleElem relist -> (*take the intersection of the results*) let subres = List.map k relist in List.fold_left Common.inter_set (List.hd subres) (List.tl subres) | _ -> k re in let cpstmt recursor k s = match Ast.unwrap s with Ast.Disj stmlist -> (*take the intersection of the results*) let subres = List.map recursor.V.combiner_statement_dots stmlist in List.fold_left Common.inter_set (List.hd subres) (List.tl subres) | _ -> k s in V.combiner bind option_default mcode mcode 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 cprule_elem cpstmt donothing donothing donothing (* ---------------------------------------------------------------- *) 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 astfvassign recursor k aop = bind (k aop) (match Ast.unwrap aop with Ast.MetaAssign(name,_,TC.Saved,_) -> [metaid name] | _ -> option_default) in let astfvbinary recursor k bop = bind (k bop) (match Ast.unwrap bop with Ast.MetaBinary(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,_,_) -> [metaid name] | Ast.MetaStmtList(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.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 mcode mcode donothing donothing donothing donothing donothing astfvident astfvexpr astfvfrag astfvfmt astfvassign astfvbinary donothing astfvtypeC astfvinit astfvparam astfvdecls donothing 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 annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let astfvrule_elem recursor k re = match Ast.unwrap re with Ast.FunHeader(bef,_,fi,nm,_,params,_,_) -> bind (cip_mcodekind recursor bef) (k re) (* no clue why this code is here *) (* 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 = List.concat (List.map (function p -> match Ast.unwrap p with Ast.VoidParam(t) | Ast.Param(t,_) -> collect_all_refs.V.combiner_fullType t | _ -> []) (Ast.unwrap params)) in bind fi_metas (bind nm_metas (bind param_metas (bind (cip_mcodekind recursor bef) (k re)))) *) | Ast.Decl decl -> bind (cip_mcodekind recursor (annotated_decl decl)) (k re) | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (cip_mcodekind recursor (annotated_decl decl)) (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)) | Ast.FunDecl(_,_,_,_,(_,_,_,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 mcode mcode donothing donothing donothing 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 || 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 assignop r k ft = let ft = k ft in match Ast.unwrap ft with Ast.MetaAssign(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap ft (Ast.MetaAssign(name,constraints,unitary,inherited)) | _ -> ft in let binaryop r k ft = let ft = k ft in match Ast.unwrap ft with Ast.MetaBinary(name,constraints,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap ft (Ast.MetaBinary(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,Ast.MetaListLen (lenname,_,_),_,_) -> let (unitary,inherited) = classify name in let (lenunitary,leninherited) = classify lenname in Ast.rewrap e (Ast.MetaStmtList (name,Ast.MetaListLen(lenname,lenunitary,leninherited), unitary,inherited)) | Ast.MetaStmtList(name,lenname,_,_) -> let (unitary,inherited) = classify name in Ast.rewrap e (Ast.MetaStmtList(name,lenname,unitary,inherited)) | _ -> e in let fn = V.rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression string_fragment string_format assignop binaryop donothing typeC init param decl donothing 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 negative 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 let refront re = match Ast.unwrap re with Ast.FunHeader _ -> "FunHeader" | Ast.Decl _ -> "Decl" | Ast.SeqStart _ -> "SeqStart" | Ast.SeqEnd _ -> "SeqEnd" | Ast.ExprStatement _ -> "ExprStatement" | Ast.IfHeader _ -> "IfHeader" | Ast.Else _ -> "Else" | Ast.WhileHeader _ -> "WhileHeader" | Ast.DoHeader _ -> "DoHeader" | Ast.WhileTail _ -> "WhileTail" | Ast.ForHeader _ -> "ForHeader" | Ast.IteratorHeader _ -> "IteratorHeader" | Ast.SwitchHeader _ -> "SwitchHeader" | Ast.Break _ -> "Break" | Ast.Continue _ -> "Continue" | Ast.Label _ -> "Label" | Ast.Goto _ -> "Goto" | Ast.Return _ -> "Return" | Ast.ReturnExpr _ -> "ReturnExpr" | Ast.Exec _ -> "Exec" | Ast.MetaRuleElem _ -> "MetaRuleElem" | Ast.MetaStmt _ -> "MetaStmt" | Ast.MetaStmtList _ -> "MetaStmtList" | Ast.Exp _ -> "Exp" | Ast.TopExp _ -> "TopExp" | Ast.Ty _ -> "Ty" | Ast.TopId _ -> "TopId" | Ast.TopInit _ -> "TopInit" | Ast.Include _ -> "Include" | Ast.Undef _ -> "Undef" | Ast.DefineHeader _ -> "DefineHeader" | Ast.Pragma _ -> "Pragma" | Ast.Case _ -> "Case" | Ast.Default _ -> "Default" | Ast.AsRe _ -> "AsRe" | Ast.DisjRuleElem _ -> "DisjRuleElem" in (* cases for the elements of anything *) let simple_setup refront 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 minus_pos_free = nub (getter collect_pos_positions 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 inherited_pos = List.filter (function x -> List.mem x bound) minus_pos_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.positive_inherited_positions = inherited_pos; Ast.saved_witness = []} in let astfvrule_elem recursor k re = simple_setup refront (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)) | Ast.FunDecl(header,lbrace,body,rbrace,(_,_,_,aft)) -> let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in Ast.FunDecl(header,lbrace,body,rbrace,(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 (fun _ -> "statement") (function x -> x.V.combiner_statement_dots) k sd in let astfvcase_line recursor k cl = simple_setup (fun _ -> "case") (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 mcode mcode donothing donothing astfvstatement_dots donothing donothing donothing 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 init/finalize provides no names, so inheritance by others is not 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 mcode mcode donothing donothing donothing 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 (_,_,_,mv,_) | Ast.FinalScriptRule (_,_,_,mv,_) -> (* only virtual identifiers *) [] | 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.4/parsing_cocci/pretty_print_cocci.mli0000644000175000017500000000362512614153277022033 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val unparse : Ast_cocci.metavar list -> 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 simpleAssignOp : Ast_cocci.simpleAssignOp -> unit val opAssignOp : Ast_cocci.arithOp -> unit val fixOp : Ast_cocci.fixOp -> unit val unaryOp : Ast_cocci.unaryOp -> unit val binaryOp : Ast_cocci.binaryOp -> unit val arithOp : Ast_cocci.arithOp -> unit val logicalOp : Ast_cocci.logicalOp -> 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 val dep : bool -> Ast_cocci.dependency -> unit coccinelle-1.0.4/parsing_cocci/free_vars.mli0000644000175000017500000000164412614153277020103 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/get_metas.ml0000644000175000017500000001264412614153277017730 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* creates AsExpr, etc *) (* @ attached metavariables can only be associated with positions, so nothing to do for them *) (* Why doesn't this use the Ast0 visitor? *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types 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,ispos) = List.partition (function Ast0.MetaPosTag _ -> false | _ -> true) (Ast0.get_pos x) in (nonpos,Ast0.set_pos ispos 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 dots fn d = rewrap d (map_split_bind fn (Ast0.unwrap d)) let rec ident r k i = let (metas,i) = k i 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 r k e = let (metas,e) = k e 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))))) | Ast0.StmtTag(stm_meta) -> (other_metas, Ast0.rewrap exp (Ast0.AsSExpr(exp,stm_meta))) | x -> (x::other_metas,exp)) ([],e) metas and typeC r k t = let (metas,t) = k t 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 declaration r k d = let (metas,d) = k d 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 r k i = let (metas,i) = k 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 param r k 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 | _ -> k p and statement r k s = let (metas,s) = k s 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 let res = V0.combiner_rebuilder bind option_default {V0.combiner_rebuilder_functions with VT0.combiner_rebuilder_meta_mcode = mcode; VT0.combiner_rebuilder_string_mcode = mcode; VT0.combiner_rebuilder_const_mcode = mcode; VT0.combiner_rebuilder_simpleAssign_mcode = mcode; VT0.combiner_rebuilder_opAssign_mcode = mcode; VT0.combiner_rebuilder_fix_mcode = mcode; VT0.combiner_rebuilder_unary_mcode = mcode; VT0.combiner_rebuilder_arithOp_mcode = mcode; VT0.combiner_rebuilder_logicalOp_mcode = mcode; VT0.combiner_rebuilder_cv_mcode = mcode; VT0.combiner_rebuilder_sign_mcode = mcode; VT0.combiner_rebuilder_struct_mcode = mcode; VT0.combiner_rebuilder_storage_mcode = mcode; VT0.combiner_rebuilder_inc_mcode = mcode; VT0.combiner_rebuilder_identfn = ident; VT0.combiner_rebuilder_exprfn = expression; VT0.combiner_rebuilder_tyfn = typeC; VT0.combiner_rebuilder_initfn = initialiser; VT0.combiner_rebuilder_paramfn = param; VT0.combiner_rebuilder_declfn = declaration; VT0.combiner_rebuilder_stmtfn = statement} let do_process fn line_getter t = match fn t with ([],code) -> code | (l,_) -> failwith (Printf.sprintf "%s contains unattached metavariables: %s" (line_getter t) (String.concat ", " (List.map (function nm -> let (r,n) = Ast0.unwrap_mcode nm in r^"."^n) (List.map Ast0.meta_pos_name l)))) let process = let line t = Printf.sprintf "rule starting on line %d" (Ast0.get_line t) in List.map (do_process res.VT0.top_level line) let process_anything x = do_process res.VT0.anything (fun _ -> "term") x coccinelle-1.0.4/parsing_cocci/test_exps.ml0000644000175000017500000000537612614153277020002 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 op with Ast0.Logical op' when (let op''=Ast0.unwrap_mcode op' in op''=Ast.AndLog || op''=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(w,ee,e) -> Ast0.WhenNotTrue(w,ee,process_exp e) | Ast0.WhenNotFalse(w,ee,e) -> Ast0.WhenNotFalse(w,ee,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.4/parsing_cocci/parse_cocci.ml0000644000175000017500000027102412614153277020231 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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"; "optional_attributes";"prototypes"] (* ----------------------------------------------------------------------- *) (* Debugging... *) let line_type (d,_,_,_,_,_,_,_,_,_) = d let line_type2c tok = match line_type tok with D.MINUS | D.OPTMINUS -> ":-" | D.PLUS -> ":+" | D.PLUSPLUS -> ":++" | D.CONTEXT | D.OPT -> "" let real_line (_,d,_,_,_,_,_,_,_,_) = d let log_line (_,_,d,_,_,_,_,_,_,_) = d let token2c (tok,_) = let add_clt str clt = Printf.sprintf "%s:%s:%d:%d" str (line_type2c clt) (real_line clt) (log_line clt) in 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.TOperator -> "operator" | PC.TBinary -> "binary" | PC.TAssignment -> "assignment" | 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.TGlobal -> "global" | PC.Tlist -> "list" | PC.TFresh -> "fresh" | PC.TCppConcatOp -> "##" | PC.TPure -> "pure" | PC.TContext -> "context" | PC.TTypedef -> "typedef" | PC.TAttribute -> "attribute" | 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) -> add_clt "char" clt | PC.Tshort(clt) -> add_clt "short" clt | PC.Tint(clt) -> add_clt "int" clt | PC.Tdouble(clt) -> add_clt "double" clt | PC.Tfloat(clt) -> add_clt "float" clt | PC.Tlong(clt) -> add_clt "long" clt | PC.Tvoid(clt) -> add_clt "void" clt | PC.Tsize_t(clt) -> add_clt "size_t" clt | PC.Tssize_t(clt) -> add_clt "ssize_t" clt | PC.Tptrdiff_t(clt) -> add_clt "ptrdiff_t" clt | PC.Tstruct(clt) -> add_clt "struct" clt | PC.Tunion(clt) -> add_clt "union" clt | PC.Tenum(clt) -> add_clt "enum" clt | PC.Tunsigned(clt) -> add_clt "unsigned" clt | PC.Tsigned(clt) -> add_clt "signed" clt | PC.Tstatic(clt) -> add_clt "static" clt | PC.Tinline(clt) -> add_clt "inline" clt | PC.Ttypedef(clt) -> add_clt "typedef" clt | PC.Tattr(s,clt) -> add_clt s clt | PC.Tauto(clt) -> add_clt "auto" clt | PC.Tregister(clt) -> add_clt "register" clt | PC.Textern(clt) -> add_clt "extern" clt | PC.Tconst(clt) -> add_clt "const" clt | PC.Tvolatile(clt) -> add_clt "volatile" clt | PC.Tdecimal(clt) -> add_clt "decimal" clt | PC.Texec(clt) -> add_clt "exec" clt | PC.TDirective(Ast.Noindent s,_) -> s | PC.TDirective(Ast.Indent s,_) -> s | PC.TDirective(Ast.Space s,_) -> s | PC.TIncludeL(s,clt) -> add_clt (pr "#include \"%s\"" s) clt | PC.TIncludeNL(s,clt) -> add_clt (pr "#include <%s>" s) clt | PC.TUndef(clt,_) -> add_clt "#undef" clt | PC.TDefine(clt,_) -> add_clt "#define" clt | PC.TDefineParam(clt,_,_,_) -> add_clt "#define_param" clt | PC.TPragma(clt) -> add_clt "#pragma" clt | PC.TMinusFile(s,clt) -> add_clt (pr "--- %s" s) clt | PC.TPlusFile(s,clt) -> add_clt (pr "+++ %s" s) clt | PC.TInc(clt) -> add_clt "++" clt | PC.TDec(clt) -> add_clt "--" clt | PC.TIf(clt) -> add_clt "if" clt | PC.TElse(clt) -> add_clt "else" clt | PC.TWhile(clt) -> add_clt "while" clt | PC.TFor(clt) -> add_clt "for" clt | PC.TDo(clt) -> add_clt "do" clt | PC.TSwitch(clt) -> add_clt "switch" clt | PC.TCase(clt) -> add_clt "case" clt | PC.TDefault(clt) -> add_clt "default" clt | PC.TReturn(clt) -> add_clt "return" clt | PC.TBreak(clt) -> add_clt "break" clt | PC.TContinue(clt) -> add_clt "continue" clt | PC.TGoto(clt) -> add_clt "goto" clt | PC.TIdent(s,clt) -> add_clt (pr "ident-%s" s) clt | PC.TTypeId(s,clt) -> add_clt (pr "typename-%s" s) clt | PC.TDeclarerId(s,clt) -> add_clt (pr "declarername-%s" s) clt | PC.TIteratorId(s,clt) -> add_clt (pr "iteratorname-%s" s) clt | PC.TSymId(s,clt) -> add_clt (pr "symbol-%s" s) clt | PC.TMetaDeclarer(_,_,_,clt) -> add_clt "declmeta" clt | PC.TMetaIterator(_,_,_,clt) -> add_clt "itermeta" clt | PC.TSizeof(clt) -> add_clt "sizeof" clt | PC.TString(x,clt) -> add_clt x clt | PC.TChar(x,clt) -> add_clt x clt | PC.TFloat(x,clt) -> add_clt x clt | PC.TInt(x,clt) -> add_clt x clt | PC.TDecimalCst(x,len,prc,clt) -> add_clt x clt | PC.TOrLog(clt) -> add_clt "||" clt | PC.TAndLog(clt) -> add_clt "&&" clt | PC.TOr(clt) -> add_clt "|" clt | PC.TXor(clt) -> add_clt "^" clt | PC.TAnd (clt) -> add_clt "&" clt | PC.TEqEq(clt) -> add_clt "==" clt | PC.TNotEq(clt) -> add_clt "!=" clt | PC.TSub(clt) -> add_clt "<=" clt | PC.TTildeEq(clt) -> add_clt "~=" clt | PC.TTildeExclEq(clt) -> add_clt "~!=" clt | PC.TLogOp(op,clt) -> add_clt (match op with Ast.Inf -> "<" | Ast.InfEq -> "<=" | Ast.Sup -> ">" | Ast.SupEq -> ">=" | _ -> failwith "not possible") clt | PC.TShLOp(op,clt) -> add_clt "<<" clt | PC.TShROp(op,clt) -> add_clt ">>" clt | PC.TPlus(clt) -> add_clt "+" clt | PC.TMinus(clt) -> add_clt "-" clt | PC.TMul(clt) -> add_clt "*" clt | PC.TDmOp(op,clt) -> add_clt (match op with Ast.Div -> "/" | Ast.Min -> " ">?" | Ast.Mod -> "%" |_ -> failwith "not possible") clt | PC.TTilde (clt) -> add_clt "~" clt | PC.TMeta(_,_,clt) -> add_clt "meta" clt | PC.TMetaAssignOp(_,_,_,clt) -> add_clt "metaassignop" clt | PC.TMetaBinaryOp(_,_,_,clt) -> add_clt "metabinaryop" clt | PC.TMetaParam(_,_,clt) -> add_clt "parammeta" clt | PC.TMetaParamList(_,_,_,clt) -> add_clt "paramlistmeta" clt | PC.TMetaConst(_,_,_,_,clt) -> add_clt "constmeta" clt | PC.TMetaErr(_,_,_,clt) -> add_clt "errmeta" clt | PC.TMetaExp(_,_,_,_,clt) -> add_clt "expmeta" clt | PC.TMetaIdExp(_,_,_,_,clt) -> add_clt "idexpmeta" clt | PC.TMetaLocalIdExp(_,_,_,_,clt) -> add_clt "localidexpmeta" clt | PC.TMetaGlobalIdExp(_,_,_,_,clt) -> add_clt "globalidexpmeta" clt | PC.TMetaExpList(_,_,_,clt) -> add_clt "explistmeta" clt | PC.TMetaId(nm,_,_,_,clt) -> "idmeta-"^add_clt (Dumper.dump nm) clt | PC.TMetaType(_,_,clt) -> add_clt "typemeta" clt | PC.TMetaInit(_,_,clt) -> add_clt "initmeta" clt | PC.TMetaInitList(_,_,_,clt) -> add_clt "initlistmeta" clt | PC.TMetaDecl(_,_,clt) -> add_clt "declmeta" clt | PC.TMetaField(_,_,clt) -> add_clt "fieldmeta" clt | PC.TMetaFieldList(_,_,_,clt) -> add_clt "fieldlistmeta" clt | PC.TMetaStm(_,_,clt) -> add_clt "stmmeta" clt | PC.TMetaStmList(_,_,_,clt) -> add_clt "stmlistmeta" clt | PC.TMetaFunc(_,_,_,clt) -> add_clt "funcmeta" clt | PC.TMetaLocalFunc(_,_,_,clt) -> add_clt "funcmeta" 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) -> add_clt "WHEN" clt | PC.TWhenTrue(clt) -> add_clt "WHEN TRUE" clt | PC.TWhenFalse(clt) -> add_clt "WHEN FALSE" clt | PC.TAny(clt) -> add_clt "ANY" clt | PC.TStrict(clt) -> add_clt "STRICT" clt | PC.TEllipsis(clt) -> add_clt "..." clt | PC.TVAEllipsis(clt) -> add_clt "......" clt | PC.TOEllipsis(clt) -> add_clt "<..." clt | PC.TCEllipsis(clt) -> add_clt "...>" clt | PC.TPOEllipsis(clt) -> add_clt "<+..." clt | PC.TPCEllipsis(clt) -> add_clt "...+>" clt | PC.TPlus0 -> "+" | PC.TWhy0 -> "?" | PC.TWhy(clt) -> add_clt "?" clt | PC.TDotDot(clt)-> add_clt ":" clt | PC.TBang(clt) -> add_clt "!" clt | PC.TOPar(clt) -> add_clt "(" clt | PC.TOPar0(s,clt) -> add_clt s clt | PC.TMid0(s,clt) -> add_clt s clt | PC.TAnd0(s,clt) -> add_clt s clt | PC.TCPar(clt) -> add_clt ")" clt | PC.TCPar0(s,clt) -> add_clt s clt | PC.TOBrace(clt) -> add_clt "{" clt | PC.TCBrace(clt) -> add_clt "}" clt | PC.TOCro(clt) -> add_clt "[" clt | PC.TCCro(clt) -> add_clt "]" clt | PC.TOInit(clt) -> add_clt "{" clt | PC.TPtrOp(clt) -> add_clt "->" clt | PC.TEq(clt) -> add_clt "=" clt | PC.TOpAssign(_,clt) -> add_clt "=op" clt | PC.TDot(clt) -> add_clt "." clt | PC.TComma(clt) -> add_clt "," clt | PC.TPtVirg(clt) -> add_clt ";" 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 | PC.TWhitespace s -> "Whitespace(" ^ 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 (* skip means ignore completely, notplus means keep in the recursion, but don't attach to it, plus means that it is possible to attach to the token *) 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.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.Texec(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.TMetaGlobalIdExp(_,_,_,_,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) (* it would seem that this should all be skips | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(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.TOpAssign(_,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(s,clt) | PC.TMid0(s,clt) | PC.TAnd0(s,clt) | PC.TCPar0(s,clt) -> NOTPLUS | PC.TMetaPos(nm,_,_,_) -> NOTPLUS | PC.TSub(clt) -> NOTPLUS | PC.TDirective(_,clt) -> NOTPLUS | _ -> SKIP exception NoClt of string 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.Texec(clt) | PC.Tstatic(clt) | PC.Ttypedef(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.TTildeExclEq(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.TMetaGlobalIdExp(_,_,_,_,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.TMetaAssignOp(_,_,_,clt) | PC.TMetaBinaryOp(_,_,_,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.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.TOpAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt) | PC.TPArob(clt) | PC.TPtVirg(clt) | PC.TOPar0(_,clt) | PC.TMid0(_,clt) | PC.TAnd0(_,clt) | PC.TCPar0(_,clt) | PC.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) | PC.TFunDecl(clt) | PC.TDirective(_,clt) | PC.TLineEnd(clt) -> clt | PC.TVAEllipsis(clt) -> clt | PC.Tlist -> failwith "No clt attached to token Tlist" | PC.TWords -> failwith "No clt attached to token TWords" | PC.TWhy0 -> failwith "No clt attached to token TWhy0" | PC.TWhitespace _ -> failwith "No clt attached to token TWhitespace" | PC.TVirtual -> failwith "No clt attached to token TVirtual" | PC.TUsing -> failwith "No clt attached to token TUsing" | PC.TUnderscore -> failwith "No clt attached to token TUnderscore" | PC.TTypedef -> failwith "No clt attached to token TTypedef" | PC.TType -> failwith "No clt attached to token TType" | PC.TSymbol -> failwith "No clt attached to token TSymbol" | PC.TStatement -> failwith "No clt attached to token TStatement" | PC.TScriptData _ -> failwith "No clt attached to token TScriptData" | PC.TScript -> failwith "No clt attached to token TScript" | PC.TRuleName _ -> failwith "No clt attached to token TRuleName" | PC.TRightIso -> failwith "No clt attached to token TRightIso" | PC.TPure -> failwith "No clt attached to token TPure" | PC.TPosition -> failwith "No clt attached to token TPosition" | PC.TPosAny -> failwith "No clt attached to token TPosAny" | PC.TPlus0 -> failwith "No clt attached to token TPlus0" | PC.TPathIsoFile _ -> failwith "No clt attached to token TPathIsoFile" | PC.TParameter -> failwith "No clt attached to token TParameter" | PC.TOperator -> failwith "No clt attached to token TOperator" | PC.TOn -> failwith "No clt attached to token TOn" | PC.TNothing -> failwith "No clt attached to token TNothing" | PC.TNever -> failwith "No clt attached to token TNever" | PC.TName -> failwith "No clt attached to token TName" | PC.TMetavariable -> failwith "No clt attached to token TMetavariable" | PC.TMPtVirg -> failwith "No clt attached to token TMPtVirg" | PC.TLocal -> failwith "No clt attached to token TLocal" | PC.TIterator -> failwith "No clt attached to token TIterator" | PC.TIsoType -> failwith "No clt attached to token TIsoType" | PC.TIsoTopLevel -> failwith "No clt attached to token TIsoTopLevel" | PC.TIsoToTestExpression -> failwith "No clt attached to token TIsoToTestExpression" | PC.TIsoTestExpression -> failwith "No clt attached to token TIsoTestExpression" | PC.TIsoStatement -> failwith "No clt attached to token TIsoStatement" | PC.TIsoExpression -> failwith "No clt attached to token TIsoExpression" | PC.TIsoDeclaration -> failwith "No clt attached to token TIsoDeclaration" | PC.TIsoArgExpression -> failwith "No clt attached to token TIsoArgExpression" | PC.TIso -> failwith "No clt attached to token TIso" | PC.TInvalid -> failwith "No clt attached to token TInvalid" | PC.TInitialize -> failwith "No clt attached to token TInitialize" | PC.TInitialiser -> failwith "No clt attached to token TInitialiser" | PC.TIdentifier -> failwith "No clt attached to token TIdentifier" | PC.TIdExpression -> failwith "No clt attached to token TIdExpression" | PC.TGlobal -> failwith "No clt attached to token TGlobal" | PC.TGenerated -> failwith "No clt attached to token TGenerated" | PC.TFunction -> failwith "No clt attached to token TFunction" | PC.TFresh -> failwith "No clt attached to token TFresh" | PC.TFormat -> failwith "No clt attached to token TFormat" | PC.TForall -> failwith "No clt attached to token TForall" | PC.TFinalize -> failwith "No clt attached to token TFinalize" | PC.TField -> failwith "No clt attached to token TField" | PC.TExtends -> failwith "No clt attached to token TExtends" | PC.TExpression -> failwith "No clt attached to token TExpression" | PC.TExists -> failwith "No clt attached to token TExists" | PC.TEver -> failwith "No clt attached to token TEver" | PC.TError -> failwith "No clt attached to token TError" | PC.TDisable -> failwith "No clt attached to token TDisable" | PC.TDepends -> failwith "No clt attached to token TDepends" | PC.TDeclarer -> failwith "No clt attached to token TDeclarer" | PC.TDeclaration -> failwith "No clt attached to token TDeclaration" | PC.TCppConcatOp -> failwith "No clt attached to token TCppConcatOp" | PC.TContext -> failwith "No clt attached to token TContext" | PC.TConstant -> failwith "No clt attached to token TConstant" | PC.TBinary -> failwith "No clt attached to token TBinary" | PC.TAttribute -> failwith "No clt attached to token TAttribute" | PC.TAssignment -> failwith "No clt attached to token TAssignment" | PC.TArobArob -> failwith "No clt attached to token TArobArob" | PC.TArob -> failwith "No clt attached to token TArob" | PC.TAnalysis -> failwith "No clt attached to token TAnalysis" | PC.EOF -> failwith "No clt attached to token EOF" 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.Texec(_) -> (PC.Texec(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.TMetaGlobalIdExp(a,b,c,d,_) -> (PC.TMetaGlobalIdExp(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.TMetaAssignOp(a,b,c,_) -> (PC.TMetaAssignOp(a,b,c,clt),x) | PC.TMetaBinaryOp(a,b,c,_) -> (PC.TMetaBinaryOp(a,b,c,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,c,_) -> (PC.TMetaStmList(a,b,c,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.TOEllipsis(_) -> (PC.TOEllipsis(clt),x) | PC.TCEllipsis(_) -> (PC.TCEllipsis(clt),x) | PC.TPOEllipsis(_) -> (PC.TPOEllipsis(clt),x) | PC.TPCEllipsis(_) -> (PC.TPCEllipsis(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(s,_) -> (PC.TOPar0(s,clt),x) | PC.TMid0(s,_) -> (PC.TMid0(s,clt),x) | PC.TAnd0(s,_) -> (PC.TAnd0(s,clt),x) | PC.TCPar(_) -> (PC.TCPar(clt),x) | PC.TCPar0(s,_) -> (PC.TCPar0(s,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.TOpAssign(s,_) -> (PC.TOpAssign(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) | PC.TTildeExclEq(_) -> (PC.TTildeExclEq(clt),x) | PC.TDirective(a,_) -> (PC.TDirective(a,clt),x) | PC.TVAEllipsis(_) -> (PC.TVAEllipsis(clt),x) | PC.Tlist -> assert false | PC.TWords -> assert false | PC.TWhy0 -> assert false | PC.TWhitespace _ -> assert false | PC.TVirtual -> assert false | PC.TUsing -> assert false | PC.TUnderscore -> assert false | PC.TTypedef -> assert false | PC.TType -> assert false | PC.TSymbol -> assert false | PC.TStatement -> assert false | PC.TScriptData _ -> assert false | PC.TScript -> assert false | PC.TRuleName _ -> assert false | PC.TRightIso -> assert false | PC.TPure -> assert false | PC.TPosition -> assert false | PC.TPosAny -> assert false | PC.TPlus0 -> assert false | PC.TPathIsoFile _ -> assert false | PC.TParameter -> assert false | PC.TOperator -> assert false | PC.TOn -> assert false | PC.TNothing -> assert false | PC.TNever -> assert false | PC.TName -> assert false | PC.TMetavariable -> assert false | PC.TMetaPos _ -> assert false | PC.TMPtVirg -> assert false | PC.TLocal -> assert false | PC.TIterator -> assert false | PC.TIsoType -> assert false | PC.TIsoTopLevel -> assert false | PC.TIsoToTestExpression -> assert false | PC.TIsoTestExpression -> assert false | PC.TIsoStatement -> assert false | PC.TIsoExpression -> assert false | PC.TIsoDeclaration -> assert false | PC.TIsoArgExpression -> assert false | PC.TIso -> assert false | PC.TInvalid -> assert false | PC.TInitialize -> assert false | PC.TInitialiser -> assert false | PC.TIdentifier -> assert false | PC.TIdExpression -> assert false | PC.TGlobal -> assert false | PC.TGenerated -> assert false | PC.TFunction -> assert false | PC.TFresh -> assert false | PC.TFormat -> assert false | PC.TForall -> assert false | PC.TFinalize -> assert false | PC.TField -> assert false | PC.TExtends -> assert false | PC.TExpression -> assert false | PC.TExists -> assert false | PC.TEver -> assert false | PC.TError -> assert false | PC.TDisable -> assert false | PC.TDepends -> assert false | PC.TDeclarer -> assert false | PC.TDeclaration -> assert false | PC.TCppConcatOp -> assert false | PC.TContext -> assert false | PC.TConstant -> assert false | PC.TBinary -> assert false | PC.TAttribute -> assert false | PC.TAssignment -> assert false | PC.TArobArob -> assert false | PC.TArob -> assert false | PC.TAnalysis -> assert false | PC.EOF -> assert false (* ----------------------------------------------------------------------- *) 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 metavariable_decl_tokens_all table file get_ats lexbuf end_markers : (bool * ((PC.token * (string * (int * int) * (int * int))) list)) = tokens_all_full Lexer_cocci.metavariable_decl_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 -> ([t],[]) | D.PLUS | D.PLUSPLUS -> ([],[t]) | D.CONTEXT | D.OPT -> ([t],[t]) let split_token ((tok,_) as t) = match tok with PC.TMetavariable | PC.TIdentifier | PC.TOperator | PC.TBinary | PC.TAssignment | 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.TAttribute | PC.TType | PC.TParameter | PC.TLocal | PC.TGlobal | 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.Texec(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.TVAEllipsis(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.TMetaGlobalIdExp(_,_,_,_,clt) | PC.TMetaAssignOp(_,_,_,clt) | PC.TMetaBinaryOp(_,_,_,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.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) -> split t clt | 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.TAnd0(_,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.TOpAssign(_,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]) | PC.TWhitespace _ -> ([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) | (PC.TAnd0(_),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 || 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 || is_mid t || 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.TPOEllipsis(_),_) | (PC.TEllipsis(_),_) | (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 || 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.TMetaGlobalIdExp(_,_,_,_,_),_) | (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 is_tyleft = function (* things that can start a var decl *) (PC.TMul(_),_) | (PC.TOPar(_),_) -> true | _ -> 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)::((id::_) as rest) when is_delim infn delim && (is_id id || is_tyleft id) -> 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)::((id::_) as rest) when start && (is_id id || is_tyleft id) -> 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.Texec(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.TMetaGlobalIdExp(_,_,_,_,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.TOEllipsis(clt) | PC.TCEllipsis(clt) | PC.TPOEllipsis(clt) | PC.TPCEllipsis(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.TOpAssign(_,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,h,i) = get_clt t in List.mem line_type [D.MINUS;D.OPTMINUS] 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,h,i) -> (match line_type with D.MINUS | D.OPTMINUS -> 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 (* This doesn't need to be done on plus code. If it fails, it will already fail on the minus code. It causes a problem when * is used and the * marks on the parentheses are unbalanced *) let check_parentheses plus tokens = if plus then tokens else begin 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 end (* ----------------------------------------------------------------------- *) (* 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,logical_line_end, offset,col,_,_,pos,_)),_)::rest -> let i = { Ast0.line_start = line; Ast0.line_end = line; Ast0.logical_start = logical_line; Ast0.logical_end = logical_line_end; 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 : 'a option) (skips : 'a list) = function [] -> add_bef bef @ List.rev skips | ((PC.TEllipsis(_),_) as a)::((PC.TComma(_),_) as b)::xs -> (* This is a ..., in an argument list, field initializer list etc, which might go away, so nothing should be attached to the , *) process_pragmas bef (b::a::skips) xs | ((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,f,strbef,straft,pos,ws) = get_clt bef in (update_clt bef (a,b,c,d,e,f,strbef,pragmas,pos,ws))::List.rev skips@ pass@process_pragmas None [] rest0 | (_,_,Some next,PLUS) -> let (a,b,lline,llineend,d,e,strbef,straft,pos,ws) = get_clt next in (add_bef bef) @ List.rev skips @ pass @ (process_pragmas (Some (update_clt next (a,b,prag_lline,llineend,d,e,pragmas,straft,pos,ws))) [] rest) | _ -> (match (bef,plus_attach false bef,next,plus_attach false next) with (Some bef,PLUS,_,_) -> let (a,b,c,d,e,f,strbef,straft,pos,ws) = get_clt bef in (update_clt bef (a,b,c,d,e,f,strbef,pragmas,pos,ws)):: List.rev skips@ pass@process_pragmas None [] rest0 | (_,_,Some next,PLUS) -> let (a,b,lline,llineend,d,e,strbef,straft,pos,ws) = get_clt next in (add_bef bef) @ List.rev skips @ pass @ (process_pragmas (Some (update_clt next (a,b,prag_lline,llineend,d,e,pragmas,straft,pos,ws))) [] 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)) (* Appends whitespace tokens to the nearest following token (assumes that * any such token contains a clt as defined in parser_cocci_menhir.mly, * otherwise get_clt and update_clt will fail). * The third case handles double whitespaces which occur around script comments * We only want to keep both whitespaces if the whitespaces are on the same * line. * Returns token list with whitespace tokens removed. *) let process_whitespaces tok = let rec pw fn = function | [] -> fn [] | (PC.TWhitespace(_),_)::((endtok,_) as e)::(_) when endtok = PC.EOF || endtok = PC.TArob || endtok = PC.TArobArob -> fn [e] | (PC.TWhitespace(a),((_,(l1,_),_) as b)):: (PC.TWhitespace(c),(_,(l2,_),_))::xs -> let s = if (l1 <> l2) then c else a ^ c in pw fn ((PC.TWhitespace(s),b) :: xs) | (PC.TWhitespace(s),_)::((tok,_) as aft)::xs -> (try let (a, b, c, d, e, f, g, h, i, _) = get_clt aft in let aft = update_clt aft (a, b, c, d, e, f, g, h, i, s) in pw (fun lst -> fn (aft :: lst)) xs with NoClt(a) -> failwith ("process_whitespaces: "^a)) | x::xs -> pw (fun lst -> fn (x :: lst)) xs in pw (fun l -> l) tok (* ----------------------------------------------------------------------- *) (* 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 -> true | D.PLUS | D.PLUSPLUS -> false | D.CONTEXT | 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(_),_) -> true | _ -> false in let middle = function (PC.TEllipsis(_),_) -> true | _ -> false in let whenline = function (PC.TLineEnd(_),_) -> true (*| (PC.TMid0(_),_) -> true*) | _ -> false in let final = function (PC.TCEllipsis(_),_) | (PC.TPCEllipsis(_),_) -> true | _ -> false in let any_before x = start x || middle x || final x || whenline x in let any_after x = start x || middle x || 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.TMetaGlobalIdExp(nm,_,pure,ty,clt),info) -> (PC.TMetaGlobalIdExp(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 plus 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 plus tokens))))))) let prepare_mv_tokens tokens = detect_types false (detect_attr tokens) let unminus (d,x1,x2,x3,x4,x5,x6,x7,x8,x9) = (* for hidden variables *) match d with D.MINUS | D.OPTMINUS -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7,x8,x9) | D.PLUS -> failwith "unexpected plus code" | D.PLUSPLUS -> failwith "unexpected plus code" | D.CONTEXT | D.OPT -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7,x8,x9) let process_minus_positions x name clt meta = let (arity,ln,lln,llne,offset,col,strbef,straft,pos,ws) = get_clt x in let name = Parse_aux.clt2mcode name (unminus clt) in update_clt x (arity,ln,lln,llne,offset,col,strbef,straft,meta name::pos,ws) (* 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 || 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 mcode mcode donothing donothing donothing 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 _ -> metavariable_decl_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 _ -> metavariable_decl_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 '(', 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) = metavariable_decl_tokens_all table file true lexbuf (in_list [PC.TArobArob; PC.TMPtVirg]) in let tokens = prepare_tokens false 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 = consume_minus_positions tokens in let tokens = prepare_tokens false (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 let entry = List.map (List.map Get_metas.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 print_dep_image name deps virt depimage = Printf.fprintf stderr "Rule: %s\n" name; Printf.fprintf stderr "Dependencies: %s\n" (Common.format_to_string (function _ -> Pretty_print_cocci.dep true deps)); Format.print_newline(); Printf.fprintf stderr "Virtual rules: %s\n" (String.concat " " virt); Printf.fprintf stderr "Res: %s\n\n" (Common.format_to_string (function _ -> Pretty_print_cocci.dep true depimage)) 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 (* remove whitespaces and glue to immediately following tokens *) let tokens = process_whitespaces tokens 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 false minus_tokens in let plus_tokens = prepare_tokens true 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"; *) Flag_parsing_cocci.in_minus := true; let minus_res = let minus_parser = match is_expression with Ast.AnyP -> PC.minus_main | Ast.TyP -> PC.minus_ty_main | Ast.IdP -> PC.minus_id_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 || !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 begin Flag_parsing_cocci.in_minus := false; let plus_parser = match is_expression with Ast.AnyP -> PC.plus_main | Ast.TyP -> PC.plus_ty_main | Ast.IdP -> PC.plus_id_main | Ast.ExpP -> PC.plus_exp_main in parse_one "plus" plus_parser file plus_tokens end 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 || 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_any_script_rule meta_parser builder 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 meta_parser table file lexbuf) in let (metavars,script_metavars) = List.fold_left (function (metavars,script_metavars) -> function (script_var,Some(parent,var),initval) -> ((script_var,parent,var,initval) :: metavars, script_metavars) | ((Some script_var,None),None,_initval) -> (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 (* No idea whether any vars are position vars, but if there are any, they can be inherited. Probably provides a way of laundering positions over changes. *) Data.inheritable_positions := name :: !Data.inheritable_positions; Hashtbl.add Data.all_metadecls name (List.map (function x -> Ast.MetaScriptDecl(ref 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, builder(name, language, deps, metavars, script_metavars, data), [],tokens) in let parse_script_rule = parse_any_script_rule PC.script_meta_main (function (name, language, deps, mvs, script_mvs, data) -> Ast0.ScriptRule(name,language,deps,mvs,script_mvs,data)) in let parse_iscript_rule = parse_any_script_rule PC.script_meta_virt_nofresh_main (function (name, language, deps, mvs, script_mvs, data) -> match script_mvs with [] -> Ast0.InitialScriptRule(name,language,deps,mvs,data) | _ -> failwith "new metavariables not allowed in initalize") in let parse_fscript_rule = parse_any_script_rule PC.script_meta_virt_nofresh_main (function (name, language, deps, mvs, script_mvs, data) -> match script_mvs with [] -> Ast0.FinalScriptRule(name,language,deps,mvs,data) | _ -> failwith "new metavariables not allowed in finalize") in let do_parse_script_rule fn name l old_metas deps = (* in generating mode, we want to keep all the dependencies *) let depimage = if !Flag_parsing_cocci.generating_mode then deps else eval_depend deps virt in (if !Flag_parsing_cocci.debug_parse_cocci then print_dep_image name deps virt depimage); fn name l old_metas depimage 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) -> (* in generating mode, keep all dependencies *) let depimage = if !Flag_parsing_cocci.generating_mode then dep else eval_depend dep virt in (if !Flag_parsing_cocci.debug_parse_cocci then print_dep_image s dep virt depimage); (match depimage 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 (Printf.sprintf "unexpected code before the first rule: %s\n" (Dumper.dump initial_tokens)) 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,e) -> [([],Ast.InitialScriptRule (a,b,c,d,e))] | Ast0.FinalScriptRule (a,b,c,d,e) -> [([],Ast.FinalScriptRule (a,b,c,d,e))] | 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.unwrap c) with [Ast0.Exp e] -> true | _ -> false) | _ -> false] in let minus = Arity.minus_arity minus in let plus = Adjust_pragmas.process plus in let ((metavars,minus),function_prototypes) = Function_prototypes.process rule_name metavars dropped_isos minus plus ruletype 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 || 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 let minus_ast = Stmtlist.stmtlist minus_ast 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.iter2 Pretty_print_cocci.unparse metavars code; let search_tokens = 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.4/parsing_cocci/get_constants.ml0000644000175000017500000002545512614153277020637 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/ast0_cocci.ml0000644000175000017500000010464612614153277017773 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci module TC = Type_cocci (* --------------------------------------------------------------------- *) (* Modified code *) type arity = OPT | 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; (* preceding whitespace*) whitespace : string; 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 dots = 'a list 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 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 * assignOp * 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 * binaryOp * expression | Nested of expression * binaryOp * 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 *) | AsSExpr of expression * statement (* 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 | ConjExpr of string mcode * expression list * string mcode list (* the &s *) * string mcode | NestExpr of string mcode * expression dots * string mcode * (string mcode * string mcode * expression) option (* whencode *) * Ast.multi | Edots of string mcode (* ... *) * (string mcode * string mcode * expression) option (* whencode *) | OptExp 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 (* --------------------------------------------------------------------- *) (* First class operators *) and base_assignOp = SimpleAssign of simpleAssignOp mcode | OpAssign of Ast_cocci.arithOp mcode | MetaAssign of Ast_cocci.meta_name mcode * assignOpconstraint * pure and simpleAssignOp = string and assignOp = base_assignOp wrap and base_binaryOp = Arith of Ast_cocci.arithOp mcode | Logical of Ast_cocci.logicalOp mcode | MetaBinary of Ast_cocci.meta_name mcode * binaryOpconstraint * pure and binaryOp = base_binaryOp wrap and assignOpconstraint = AssignOpNoConstraint | AssignOpInSet of assignOp list and binaryOpconstraint = BinaryOpNoConstraint | BinaryOpInSet of binaryOp list (* --------------------------------------------------------------------- *) (* 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(* ) *) | 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 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 (* ; *) | FunProto of fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* ; *) | TyDecl of typeC * string mcode (* ; *) | MacroDecl of Ast.storage mcode option * ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of Ast.storage mcode option * 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 (* ... *) * (string mcode * string mcode * declaration) option (* whencode *) | OptDecl 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 (* ... *) * (string mcode * string mcode * initialiser) option (* whencode *) | OptIni 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 (* ... *) | OptParam 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 (* ... *) | OptDParam 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 (* ; *) | Exec of string mcode (* EXEC *) * string mcode (* language *) * exec_code dots * string mcode (* ; *) | MetaStmt of Ast.meta_name mcode * pure | MetaStmtList of Ast.meta_name mcode(*only in statement lists*) * listlen * 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 *) | TopId of ident (* 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 | Conj 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 | FunDecl of (info * mcodekind) (* before the function decl *) * fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* { *) * statement dots * string mcode (* } *) * (info * mcodekind) (* after the function decl *) | 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 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 string mcode (* when *) * string mcode (* != *) * 'a | WhenAlways of string mcode (* when *) * string mcode (* = *) * 'b | WhenModifier of string mcode (* when *) * Ast.when_modifier | WhenNotTrue of string mcode (* when *) * string mcode (* != *) * expression | WhenNotFalse of string mcode (* when *) * string mcode (* != *) * 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 and base_exec_code = ExecEval of string mcode (* : *) * expression | ExecToken of string mcode | ExecDots of string mcode (* ... *) and exec_code = base_exec_code 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 (*minus*) * Ast.metavar list (*minus metavars*) * (string list (*isos*) * string list (*drop_isos*) * Ast.dependency (*dependencies*) * string (*rulename*) * Ast.exists)) * (rule (*plus*) * Ast.metavar list (*plus metavars*)) * Ast.ruletype | ScriptRule of string (* name *) * string * Ast.dependency * (Ast.script_meta_name * Ast.meta_name * Ast.metavar * Ast.mvinit) list * Ast.meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string * Ast.dependency * (Ast.script_meta_name * Ast.meta_name * Ast.metavar * Ast.mvinit) list * string | FinalScriptRule of string (* name *) * string * Ast.dependency * (Ast.script_meta_name * Ast.meta_name * Ast.metavar * Ast.mvinit) list * string (* no script vars possible here *) (* --------------------------------------------------------------------- *) 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 | AssignOpTag of assignOp | BinaryOpTag of binaryOp | 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 | StringFragmentTag of string_fragment | 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 *) | WhenTag of string mcode (* when *) * string mcode option (* !=, =, or none if whenmodifier*) * anything (* iso pattern *) 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 assignOp x = AssignOpTag x let binaryOp x = BinaryOpTag 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 string_fragment x = StringFragmentTag 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; whitespace = ""; 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_mcode_line (_,_,info,_,_,_) = info.pos_info.line_start 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 get_rule_name = function | CocciRule ((_,_,(_,_,_,nm,_)),_,_) | InitialScriptRule (nm,_,_,_,_) | FinalScriptRule (nm,_,_,_,_) | ScriptRule (nm,_,_,_,_,_) -> nm (* --------------------------------------------------------------------- *) 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" let rec meta_pos_constraint_names = function ExprTag(e) -> (match unwrap e with MetaExpr(name,constraints,ty,form,pure) -> (match ty with Some tylist -> List.fold_left (fun prev cur -> TC.meta_names cur @ prev) [] tylist | None -> []) | _ -> []) | _ -> [] (* --------------------------------------------------------------------- *) (* 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 rec ast0_type_to_type inmeta ty = match unwrap ty with ConstVol(cv,ty) -> TC.ConstVol(const_vol cv,ast0_type_to_type inmeta 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 inmeta ty in TC.SignedT(sign sgn,Some bty) | Pointer(ty,_) -> TC.Pointer(ast0_type_to_type inmeta ty) | FunctionPointer(ty,_,_,_,_,params,_) -> TC.FunctionPointer(ast0_type_to_type inmeta ty) | Array(ety,_,_,_) -> TC.Array(ast0_type_to_type inmeta 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,Ast.IdNoConstraint,_,_) when inmeta -> TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false)) | MetaId(tag,_,_,_) when inmeta -> (* would have to duplicate the type in type_cocci.ml? perhaps polymorphism would help? *) failwith "constraints not supported on enum type name" | _ -> (* can't arise for metavariables and doesn't matter for type checking *) TC.EnumName(TC.NoName)) | EnumName(su,None) -> TC.EnumName TC.NoName | EnumDef(ty,_,_,_) -> ast0_type_to_type inmeta ty | StructUnionName(su,Some tag) -> (match unwrap tag with Id(tag) -> TC.StructUnionName(structUnion su,TC.Name(unwrap_mcode tag)) | MetaId(tag,Ast.IdNoConstraint,_,_) when inmeta -> TC.StructUnionName(structUnion su, TC.MV(unwrap_mcode tag,TC.Unitary,false)) | MetaId(tag,_,_,_) when inmeta -> (* would have to duplicate the type in type_cocci.ml? perhaps polymorphism would help? *) failwith "constraints not supported on struct type name" | _ -> (* can't arise for metavariables and doesn't matter for type checking *) TC.StructUnionName(structUnion su,TC.NoName)) | StructUnionName(su,None) -> TC.StructUnionName(structUnion su,TC.NoName) | StructUnionDef(ty,_,_,_) -> ast0_type_to_type inmeta 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) -> ast0_type_to_type inmeta 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 *) let string_of_binaryOp op = match (unwrap op) with | Arith arithOp -> Ast.string_of_arithOp (unwrap_mcode arithOp) | Logical logicalOp -> Ast.string_of_logicalOp (unwrap_mcode logicalOp) | MetaBinary _ -> "MetaBinary" let string_of_assignOp op = match (unwrap op) with | SimpleAssign _ -> "=" | OpAssign op' -> let op'' = rewrap op (Arith op') in let s = string_of_binaryOp op'' in s ^ "=" | MetaAssign _ -> "MetaAssign" coccinelle-1.0.4/parsing_cocci/context_neg.mli0000644000175000017500000000101212614153277020431 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/index.mli0000644000175000017500000000253212614153277017233 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 assignOp : Ast0_cocci.assignOp -> int list val binaryOp : Ast0_cocci.binaryOp -> 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 string_fragment : Ast0_cocci.string_fragment -> int list val top_level : Ast0_cocci.top_level -> int list coccinelle-1.0.4/parsing_cocci/unitary_ast0.ml0000644000175000017500000002623112614153277020377 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* find unitary metavariables *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module TC = Type_cocci 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 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 constraints_collect r res = function Ast0.NotExpCstrt(el) -> List.fold_left bind res (List.map r.VT0.combiner_rec_expression el) | Ast0.SubExpCstrt(names) -> bind names res | _ -> res in let expression r k e = match Ast0.unwrap e with Ast0.MetaErr(name,constraints,_) -> let constraints = constraints_collect r option_default constraints in bind (checker name) constraints | Ast0.MetaExpr(name,constraints,type_list,_,_) -> let types = match type_list with Some type_list -> List.fold_left type_collect option_default type_list | None -> option_default in let constraints = constraints_collect r types constraints in bind (checker name) constraints | Ast0.MetaExprList(name,_,_) -> checker name | Ast0.DisjExpr(starter,expr_list,mids,ender) -> detect_unitary_frees(List.map r.VT0.combiner_rec_expression expr_list) | Ast0.ConjExpr(starter,expr_list,mids,ender) -> List.fold_left (fun prev cur -> bind (r.VT0.combiner_rec_expression cur) prev) option_default 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.Conj(starter,stmt_list,mids,ender) -> List.fold_left (fun prev cur -> bind (r.VT0.combiner_rec_statement_dots cur) prev) option_default 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) -> 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,lenname,_) -> Ast0.rewrap s (Ast0.MetaStmtList(name,lenname,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.4/parsing_cocci/simple_assignments.mli0000644000175000017500000000044512614153277022031 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val simple_assignments : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/lexer_cocci.mll0000644000175000017500000013254712614153277020420 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) { 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 | PLUS | CONTEXT | 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) || (c = D.PLUSPLUS); (c,l,ll,ll,lex_start,preceeding_spaces,[],[],[],"") let current_line_started = ref false let col_zero = ref true let contextify (c,l,ll,lle,lex_start,preceeding_spaces,bef,aft,pos,ws) = (D.CONTEXT,l,ll,lle,lex_start,preceeding_spaces,bef,aft,pos,ws) 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.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.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.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.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 attr_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 let x = (Hashtbl.find attr_names s) linetype in check_plus_linetype s; x 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 || !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 || in_rule_name -> 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 | "operator" when in_meta -> check_arity_context_linetype s; TOperator | "binary" when in_meta -> check_arity_context_linetype s; TBinary | "assignment" when in_meta -> check_arity_context_linetype s; TAssignment | "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 | "global" when in_meta -> check_arity_context_linetype s; TGlobal | "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 | "attribute" when in_meta -> check_arity_context_linetype s; TAttribute | "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 || in_rule_name || 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 | "EXEC" when !Flag.ibm -> Texec 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 = TOpAssign (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_global_idexp_meta := (fun tyopt name constraints pure -> let fn clt = TMetaGlobalIdExp(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 lenname -> function pure -> let fn clt = TMetaStmList(name,lenname,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_assignOp_meta := (fun name constraints pure -> let fn clt = TMetaAssignOp (name, constraints, pure, clt) in Hashtbl.replace metavariables (get_name name) fn); Data.add_binaryOp_meta := (fun name constraints pure -> let fn clt = TMetaBinaryOp (name, constraints, pure, 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_attribute := (function name -> let fn clt = TDirective (Ast.Space name, clt) in Hashtbl.replace attr_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,_,_) -> (* increment the logical line even though nothing seen *) start_line true; 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' ]+ as w) { (* collect whitespaces only when inside a rule *) start_line false; if !Data.in_rule_name || !Data.in_prolog || !Data.in_iso then token lexbuf else TWhitespace w } | [' ' '\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 || not !current_line_started then (start_line true; TArob) else (check_minus_context_linetype "@"; TPArob (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) } | "<..." { 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) } | "-" { 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 (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 (add_current_line_type D.OPT; token lexbuf) } | "!" { start_line true; TBang (get_current_line_type lexbuf) } | "(" { if 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; TVAEllipsis (get_current_line_type lexbuf) } | ";" { start_line true; 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; 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) } | "&" { if not (!col_zero) then (start_line true; TAnd(get_current_line_type lexbuf)) else (start_line true; check_context_linetype (tok lexbuf); TAnd0 ("&",get_current_line_type lexbuf))} | "\\&" { start_line true; TAnd0 ("\\&",contextify(get_current_line_type lexbuf)) } | "^" { start_line true; TXor(get_current_line_type lexbuf) } | "##" { start_line true; TCppConcatOp } | (("#" [' ' '\t']* "undef" ([' ' '\t']+ as wss)) as def) ((letter (letter |digit)*) as ident) { start_line true; let (arity,line,lline,llend,offset,col,strbef,straft,pos,ws) 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,llend,offset+off,col+off,[],[],[],wss)) } | (( ("#" [' ' '\t']* "define" ([' ' '\t']+ as wss))) as def) ( (letter (letter |digit)*) as ident) { start_line true; let (arity,line,lline,llend,offset,col,strbef,straft,pos,ws) 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,llend,offset+off,col+off,[],[],[],wss)) } | (( ("#" [' ' '\t']* "define" ([' ' '\t']+ as wss))) as def) ( (letter (letter | digit)*) as ident) '(' { start_line true; let (arity,line,lline,llend,offset,col,strbef,straft,pos,ws) 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,llend,offset+off,col+off,strbef,straft,pos,wss), offset + off + (String.length ident), col + off + (String.length ident)) } | ("#" [' ' '\t']* "pragma") { start_line true; TPragma(get_current_line_type lexbuf) } (* For the unparser: in TIncludeL and TIncludeNL, the whitespace after * #include is not preserved, because we have nowhere to put it. *) | "#" [' ' '\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) } (* This is for both SmPL and script metavariable declarations *) and metavariable_decl_token = parse | [' ' '\t']* ['\n' '\r' '\011' '\012'] { reset_line lexbuf; metavariable_decl_token lexbuf } | [' ' '\t' ]+ { start_line false; metavariable_decl_token lexbuf } | [' ' '\t' ]* ("//" [^ '\n']*) { start_line false; metavariable_decl_token lexbuf } | "@@" { start_line true; TArobArob } | "=~" { start_line true; TTildeEq (get_current_line_type lexbuf) } | "!~" { start_line true; TTildeExclEq (get_current_line_type lexbuf) } | "=" { start_line true; TEq (get_current_line_type lexbuf) } | "(" { start_line true; TOPar (get_current_line_type lexbuf) } | ")" { start_line true; TCPar (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; TMPtVirg (* works better with tokens_all *) } | "<<" { start_line true; TShLOp(Ast.DecLeft,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; metavariable_decl_token lexbuf) } | "==" { start_line true; TEqEq (get_current_line_type lexbuf) } | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) } | "<=" { start_line true; TSub (get_current_line_type lexbuf) } | "+" { (start_line true; TPlus (get_current_line_type lexbuf)) } | "-" { (start_line true; TMinus (get_current_line_type lexbuf)) } | "/" { start_line true; TDmOp (Ast.Div,get_current_line_type lexbuf) } | "%" { start_line true; TDmOp (Ast.Mod,get_current_line_type lexbuf) } | ">>" { start_line true; TShROp(Ast.DecRight,get_current_line_type lexbuf) } | "&" { start_line true; TAnd (get_current_line_type lexbuf) } | "|" { (start_line true; TOr(get_current_line_type lexbuf)) } | "^" { start_line true; TXor(get_current_line_type lexbuf) } | ">=" { start_line true; TLogOp(Ast.SupEq,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; 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.DecLeft lexbuf } | ">>=" { start_line true; mkassign Ast.DecRight 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 metavariable_decl_token lexbuf } | "##" { start_line true; TCppConcatOp (* for fresh vars *) } | 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) { Printf.printf "36\n"; 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" } | _ { lexerr "metavariables: unrecognised symbol in metavariable_decl_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 | '\"' { "" } | ['\n' '\r' '\011' '\012'] as x { line := !line + 1; (Printf.sprintf "%c" x) ^ string lexbuf } | (_ 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.4/parsing_cocci/ast_cocci.mli0000644000175000017500000007112612614153277020060 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* 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; whitespace : string } 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*) positive_inherited_positions : meta_name list; 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 *) | MetaBinaryOperatorDecl of arity * meta_name | MetaAssignmentOperatorDecl of arity * meta_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 | MetaGlobalIdExpDecl 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 *) * list_len (*len*) | 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 *) | MetaScriptDecl of metavar option ref * 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 dots = 'a list 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 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 * 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 * expression | Nested of expression * binaryOp * 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 *) | AsSExpr of expression * rule_elem (* as expr, always metavar *) | EComma of string mcode (* only in arg lists *) | DisjExpr of expression list | ConjExpr 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 | OptExp 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 | IdPosIdSet of string list * meta_name list | IdNegIdSet of string list * meta_name list | IdRegExpConstraint of reconstraint and reconstraint = | IdRegExp of string * Regexp.regexp | IdNotRegExp of string * Regexp.regexp and assignOpconstraint = AssignOpNoConstraint | AssignOpInSet of assignOp list and binaryOpconstraint = BinaryOpNoConstraint | BinaryOpInSet of binaryOp list and form = ANY | ID | LocalID| GlobalID | 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 base_assignOp = SimpleAssign of simpleAssignOp mcode | OpAssign of arithOp mcode | MetaAssign of meta_name mcode * assignOpconstraint * keep_binding * inherited and simpleAssignOp = string and assignOp = base_assignOp wrap and fixOp = Dec | Inc and base_binaryOp = Arith of arithOp mcode | Logical of logicalOp mcode | MetaBinary of meta_name mcode * binaryOpconstraint * keep_binding * inherited and binaryOp = base_binaryOp wrap 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 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(* ) *) | 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 (* { *) * annotated_decl 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 (* ; *) | FunProto of fninfo list * ident (* name *) * string mcode (* ( *) * parameter_list * (string mcode (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) * string mcode (* ; *) | TyDecl of fullType * string mcode (* ; *) | MacroDecl of storage mcode option * ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) | MacroDeclInit of storage mcode option * 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 | 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 and declaration = base_declaration wrap and base_annotated_decl = DElem of mcodekind (* before the decl *) * bool (* true if all minus *) * declaration (* Ddots is for a structure declaration *) | Ddots of string mcode (* ... *) * declaration option (* whencode *) and annotated_decl = base_annotated_decl 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 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 (* ... *) | OptParam 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 (* ... *) | OptDParam 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 (* , *) * string mcode (* ...... *) ) option * string mcode (* ) *) | Decl of annotated_decl | 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 (* ; *) | Exec of string mcode (* EXEC *) * string mcode (* language *) * exec_code dots * string mcode (* ; *) | MetaRuleElem of meta_name mcode * keep_binding * inherited | MetaStmt of meta_name mcode * keep_binding * metaStmtInfo * inherited | MetaStmtList of meta_name mcode * listlen * keep_binding * inherited | Exp of expression | TopExp of expression (* for macros body *) | Ty of fullType (* only at top level *) | TopId of ident (* 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 (*:*) | AsRe of rule_elem * rule_elem (* always { and MetaStmtList *) | 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 annotated_decl 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 | Conj 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 (* } *) * end_info (*exit*) | 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 | OptStm 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 base_exec_code = ExecEval of string mcode (* : *) * expression | ExecToken of string mcode | ExecDots of string mcode (* ... *) and exec_code = base_exec_code 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 | IdP | 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 * mvinit) list * meta_name list (*script vars*) * string | InitialScriptRule of string (* name *) * string * dependency * (script_meta_name * meta_name * metavar * mvinit) list (*virtual vars*) * string | FinalScriptRule of string (* name *) * string * dependency * (script_meta_name * meta_name * metavar * mvinit) list (*virtual vars*) * string and script_meta_name = string option (*string*) * string option (*ast*) and mvinit = NoMVInit | MVInitString of string | MVInitPosList 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 | SimpleAssignOpTag of simpleAssignOp | OpAssignOpTag of arithOp | 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 | StringFragmentTag of string_fragment | 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 | AnnDeclDotsTag of annotated_decl dots | TypeCTag of typeC | ParamTag of parameterTypeDef | SgrepStartTag of string | SgrepEndTag of string (* --------------------------------------------------------------------- *) and exists = Exists | Forall | Undetermined (* --------------------------------------------------------------------- *) val mkToken : string -> anything val lub_count : count -> count -> count (* --------------------------------------------------------------------- *) val rewrap : 'a wrap -> 'b -> 'b wrap val rewrap_mcode : 'a mcode -> 'b -> 'b 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_inherited_pos : '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 *) -> meta_name list (* definitely inherited positions *) -> 'a wrap val make_mcode : 'a -> 'a mcode val equal_pos : fixpos -> fixpos -> bool val string_of_arithOp : arithOp -> string val string_of_logicalOp : logicalOp -> string val string_of_assignOp : assignOp -> string val string_of_binaryOp : binaryOp -> string coccinelle-1.0.4/parsing_cocci/disjdistr.mli0000644000175000017500000000047712614153277020131 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val disj : Ast_cocci.rule_with_metavars list -> Ast_cocci.rule_with_metavars list coccinelle-1.0.4/parsing_cocci/function_prototypes.mli0000644000175000017500000000074512614153277022265 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/safe_for_multi_decls.mli0000644000175000017500000000052512614153277022274 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val safe_for_multi_decls : Ast_cocci.rule_with_metavars list -> Ast_cocci.rule_with_metavars list coccinelle-1.0.4/parsing_cocci/command_line.mli0000644000175000017500000000042712614153277020552 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val command_line : string list -> string list coccinelle-1.0.4/parsing_cocci/simple_assignments.ml0000644000175000017500000000730112614153277021656 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 semi_pure_mcodekind = function Ast0.CONTEXT(mc) | Ast0.MIXED(mc) -> (match !mc with (Ast.NOTHING,_,_) -> true | _ -> false) | _ -> false let is_simple_assign left op = let is_simple_assign_op op = match Ast0.unwrap op with | Ast0.OpAssign _ -> false | _ -> true in (match Ast0.unwrap left with Ast0.Ident(_) | Ast0.MetaExpr(_,_,_,_,_) -> true | _ -> false) && is_simple_assign_op op let is_simple_ast_assign left op minus_left = let is_simple_ast_assign_op op = match Ast.unwrap op with | Ast.SimpleAssign _ -> true | _ -> false in (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) && is_simple_ast_assign_op op 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 k = match Ast0.unwrap op with | Ast0.SimpleAssign o -> Ast0.get_mcode_mcodekind o | Ast0.OpAssign o -> Ast0.get_mcode_mcodekind o | Ast0.MetaAssign(mv,_,_) -> Ast0.get_mcode_mcodekind mv in let pure = (* The goal of this code is to ensure that neither the left side of the assignment nor its operator is changed. *) (semi_pure_mcodekind m) && (pure_mcodekind (Ast0.get_mcodekind left)) && (pure_mcodekind k) 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.ConjExpr(lp,exps,mids,rp) -> Ast0.rewrap e1 (Ast0.ConjExpr (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)) | _ -> 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.4/parsing_cocci/adjust_pragmas.ml0000644000175000017500000003436612614153277020771 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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_before2 pragmas (info,x) = ({info with Ast0.strings_before = pragmas @ info.Ast0.strings_before}, Ast0.PLUS Ast.ONE)(*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(stg,ty,id,eq,ini,sem) -> call_right right_mcode sem d (function sem -> Ast0.Init(stg,ty,id,eq,ini,sem)) | Ast0.UnInit(stg,ty,id,sem) -> call_right right_mcode sem d (function sem -> Ast0.UnInit(stg,ty,id,sem)) | Ast0.FunProto(fninfo,id,lp1,params,va,rp1,sem) -> call_right right_mcode sem d (function ty -> Ast0.FunProto(fninfo,id,lp1,params,va,rp1,sem)) | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> call_right right_mcode sem d (function sem -> Ast0.MacroDecl(stg,name,lp,args,rp,sem)) | Ast0.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> call_right right_mcode sem d (function sem -> Ast0.MacroDeclInit(stg,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)) let rec right_statement s = match Ast0.unwrap s with Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft) -> 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.Exec(exec,lang,exp,sem) -> call_right right_mcode sem s (function sem -> Ast0.Exec(exec,lang,exp,sem)) | Ast0.MetaStmt(name,pure) -> call_right right_mcode name s (function name -> Ast0.MetaStmt(name,pure)) | Ast0.MetaStmtList(name,lenname,pure) -> call_right right_mcode name s (function name -> Ast0.MetaStmtList(name,lenname,pure)) | Ast0.AsStmt(stm,asstm) -> failwith "not possible" | Ast0.Disj(starter,statement_dots_list,mids,ender) | Ast0.Conj(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.TopId(id) -> None | Ast0.TopInit(init) -> None | Ast0.Dots(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)) and right_statement_dots sd = match Ast0.unwrap sd with [] -> failwith "empty statement dots" | s::r -> call_right right_statement s sd (function s -> List.rev(s::r)) 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.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)) 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.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.FunProto(fi,name,lp1,params,va,rp1,sem) -> (match fi with [] -> call_right left_ident name decl (function name -> Ast0.FunProto(fi,name,lp1,params,va,rp1,sem)) | (Ast0.FStorage sto)::x -> call_right left_mcode sto decl (function sto -> Ast0.FunProto((Ast0.FStorage sto)::x,name,lp1,params,va,rp1,sem)) | (Ast0.FType ty)::x -> call_right left_ty ty decl (function ty -> Ast0.FunProto((Ast0.FType ty)::x,name,lp1,params,va,rp1,sem)) | (Ast0.FInline inl)::x -> call_right left_mcode inl decl (function inl -> Ast0.FunProto((Ast0.FInline inl)::x,name,lp1,params,va,rp1,sem)) | (Ast0.FAttr attr)::x -> call_right left_mcode attr decl (function attr -> Ast0.FunProto((Ast0.FAttr attr)::x,name,lp1,params,va,rp1,sem))) | Ast0.MacroDecl(Some stg,name,lp,args,rp,sem) -> call_right left_mcode stg decl (function stg -> Ast0.MacroDecl(Some stg,name,lp,args,rp,sem)) | Ast0.MacroDecl(None,name,lp,args,rp,sem) -> call_right left_ident name decl (function name -> Ast0.MacroDecl(None,name,lp,args,rp,sem)) | Ast0.MacroDeclInit(Some stg,name,lp,args,rp,eq,ini,sem) -> call_right left_mcode stg decl (function stg -> Ast0.MacroDeclInit(Some stg,name,lp,args,rp,eq,ini,sem)) | Ast0.MacroDeclInit(None,name,lp,args,rp,eq,ini,sem) -> call_right left_ident name decl (function name -> Ast0.MacroDeclInit(None,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)) 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,va,rp,lbrace,body,rbrace,aft) -> let (rbrace,aft) = match right_mcode rbrace with None -> (rbrace,aft) | Some (pragmas,rbrace) -> (rbrace,update_after pragmas aft) in (match left_fundecl name fi with None -> Ast0.FunDecl(bef,fi,name,lp,params,va,rp,lbrace,body,rbrace,aft) | Some (pragmas,fi,name) -> Ast0.FunDecl (update_before2 pragmas bef, fi,name,lp,params,va,rp,lbrace,body,rbrace,aft)) | Ast0.Decl(bef,decl) -> (match left_decl decl with None -> Ast0.unwrap s | Some (pragmas,decl) -> Ast0.Decl(update_before2 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.4/parsing_cocci/main.ml0000644000175000017500000000154312614153277016700 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ----------------------------------------------------------------------- *) (* 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.4/parsing_cocci/visitor_ast.ml0000644000175000017500000020030412614153277020316 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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_assignOp : Ast_cocci.assignOp -> 'a; combiner_binaryOp : Ast_cocci.binaryOp -> '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_anndecl_dots : Ast.annotated_decl 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 simpleassign_mcodefn opassign_mcodefn fix_mcodefn unary_mcodefn arithop_mcodefn logicalop_mcodefn cv_mcodefn sign_mcodefn struct_mcodefn storage_mcodefn inc_file_mcodefn expdotsfn paramdotsfn stmtdotsfn anndecldotsfn initdotsfn identfn exprfn fragfn fmtfn assignOpfn binaryOpfn ftfn tyfn initfn paramfn declfn annotated_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 = multibind (List.map default (Ast.unwrap d)) 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 simpleassign_mcode x = simpleassign_mcodefn all_functions x and opassign_mcode x = opassign_mcodefn all_functions x and fix_mcode x = fix_mcodefn all_functions x and unary_mcode x = unary_mcodefn all_functions x and arithop_mcode x = arithop_mcodefn all_functions x and logicalop_mcode x = logicalop_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 ecdotsfn 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 annotated_decl_dots d = dotsfn anndecldotsfn annotated_decl 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 exec_code_dots d = dotsfn ecdotsfn exec_code 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) -> (* use let-ins to ensure arg evaluation happens left-to-right *) let lid = ident id in let lasid = ident asid in bind lid lasid | Ast.DisjId(id_list) -> multibind (List.map ident id_list) | Ast.OptIdent(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) -> let llq = string_mcode lq in let lstr = string_fragment_dots str in let lrq = string_mcode rq in multibind [llq; lstr; lrq] | Ast.FunCall(fn,lp,args,rp) -> let lfn = expression fn in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in multibind [lfn; llp; largs; lrp] | Ast.Assignment(left,op,right,simple) -> let lleft = expression left in let lop = assignOp op in let lright = expression right in multibind [lleft; lop; lright] | Ast.Sequence(left,op,right) -> let lleft = expression left in let lop = string_mcode op in let lright = expression right in multibind [lleft; lop; lright] | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> let lexp1 = expression exp1 in let lwhy = string_mcode why in let lexp2 = get_option expression exp2 in let lcolon = string_mcode colon in let lexp3 = expression exp3 in multibind [lexp1; lwhy; lexp2; lcolon; lexp3] | Ast.Postfix(exp,op) -> let lexp = expression exp in let lop = fix_mcode op in bind lexp lop | Ast.Infix(exp,op) -> let lop = fix_mcode op in let lexp = expression exp in bind lop lexp | Ast.Unary(exp,op) -> let lop = unary_mcode op in let lexp = expression exp in bind lop lexp | Ast.Binary(left,op,right) -> let lleft = expression left in let lop = binaryOp op in let lright = expression right in multibind [lleft; lop; lright] | Ast.Nested(left,op,right) -> let lleft = expression left in let lop = binaryOp op in let lright = expression right in multibind [lleft; lop; lright] | Ast.Paren(lp,exp,rp) -> let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in multibind [llp; lexp; lrp] | Ast.ArrayAccess(exp1,lb,exp2,rb) -> let lexp1 = expression exp1 in let llb = string_mcode lb in let lexp2 = expression exp2 in let lrb = string_mcode rb in multibind [lexp1; llb; lexp2; lrb] | Ast.RecordAccess(exp,pt,field) -> let lexp = expression exp in let lpt = string_mcode pt in let lfield = ident field in multibind [lexp; lpt; lfield] | Ast.RecordPtAccess(exp,ar,field) -> let lexp = expression exp in let lar = string_mcode ar in let lfield = ident field in multibind [lexp; lar; lfield] | Ast.Cast(lp,ty,rp,exp) -> let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in let lexp = expression exp in multibind [llp; lty; lrp; lexp] | Ast.SizeOfExpr(szf,exp) -> let lszf = string_mcode szf in let lexp = expression exp in bind lszf lexp | Ast.SizeOfType(szf,lp,ty,rp) -> let lszf = string_mcode szf in let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in multibind [lszf; llp; lty; lrp] | Ast.TypeExp(ty) -> fullType ty | Ast.Constructor(lp,ty,rp,init) -> let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in let linit = initialiser init in multibind [llp; lty; lrp; linit] | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) | Ast.MetaExprList(name,_,_,_) -> meta_mcode name | Ast.AsExpr(exp,asexp) -> let lexp = expression exp in let lasexp = expression asexp in bind lexp lasexp | Ast.AsSExpr(exp,asstm) -> let lexp = expression exp in let lasstm = rule_elem asstm in bind lexp lasstm | Ast.EComma(cm) -> string_mcode cm | Ast.DisjExpr(exp_list) | Ast.ConjExpr(exp_list) -> multibind (List.map expression exp_list) | Ast.NestExpr(starter,expr_dots,ender,whncode,multi) -> let lstarter = string_mcode starter in let lexpr_dots = expression_dots expr_dots in let lender = string_mcode ender in let lwhncode = get_option expression whncode in multibind [lstarter; lexpr_dots; lender; lwhncode] | Ast.Edots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option expression whncode in bind ldots lwhncode | Ast.OptExp(exp) -> expression exp in exprfn all_functions k e and assignOp op = let k e = match Ast.unwrap e with Ast.SimpleAssign o -> simpleassign_mcode o | Ast.OpAssign o -> opassign_mcode o | Ast.MetaAssign (mv,_,_,_) -> meta_mcode mv in assignOpfn all_functions k op and binaryOp op = let k e = match Ast.unwrap e with Ast.Arith o -> arithop_mcode o | Ast.Logical o -> logicalop_mcode o | Ast.MetaBinary (mv,_,_,_) -> meta_mcode mv in binaryOpfn all_functions k op 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 bind 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) -> let lcv = get_option cv_mcode cv in let lty = typeC ty in bind lcv lty | Ast.AsType(ty,asty) -> let lty = fullType ty in let lasty = fullType asty in bind lty lasty | Ast.DisjType(types) -> multibind (List.map fullType types) | Ast.OptType(ty) -> fullType ty in ftfn all_functions k ft and function_pointer (ty, lp1, star, (id : Ast.ident option), rp1, lp2, params, rp2) = (* have to put the treatment of the identifier into the right position *) let lty = fullType ty in let llp1 = string_mcode lp1 in let lstar = string_mcode star in let lid = match id with Some idd -> [ident idd] | None -> [] in let lrp1 = string_mcode rp1 in let llp2 = string_mcode lp2 in let lparams = parameter_dots params in let lrp2 = string_mcode rp2 in multibind ([lty; llp1; lstar] @ lid @ [lrp1; llp2; lparams; lrp2]) and array_type (ty,(id : Ast.ident option),lb,size,rb) = let lty = fullType ty in let lid = match id with Some idd -> [ident idd] | None -> [] in let lb = string_mcode lb in let lsize = get_option expression size in let lrb = string_mcode rb in multibind ([lty] @ lid @ [lb; lsize; lrb]) 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) -> let lsgn = sign_mcode sgn in let lty = get_option typeC ty in bind lsgn lty | Ast.Pointer(ty,star) -> let lty = fullType ty in let lstar = string_mcode star in bind lty lstar | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> function_pointer (ty,lp1,star,None,rp1,lp2,params,rp2) | Ast.Array(ty,lb,size,rb) -> array_type (ty,None,lb,size,rb) | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> let ldec = string_mcode dec in let llp = string_mcode lp in let llength = expression length in let lcomma = get_option string_mcode comma in let lprecision_opt = get_option expression precision_opt in let lrp = string_mcode rp in multibind [ldec; llp; llength; lcomma; lprecision_opt; lrp] | Ast.EnumName(kind,name) -> let lkind = string_mcode kind in let lname = get_option ident name in bind lkind lname | Ast.EnumDef(ty,lb,ids,rb) -> let lty = fullType ty in let llb = string_mcode lb in let lids = expression_dots ids in let lrb = string_mcode rb in multibind [lty; llb; lids; lrb] | Ast.StructUnionName(kind,name) -> let lkind = struct_mcode kind in let lname = get_option ident name in bind lkind lname | Ast.StructUnionDef(ty,lb,decls,rb) -> let lty = fullType ty in let llb = string_mcode lb in let ldecls = annotated_decl_dots decls in let lrb = string_mcode rb in multibind [lty; llb; ldecls; lrb] | 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, Some id, rp1, lp2, params, rp2) | Ast.Array(ty,lb,size,rb) -> array_type (ty, Some id, lb, size, rb) | _ -> let lty = fullType ty in let lid = ident id in bind lty lid) | _ -> let lty = fullType ty in let lid = ident id in bind lty lid 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) -> let ldecl = declaration decl in let lasdecl = declaration asdecl in bind ldecl lasdecl | Ast.Init(stg,ty,id,eq,ini,sem) -> let lstg = get_option storage_mcode stg in let lid = named_type ty id in let leq = string_mcode eq in let lini = initialiser ini in let lsem = string_mcode sem in multibind [lstg; lid; leq; lini; lsem] | Ast.UnInit(stg,ty,id,sem) -> let lstg = get_option storage_mcode stg in let lid = named_type ty id in let lsem = string_mcode sem in multibind [lstg; lid; lsem] | Ast.FunProto(fi,name,lp1,params,va,rp1,sem) -> let lfi = List.map fninfo fi in let lname = ident name in let llp1 = string_mcode lp1 in let lparams = parameter_dots params in let (lcomma,lellipsis) = match va with | None -> ([],[]) | Some (comma,ellipsis) -> ([string_mcode comma],[string_mcode ellipsis]) in let lrp1 = string_mcode rp1 in multibind (lfi @ [lname; llp1; lparams] @ lcomma @ lellipsis @ [lrp1]) | Ast.MacroDecl(stg,name,lp,args,rp,sem) -> let lstg = get_option storage_mcode stg in let lname = ident name in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in let lsem = string_mcode sem in multibind [lstg; lname; llp; largs; lrp; lsem] | Ast.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> let lstg = get_option storage_mcode stg in let lname = ident name in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in let leq = string_mcode eq in let lini = initialiser ini in let lsem = string_mcode sem in multibind [lstg; lname; llp; largs; lrp; leq; lini; lsem] | Ast.TyDecl(ty,sem) -> let lty = fullType ty in let lsem = string_mcode sem in bind lty lsem | Ast.Typedef(stg,ty,id,sem) -> let lstg = string_mcode stg in let lty = fullType ty in let lid = typeC id in let lsem = string_mcode sem in multibind [lstg; lty; lid; lsem] | Ast.DisjDecl(decls) -> multibind (List.map declaration decls) | Ast.OptDecl(decl) -> declaration decl in declfn all_functions k d and annotated_decl d = let k d = match Ast.unwrap d with Ast.DElem(_,_,d) -> declaration d | Ast.Ddots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option declaration whncode in bind ldots lwhncode in annotated_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) -> let linit = initialiser init in let lasinit = initialiser asinit in bind linit lasinit | Ast.InitExpr(exp) -> expression exp | Ast.ArInitList(lb,initlist,rb) -> let llb = string_mcode lb in let linitlist = initialiser_dots initlist in let lrb = string_mcode rb in multibind [llb; linitlist; lrb] | Ast.StrInitList(allminus,lb,initlist,rb,whncode) -> let llb = string_mcode lb in let linitlist = multibind (List.map initialiser initlist) in let lrb = string_mcode rb in let lwhncode = multibind (List.map initialiser whncode) in multibind [llb; linitlist; lrb; lwhncode] | Ast.InitGccName(name,eq,ini) -> let lname = ident name in let leq = string_mcode eq in let lini = initialiser ini in multibind [lname; leq; lini] | Ast.InitGccExt(designators,eq,ini) -> let ldesignators = List.map designator designators in let leq = string_mcode eq in let lini = initialiser ini in multibind (ldesignators @ [leq; lini]) | Ast.IComma(cm) -> string_mcode cm | Ast.Idots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option initialiser whncode in bind ldots lwhncode | Ast.OptIni(i) -> initialiser i in initfn all_functions k i and designator = function Ast.DesignatorField(dot,id) -> let ldot = string_mcode dot in let lid = ident id in bind ldot lid | Ast.DesignatorIndex(lb,exp,rb) -> let llb = string_mcode lb in let lexp = expression exp in let lrb = string_mcode rb in multibind [llb; lexp; lrb] | Ast.DesignatorRange(lb,min,dots,max,rb) -> let llb = string_mcode lb in let lmin = expression min in let ldots = string_mcode dots in let lmax = expression max in let lrb = string_mcode rb in multibind [llb; lmin; ldots; lmax; lrb] 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) -> let lp = parameterTypeDef p in let lasexp = expression asexp in bind lp lasexp | Ast.PComma(cm) -> string_mcode cm | Ast.Pdots(dots) -> string_mcode dots | Ast.OptParam(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,va,rp) -> let lfi = List.map fninfo fi in let lname = ident name in let llp = string_mcode lp in let lparams = parameter_dots params in let (lcomma,lellipsis) = match va with | None -> ([],[]) | Some (comma,ellipsis) -> ([string_mcode comma],[string_mcode ellipsis]) in let lrp = string_mcode rp in multibind (lfi @ [lname; llp; lparams] @ lcomma @ lellipsis @ [lrp]) | Ast.Decl decl -> annotated_decl decl | Ast.SeqStart(brace) -> string_mcode brace | Ast.SeqEnd(brace) -> string_mcode brace | Ast.ExprStatement(exp,sem) -> let lexp = get_option expression exp in let lsem = string_mcode sem in bind lexp lsem | Ast.IfHeader(iff,lp,exp,rp) -> let liff = string_mcode iff in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in multibind [liff; llp; lexp; lrp] | Ast.Else(els) -> string_mcode els | Ast.WhileHeader(whl,lp,exp,rp) -> let lwhl = string_mcode whl in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in multibind [lwhl; llp; lexp; lrp] | Ast.DoHeader(d) -> string_mcode d | Ast.WhileTail(whl,lp,exp,rp,sem) -> let lwhl = string_mcode whl in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in let lsem = string_mcode sem in multibind [lwhl; llp; lexp; lrp; lsem] | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> let lfr = string_mcode fr in let llp = string_mcode lp in let lfirst = forinfo first in let le2 = get_option expression e2 in let lsem2 = string_mcode sem2 in let le3 = get_option expression e3 in let lrp = string_mcode rp in multibind [lfr; llp; lfirst; le2; lsem2; le3; lrp] | Ast.IteratorHeader(nm,lp,args,rp) -> let lnm = ident nm in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in multibind [lnm; llp; largs; lrp] | Ast.SwitchHeader(switch,lp,exp,rp) -> let lswitch = string_mcode switch in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in multibind [lswitch; llp; lexp; lrp] | Ast.Break(br,sem) -> let lbr = string_mcode br in let lsem = string_mcode sem in bind lbr lsem | Ast.Continue(cont,sem) -> let lcont = string_mcode cont in let lsem = string_mcode sem in bind lcont lsem | Ast.Label(l,dd) -> let ll = ident l in let ldd = string_mcode dd in bind ll ldd | Ast.Goto(goto,l,sem) -> let lgoto = string_mcode goto in let ll = ident l in let lsem = string_mcode sem in multibind [lgoto; ll; lsem] | Ast.Return(ret,sem) -> let lret = string_mcode ret in let lsem = string_mcode sem in bind lret lsem | Ast.ReturnExpr(ret,exp,sem) -> let lret = string_mcode ret in let lexp = expression exp in let lsem = string_mcode sem in multibind [lret; lexp; lsem] | Ast.Exec(exec,lang,code,sem) -> let lexec = string_mcode exec in let lland = string_mcode lang in let lcode = exec_code_dots code in let lsem = string_mcode sem in multibind [lexec; lland; lcode; lsem] | 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.TopId(ty) -> ident ty | Ast.TopInit(init) -> initialiser init | Ast.Include(inc,name) -> let linc = string_mcode inc in let lname = inc_file_mcode name in bind linc lname | Ast.Undef(def,id) -> let ldef = string_mcode def in let lid = ident id in bind ldef lid | Ast.DefineHeader(def,id,params) -> let ldef = string_mcode def in let lid = ident id in let lparams = define_parameters params in multibind [ldef; lid; lparams] | Ast.Pragma(prg,id,body) -> let lprg = string_mcode prg in let lid = ident id in let lbody = pragmainfo body in multibind [lprg; lid; lbody] | Ast.Default(def,colon) -> let ldef = string_mcode def in let lcolon = string_mcode colon in bind ldef lcolon | Ast.Case(case,exp,colon) -> let lcase = string_mcode case in let lexp = expression exp in let lcolon = string_mcode colon in multibind [lcase; lexp; lcolon] | Ast.AsRe(re,asre) -> let re = rule_elem re in let asre = rule_elem asre in bind re asre | 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) -> let le1 = get_option expression e1 in let lsem1 = string_mcode sem1 in bind le1 lsem1 | Ast.ForDecl decl -> annotated_decl decl in k fi (* not parameterisable, for now *) and pragmainfo pi = let k pi = match Ast.unwrap pi with Ast.PragmaTuple(lp,args,rp) -> let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in multibind [llp; largs; lrp] | 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) -> let llp = string_mcode lp in let lparams = define_param_dots params in let lrp = string_mcode rp in multibind [llp; lparams; lrp] in k p and define_param_dots d = multibind (List.map define_param (Ast.unwrap 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.OptDParam(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) -> let llbrace = rule_elem lbrace in let lbody = statement_dots body in let lrbrace = rule_elem rbrace in multibind [llbrace; lbody; lrbrace] | Ast.IfThen(header,branch,_) -> let lheader = rule_elem header in let lbranch = statement branch in bind lheader lbranch | Ast.IfThenElse(header,branch1,els,branch2,_) -> let lheader = rule_elem header in let lbranch1 = statement branch1 in let lels = rule_elem els in let lbranch2 = statement branch2 in multibind [lheader; lbranch1; lels; lbranch2] | Ast.While(header,body,_) -> let lheader = rule_elem header in let lbody = statement body in bind lheader lbody | Ast.Do(header,body,tail) -> let lheader = rule_elem header in let lbody = statement body in let ltail = rule_elem tail in multibind [lheader; lbody; ltail] | Ast.For(header,body,_) -> let lheader = rule_elem header in let lbody = statement body in bind lheader lbody | Ast.Iterator(header,body,_) -> let lheader = rule_elem header in let lbody = statement body in bind lheader lbody | Ast.Switch(header,lb,decls,cases,rb) -> let lheader = rule_elem header in let llb = rule_elem lb in let ldecls = statement_dots decls in let lcases = multibind (List.map case_line cases) in let lrb = rule_elem rb in multibind [lheader; llb; ldecls; lcases; lrb] | Ast.Atomic(re) ->rule_elem re | Ast.Disj(stmt_dots_list) | Ast.Conj(stmt_dots_list) -> multibind (List.map statement_dots stmt_dots_list) | Ast.Nest(starter,stmt_dots,ender,whn,_,_,_) -> let lstarter = string_mcode starter in let lstmt_dots = statement_dots stmt_dots in let lender = string_mcode ender in let lwhn = multibind (List.map (whencode statement_dots statement) whn) in multibind [lstarter; lstmt_dots; lender; lwhn] | Ast.FunDecl(header,lbrace,body,rbrace,_) -> let lheader = rule_elem header in let lbraces = rule_elem lbrace in let lbody = statement_dots body in let lrbrace = rule_elem rbrace in multibind [lheader; lbraces; lbody; lrbrace] | Ast.Define(header,body) -> let lheader = rule_elem header in let lbody = statement_dots body in bind lheader lbody | Ast.AsStmt(stm,asstm) -> let lstm = statement stm in let lasstm = statement asstm in bind lstm lasstm | Ast.Dots(d,whn,_,_) -> let ld = string_mcode d in let lwhn = multibind (List.map (whencode statement_dots statement) whn) in bind ld lwhn | Ast.OptStm(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) -> let lheader = rule_elem header in let lcode = statement_dots code in bind lheader lcode | Ast.OptCase(case) -> case_line case in casefn all_functions k c and exec_code e = (* not configurable *) match Ast.unwrap e with Ast.ExecEval(colon,id) -> let lcolon = string_mcode colon in let lid = expression id in bind lcolon lid | Ast.ExecToken(tok) -> string_mcode tok | Ast.ExecDots(dots) -> string_mcode dots 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.SimpleAssignOpTag _ -> option_default | Ast.OpAssignOpTag _ -> 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.StringFragmentTag(frag) -> string_fragment frag | 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.AnnDeclDotsTag(sd) -> annotated_decl_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_assignOp = assignOp; combiner_binaryOp = binaryOp; 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_anndecl_dots = annotated_decl_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_assignOp : Ast_cocci.assignOp inout; rebuilder_binaryOp : Ast_cocci.binaryOp 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_anndecl_dots : Ast.annotated_decl 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 simpleassign_mcode opassign_mcode fix_mcode unary_mcode arithop_mcode logicalop_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_file_mcode expdotsfn paramdotsfn stmtdotsfn anndecldotsfn initdotsfn identfn exprfn fragfn fmtfn assignOpfn binaryOpfn ftfn tyfn initfn paramfn declfn annotated_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 (List.map default (Ast.unwrap d)) 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 ecdotsfn 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 annotated_decl_dots d = dotsfn anndecldotsfn annotated_decl 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 exec_code_dots d = dotsfn ecdotsfn exec_code 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)) 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) -> let llq = string_mcode lq in let lstr = string_fragment_dots str in let lrq = string_mcode rq in Ast.StringConstant(llq, lstr, lrq) | Ast.FunCall(fn,lp,args,rp) -> let lfn = expression fn in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in Ast.FunCall(lfn, llp, largs, lrp) | Ast.Assignment(left,op,right,simple) -> let lleft = expression left in let lop = assignOp op in let lright = expression right in Ast.Assignment(lleft, lop, lright, simple) | Ast.Sequence(left,op,right) -> let lleft = expression left in let lop = string_mcode op in let lright = expression right in Ast.Sequence(lleft, lop, lright) | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> let lexp1 = expression exp1 in let lwhy = string_mcode why in let lexp2 = get_option expression exp2 in let lcolon = string_mcode colon in let lexp3 = expression exp3 in Ast.CondExpr(lexp1, lwhy, lexp2, lcolon, lexp3) | Ast.Postfix(exp,op) -> let lexp = expression exp in let lop = fix_mcode op in Ast.Postfix(lexp, lop) | Ast.Infix(exp,op) -> let lexp = expression exp in let lop = fix_mcode op in Ast.Infix(lexp, lop) | Ast.Unary(exp,op) -> let lexp = expression exp in let lop = unary_mcode op in Ast.Unary(lexp, lop) | Ast.Binary(left,op,right) -> let lleft = expression left in let lop = binaryOp op in let lright = expression right in Ast.Binary(lleft, lop, lright) | Ast.Nested(left,op,right) -> let lleft = expression left in let lop = binaryOp op in let lright = expression right in Ast.Nested(lleft, lop, lright) | Ast.Paren(lp,exp,rp) -> let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in Ast.Paren(llp, lexp, lrp) | Ast.ArrayAccess(exp1,lb,exp2,rb) -> let lexp1 = expression exp1 in let llb = string_mcode lb in let lexp2 = expression exp2 in let lrb = string_mcode rb in Ast.ArrayAccess(lexp1, llb, lexp2, lrb) | Ast.RecordAccess(exp,pt,field) -> let lexp = expression exp in let lpt = string_mcode pt in let lfield = ident field in Ast.RecordAccess(lexp, lpt, lfield) | Ast.RecordPtAccess(exp,ar,field) -> let lexp = expression exp in let lar = string_mcode ar in let lfield = ident field in Ast.RecordPtAccess(lexp, lar, lfield) | Ast.Cast(lp,ty,rp,exp) -> let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in let lexp = expression exp in Ast.Cast(llp, lty, lrp, lexp) | Ast.SizeOfExpr(szf,exp) -> let lszf = string_mcode szf in let lexp = expression exp in Ast.SizeOfExpr(lszf, lexp) | Ast.SizeOfType(szf,lp,ty,rp) -> let lszf = string_mcode szf in let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in Ast.SizeOfType(lszf, llp, lty, lrp) | Ast.TypeExp(ty) -> Ast.TypeExp(fullType ty) | Ast.Constructor(lp,ty,rp,init) -> let llp = string_mcode lp in let lty = fullType ty in let lrp = string_mcode rp in let linit = initialiser init in Ast.Constructor(llp, lty, lrp, linit) | 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) -> let lexp = expression exp in let lasexp = expression asexp in Ast.AsExpr(lexp, lasexp) | Ast.AsSExpr(exp,asstm) -> let lexp = expression exp in let lasstm = rule_elem asstm in Ast.AsSExpr(lexp, lasstm) | Ast.EComma(cm) -> Ast.EComma(string_mcode cm) | Ast.DisjExpr(exp_list) -> Ast.DisjExpr(List.map expression exp_list) | Ast.ConjExpr(exp_list) -> Ast.ConjExpr(List.map expression exp_list) | Ast.NestExpr(starter,expr_dots,ender,whncode,multi) -> let lstarter = string_mcode starter in let lexpr_dots = expression_dots expr_dots in let lender = string_mcode ender in let lwhncode = get_option expression whncode in Ast.NestExpr(lstarter, lexpr_dots, lender, lwhncode, multi) | Ast.Edots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option expression whncode in Ast.Edots(ldots, lwhncode) | Ast.OptExp(exp) -> Ast.OptExp(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) -> let lpct = string_mcode pct in let lfmt = string_format fmt in Ast.FormatFragment(lpct, lfmt) | Ast.Strdots dots -> Ast.Strdots (string_mcode dots) | Ast.MetaFormatList(pct,name,lenname,keep,inherited) -> let lpct = string_mcode pct in let lname = meta_mcode name in Ast.MetaFormatList(lpct, lname, 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 assignOp op = let k op = Ast.rewrap op (match Ast.unwrap op with Ast.SimpleAssign o -> Ast.SimpleAssign (simpleassign_mcode o) | Ast.OpAssign o -> Ast.OpAssign (opassign_mcode o) | Ast.MetaAssign (mv,x,y,z) -> Ast.MetaAssign ((meta_mcode mv),x,y,z) ) in assignOpfn all_functions k op and binaryOp op = let k op = Ast.rewrap op (match Ast.unwrap op with Ast.Arith o -> Ast.Arith (arithop_mcode o) | Ast.Logical o -> Ast.Logical (logicalop_mcode o) | Ast.MetaBinary (mv,x,y,z) -> Ast.MetaBinary ((meta_mcode mv),x,y,z) ) in binaryOpfn all_functions k op and fullType ft = let k ft = Ast.rewrap ft (match Ast.unwrap ft with Ast.Type(allminus,cv,ty) -> let lcv = get_option cv_mcode cv in let lty = typeC ty in Ast.Type (allminus, lcv, lty) | Ast.AsType(ty,asty) -> let lty = fullType ty in let lasty = fullType asty in Ast.AsType(lty, lasty) | Ast.DisjType(types) -> Ast.DisjType(List.map fullType types) | Ast.OptType(ty) -> Ast.OptType(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) -> let lsgn = sign_mcode sgn in let lty = get_option typeC ty in Ast.SignedT(lsgn, lty) | Ast.Pointer(ty,star) -> let lty = fullType ty in let lstar = string_mcode star in Ast.Pointer (lty, lstar) | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> let lty = fullType ty in let llp1 = string_mcode lp1 in let lstar = string_mcode star in let lrp1 = string_mcode rp1 in let llp2 = string_mcode lp2 in let lparams = parameter_dots params in let lrp2 = string_mcode rp2 in Ast.FunctionPointer(lty, llp1, lstar, lrp1, llp2, lparams, lrp2) | Ast.Array(ty,lb,size,rb) -> let lty = fullType ty in let llb = string_mcode lb in let lsize = get_option expression size in let lrb = string_mcode rb in Ast.Array(lty, llb, lsize, lrb) | Ast.Decimal(dec,lp,length,comma,precision_opt,rp) -> let ldec = string_mcode dec in let llp = string_mcode lp in let llength = expression length in let lcomma = get_option string_mcode comma in let lprecision_opt = get_option expression precision_opt in let lrp = string_mcode rp in Ast.Decimal(ldec, llp, llength, lcomma, lprecision_opt, lrp) | Ast.EnumName(kind,name) -> let lkind = string_mcode kind in let lname = get_option ident name in Ast.EnumName(lkind, lname) | Ast.EnumDef(ty,lb,ids,rb) -> let lty = fullType ty in let llb = string_mcode lb in let lids = expression_dots ids in let lrb = string_mcode rb in Ast.EnumDef (lty, llb, lids, lrb) | Ast.StructUnionName(kind,name) -> let lkind = struct_mcode kind in let lname = get_option ident name in Ast.StructUnionName (lkind, lname) | Ast.StructUnionDef(ty,lb,decls,rb) -> let lty = fullType ty in let llb = string_mcode lb in let ldecls = annotated_decl_dots decls in let lrb = string_mcode rb in Ast.StructUnionDef (lty, llb, ldecls, lrb) | 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) -> let ldecl = declaration decl in let lasdecl = declaration asdecl in Ast.AsDecl(ldecl, lasdecl) | Ast.Init(stg,ty,id,eq,ini,sem) -> let lstg = get_option storage_mcode stg in let lty = fullType ty in let lid = ident id in let leq = string_mcode eq in let lini = initialiser ini in let lsem = string_mcode sem in Ast.Init(lstg, lty, lid, leq, lini, lsem) | Ast.UnInit(stg,ty,id,sem) -> let lstg = get_option storage_mcode stg in let lty = fullType ty in let lid = ident id in let lsem = string_mcode sem in Ast.UnInit(lstg, lty, lid, lsem) | Ast.FunProto(fi,name,lp,params,va,rp,sem) -> let lfi = List.map fninfo fi in let lname = ident name in let llp = string_mcode lp in let lparams = parameter_dots params in let lva = match va with | None -> None | Some (comma,ellipsis) -> Some (string_mcode comma,string_mcode ellipsis) in let lrp = string_mcode rp in let lsem = string_mcode sem in Ast.FunProto(lfi,lname,llp,lparams,lva,lrp,lsem) | Ast.MacroDecl(stg,name,lp,args,rp,sem) -> let lstg = get_option storage_mcode stg in let lname = ident name in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in let lsem = string_mcode sem in Ast.MacroDecl(lstg, lname, llp, largs, lrp, lsem) | Ast.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> let lstg = get_option storage_mcode stg in let lname = ident name in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in let leq = string_mcode eq in let lini = initialiser ini in let lsem = string_mcode sem in Ast.MacroDeclInit(lstg, lname, llp, largs, lrp, leq, lini, lsem) | Ast.TyDecl(ty,sem) -> let lty = fullType ty in let lsem = string_mcode sem in Ast.TyDecl(lty, lsem) | Ast.Typedef(stg,ty,id,sem) -> let lstg = string_mcode stg in let lty = fullType ty in let lid = typeC id in let lsem = string_mcode sem in Ast.Typedef(lstg, lty, lid, lsem) | Ast.DisjDecl(decls) -> Ast.DisjDecl(List.map declaration decls) | Ast.OptDecl(decl) -> Ast.OptDecl(declaration decl)) in declfn all_functions k d and annotated_decl d = let k d = Ast.rewrap d (match Ast.unwrap d with Ast.DElem(bef,allminus,decl) -> Ast.DElem(bef,allminus,declaration decl) | Ast.Ddots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option declaration whncode in Ast.Ddots(ldots, lwhncode)) in annotated_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) -> let lini = initialiser ini in let lasinit = initialiser asini in Ast.AsInit(lini, lasinit) | Ast.InitExpr(exp) -> Ast.InitExpr(expression exp) | Ast.ArInitList(lb,initlist,rb) -> let llb = string_mcode lb in let linitlist = initialiser_dots initlist in let lrb = string_mcode rb in Ast.ArInitList(llb, linitlist, lrb) | Ast.StrInitList(allminus,lb,initlist,rb,whncode) -> let llb = string_mcode lb in let linitlist = List.map initialiser initlist in let lrb = string_mcode rb in let lwhncode = List.map initialiser whncode in Ast.StrInitList(allminus,llb, linitlist, lrb, lwhncode) | Ast.InitGccName(name,eq,ini) -> let lname = ident name in let leq = string_mcode eq in let lini = initialiser ini in Ast.InitGccName(lname, leq, lini) | Ast.InitGccExt(designators,eq,ini) -> let ldesignators = List.map designator designators in let leq = string_mcode eq in let lini = initialiser ini in Ast.InitGccExt(ldesignators, leq, lini) | Ast.IComma(cm) -> Ast.IComma(string_mcode cm) | Ast.Idots(dots,whncode) -> let ldots = string_mcode dots in let lwhncode = get_option initialiser whncode in Ast.Idots(ldots, lwhncode) | Ast.OptIni(i) -> Ast.OptIni(initialiser i)) in initfn all_functions k i and designator = function Ast.DesignatorField(dot,id) -> let ldot = string_mcode dot in let lid = ident id in Ast.DesignatorField(ldot, lid) | Ast.DesignatorIndex(lb,exp,rb) -> let llb = string_mcode lb in let lexp = expression exp in let lrb = string_mcode rb in Ast.DesignatorIndex(llb, lexp, lrb) | Ast.DesignatorRange(lb,min,dots,max,rb) -> let llb = string_mcode lb in let lmin = expression min in let ldots = string_mcode dots in let lmax = expression max in let lrb = string_mcode rb in Ast.DesignatorRange(llb, lmin, ldots, lmax, lrb) 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) -> let lp = parameterTypeDef p in let lasexp = expression asexp in Ast.AsParam(lp, lasexp) | Ast.PComma(cm) -> Ast.PComma(string_mcode cm) | Ast.Pdots(dots) -> Ast.Pdots(string_mcode dots) | Ast.OptParam(param) -> Ast.OptParam(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,va,rp) -> let lfi = List.map fninfo fi in let lname = ident name in let llp = string_mcode lp in let lparams = parameter_dots params in let lva = match va with | None -> None | Some (comma,ellipsis) -> Some(string_mcode comma,string_mcode ellipsis) in let lrp = string_mcode rp in Ast.FunHeader(bef,allminus, lfi, lname, llp, lparams, lva, lrp) | Ast.Decl decl -> Ast.Decl (annotated_decl decl) | Ast.SeqStart(brace) -> Ast.SeqStart(string_mcode brace) | Ast.SeqEnd(brace) -> Ast.SeqEnd(string_mcode brace) | Ast.ExprStatement(exp,sem) -> let lexp = get_option expression exp in let lsem = string_mcode sem in Ast.ExprStatement (lexp, lsem) | Ast.IfHeader(iff,lp,exp,rp) -> let liff = string_mcode iff in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in Ast.IfHeader(liff, llp, lexp, lrp) | Ast.Else(els) -> Ast.Else(string_mcode els) | Ast.WhileHeader(whl,lp,exp,rp) -> let lwhl = string_mcode whl in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in Ast.WhileHeader(lwhl, llp, lexp, lrp) | Ast.DoHeader(d) -> Ast.DoHeader(string_mcode d) | Ast.WhileTail(whl,lp,exp,rp,sem) -> let lwhl = string_mcode whl in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in let lsem = string_mcode sem in Ast.WhileTail(lwhl, llp, lexp, lrp, lsem) | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> let lfr = string_mcode fr in let llp = string_mcode lp in let lfirst = forinfo first in let le2 = get_option expression e2 in let lsem2 = string_mcode sem2 in let le3 = get_option expression e3 in let lrp = string_mcode rp in Ast.ForHeader(lfr, llp, lfirst, le2, lsem2, le3, lrp) | Ast.IteratorHeader(whl,lp,args,rp) -> let lnm = ident whl in let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in Ast.IteratorHeader(lnm, llp, largs, lrp) | Ast.SwitchHeader(switch,lp,exp,rp) -> let lswitch = string_mcode switch in let llp = string_mcode lp in let lexp = expression exp in let lrp = string_mcode rp in Ast.SwitchHeader(lswitch, llp, lexp, lrp) | Ast.Break(br,sem) -> let lbr = string_mcode br in let lsem = string_mcode sem in Ast.Break(lbr, lsem) | Ast.Continue(cont,sem) -> let lcont = string_mcode cont in let lsem = string_mcode sem in Ast.Continue(lcont, lsem) | Ast.Label(l,dd) -> let ll = ident l in let ldd = string_mcode dd in Ast.Label(ll, ldd) | Ast.Goto(goto,l,sem) -> let lgoto = string_mcode goto in let ll = ident l in let lsem = string_mcode sem in Ast.Goto(lgoto, ll, lsem) | Ast.Return(ret,sem) -> let lret = string_mcode ret in let lsem = string_mcode sem in Ast.Return(lret, lsem) | Ast.ReturnExpr(ret,exp,sem) -> let lret = string_mcode ret in let lexp = expression exp in let lsem = string_mcode sem in Ast.ReturnExpr(lret, lexp, lsem) | Ast.Exec(exec,lang,code,sem) -> let lexec = string_mcode exec in let lland = string_mcode lang in let lcode = exec_code_dots code in let lsem = string_mcode sem in Ast.Exec(lexec, lland, lcode, lsem) | Ast.MetaStmt(name,keep,seqible,inherited) -> Ast.MetaStmt(meta_mcode name,keep,seqible,inherited) | Ast.MetaStmtList(name,lenname_inh,keep,inherited) -> Ast.MetaStmtList(meta_mcode name,lenname_inh,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.TopId(id) -> Ast.TopId(ident id) | Ast.TopInit(init) -> Ast.TopInit(initialiser init) | Ast.Include(inc,name) -> let linc = string_mcode inc in let lname = inc_file_mcode name in Ast.Include(linc, lname) | Ast.Undef(def,id) -> let ldef = string_mcode def in let lid = ident id in Ast.Undef(ldef, lid) | Ast.DefineHeader(def,id,params) -> let ldef = string_mcode def in let lid = ident id in let lparams = define_parameters params in Ast.DefineHeader(ldef, lid, lparams) | Ast.Pragma(prg,id,body) -> let lprg = string_mcode prg in let lid = ident id in let lbody = pragmainfo body in Ast.Pragma(lprg, lid, lbody) | Ast.Default(def,colon) -> let ldef = string_mcode def in let lcolon = string_mcode colon in Ast.Default(ldef, lcolon) | Ast.Case(case,exp,colon) -> let lcase = string_mcode case in let lexp = expression exp in let lcolon = string_mcode colon in Ast.Case(lcase, lexp, lcolon) | Ast.AsRe(re,asre) -> let re = rule_elem re in let asre = rule_elem asre in Ast.AsRe(re,asre) | 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) -> let le1 = get_option expression e1 in let lsem1 = string_mcode sem1 in Ast.ForExp(le1, lsem1) | Ast.ForDecl decl -> Ast.ForDecl (annotated_decl 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) -> let llp = string_mcode lp in let largs = expression_dots args in let lrp = string_mcode rp in Ast.PragmaTuple(llp, largs, lrp) | 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) -> let llp = string_mcode lp in let lparams = define_param_dots params in let lrp = string_mcode rp in Ast.DParams(llp, lparams, lrp)) in k p and define_param_dots d = Ast.rewrap d (List.map define_param (Ast.unwrap 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.OptDParam(dp) -> Ast.OptDParam(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) -> let llbrace = rule_elem lbrace in let lbody = statement_dots body in let lrbrace = rule_elem rbrace in Ast.Seq(llbrace, lbody, lrbrace) | Ast.IfThen(header,branch,aft) -> let lheader = rule_elem header in let lbranch = statement branch in Ast.IfThen(lheader, lbranch, aft) | Ast.IfThenElse(header,branch1,els,branch2,aft) -> let lheader = rule_elem header in let lbranch1 = statement branch1 in let lels = rule_elem els in let lbranch2 = statement branch2 in Ast.IfThenElse(lheader, lbranch1, lels, lbranch2, aft) | Ast.While(header,body,aft) -> let lheader = rule_elem header in let lbody = statement body in Ast.While(lheader, lbody, aft) | Ast.Do(header,body,tail) -> let lheader = rule_elem header in let lbody = statement body in let ltail = rule_elem tail in Ast.Do(lheader, lbody, ltail) | Ast.For(header,body,aft) -> let lheader = rule_elem header in let lbody = statement body in Ast.For(lheader, lbody, aft) | Ast.Iterator(header,body,aft) -> let lheader = rule_elem header in let lbody = statement body in Ast.Iterator(lheader, lbody, aft) | Ast.Switch(header,lb,decls,cases,rb) -> let lheader = rule_elem header in let llb = rule_elem lb in let ldecls = statement_dots decls in let lcases = List.map case_line cases in let lrb = rule_elem rb in Ast.Switch(lheader, llb, ldecls, lcases, lrb) | Ast.Atomic(re) -> Ast.Atomic(rule_elem re) | Ast.Disj(stmt_dots_list) -> Ast.Disj (List.map statement_dots stmt_dots_list) | Ast.Conj(stmt_dots_list) -> Ast.Conj (List.map statement_dots stmt_dots_list) | Ast.Nest(starter,stmt_dots,ender,whn,multi,bef,aft) -> let lstarter = string_mcode starter in let lstmt_dots = statement_dots stmt_dots in let lender = string_mcode ender in let lwhn = List.map (whencode statement_dots statement) whn in Ast.Nest(lstarter, lstmt_dots, lender, lwhn, multi, bef, aft) | Ast.FunDecl(header,lbrace,body,rbrace,aft) -> let lheader = rule_elem header in let lbraces = rule_elem lbrace in let lbody = statement_dots body in let lrbrace = rule_elem rbrace in Ast.FunDecl(lheader, lbraces, lbody, lrbrace, aft) | Ast.Define(header,body) -> let lheader = rule_elem header in let lbody = statement_dots body in Ast.Define(lheader, lbody) | Ast.AsStmt(stm,asstm) -> let lstm = statement stm in let lasstm = statement asstm in Ast.AsStmt(lstm, lasstm) | Ast.Dots(d,whn,bef,aft) -> let ld = string_mcode d in let lwhn = List.map (whencode statement_dots statement) whn in Ast.Dots(ld, lwhn, bef, aft) | Ast.OptStm(stmt) -> Ast.OptStm(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) -> let lheader = rule_elem header in let lcode = statement_dots code in Ast.CaseLine(lheader, lcode) | Ast.OptCase(case) -> Ast.OptCase(case_line case)) in casefn all_functions k c and exec_code e = (* not configurable *) Ast.rewrap e (match Ast.unwrap e with Ast.ExecEval(colon,id) -> let lcolon = string_mcode colon in let lid = expression id in Ast.ExecEval(lcolon, lid) | Ast.ExecToken(tok) -> Ast.ExecToken(string_mcode tok) | Ast.ExecDots(dots) -> Ast.ExecDots(string_mcode dots)) 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.SimpleAssignOpTag _ as x -> x | Ast.OpAssignOpTag _ 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.StringFragmentTag(frag) -> Ast.StringFragmentTag(string_fragment frag) | 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.AnnDeclDotsTag(sd) -> Ast.AnnDeclDotsTag(annotated_decl_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_assignOp = assignOp; rebuilder_binaryOp = binaryOp; 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_anndecl_dots = annotated_decl_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.4/parsing_cocci/commas_on_lists.mli0000644000175000017500000000043212614153277021312 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val process : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/get_constants2.ml0000644000175000017500000006445312614153277020722 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 | Not of combine | 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. If the problem is not clear, try the option --debug-parse-cocci." 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)) | Not x -> Printf.sprintf "!(%s)" (dep2c x) | 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() | Not _ -> failwith "no not in constant formula" | 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 | Not x -> failwith "not unexpected in glimpse arg" | 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 | Not x -> failwith "not unexpected in grep arg" | 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_git_grep strict x = (* convert to cnf *) let subset l1 l2 = List.for_all (fun e1 -> List.mem e1 l2) l1 in let opt_union_set longer shorter = (* (A v B) & (A v B v C) = A v B *) (* tries to be efficient by not updating prv, so optimize is still needed *) List.fold_left (function prev -> function cur -> if List.exists (function x -> subset x cur) prev then prev else cur :: prev) longer shorter in let rec cnf = function Elem x -> [[x]] | Not x -> failwith "not unexpected in coccigrep arg" | And l -> List.fold_left opt_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 opt_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 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 | Not x -> failwith "not unexpected in atoms" | 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;*) let res3 = List.map (function x -> "\\( -e "^(String.concat " -e " x)^" \\)") res in Some (res1,res2,res3) 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 (*get inheritance information from fresh variable construction information*) (* can't do anything with DisjRuleElem, don't know which will be used *) (* expect that the same info will be in branches, which after disjdistr should be atomic *) let fresh_info re = match Ast.unwrap re with Ast.DisjRuleElem(res) -> option_default | _ -> let fresh = Ast.get_fresh re in List.fold_left (function prev -> function (_,Ast.NoVal) -> prev | (_,Ast.StringSeed _) -> prev | (_,Ast.ListSeed l) -> List.fold_left (function prev -> function Ast.SeedString _ -> prev | Ast.SeedId name -> bind (inherited name) prev) prev l) option_default fresh 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.IdPosIdSet(strs,mids),_,_) | Ast.MetaFunc(name,Ast.IdPosIdSet(strs,mids),_,_) | Ast.MetaLocalFunc(name,Ast.IdPosIdSet(strs,mids),_,_) -> let cur = build_or (disj_union_all (List.map constants strs)) (disj_union_all (List.map inherited mids)) in bind (k i) (bind (minherited name) cur) | 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*) (* not useful if the string contains non letters, etc *) (* seems safer to ignore *) option_default | 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) -> option_default (* Like the above constant case, this information is not likely indexed 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(_,_) -> 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 | _ -> 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 = bind (fresh_info 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,_,_) -> option_default | _ -> k s in V.combiner bind option_default mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode donothing donothing donothing donothing donothing ident expression string_fragment string_format donothing donothing fullType typeC initialiser parameter declaration 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 (* used with + items to find inconsistencies *) let rec exact_dependencies = function Ast.Dep s -> Elem s | Ast.AntiDep s -> Not (Elem s) | Ast.EverDep s -> Elem s | Ast.NeverDep s -> Not (Elem s) | Ast.AndDep (d1,d2) -> build_and (exact_dependencies d1) (exact_dependencies d2) | Ast.OrDep (d1,d2) -> build_or (exact_dependencies d1) (exact_dependencies 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 annotated_decl decl = match Ast.unwrap decl with Ast.DElem(bef,_,_) -> bef | _ -> failwith "not possible" in let rule_elem r k e = match Ast.unwrap e with Ast.FunHeader(bef,_,_,_,_,_,_,_) -> bind (process_mcodekind bef) (k e) | Ast.Decl decl -> bind (process_mcodekind (annotated_decl decl)) (k e) | Ast.ForHeader(fr,lp,Ast.ForDecl(decl),e2,sem2,e3,rp) -> bind (process_mcodekind (annotated_decl decl)) (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) | Ast.FunDecl(_,_,_,_,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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing initialiser donothing donothing donothing rule_elem statement donothing donothing donothing (* ------------------------------------------------------------------------ *) (* The whole "in_plus" idea is flawed. If something is added in one rule and matched in a later one, we want to include files that originally contain the thing, so no point to keep track of what is added by earlier rules. The situation is something like a -> b v (b & c). We don't actually need both b and c, but if we don't have b, then the only way that we can get it is fro the first rule matching, in which case the formula is already true. *) let rule_fn nm tls exact_dependencies env neg_pos = (* tls seems like it is supposed to relate to multiple minirules. If we were to actually allow that, then the following could be inefficient, because it could run sat on the same rule name (x) more than once. *) List.fold_left (function rest_info -> function (cur,neg_pos) -> let minuses = let getter = do_get_constants keep drop env neg_pos in getter.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 was_bot = minuses = True in (* perhaps it should be build_and here? we don't really have multiple minirules anymore anyway. *) match 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 | x -> build_or x rest_info) | x -> build_or x rest_info) False (List.combine tls neg_pos) let debug_deps nm deps res = if !Flag_parsing_cocci.debug_parse_cocci then begin Printf.fprintf stderr "Rule: %s\n" nm; Printf.fprintf stderr "Dependecies: %s\n" (Common.format_to_string (function _ -> Pretty_print_cocci.dep true deps)); Printf.fprintf stderr "Result: %s\n\n" (dep2c res) end let run rules neg_pos_vars = let (info,_,_) = List.fold_left (function (rest_info,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 let dependencies = dependencies env extra_deps in debug_deps nm extra_deps dependencies; (match dependencies with False -> (rest_info, (nm,True)::env, nm::locals) | dependencies -> (build_or dependencies rest_info, env, locals)) | (Ast.InitialScriptRule (_,_,deps,_,_),_) | (Ast.FinalScriptRule (_,_,deps,_,_),_) -> (* initialize and finalize dependencies are irrelevant to get_constants *) (* only possible metavariables are virtual *) (rest_info, env, locals) | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) -> let dependencies = dependencies env dep in let exact_dependencies = exact_dependencies dep in let cur_info = rule_fn nm cur exact_dependencies ((nm,True)::env) neg_pos_vars in debug_deps nm dep dependencies; (match dependencies with False -> (rest_info,env,locals) | dependencies -> let re_cur_info = build_and dependencies cur_info in if List.for_all all_context.V.combiner_top_level cur then (rest_info,(nm,re_cur_info)::env,nm::locals) else (* no constants if dependent on another rule; then we need to find the constants of that rule *) (* why does env not use re_cur_info? *) (build_or re_cur_info rest_info, (nm,cur_info)::env,locals))) (False,[],[]) (List.combine (rules : Ast.rule list) neg_pos_vars) in info (* The return value is a tuple of four components. 1. A list of all words, regardless of & and |, for use with grep (or only) 2. A list of single strings using the glimpse ; and , operators 3. A triple of 1 and of a CNF representation, both as regexps, and of the CNF as a list of git grep strings. coccigrep uses 1 for basic scanning and then the CNF regexp for more refined scanning. git grep uses the second CNF representation. 4. An arbitrary formula, usable by the support for idutils *) let get_constants rules neg_pos_vars = if !Flag.worth_trying_opt then begin let res = run rules neg_pos_vars in let grep = interpret_grep true res in (* useful because in string form *) let coccigrep = interpret_cocci_git_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 | Flag.GitGrep -> (grep,None,coccigrep,None) end else (None,None,None,None) coccinelle-1.0.4/parsing_cocci/plus.ml0000644000175000017500000001653112614153277016742 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/id_utils.mli0000644000175000017500000000045112614153277017736 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val interpret : string -> Get_constants2.combine -> string list coccinelle-1.0.4/parsing_cocci/parser_cocci_menhir.mly0000644000175000017500000032042412614153277022145 0ustar eugeneugen/* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr */ %{ (* 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 argument lists *) type 'a argorellipsis = | Nothing | Arg of 'a | Ellipsis of Data.clt | VAEllipsis of Data.clt | Separator of Data.clt let string_of_arg = function | Nothing -> "Nothing" | Arg _ -> "Arg" | Ellipsis _ -> "Ellipsis" | VAEllipsis _ -> "VAEllipsis" | Separator _ -> "Comma" let is_nothing = function | Nothing -> true | _ -> false let is_separator = function | Separator _ -> true | _ -> false let is_vaellipsis = function | VAEllipsis _ -> true | _ -> false let rec adjacent_ellipsis = function | [] -> false | [_] -> false | (Ellipsis _) :: (Ellipsis _) :: _ -> true | x::xs -> adjacent_ellipsis xs let build_arg = function | Arg arg -> arg | Ellipsis e -> Ast0.wrap (Ast0.Pdots(P.clt2mcode "..." e)) | Separator comma -> Ast0.wrap (Ast0.PComma (P.clt2mcode "," comma)) | VAEllipsis _ -> assert false | Nothing -> assert false let string_of_arglist l = "[" ^ (String.concat ";" (List.map string_of_arg l)) ^ "]" let cleanup_arglist l = if l=[] then ([], None) else begin let (args, vararg) = match l with | (VAEllipsis vaellipsis)::(Separator comma)::rem -> let c = P.clt2mcode "," comma in let e = P.clt2mcode "......" vaellipsis in (rem, Some (c, e)) | _ -> (l, None) in let just_args = List.filter (fun x -> not (is_separator x)) args in if List.exists is_vaellipsis just_args then failwith "...... can occur only as last argument" else if adjacent_ellipsis just_args then failwith "Argument list contains adjacent ellipsis" else let pure_args = List.filter (fun x -> not (is_nothing x)) args in (List.map build_arg (List.rev pure_args), vararg) end (* ---------------------------------------------------------------------- *) (* 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_assignOp (name,pure,clt) = (coerce_tmeta "an assignment operator" name (TMetaAssignOp(name,Ast0.AssignOpNoConstraint,pure,clt)) (function TMetaAssignOp(_,_,_,_) -> true | _ -> false)); Ast0.wrap (Ast0.MetaAssign(P.clt2mcode name clt,Ast0.AssignOpNoConstraint, pure)) let tmeta_to_binaryOp (name,pure,clt) = (coerce_tmeta "a binary operator" name (TMetaBinaryOp(name,Ast0.BinaryOpNoConstraint,pure,clt)) (function TMetaBinaryOp(_,_,_,_) -> true | _ -> false)); Ast0.wrap (Ast0.MetaBinary(P.clt2mcode name clt,Ast0.BinaryOpNoConstraint, pure),clt) 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)) and arithOp = function Ast.Plus -> "+" | Ast.Minus -> "-" | Ast.Mul -> "*" | Ast.Div -> "/" | Ast.Min -> " ">?" | Ast.Mod -> "%" | Ast.DecLeft -> "<<" | Ast.DecRight -> ">>" | Ast.And -> "&" | Ast.Or -> "|" | Ast.Xor -> "^" and logicalOp = function Ast.Inf -> "<" | Ast.Sup -> ">" | Ast.InfEq -> "<=" | Ast.SupEq -> ">=" | Ast.Eq -> "==" | Ast.NotEq -> "!=" | Ast.AndLog -> "&&" | Ast.OrLog -> "||" let mkarithop (op, clt) = let op' = P.clt2mcode op clt in Ast0.wrap (Ast0.Arith op') let mklogop (op,clt) = let op' = P.clt2mcode op clt in Ast0.wrap (Ast0.Logical op') %} %token EOF %token TIdentifier TExpression TStatement TFunction TType TParameter %token TIdExpression TInitialiser TDeclaration TField TMetavariable TSymbol %token TOperator TBinary TAssignment %token Tlist TFresh TConstant TError TWords TWhy0 TPlus0 %token TPure TContext TGenerated TFormat TLocal TGlobal %token TTypedef TAttribute TDeclarer TIterator TName TPosition TAnalysis %token 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 TVAEllipsis %token TIf TElse TWhile TFor TDo TSwitch TCase TDefault TReturn %token TBreak TContinue TGoto TSizeof TFunDecl Tdecimal Texec %token TIdent TTypeId TDeclarerId TIteratorId TSymId %token TDirective %token TMetaId %token TMetaFunc TMetaLocalFunc %token TMetaIterator TMetaDeclarer %token TMetaAssignOp %token TMetaBinaryOp %token TMetaErr %token TMetaParam TMetaStm TMetaType %token TMetaInit TMetaDecl TMetaField TMeta %token TMetaParamList TMetaExpList TMetaInitList %token TMetaFieldList TMetaStmList %token TMetaExp TMetaIdExp TMetaLocalIdExp %token TMetaGlobalIdExp TMetaConst %token TMetaPos %token TArob TArobArob %token TPArob %token TScriptData TWhitespace %token TEllipsis TOEllipsis TCEllipsis TPOEllipsis TPCEllipsis %token TWhen TWhenTrue TWhenFalse TAny TStrict TLineEnd %token TWhy TDotDot TBang TOPar TCPar %token TOPar0 TMid0 TAnd0 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 TOpAssign %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 TMetaBinaryOp %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 minus_id_main %type minus_id_main %start plus_main %type plus_main %start plus_exp_main %type plus_exp_main %start plus_ty_main %type plus_ty_main %start plus_id_main %type plus_id_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 * Ast_cocci.mvinit> script_meta_main %start <(string option (*string*) * string option (*ast*)) * (Ast_cocci.meta_name * Ast_cocci.metavar) option * Ast_cocci.mvinit> script_meta_virt_nofresh_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 %% 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_ty_body EOF { $1 } | m=minus_ty_body TArobArob { m } | m=minus_ty_body TArob { m } minus_id_main: minus_id_body EOF { $1 } | m=minus_id_body TArobArob { m } | m=minus_id_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_ty_body EOF { $1 } | p=plus_ty_body TArobArob { p } | p=plus_ty_body TArob { p } plus_id_main: plus_id_body EOF { $1 } | p=plus_id_body TArobArob { p } | p=plus_id_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 } | TIdentifier { Ast.IdP } | 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 ids=comma_list(pure_ident) { let names = List.map P.id2name ids 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 } | ar=arity ispure=pure TStatement 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.MetaStmListDecl(arity,name,lenname)) in !Data.add_stmlist_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 } | ar=arity TBinary TOperator ids=comma_list(pure_ident_or_meta_ident_with_binop_constraint) TMPtVirg { P.create_metadec_with_constraints ar Ast0.Impure (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaBinaryOperatorDecl(arity,name)) in !Data.add_binaryOp_meta name constraints pure; tok) ids } | ar=arity TAssignment TOperator ids=comma_list(pure_ident_or_meta_ident_with_assignop_constraint) TMPtVirg { P.create_metadec_with_constraints ar Ast0.Impure (fun arity name pure check_meta constraints -> let tok = check_meta(Ast.MetaAssignmentOperatorDecl(arity,name)) in !Data.add_assignOp_meta name constraints pure; tok) ids } pure_ident_or_meta_ident_with_binop_constraint: i=pure_ident_or_meta_ident c=binaryopconstraint { (i,c) } binaryopconstraint: { Ast0.BinaryOpNoConstraint } | TEq TOBrace ops=comma_list(binary_operator) TCBrace { Ast0.BinaryOpInSet ops } | TEq op=binary_operator { Ast0.BinaryOpInSet [op] } pure_ident_or_meta_ident_with_assignop_constraint: i=pure_ident_or_meta_ident c=assignopconstraint { (i,c) } assignopconstraint: { Ast0.AssignOpNoConstraint } | TEq TOBrace ops=comma_list(assignment_operator) TCBrace { Ast0.AssignOpInSet ops } | TEq op=assignment_operator { Ast0.AssignOpInSet [op] } binary_operator: | TShLOp { mkarithop $1 } (* Ast.Arith Ast.DecLeft *) | TMul { mkarithop (Ast.Mul,$1) } | TEqEq { mklogop (Ast.Eq,$1) } | TNotEq { mklogop (Ast.NotEq,$1) } | TSub { mklogop (Ast.InfEq,$1) } | TPlus { mkarithop (Ast.Plus,$1) } | TMinus { mkarithop (Ast.Minus,$1) } | TDmOp { mkarithop $1 } | TShROp { mkarithop $1 } | TAnd { mkarithop (Ast.And,$1) } | TOr { mkarithop (Ast.Or,$1) } | TXor { mkarithop (Ast.Xor,$1) } | TLogOp { mklogop $1 } | TAndLog { mklogop (Ast.AndLog,$1) } | TOrLog { mklogop (Ast.OrLog,$1) } assignment_operator: | TEq { let clt = $1 in let op' = P.clt2mcode "=" clt in Ast0.wrap (Ast0.SimpleAssign op') } | TOpAssign { let (op,clt) = $1 in let op' = P.clt2mcode op clt in Ast0.wrap (Ast0.OpAssign op') } 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 len = Ast.AnyLen in let tok = check_meta(Ast.MetaStmListDecl(arity,name,len)) in !Data.add_stmlist_meta name len 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")) } | TAttribute { (fun arity (_,name) pure check_meta -> if arity = Ast.NONE && pure = Ast0.Impure then (!Data.add_attribute name; []) else raise (Semantic_cocci.Semantic "bad attribute")) } | 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))) } | TGlobal TIdExpression ty=ioption(meta_exp_type) { (fun arity name pure check_meta constraints -> !Data.add_global_idexp_meta ty name constraints pure; check_meta(Ast.MetaGlobalIdExpDecl(arity,name,ty))) } | TGlobal TIdExpression m=nonempty_list(TMul) { (fun arity name pure check_meta constraints -> let ty = Some [P.ty_pointerify Type_cocci.Unknown m] in !Data.add_global_idexp_meta ty name constraints pure; check_meta(Ast.MetaGlobalIdExpDecl(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 true t] } | t=typedef_ctype TOCro TCCro { [Type_cocci.Array (Ast0_cocci.ast0_type_to_type true t)] } | TOBrace t=comma_list(ctype) TCBrace m=list(TMul) { List.map (function x -> P.ty_pointerify (Ast0_cocci.ast0_type_to_type true x) m) t } arity: 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.id2mcode lp,code,mids, P.id2mcode 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.id2mcode lp,code,mids, P.id2mcode 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.id2mcode lp,code,mids, P.id2mcode 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 $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 let (op,clt) = ("=",$2) in let op' = P.clt2mcode op clt in let op'' = Ast0.wrap (Ast0.SimpleAssign op') in Ast0.wrap (Ast0.Assignment (id, op'', 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($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*) } minus_id_body: f=loption(filespec) b=top_ident /*ew=loption(error_words)*/ { match f@[b](*@ew*) with [] -> raise (Semantic_cocci.Semantic "minus slice can't be empty") | code -> code } plus_id_body: f=loption(filespec) b=top_ident /*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,llne,offset,col,strbef,straft,pos,_) = P.id2clt $1 in let clt = (* default to one space whitespace *) (arity,ln,lln,llne,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,llne,offset,col,strbef,straft,pos,_) = P.id2clt $1 in let clt = (* default to one space whitespace *) (arity,ln,lln,llne,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 []) } | d=defineop t=ctype TLineEnd { let ty = Ast0.wrap(Ast0.TopExp(Ast0.wrap(Ast0.TypeExp(t)))) in d (Ast0.wrap [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 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 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,llineend,offset,col,strbef,straft,pos,ws) = clt in let lp = P.clt2mcode "(" (arity,line,lline,llineend,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 ($1 (fun _ d -> Ast0.wrap(Ast0.DPdots(P.clt2mcode "," d))) (fun c -> Ast0.DPComma c)) } /*****************************************************************************/ /* Lists of arguments in function declarations */ arg_list(arg): arglist=separated_llist(TComma, argorellipsis(one_arg(arg))) { let (args,vararg) = cleanup_arglist arglist in ((Ast0.wrap args), vararg) } argorellipsis(arg): arg=arg { Arg arg } | x=TVAEllipsis { VAEllipsis (x) } | y=TEllipsis { Ellipsis (y) } one_arg(arg): arg=arg { arg } | metaparamlist=TMetaParamList { let (nm,lenname,pure,clt) = metaparamlist 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)) } %inline separated_llist(separator, X): xs = reverse_separated_llist(separator, X) { xs } %inline reverse_separated_llist(separator, X): { [] } | xs = reverse_separated_nonempty_llist(separator, X) { xs } reverse_separated_nonempty_llist(separator, X): x = X { [ x ] } | xs = reverse_separated_nonempty_llist(separator, X); s=separator; x = X { x :: (Separator s) :: xs } | xs = reverse_separated_nonempty_llist(separator, X); s=separator; TNothing; x = X { x :: Nothing :: (Separator s) :: xs } funproto: s=ioption(storage) i=ioption(Tinline) t=ctype id=fn_ident lp=TOPar arglist=arg_list(name_opt_decl) rp=TCPar pt=TPtVirg { let s = match s with None -> [] | Some s -> [Ast0.FStorage s] in let i = match i with None -> [] | Some i -> [Ast0.FInline (P.clt2mcode "inline" i)] in let t = [Ast0.FType t] in let (args,vararg) = arglist in Ast0.wrap (Ast0.FunProto (s @ i @ t, id, P.clt2mcode "(" lp, args, vararg, P.clt2mcode ")" rp, P.clt2mcode ";" pt)) } | i=Tinline s=storage t=ctype id=fn_ident lp=TOPar arglist=arg_list(name_opt_decl) rp=TCPar pt=TPtVirg { let s = [Ast0.FStorage s] in let i = [Ast0.FInline (P.clt2mcode "inline" i)] in let t = [Ast0.FType t] in let (args,vararg) = arglist in Ast0.wrap (Ast0.FunProto (s @ i @ t, id, P.clt2mcode "(" lp, args, vararg, P.clt2mcode ")" rp, P.clt2mcode ";" pt)) } fundecl: f=fninfo TFunDecl i=fn_ident lp=TOPar arglist=arg_list(decl) rp=TCPar lb=TOBrace b=fun_start rb=TCBrace { let (args,vararg) = arglist in Ast0.wrap(Ast0.FunDecl((Ast0.default_info(),Ast0.context_befaft()), f, i, P.clt2mcode "(" (lp), args, vararg, P.clt2mcode ")" rp, P.clt2mcode "{" lb, b, P.clt2mcode "}" rb, (Ast0.default_info(),Ast0.context_befaft()))) } 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 } | Texec TIdent exec_list TPtVirg { Ast0.wrap( Ast0.Exec(P.clt2mcode "EXEC" $1,P.clt2mcode (fst $2) (snd $2), Ast0.wrap $3,P.clt2mcode ";" $4)) } 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.id2mcode $1, List.map (function x -> Ast0.wrap [x]) code, mids, P.id2mcode $3)) } | TOPar0 andzero_list(rule_elem_statement,rule_elem_statement) TCPar0 { let (mids,code) = $2 in Ast0.wrap (Ast0.Conj(P.id2mcode $1, List.map (function x -> Ast0.wrap [x]) code, mids, P.id2mcode $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.id2mcode $1, List.map (function x -> Ast0.wrap [x]) code, mids, P.id2mcode $3)) } | TOPar0 andzero_list(statement,statement) TCPar0 /* degenerate case, elements are single statements and thus don't contain dots */ { let (mids,code) = $2 in Ast0.wrap (Ast0.Conj(P.id2mcode $1, List.map (function x -> Ast0.wrap [x]) code, mids, P.id2mcode $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.id2mcode lp,code,mids, P.id2mcode 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))] } | s=ioption(storage) d=decl_ident o=TOPar e=eexpr_list_option c=TCPar p=TPtVirg { [Ast0.wrap(Ast0.MacroDecl(s,d,P.clt2mcode "(" o,e, P.clt2mcode ")" c,P.clt2mcode ";" p))] } | s=ioption(storage) d=decl_ident o=TOPar e=eexpr_list_option c=TCPar q=TEq i=initialize p=TPtVirg { [Ast0.wrap (Ast0.MacroDeclInit (s,d,P.clt2mcode "(" o,e, P.clt2mcode ")" c,P.clt2mcode "=" q,i, P.clt2mcode ";" p))] } | 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)) } | s=ioption(storage) d=decl_ident o=TOPar e=eexpr_list_option c=TCPar p=TPtVirg { Ast0.wrap(Ast0.MacroDecl(s,d,P.clt2mcode "(" o,e, P.clt2mcode ")" c,P.clt2mcode ";" p)) } | s=ioption(storage) d=decl_ident o=TOPar e=eexpr_list_option c=TCPar q=TEq i=initialize p=TPtVirg { Ast0.wrap (Ast0.MacroDeclInit (s,d,P.clt2mcode "(" o,e, P.clt2mcode ")" c,P.clt2mcode "=" q,i, P.clt2mcode ";" p)) } | 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($1 P.mkidots (fun c -> Ast0.IComma c)) } /* a statement that is part of a list */ decl_statement: TMetaStmList { [P.meta_stm_list $1] } | 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 [] -> true | _ -> false) code then [] else [Ast0.wrap(Ast0.Disj(P.id2mcode $1, code, mids, P.id2mcode $3))] } | TOPar0 t=andzero_list(fun_start,fun_start) TCPar0 { let (mids,code) = t in if List.for_all (function x -> match Ast0.unwrap x with [] -> true | _ -> false) code then [] else [Ast0.wrap(Ast0.Conj(P.id2mcode $1, code, mids, P.id2mcode $3))] } /* a statement that is part of a list */ decl_statement_expr: TMetaStmList { [P.meta_stm_list $1] } | 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 Ast0.wrap code in [Ast0.wrap(Ast0.Disj(P.id2mcode $1, dot_code, mids, P.id2mcode $3))] } | TOPar0 t=andzero_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 Ast0.wrap code in [Ast0.wrap(Ast0.Conj(P.id2mcode $1, dot_code, mids, P.id2mcode $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(e (P.mkedots "...")), P.clt2mcode "...>" c, None, false)) } | TPOEllipsis e=expr_dots(TEllipsis) c=TPCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<+..." $1, Ast0.wrap(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(e (P.mkedots "...")), P.clt2mcode "...>" c, None, false)) } | TPOEllipsis e=expr_dots(TEllipsis) c=TPCEllipsis { Ast0.wrap(Ast0.NestExpr(P.clt2mcode "<+..." $1, Ast0.wrap(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) TOpAssign assign_expr_bis { let (op,clt) = $2 in let op' = P.clt2mcode op clt in let op'' = Ast0.wrap (Ast0.OpAssign op') in Ast0.wrap(Ast0.Assignment($1, op'', Ast0.set_arg_exp $3,false)) } | unary_expr(r,pe) TEq assign_expr_bis { let (op,clt) = ("=",$2) in let op' = P.clt2mcode op clt in let op'' = Ast0.wrap (Ast0.SimpleAssign op') in Ast0.wrap (Ast0.Assignment ($1, op'', Ast0.set_arg_exp $3,false)) } | unary_expr(r,pe) TMetaAssignOp assign_expr_bis { let (mv, cstrt, pure, clt) = $2 in let op' = P.clt2mcode mv clt in let op'' = Ast0.wrap (Ast0.MetaAssign (op', cstrt, pure)) in Ast0.wrap (Ast0.Assignment ($1, op'', Ast0.set_arg_exp $3,false)) } assign_expr_bis: cond_expr(eexpr,dot_expressions) { $1 } | unary_expr(eexpr,dot_expressions) TOpAssign assign_expr_bis { let (op,clt) = $2 in let op' = P.clt2mcode op clt in let op'' = Ast0.wrap (Ast0.OpAssign op') in Ast0.wrap(Ast0.Assignment($1, op'', Ast0.set_arg_exp $3,false)) } | unary_expr(eexpr,dot_expressions) TEq assign_expr_bis { let (op,clt) = ("=",$2) in let op' = P.clt2mcode op clt in let op'' = Ast0.wrap (Ast0.SimpleAssign op') in Ast0.wrap (Ast0.Assignment ($1, op'', 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 } | arith_expr(r,pe) TMetaBinaryOp arith_expr_bis { let (mv, cstrt, pure, clt) = $2 in let op' = P.clt2mcode mv clt in let op = Ast0.wrap (Ast0.MetaBinary (op', cstrt, pure)) in Ast0.wrap (Ast0.Binary($1, op, $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)) } | 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)) } | 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 } | TBang { P.clt2mcode Ast.Not $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)) } | TMetaGlobalIdExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.GlobalID,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.id2mcode $1, code, mids, P.id2mcode $3)) } | TOPar0 andzero_list(recurser,eexpr) TCPar0 { let (mids,code) = $2 in Ast0.wrap(Ast0.ConjExpr(P.id2mcode $1, code, mids, P.id2mcode $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} | TEq ne=idcstr {Ast.IdPosIdSet (fst ne,snd ne)} | TNotEq ne=idcstr {Ast.IdNegIdSet (fst ne,snd 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) } idcstr: 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 ([],[i]) | (None,i) -> ([i],[])) } | 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 (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.id2mcode lp,code,mids, P.id2mcode rp)) } top_ident: disj_ident { Ast0.wrap(Ast0.OTHER(Ast0.wrap(Ast0.TopId($1)))) } 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 ($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 -> [] } | list=nonempty_list_start(elem,dotter) { list } nonempty_list_start(elem,dotter): /* dots allowed */ element=elem { fun build_dots build_comma -> [element] } | element=elem comma=TComma { fun build_dots build_comma -> element::[Ast0.wrap(build_comma(P.clt2mcode "," comma))] } | element=elem comma=TComma remainder=nonempty_list_start(elem,dotter) { fun build_dots build_comma -> element::(Ast0.wrap(build_comma(P.clt2mcode "," comma))):: (remainder build_dots build_comma) } | TNothing list=nonempty_list_start(elem,dotter) { list } | dotter=dotter { fun build_dots build_comma -> [(build_dots "..." dotter)] } | dotter=dotter comma=TComma { fun build_dots build_comma -> [(build_dots "..." dotter);Ast0.wrap(build_comma(P.clt2mcode "," comma))] } | dotter=dotter comma=TComma remainder=continue_list(elem,dotter) { fun build_dots build_comma -> (build_dots "..." dotter):: (Ast0.wrap(build_comma(P.clt2mcode "," comma))):: (remainder build_dots build_comma) } continue_list(elem,dotter): /* dots not allowed */ element=elem { fun build_dots build_comma -> [element] } | element=elem comma=TComma { fun build_dots build_comma -> element::[Ast0.wrap(build_comma(P.clt2mcode "," comma))] } | element=elem comma=TComma remainder=nonempty_list_start(elem,dotter) { fun build_dots build_comma -> element::(Ast0.wrap(build_comma(P.clt2mcode "," comma))):: (remainder build_dots build_comma) } | TNothing list=nonempty_list_start(elem,dotter) { list } /* ---------------------------------------------------------------------- */ /* 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 $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 $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.wrap(Ast0.Exp($1)))::$2) } | decl_statement toplevel_after_stm { Ast0.wrap($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 ($1 (fun _ d -> Ast0.wrap(Ast0.Edots(P.clt2mcode "..." d,None))) (fun c -> Ast0.EComma c)) } /****************************************************************************/ // IBM C only exec_list: /* empty */ { [] } | TDotDot exec_front_ident exec_ident exec_list { Ast0.wrap(Ast0.ExecEval(P.clt2mcode ":" $1,$3 $2)) :: $4 } | TIdent exec_ident2 exec_list { Ast0.wrap(Ast0.ExecToken(P.clt2mcode (fst $1) (snd $1))) :: List.map (function x -> Ast0.wrap(Ast0.ExecToken x)) $2 @ $3 } | token exec_list { Ast0.wrap(Ast0.ExecToken $1) :: $2 } | TEllipsis exec_list { Ast0.wrap(Ast0.ExecDots(P.clt2mcode "..." $1)) :: $2 } exec_front_ident: ident { Ast0.wrap(Ast0.Ident($1)) } | TMetaIdExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ID,pure)) } | TMetaExp { let (nm,constraints,pure,ty,clt) = $1 in Ast0.wrap (Ast0.MetaExpr(P.clt2mcode nm clt,constraints,ty,Ast.ANY,pure)) } exec_ident: { function prev -> prev } | TDot disj_ident exec_ident { function prev -> $3 (Ast0.wrap(Ast0.RecordAccess(prev, P.clt2mcode "." $1, $2))) } | TPtrOp disj_ident exec_ident { function prev -> $3 (Ast0.wrap(Ast0.RecordPtAccess(prev, P.clt2mcode "->" $1, $2))) } exec_ident2: { [] } | TDot TIdent exec_ident2 { (P.clt2mcode "." $1) :: (P.clt2mcode (fst $2) (snd $2)) :: $3 } | TPtrOp TIdent exec_ident2 { (P.clt2mcode "." $1) :: (P.clt2mcode (fst $2) (snd $2)) :: $3 } token: TPlus { P.clt2mcode "+" $1 } | TMinus { P.clt2mcode "-" $1 } | TMul { P.clt2mcode "*" $1 } | TEqEq { P.clt2mcode "==" $1 } | TNotEq { P.clt2mcode "!=" $1 } | TDmOp { P.clt2mcode (arithOp(fst $1)) (snd $1) } | TShLOp { P.clt2mcode (arithOp(fst $1)) (snd $1) } | TShROp { P.clt2mcode (arithOp(fst $1)) (snd $1) } | TLogOp { P.clt2mcode (logicalOp(fst $1)) (snd $1) } | TOr { P.clt2mcode "|" $1 } | TXor { P.clt2mcode "+" $1 } | TAnd { P.clt2mcode "&" $1 } | TOrLog { P.clt2mcode "||" $1 } | TAndLog { P.clt2mcode "&&" $1 } | TOBrace { P.clt2mcode "{" $1 } | TCBrace { P.clt2mcode "}" $1 } | TOCro { P.clt2mcode "[" $1 } | TCCro { P.clt2mcode "]" $1 } | TEq { P.clt2mcode "=" $1 } | TWhy { P.clt2mcode "?" $1 } | TBang { P.clt2mcode "!" $1 } | TOPar { P.clt2mcode "(" $1 } | TCPar { P.clt2mcode ")" $1 } | TIf { P.clt2mcode "if" $1 } | TElse { P.clt2mcode "else" $1 } /****************************************************************************/ // non-empty lists - drop separator %inline comma_list(elem): l=separated_nonempty_list(TComma,elem) { l } 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.id2mcode a, b) } andzero_list(elem,aft): a=elem b=nonempty_list(azl(aft)) { let (mids,code) = List.split b in (mids,(a::code)) } azl(elem): a=TAnd0 b=elem { (P.id2mcode a, b) } edots_when(dotter,when_grammar): d=dotter { (d,None) } | d=dotter t=TWhen e=TNotEq w=when_grammar TLineEnd { (d, Some (P.clt2mcode "when" t, P.clt2mcode "!=" e,w)) } whens(when_grammar,simple_when_grammar,any_strict): t=TWhen e=TNotEq w=when_grammar TLineEnd { [Ast0.WhenNot (P.clt2mcode "when" t, P.clt2mcode "!=" e, w)] } | t=TWhen e=TEq w=simple_when_grammar TLineEnd { [Ast0.WhenAlways (P.clt2mcode "when" t, P.clt2mcode "=" e, w)] } | t=TWhen l=comma_list(any_strict) TLineEnd { List.map (function x -> Ast0.WhenModifier(P.clt2mcode "when" t,x)) l } | t=TWhenTrue ee=TNotEq e = eexpr TLineEnd { [Ast0.WhenNotTrue (P.clt2mcode "when" t, P.clt2mcode "!=" ee, e)] } | t=TWhenFalse ee=TNotEq e = eexpr TLineEnd { [Ast0.WhenNotFalse (P.clt2mcode "when" t, P.clt2mcode "!=" ee, 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 { () } | TWhitespace { () } script_meta_main: py=pure_ident TMPtVirg { ((Some (P.id2name py), None), None, Ast.NoMVInit) } | py=pure_ident script_name_decl_ext TMPtVirg { ((Some (P.id2name py), None), Some (fst $2), snd $2) } | TOPar TUnderscore TComma ast=pure_ident TCPar script_name_decl TMPtVirg { ((None, Some (P.id2name ast)), Some $6, Ast.NoMVInit) } | TOPar str=pure_ident TComma TUnderscore TCPar script_name_decl_ext TMPtVirg { ((Some (P.id2name str), None), Some (fst $6), snd $6) } | TOPar str=pure_ident TComma ast=pure_ident TCPar script_name_decl TMPtVirg { ((Some (P.id2name str), Some (P.id2name ast)), Some $6, Ast.NoMVInit) } 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) } script_name_decl_ext: script_name_decl { ($1,Ast.NoMVInit) } | script_name_decl TEq TString { let (nm,mv) = $1 in match mv with Ast.MetaPosDecl _ -> raise (Semantic_cocci.Semantic "default value of position variable should be a list") | _ -> let (s,clt) = $3 in ($1,Ast.MVInitString s) } | script_name_decl TEq TOCro TCCro { let (nm,mv) = $1 in match mv with Ast.MetaPosDecl _ -> ($1,Ast.MVInitPosList) (* just empty, so nothing to record *) | _ -> raise (Semantic_cocci.Semantic "default value of non-position variable should be a string") } script_meta_virt_nofresh_main: py=pure_ident script_virt_name_decl TMPtVirg { ((Some (P.id2name py), None), Some $2, Ast.NoMVInit) } script_virt_name_decl: 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.4/parsing_cocci/tests/0000755000175000017500000000000012614153277016561 5ustar eugeneugencoccinelle-1.0.4/parsing_cocci/tests/30.cocci0000644000175000017500000000056012614153277020006 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.4/parsing_cocci/tests/8.cocci0000644000175000017500000000122012614153277017725 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.4/parsing_cocci/tests/26.cocci0000644000175000017500000000025212614153277020011 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.4/parsing_cocci/tests/22.cocci0000644000175000017500000000103212614153277020002 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.4/parsing_cocci/tests/3.cocci0000644000175000017500000000122412614153277017724 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.4/parsing_cocci/tests/21.cocci0000644000175000017500000000074712614153277020015 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.4/parsing_cocci/tests/13.cocci0000644000175000017500000000022712614153277020007 0ustar eugeneugen@@ expression E; @@ - printk("... %s ...", + printk("... %u.%u.%u.%u ...", ..., - in_ntoa(E), + NIPQUAD(E), ...); coccinelle-1.0.4/parsing_cocci/tests/4.cocci0000644000175000017500000000071312614153277017727 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.4/parsing_cocci/tests/7.cocci0000644000175000017500000000010312614153277017723 0ustar eugeneugen@@ @@ if (blk_queue_empty(QUEUE)) { - CLEAR_INTR; ... } coccinelle-1.0.4/parsing_cocci/tests/29.cocci0000644000175000017500000000035712614153277020022 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.4/parsing_cocci/tests/9.cocci0000644000175000017500000000111112614153277017725 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.4/parsing_cocci/tests/18.cocci0000644000175000017500000000057212614153277020017 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.4/parsing_cocci/tests/2.cocci0000644000175000017500000000050312614153277017722 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.4/parsing_cocci/tests/25.cocci0000644000175000017500000000052112614153277020007 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.4/parsing_cocci/tests/problems0000644000175000017500000000141112614153277020324 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.4/parsing_cocci/tests/10.cocci0000644000175000017500000000016012614153277020000 0ustar eugeneugen@@ expression E; @@ - pnp_activate_dev(E, NULL) + pnp_activate_dev(E) @@ @@ error words = [pnp_activate_dev] coccinelle-1.0.4/parsing_cocci/tests/24.cocci0000644000175000017500000000000012614153277017776 0ustar eugeneugencoccinelle-1.0.4/parsing_cocci/tests/19.cocci0000644000175000017500000000073112614153277020015 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.4/parsing_cocci/tests/23.cocci0000644000175000017500000000054712614153277020015 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.4/parsing_cocci/tests/12.cocci0000644000175000017500000000102212614153277020000 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.4/parsing_cocci/tests/17.cocci0000644000175000017500000000032412614153277020011 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.4/parsing_cocci/tests/14.cocci0000644000175000017500000000052112614153277020005 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.4/parsing_cocci/tests/11.cocci0000644000175000017500000000310712614153277020005 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.4/parsing_cocci/tests/16.cocci0000644000175000017500000000012512614153277020007 0ustar eugeneugen@@ @@ --- a/drivers/scsi/... +++ b/drivers/scsi/... - ATA_MAX_PRD + LIBATA_MAX_PRD coccinelle-1.0.4/parsing_cocci/tests/20.cocci0000644000175000017500000000101612614153277020002 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.4/parsing_cocci/tests/27.cocci0000644000175000017500000000023212614153277020010 0ustar eugeneugen@@ local function f; struct IsdnCard card; @@ card.irq_func = f @@ fresh identifier mode_switch; @@ f(... + , int mode_switch ) { ... } coccinelle-1.0.4/parsing_cocci/tests/1.cocci0000644000175000017500000000040412614153277017721 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.4/parsing_cocci/tests/Makefile0000644000175000017500000000473612614153277020233 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.4/parsing_cocci/tests/5.cocci0000644000175000017500000000073212614153277017731 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.4/parsing_cocci/tests/28.cocci0000644000175000017500000000032612614153277020015 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.4/parsing_cocci/tests/15.cocci0000644000175000017500000000027012614153277020007 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.4/parsing_cocci/tests/6.cocci0000644000175000017500000001431612614153277017735 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.4/parsing_cocci/Makefile0000644000175000017500000000724712614153277017071 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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 stmtlist.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 dpll.ml get_constants2.ml id_utils.ml git_grep.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) 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 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) $(PARSER_SOURCES:.mly=.ml) $(PARSER_SOURCES:.mly=.mli) : $(PARSER_SOURCES) $(MENHIR) --ocamlc "${OCAMLC}" --ocamldep "${OCAMLDEP}" --table --base parser_cocci_menhir $(PARSER_SOURCES) $(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 .PHONY: 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) -include .depend endif endif include ../Makefile.common coccinelle-1.0.4/parsing_cocci/merge.ml0000644000175000017500000001510012614153277017045 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/parsing_cocci/parse_printf.mli0000644000175000017500000000046712614153277020625 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) exception Not_format_string val get_format_string : string -> string * string coccinelle-1.0.4/parsing_cocci/comm_assoc.mli0000644000175000017500000000054312614153277020247 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val comm_assoc : Ast0_cocci.rule -> string (* rule name *) -> string list (* dropped isos *) -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/function_prototypes.ml0000644000175000017500000004251512614153277022115 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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) -> get_name id (* --------------------------------------------------------------------- *) (* collect all of the functions *) let make_semi info = 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}; Ast0.mcode_start = []; Ast0.mcode_end = []} in let (tok,arity,_,mcodekind,pos,adj) = Ast0.make_mcode ";" in (tok,arity,info,mcodekind,pos,adj) let collect_function (stm : Ast0.statement) = match Ast0.unwrap stm with Ast0.FunDecl((bef_info,_), fninfo,name,lp,params,va,rp,lbrace,body,rbrace, (aft_info,_)) -> let new_bef_info = {(Ast0.default_info()) with Ast0.strings_before = bef_info.Ast0.strings_before} in List.map (function nm -> (nm,stm, Ast0.copywrap stm (Ast0.Decl((new_bef_info,Ast0.context_befaft()), Ast0.copywrap stm (Ast0.FunProto (fninfo,name,lp,params,None,rp,make_semi aft_info)))))) (get_name name) | _ -> [] let collect_functions stmt_dots = List.concat (List.map collect_function (Ast0.unwrap 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 mcode mcode donothing donothing donothing 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. *) 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,constraints,seed,Ast0.Pure) | Ast0.MetaFunc(nm,constraints,pure) -> Ast0.MetaFunc(nm,constraints,Ast0.Pure) | Ast0.MetaLocalFunc(nm,constraints,pure) -> Ast0.MetaLocalFunc(nm,constraints,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 mcode mcode donothing donothing donothing donothing donothing donothing ident donothing donothing donothing typeC donothing param donothing 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 collect_ident_strings id = let bind x y = x @ y in let option_default = [] in let donothing r k e = k e in let mcode (_,_,info,_,_,_) = info.Ast0.strings_before @ info.Ast0.strings_after in let v = V0.flat_combiner bind option_default mcode mcode 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.VT0.combiner_rec_ident id let right_attach_mcode strings (x,ar,info,mc,pos,adj) = let info = {info with Ast0.strings_after = info.Ast0.strings_after @ strings} in (x,ar,info,mc,pos,adj) let rec right_attach_ident strings id = Ast0.rewrap id (match Ast0.unwrap id with Ast0.Id(name) -> Ast0.Id(right_attach_mcode strings name) | Ast0.MetaId(name,x,y,z) -> Ast0.MetaId(right_attach_mcode strings name,x,y,z) | Ast0.AsIdent(id,asid) -> Ast0.AsIdent(right_attach_ident strings id,asid) | _ -> failwith "disj, opt, and funcs not supported") let rec attach_right strings ty = Ast0.rewrap ty (match Ast0.unwrap ty with Ast0.ConstVol(cv,ty) -> Ast0.ConstVol(cv,attach_right strings ty) | Ast0.BaseType(bt,sl) -> let slhd = right_attach_mcode strings (List.hd(List.rev sl)) in Ast0.BaseType(bt,List.rev (slhd :: (List.tl (List.rev sl)))) | Ast0.Signed(sgn,None) -> Ast0.Signed(right_attach_mcode strings sgn,None) | Ast0.Signed(sgn,Some ty) -> Ast0.Signed(sgn,Some (attach_right strings ty)) | Ast0.Pointer(ty,star) -> Ast0.Pointer(ty,right_attach_mcode strings star) | Ast0.FunctionPointer(ty,lp,star,rp,lp1,ps,rp1) -> Ast0.FunctionPointer(ty,lp,star,rp,lp1,ps, right_attach_mcode strings rp1) | Ast0.Array(ty,lb,e,rb) -> Ast0.Array(ty,lb,e,right_attach_mcode strings rb) | Ast0.Decimal(dec,lp,e1,comma,e2,rp) -> Ast0.Decimal(dec,lp,e1,comma,e2,right_attach_mcode strings rp) | Ast0.EnumName(enum,None) -> Ast0.EnumName(right_attach_mcode strings enum, None) | Ast0.EnumName(enum,Some id) -> Ast0.EnumName(enum,Some (right_attach_ident strings id)) | Ast0.EnumDef(ty,lb,es,rb) -> Ast0.EnumDef(ty,lb,es,right_attach_mcode strings rb) | Ast0.StructUnionName(su,None) -> Ast0.StructUnionName(right_attach_mcode strings su, None) | Ast0.StructUnionName(su,Some id) -> Ast0.StructUnionName(su,Some (right_attach_ident strings id)) | Ast0.StructUnionDef(ty,lb,decls,rb) -> Ast0.StructUnionDef(ty,lb,decls,right_attach_mcode strings rb) | Ast0.TypeName(nm) -> Ast0.TypeName(right_attach_mcode strings nm) | Ast0.MetaType(nm,pure) -> Ast0.MetaType(right_attach_mcode strings nm,pure) | Ast0.AsType(ty,asty) -> Ast0.AsType(attach_right strings ty,asty) | _ -> failwith "disj and opt type not supported") let rec drop_param_name p = Ast0.rewrap p (match Ast0.unwrap p with Ast0.Param(p,Some id) -> let strings = collect_ident_strings id in let p = attach_right strings p in Ast0.Param(p,None) | Ast0.OptParam(p) -> Ast0.OptParam(drop_param_name 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,proto) -> (match Ast0.unwrap proto with Ast0.FunProto(fninfo,name,lp,params,va,rp,sem) -> let params = Ast0.rewrap params (List.map drop_param_name (Ast0.unwrap params)) in Ast0.rewrap dec (Ast0.Decl (info, Ast0.rewrap proto (Ast0.FunProto(fninfo,name,lp,params,va,rp,sem)))) | _ -> 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))) | _ -> ([],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,proto) -> (match Ast0.unwrap proto with Ast0.FunProto(fninfo,name,lp,params,va,rp,sem) -> let (metavars,newdec) = let (metavars,l) = let params = Ast0.unwrap 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 proto (Ast0.FunProto (fninfo,name,lp,Ast0.rewrap params l,va,rp,sem))))) in let (def_metavars,newdef) = match Ast0.unwrap mdef with Ast0.FunDecl(x,fninfo,name,lp,params,va,rp,lb,body,rb,y) -> let (def_metavars,def_l) = let params = Ast0.unwrap 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 def_l,va, rp,lb,body,rb,y))) | _ -> failwith "unexpected function definition" in (metavars,def_metavars,newdec,newdef) | _ -> 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,proto) -> (match Ast0.unwrap proto with Ast0.FunProto(fninfo,name,lp,params,va,rp,sem) -> let sem = (* convert semicolon to minus, since we are dropping the whole thing *) let (_,_,info,_,_,_) = sem in let (tok,arity,_,mcodekind,pos,adj) = Ast0.make_minus_mcode ";" in (tok,arity,info,mcodekind,pos,adj) in Ast0.rewrap dec (Ast0.Decl (info, Ast0.rewrap proto (Ast0.FunProto (fninfo,name,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.rewrap params (Ast0.Pdots(pdots))]), va,rp,sem)))) | _ -> dec) | _ -> dec let mkcode proto = Ast0.copywrap proto (Ast0.CODE(Ast0.copywrap proto [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.unwrap 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,va,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,va,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.unwrap rule_elem_dots with [f] -> (match Ast0.unwrap f with Ast0.FunDecl(_,fninfo,name,lp,params,va,rp,lbrace,body, rbrace,_) -> (try Ast0.rewrap x (Ast0.CODE(Ast0.rewrap x [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 [proto])) let process rule_name rule_metavars dropped_isos minus plus ruletype = if List.mem "prototypes" dropped_isos then ((rule_metavars,minus),None) else 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 [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.4/parsing_cocci/cocci_grep.mli0000644000175000017500000000057112614153277020222 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val interpret : (Str.regexp * Str.regexp list) (*pattern*) -> string (*filename*) -> bool val split : string list list -> string list list coccinelle-1.0.4/parsing_cocci/flag_parsing_cocci.ml0000644000175000017500000000165712614153277021556 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 *) let in_minus = ref false let debug_parse_cocci = ref false (* When using the parser to generate hardened semantic patches *) let generating_mode = ref false coccinelle-1.0.4/parsing_cocci/cocci_grep.ml0000644000175000017500000000757412614153277020063 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 = try open_in file with _ -> raise (Flag.UnreadableFile 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.4/parsing_cocci/index.ml0000644000175000017500000001672612614153277017074 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* create an index for each constructor *) (* current max is 188, also unused: 7-9, 15, 39, 40, 42, 46, 57, 65, 67, 85-86, 88, 111, 113-115, 134-136, 138-140 *) (* 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 dots d = match Ast0.unwrap d with [] -> [(Ast0.get_info d).Ast0.pos_info.Ast0.line_start] | _ -> [0] let expression_dots x = 1 :: dots x let initialiser_dots x = 2 :: dots x let parameter_dots x = 3 :: dots x let statement_dots x = 4 :: dots x let declaration_dots x = 5 :: dots x let case_line_dots x = 6 :: dots x 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.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.ConjExpr(_,expr_list,_,_) -> [187] | Ast0.NestExpr(_,expr_dots,_,_,_) -> [37] | Ast0.Edots(dots,whencode) -> [38] | Ast0.OptExp(exp) -> [41] | Ast0.AsExpr _ | Ast0.AsSExpr _ -> failwith "not possible" let assignOp op = match Ast0.unwrap op with | Ast0.SimpleAssign _ -> [180] | Ast0.OpAssign _ -> [181] | Ast0.MetaAssign(_,_,_) -> [182] let binaryOp op = match Ast0.unwrap op with | Ast0.Arith _ -> [183] | Ast0.Logical _ -> [184] | Ast0.MetaBinary(_,_,_) -> [185] 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.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.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.FunProto(fi,name,lp1,params,va,rp1,sem) -> [132] | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> [137] | Ast0.MacroDeclInit(stg,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.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.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.OptParam(param) -> [66] | Ast0.AsParam _ -> failwith "not possible" let statement s = match Ast0.unwrap s with Ast0.FunDecl(bef,fninfo,name,lp,params,va,rp,lbrace,body,rbrace,aft) -> [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.Exec(exec,lang,code,sem) -> [170] | Ast0.MetaStmt(name,_) -> [79] | Ast0.MetaStmtList(name,_,_) -> [80] | Ast0.Disj(_,statement_dots_list,_,_) -> [81] | Ast0.Conj(_,statement_dots_list,_,_) -> [188] | Ast0.Nest(_,stmt_dots,_,_,_) -> [82] | Ast0.Exp(exp) -> [83] | Ast0.TopExp(exp) -> [141] | Ast0.Ty(ty) -> [124] | Ast0.TopId(ty) -> [186] | Ast0.TopInit(init) -> [146] | Ast0.Dots(d,whencode) -> [84] | 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.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 string_fragment f = match Ast0.unwrap f with Ast0.ConstantFragment(str) -> [166] | Ast0.FormatFragment(pct,fmt) -> [167] | Ast0.Strdots(dots) -> [168] | Ast0.MetaFormatList(pct,name,lenname) -> [169] 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.4/parsing_cocci/unify_ast.ml0000644000175000017500000006661512614153277017770 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* --------------------------------------------------------------------- *) (* 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 unify_assignOp_mcode op1 op2 = match (Ast.unwrap op1, Ast.unwrap op2) with | (Ast.SimpleAssign op1', Ast.SimpleAssign op2') -> unify_mcode op1' op2' | (Ast.OpAssign op1', Ast.OpAssign op2') -> unify_mcode op1' op2' | (Ast.MetaAssign(mv1,_,_,_), Ast.MetaAssign(mv2,_,_,_)) -> unify_mcode mv1 mv2 | _ -> false let unify_binaryOp_mcode op1 op2 = match (Ast.unwrap op1, Ast.unwrap op2) with | (Ast.Arith op1', Ast.Arith op2') -> unify_mcode op1' op2' | (Ast.Logical op1', Ast.Logical op2') -> unify_mcode op1' op2' | (Ast.MetaBinary(mv1,_,_,_), Ast.MetaBinary(mv2,_,_,_)) -> unify_mcode mv1 mv2 | _ -> false 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 let conjunct_all_bindings = List.fold_left conjunct_bindings MAYBE (* --------------------------------------------------------------------- *) (* 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 || dfn curb then MAYBE else NO) in loop (la,lb) let unify_dots fn dfn d1 d2 = unify_lists fn dfn (Ast.unwrap d1) (Ast.unwrap d2) let edots e = match Ast.unwrap e with Ast.Edots(_,_) -> true | _ -> false let ddots e = match Ast.unwrap e with Ast.Ddots(_,_) -> true | _ -> false let pdots p = match Ast.unwrap p with Ast.Pdots(_) -> true | _ -> false let dpdots e = match Ast.unwrap e with Ast.DPdots(_) -> true | _ -> false let sdots s = match Ast.unwrap s with Ast.Dots(_,_,_,_) -> 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 let ecdots e = match Ast.unwrap e with Ast.ExecDots(_) -> 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.OptIdent(_)) -> 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_assignOp_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_binaryOp_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]) (* no idea what to do with the statement *) | (Ast.AsSExpr(exp1,asstm1),_) -> unify_expression exp1 e2 | (_,Ast.AsSExpr(exp2,asstm2)) -> unify_expression exp2 e2 | (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.ConjExpr(e1),_) -> conjunct_all_bindings (List.map (function x -> unify_expression x e2) e1) | (_,Ast.ConjExpr(e2)) -> conjunct_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(_,_)) -> return true | (Ast.OptExp(_),_) | (_,Ast.OptExp(_)) -> 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.OptType(_)) -> 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.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_annotated_decl 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.FunProto(fi1,nm1,lp1,params1,va1,rp1,sem1), Ast.FunProto(fi2,nm2,lp2,params2,va2,rp2,sem2)) -> let l1 = match va1 with | None -> [lp1;rp1] | Some (c1,e1) -> [lp1;c1;e1;rp1] in let l2 = match va2 with | None -> [lp2;rp2] | Some (c2,e2) -> [lp2;c2;e2;rp2] in if List.for_all2 unify_mcode l1 l2 then conjunct_bindings (unify_fninfo fi1 fi2) (conjunct_bindings (unify_ident nm1 nm2) (unify_dots unify_parameterTypeDef pdots params1 params2)) else return false | (Ast.MacroDecl(s1,n1,lp1,args1,rp1,sem1), Ast.MacroDecl(s2,n2,lp2,args2,rp2,sem2)) -> if bool_unify_option unify_mcode s1 s2 then conjunct_bindings (unify_ident n1 n2) (unify_dots unify_expression edots args1 args2) else return false | (Ast.MacroDeclInit(s1,n1,lp1,args1,rp1,eq1,ini1,sem1), Ast.MacroDeclInit(s2,n2,lp2,args2,rp2,eq2,ini2,sem2)) -> if bool_unify_option unify_mcode s1 s2 then conjunct_bindings (unify_ident n1 n2) (conjunct_bindings (unify_dots unify_expression edots args1 args2) (unify_initialiser ini1 ini2)) else return false | (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) | (Ast.OptDecl(_),_) | (_,Ast.OptDecl(_)) -> failwith "unsupported decl" | _ -> return false and unify_annotated_decl d1 d2 = match (Ast.unwrap d1,Ast.unwrap d2) with (Ast.DElem(_,_,d1),Ast.DElem(_,_,d2)) -> unify_declaration d1 d2 (* dots can match against anything. return true to be safe. *) | (Ast.Ddots(_,_),_) | (_,Ast.Ddots(_,_)) -> return true (* --------------------------------------------------------------------- *) (* 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.OptIni(_)) -> 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(_)) -> 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.OptParam(_)) -> 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(_)) -> return true | (Ast.OptDParam(_),_) | (_,Ast.OptDParam(_)) -> 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,va1,rp1), Ast.FunHeader(_,_,fi2,nm2,lp2,params2,v2,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_annotated_decl 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_annotated_decl 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.Exec(exec1,lang1,code1,sem1),Ast.Exec(exec2,lang2,code2,sem2)) -> if unify_mcode lang1 lang2 then unify_dots unify_exec_code ecdots code1 code2 else return false | (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 unify_exec_code ec1 ec2 = match (Ast.unwrap ec1,Ast.unwrap ec2) with (Ast.ExecEval(colon1,id1),Ast.ExecEval(colon2,id2)) -> unify_expression id1 id2 | (Ast.ExecToken(tok1),Ast.ExecToken(tok2)) -> return (unify_mcode tok1 tok2) | (Ast.ExecDots(_),_) | (_,Ast.ExecDots(_)) -> return true | _ -> return false 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 mcode mcode donothing donothing donothing donothing donothing donothing expr donothing donothing donothing 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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing fullType donothing 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 [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 [s1] in disjunct_all_bindings (List.map (function x -> unify_dots unify_statement sdots s1 x) s2) | (Ast.Conj(s1),_) -> let s2 = Ast.rewrap s2 [s2] in conjunct_all_bindings (List.map (function x -> unify_dots unify_statement sdots x s2) s1) | (_,Ast.Conj(s2)) -> let s1 = Ast.rewrap s1 [s1] in conjunct_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(_,_,_,_)) -> return true | (Ast.OptStm(_),_) | (_,Ast.OptStm(_)) -> failwith "unsupported statement" | _ -> return false let unify_statement_dots = unify_dots unify_statement sdots coccinelle-1.0.4/parsing_cocci/adjust_pragmas.mli0000644000175000017500000000043212614153277021125 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val process : Ast0_cocci.rule -> Ast0_cocci.rule coccinelle-1.0.4/parsing_cocci/parse_aux.ml0000644000175000017500000006663612614153277017761 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 assignOpinfo = Ast.meta_name * Ast0_cocci.assignOpconstraint * Ast0.pure * Data.clt type binaryOpinfo = Ast.meta_name * Ast0_cocci.binaryOpconstraint * 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 logical_line_end offset col strbef straft isSymbol ws = let new_pos_info = {Ast0.line_start = line; Ast0.line_end = line; Ast0.logical_start = logical_line; Ast0.logical_end = logical_line_end; Ast0.column = col; Ast0.offset = offset; } in { Ast0.pos_info = new_pos_info; Ast0.whitespace = ws; 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,logical_line_end,offset,col, strbef,straft,pos,ws) = make_info line logical_line logical_line_end offset col strbef straft false ws let drop_bef (arity,line,lline,llineend,offset,col,strbef,straft,pos,ws) = (arity,line,lline,llineend,offset,col,[],straft,pos,ws) let drop_aft (arity,line,lline,llineend,offset,col,strbef,straft,pos,ws) = (arity,line,lline,llineend,offset,col,strbef,[],pos,ws) (* used for #define, to put aft on ident/( *) let get_aft (arity,line,lline,llineen,offset,col,strbef,straft,pos,ws) = straft let set_aft aft (arity,line,lline,llineend,offset,col,strbef,_,pos,ws) = (arity,line,lline,llineend,offset,col,strbef,aft,pos,ws) let drop_pos (arity,line,lline,llineend,offset,col,strbef,straft,pos,ws) = (arity,line,lline,llineend,offset,col,strbef,straft,[],ws) let clt2mcode_ext str isSymbol = function (Data.MINUS,line,lline,llineend,offset,col,strbef,straft,pos,ws) -> (str,Ast0.NONE, make_info line lline llineend offset col strbef straft isSymbol ws, Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1) | (Data.OPTMINUS,line,lline,llineend,offset,col,strbef,straft,pos,ws)-> (str,Ast0.OPT, make_info line lline llineend offset col strbef straft isSymbol ws, Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)),ref pos,-1) | (Data.PLUS,line,lline,llineend,offset,col,strbef,straft,pos,ws) -> (str,Ast0.NONE, make_info line lline llineend offset col strbef straft isSymbol ws, Ast0.PLUS(Ast.ONE),ref pos,-1) | (Data.PLUSPLUS,line,lline,llineend,offset,col,strbef,straft,pos,ws) -> (str,Ast0.NONE, make_info line lline llineend offset col strbef straft isSymbol ws, Ast0.PLUS(Ast.MANY),ref pos,-1) | (Data.CONTEXT,line,lline,llineend,offset,col,strbef,straft,pos,ws) -> (str,Ast0.NONE, make_info line lline llineend offset col strbef straft isSymbol ws, Ast0.CONTEXT(ref(Ast.NOTHING, Ast0.default_token_info,Ast0.default_token_info)), ref pos,-1) | (Data.OPT,line,lline,llineend,offset,col,strbef,straft,pos,ws) -> (str,Ast0.OPT, make_info line lline llineend offset col strbef straft isSymbol ws, 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)) | _ -> failwith "cannot happen" let mkedots str (dot,whencode) = match str with "..." -> Ast0.wrap(Ast0.Edots(clt2mcode str dot, whencode)) | _ -> failwith "cannot happen" let mkdpdots str dot = match str with "..." -> Ast0.wrap(Ast0.DPdots(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)) | _ -> failwith "cannot happen" let arith_op ast_op left op right = let op' = Ast0.wrap (Ast0.Arith (clt2mcode ast_op op)) in Ast0.wrap (Ast0.Binary(left, op', right)) let logic_op ast_op left op right = let op' = Ast0.wrap (Ast0.Logical (clt2mcode ast_op op)) in Ast0.wrap (Ast0.Binary(left, op', right)) let make_cv cv ty = match cv with None -> ty | Some x -> Ast0.wrap (Ast0.ConstVol(x,ty)) let top_dots l = Ast0.wrap 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 meta_lookup rule name v = match lookup rule name with Ast.MetaScriptDecl(cell,_) -> (match !cell with Some x -> x | None -> cell := Some v; v) | res -> res let check_meta_tyopt type_irrelevant v = let fail name = raise (Semantic_cocci.Semantic ("incompatible inheritance declaration "^name)) in match v with Ast.MetaMetaDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaMetaDecl(_,_) -> () | _ -> fail name) | Ast.MetaIdDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaIdDecl(_,_) | Ast.MetaFreshIdDecl(_,_) -> () | _ -> fail 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 meta_lookup rule name v with Ast.MetaTypeDecl(_,_) -> () | _ -> fail name) | Ast.MetaInitDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaInitDecl(_,_) -> () | _ -> fail name) | Ast.MetaInitListDecl(Ast.NONE,(rule,name),len_name) -> (match meta_lookup rule name v with Ast.MetaInitListDecl(_,_,_) -> () | _ -> fail name) | Ast.MetaListlenDecl((rule,name)) -> (match meta_lookup rule name v with Ast.MetaListlenDecl(_) -> () | _ -> fail name) | Ast.MetaParamDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaParamDecl(_,_) -> () | _ -> fail name) | Ast.MetaParamListDecl(Ast.NONE,(rule,name),len_name) -> (match meta_lookup rule name v with Ast.MetaParamListDecl(_,_,_) -> () | _ -> fail name) | Ast.MetaConstDecl(Ast.NONE,(rule,name),ty) -> (match meta_lookup rule name v with Ast.MetaConstDecl(_,_,ty1) when type_irrelevant || ty = ty1 -> () | _ -> fail name) | Ast.MetaErrDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaErrDecl(_,_) -> () | _ -> fail name) | Ast.MetaExpDecl(Ast.NONE,(rule,name),ty) -> (match meta_lookup rule name v with Ast.MetaExpDecl(_,_,ty1) when type_irrelevant || ty = ty1 -> () | _ -> fail name) | Ast.MetaIdExpDecl(Ast.NONE,(rule,name),ty) -> (match meta_lookup rule name v with Ast.MetaIdExpDecl(_,_,ty1) when type_irrelevant || ty = ty1 -> () | _ -> fail name) | Ast.MetaLocalIdExpDecl(Ast.NONE,(rule,name),ty) -> (match meta_lookup rule name v with Ast.MetaLocalIdExpDecl(_,_,ty1) when type_irrelevant || ty = ty1 -> () | _ -> fail name) | Ast.MetaExpListDecl(Ast.NONE,(rule,name),len_name) -> (match meta_lookup rule name v with Ast.MetaExpListDecl(_,_,_) -> () | Ast.MetaParamListDecl(_,_,_) when not (!Flag.make_hrule = None) -> () | _ -> fail name) | Ast.MetaDeclDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaDeclDecl(_,_) -> () | _ -> fail name) | Ast.MetaFieldDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaFieldDecl(_,_) -> () | _ -> fail name) | Ast.MetaFieldListDecl(Ast.NONE,(rule,name),len_name) -> (match meta_lookup rule name v with Ast.MetaFieldListDecl(_,_,_) -> () | _ -> fail name) | Ast.MetaStmDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaStmDecl(_,_) -> () | _ -> fail name) | Ast.MetaStmListDecl(Ast.NONE,(rule,name),len_name) -> (match meta_lookup rule name v with Ast.MetaStmListDecl(_,_,_) -> () | _ -> fail name) | Ast.MetaFuncDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaFuncDecl(_,_) -> () | _ -> fail name) | Ast.MetaLocalFuncDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaLocalFuncDecl(_,_) -> () | _ -> fail name) | Ast.MetaPosDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v 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)) | _ -> fail name) | Ast.MetaFmtDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaFmtDecl(_,_) -> () | _ -> fail name) | Ast.MetaFragListDecl(Ast.NONE,(rule,name),len) -> (match meta_lookup rule name v with Ast.MetaFragListDecl(_,_,_) -> () | _ -> fail name) | Ast.MetaAnalysisDecl(analyzer,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaAnalysisDecl(analyzer1,_) -> if analyzer = analyzer1 then () else fail name | _ -> fail name) | Ast.MetaDeclarerDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaDeclarerDecl(Ast.NONE,(rule,name)) -> () | _ -> fail name) | Ast.MetaIteratorDecl(Ast.NONE,(rule,name)) -> (match meta_lookup rule name v with Ast.MetaIteratorDecl(Ast.NONE,(rule,name)) -> () | _ -> fail 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 meta_stm_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.MetaStmtList(clt2mcode nm clt,lenname,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 d,Ast0.wrap 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 -> loop i | Ast0.MetaInit _ | Ast0.MetaInitList _ -> false (* ambiguous... *) | _ -> false in let l = Ast0.unwrap initlist in (l = []) || (List.exists loop l) let drop_dot_commas initlist = 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 (loop false (Ast0.unwrap initlist)) (* ----------------------------------------------------------------------- *) (* 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 -> if n < 1 then failwith (Printf.sprintf "length of format list %s must be at least 1" str) else 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 let update_clt (a,line,logical_line,logical_line_end,offset,col,strbef,straft,pos,ws) chars = (* not sure how to update col: wrong if there are newlines *) (a,line,logical_line,logical_line_end,offset+chars,col+chars,strbef,straft, pos,ws) in match pieces with [] -> failwith "not possible" | fst::rest -> let chars = 1 in let clt = update_clt clt chars in let first = match fst with "" -> [] | "..." -> [Ast0.wrap(Ast0.Strdots(clt2mcode fst clt))] | _ -> [Ast0.wrap (Ast0.ConstantFragment(clt2mcode fst clt))] in let chars = String.length fst in let mkrest clt = function "" -> [] | "..." -> [Ast0.wrap(Ast0.Strdots(clt2mcode "..." clt))] | s -> [Ast0.wrap(Ast0.ConstantFragment(clt2mcode s clt))] in let rec loop chars = function [] -> [] | r::rs -> (* there may be bugs in the management of clt here... *) let clt = update_clt clt chars in let pct = clt2mcode "%" clt in let mkfmt d = Ast0.wrap (Ast0.ConstantFormat(clt2mcode d clt)) in let rres = match String.get r 0 with '@' -> (match Str.split (Str.regexp "@") r with first::rest -> (* 3+ for the % and the starting and ending @ *) let clt2 = update_clt clt (3+(String.length first)) in (match string_metavariables first clt with MFmt fmtvar -> (Ast0.wrap (Ast0.FormatFragment(pct,fmtvar))):: (mkrest clt2 (String.concat "@" rest)) | MFrag fragvar -> (fragvar pct):: (mkrest clt2 (String.concat "@" rest))) | _ -> failwith "bad string2") | _ -> match Parse_printf.get_format_string r with (d,"") -> [Ast0.wrap (Ast0.FormatFragment(pct,mkfmt d))] | (d,rest) -> let clt2 = update_clt clt 1 in (Ast0.wrap (Ast0.FormatFragment(pct,mkfmt d))) :: (mkrest clt2 rest) in (* +1 is for the %, which is not shown *) rres @ (loop (chars + (String.length r) + 1) rs) in first @ (loop chars rest) (* This doen't allow a newline in the middle of a string except at a %, perhaps not ideal *) let check_no_duplicates l = let rec loop = function [] | [_] -> () | x :: y :: rest -> (match (Ast0.unwrap x, Ast0.unwrap y) with (Ast0.FormatFragment _, Ast0.FormatFragment _) | (Ast0.ConstantFragment _, Ast0.ConstantFragment _) | (Ast0.Strdots _, Ast0.Strdots _) | (Ast0.MetaFormatList _, Ast0.MetaFormatList _) -> failwith "adjacent string fragments of the same kind not allowed" | _ -> loop (y :: rest)) in loop l let update_line (c,l,ll,lle,lex_start,preceeding_spaces,cb,ca,m,ws) line = let l = l + line in let ll = ll + line in let lle = lle + line in let lex_start = if line > 0 then 0 else lex_start in let preceeding_spaces = if line > 0 then 0 else preceeding_spaces in (c,l,ll,lle,lex_start,preceeding_spaces,cb,ca,m,ws) let drop_minus_plus l clt = let pclt (_,a,b,c,d,e,cb,ca,m,w) = (Data.PLUS,a,b,c,d,e,cb,ca,m,w) in let mclt (_,a,b,c,d,e,cb,ca,m,w) = (Data.MINUS,a,b,c,d,e,cb,ca,m,w) in (* not sure this works for all kinds of newlines, cf lexer *) let pieces = Str.split (Str.regexp "\n") l in if pieces = [] then (1,[]) (* split gives [] on empty string? *) else let (line,pieces) = List.fold_left (function (line,prev) -> let clt = update_line clt line in function "" -> let empty = Ast0.wrap (Ast0.ConstantFragment(clt2mcode "" clt)) in (line+1, empty :: prev) | cur -> let res = let first = String.get cur 0 in match first with '-' -> if !Flag_parsing_cocci.in_minus then let str = String.sub cur 1 ((String.length cur) - 1) in (List.rev(parse_middle str (mclt clt))) @ prev else prev | '+' -> if !Flag_parsing_cocci.in_minus then prev else let str = String.sub cur 1 ((String.length cur) - 1) in (List.rev(parse_middle str (pclt clt))) @ prev | _ -> (List.rev(parse_middle cur clt)) @ prev in (line+1,res)) (0,[]) pieces in let res = List.rev pieces in check_no_duplicates res; (line,res) let not_format_string str clt = Ast0.wrap(Ast0.Constant (clt2mcode (Ast.String str) clt)) let nometas str = match Str.split (Str.regexp "@") str with before::within::after::_ -> false (* need at least %@d@ *) | _ -> true let parse_string str ((mc,b,c,d,e,f,g,h,i,_) as clt) = match mc with Data.PLUS when nometas str -> (* not matched against, no internal changes possible, so no need to parse *) not_format_string str clt | _ -> if List.length(Str.split_delim (Str.regexp "%") str) > 1 then try begin let first = clt2mcode "\"" clt in (*do not want subsequent tokens to inherit whitespace from first*) let clt = (mc,b,c,d,e,f,g,h,i,"") in let (line,middle) = drop_minus_plus str clt in let middle = Ast0.wrap middle in let last = clt2mcode "\"" (update_line clt (line-1)) in contains_string_constant := true; Ast0.wrap(Ast0.StringConstant(first,middle,last)) end with Parse_printf.Not_format_string -> not_format_string str clt else not_format_string str clt coccinelle-1.0.4/parsing_cocci/check_meta.mli0000644000175000017500000000073112614153277020206 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/parsing_cocci/context_neg.ml0000644000175000017500000013716712614153277020305 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.AssignOpTag(d) -> Ast0.set_mcodekind d mcodekind | Ast0.BinaryOpTag(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.StringFragmentTag(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" | Ast0.WhenTag _ -> failwith "whentag 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.AssignOpTag(d) -> Ast0.set_index d index | Ast0.BinaryOpTag(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.StringFragmentTag(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" | Ast0.WhenTag _ -> failwith "whentag 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.AssignOpTag(d) -> Index.assignOp d | Ast0.BinaryOpTag(d) -> Index.binaryOp 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.StringFragmentTag(d) -> Index.string_fragment 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" | Ast0.WhenTag _ -> failwith "whentag 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 statement r k s = let mcode info bef = mcode ((),(),info,bef,(),-1) in match Ast0.unwrap s with (* cases for everything with extra mcode *) | Ast0.Decl((info,bef),_) -> bind (mcode info bef) (k s) | Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_,_,(ainfo,aft)) -> bind (mcode info bef) (bind (k s) (mcode ainfo aft)) | Ast0.IfThen(_,_,_,_,_,(info,aft,adj)) | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft,adj)) | Ast0.Iterator(_,_,_,_,_,(info,aft,adj)) | Ast0.While(_,_,_,_,_,(info,aft,adj)) | Ast0.For(_,_,_,_,_,_,_,_,(info,aft,adj)) -> bind (k s) (mcode info aft) | _ -> k s in let fn = V0.flat_combiner bind option_default mcode mcode 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 statement 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 contains_added_strings info = not (info.Ast0.strings_before = []) || not (info.Ast0.strings_after = []) 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. *) if contains_added_strings info then (* can we have ++ for strings? *) Token(NotAllMarked,offset,mcodekind,[]) else 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.DisjExpr(starter,expr_list,_,ender) | Ast0.ConjExpr(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.Disj(starter,statement_dots_list,_,ender) | Ast0.Conj(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.Decl((info,bef),_) -> bind (nc_mcode ((),(),info,bef,(),-1)) (k s) | Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_,_,(ainfo,aft)) -> (* not sure that the use of start is relevant here *) let a1 = nc_mcode ((),(),info,bef,(),-1) in let a2 = nc_mcode ((),(),ainfo,aft,(),-1) in let b = k s in bind a1 (bind b a2) (* 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 string_fragment r k s = compute_result Ast0.string_fragment s (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 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 (do_nothing Ast0.assignOp) (do_nothing Ast0.binaryOp) typeC initialiser param declaration statement (do_nothing Ast0.forinfo) case_line string_fragment (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 assignOp_equal_mcode op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with Ast0.SimpleAssign op1', Ast0.SimpleAssign op2' -> equal_mcode op1' op2' | Ast0.OpAssign op1', Ast0.OpAssign op2' -> equal_mcode op1' op2' | Ast0.MetaAssign(mv1,_,_), Ast0.MetaAssign(mv2,_,_) -> equal_mcode mv1 mv2 | _ -> false let binaryOp_equal_mcode op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with Ast0.Arith op1', Ast0.Arith op2' -> equal_mcode op1' op2' | Ast0.Logical op1', Ast0.Logical op2' -> equal_mcode op1' op2' | Ast0.MetaBinary(mv1,_,_), Ast0.MetaBinary(mv2,_,_) -> equal_mcode mv1 mv2 | _ -> false 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 = List.length (Ast0.unwrap d1) = List.length (Ast0.unwrap d2) 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 | _ -> 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,_,_)) -> assignOp_equal 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,_)) -> binaryOp_equal 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.ConjExpr(starter1,_,mids1,ender1), Ast0.ConjExpr(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,_)) -> equal_mcode dots1 dots2 | (Ast0.OptExp(_),Ast0.OptExp(_)) -> true | _ -> false and assignOp_equal op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with | Ast0.SimpleAssign o1, Ast0.SimpleAssign o2 -> equal_mcode o1 o2 | Ast0.OpAssign o1, Ast0.OpAssign o2 -> equal_mcode o1 o2 | Ast0.MetaAssign(mv1,_,_), Ast0.MetaAssign(mv2,_,_) -> equal_mcode mv1 mv2 | _ -> false and binaryOp_equal op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with | Ast0.Arith o1, Ast0.Arith o2 -> equal_mcode o1 o2 | Ast0.Logical o1, Ast0.Logical o2 -> equal_mcode o1 o2 | Ast0.MetaBinary(mv1,_,_), Ast0.MetaBinary(mv2,_,_) -> equal_mcode mv1 mv2 | _ -> 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.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 | _ -> false let 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_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.FunProto(fninfo1,name1,lp1,p1,va1,rp1,sem1), Ast0.FunProto(fninfo2,name2,lp2,p2,va2,rp2,sem2)) -> let equal_varargs va1 va2 = match (va1,va2) with | None, None -> true | Some (c1, e1), Some (c2, e2) -> equal_mcode c1 c2 && equal_mcode e1 e2 | _ -> false in (List.length fninfo1) = (List.length fninfo2) && List.for_all2 equal_fninfo fninfo1 fninfo2 && equal_mcode lp1 lp2 && equal_varargs va1 va2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2 | (Ast0.MacroDecl(stg1,nm1,lp1,_,rp1,sem1), Ast0.MacroDecl(stg2,nm2,lp2,_,rp2,sem2)) -> equal_option stg1 stg2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2 | (Ast0.MacroDeclInit(stg1,nm1,lp1,_,rp1,eq1,_,sem1), Ast0.MacroDeclInit(stg2,nm2,lp2,_,rp2,eq2,_,sem2)) -> equal_option stg1 stg2 && 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.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 | _ -> 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)) -> equal_mcode dots1 dots2 | (Ast0.OptParam(_),Ast0.OptParam(_)) -> 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.Exec(exec1,lang1,_,sem1),Ast0.Exec(exec2,lang2,_,sem2)) -> equal_mcode exec1 exec2 && equal_mcode lang1 lang2 && 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.Conj(starter1,_,mids1,ender1),Ast0.Conj(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.TopId(_),Ast0.TopId(_)) -> true | (Ast0.TopInit(_),Ast0.TopInit(_)) -> true | (Ast0.Dots(d1,_),Ast0.Dots(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 | _ -> 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 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 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)) -> 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) -> 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 (Ast0.unwrap ss)@stms | _ -> failwith "plus code is being discarded") in let res = Compute_lines.compute_statement_dots_lines false (Ast0.rewrap (List.hd l) (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.unwrap l with [s] -> f s | _ -> false let isall f l = List.for_all (isonly f) l let isany f l = List.exists (isonly f) l let rec is_exp s = match Ast0.unwrap s with Ast0.Exp(e) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_exp stmts | Ast0.Conj(_,stmts,_,_) -> isany 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 | Ast0.Conj(_,stmts,_,_) -> isany 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 | Ast0.Conj(_,stmts,_,_) -> isany 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 | Ast0.Conj(_,stmts,_,_) -> isany is_decl stmts | _ -> false let rec is_fndecl s = match Ast0.unwrap s with Ast0.FunDecl(_,_,_,_,_,_,_,_,_,_,_) -> true | Ast0.Disj(_,stmts,_,_) -> isall is_fndecl stmts | Ast0.Conj(_,stmts,_,_) -> isany 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.Conj(_,stmts,_,_) -> isany 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.unwrap 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.unwrap 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) || (!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.unwrap 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 || 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 || 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 || iscode p) && (mend + 1 = pstart || pend + 1 = mstart || (* adjacent *) (mstart <= pstart && mend >= pstart) || (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 || 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.4/parsing_cocci/unify_ast.mli0000644000175000017500000000056512614153277020131 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) type res = NO | MAYBE val unify_statement_dots : Ast_cocci.statement Ast_cocci.dots -> Ast_cocci.statement Ast_cocci.dots -> res coccinelle-1.0.4/parsing_cocci/lexer_script.mll0000644000175000017500000000341612614153277020634 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) { 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 *) | "#" [^ '\n']* { token lexbuf } (* skip python 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 | '"' { "" } | "\\\"" { "\\\"" ^ string lexbuf } | (_ as x) { (String.make 1 x) ^ string lexbuf } and cstring = parse | "'" { "" } | (_ as x) { (String.make 1 x) ^ cstring lexbuf } coccinelle-1.0.4/parsing_cocci/ast0toast.ml0000644000175000017500000012622612614153277017704 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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) || 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 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 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) (* ignore starter, etc *) | Ast0.ConjExpr(starter,expr_list,mids,ender) -> List.for_all r.VT0.combiner_rec_expression expr_list | Ast0.AsExpr(exp,asexp) -> k exp | Ast0.AsSExpr(exp,asstm) -> 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) | Ast0.Conj(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 mcode mcode donothing donothing donothing donothing donothing donothing ident expression donothing donothing typeC initialiser donothing declaration statement donothing case_line donothing 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; Ast.whitespace = info.Ast0.whitespace; } 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 (List.map fn (Ast0.unwrap d)) (* --------------------------------------------------------------------- *) (* 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)) (* --------------------------------------------------------------------- *) (* 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,assignOp 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,binaryOp op,expression right) | Ast0.Nested(left,op,right) -> Ast.Nested(expression left,binaryOp 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.AsSExpr(expr,asstm) -> let stm = match Ast.unwrap (statement asstm) with Ast.Atomic(re) -> re | _ -> failwith "stmt should be metavar, and thus atomic" in Ast.AsSExpr(expression expr,stm) | Ast0.EComma(cm) -> Ast.EComma(mcode cm) | Ast0.DisjExpr(_,exps,_,_) -> Ast.DisjExpr(List.map expression exps) | Ast0.ConjExpr(_,exps,_,_) -> Ast.ConjExpr(List.map expression exps) | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) -> let starter = mcode starter in let whencode = get_option (fun (_,_,b) -> expression b) 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 (fun (_,_,b) -> expression b) whencode in Ast.Edots(dots,whencode) | Ast0.OptExp(exp) -> Ast.OptExp(expression exp)) in if Ast0.get_test_exp e then Ast.set_test_exp e1 else e1 and assignOp op = rewrap op no_isos (match Ast0.unwrap op with Ast0.SimpleAssign op' -> Ast.SimpleAssign (mcode op') | Ast0.OpAssign op' -> Ast.OpAssign (mcode op') | Ast0.MetaAssign(mv, c, _) -> Ast.MetaAssign(mcode mv, assignOpconstraint c, unitary, false)) and assignOpconstraint = function | Ast0.AssignOpNoConstraint -> Ast.AssignOpNoConstraint | Ast0.AssignOpInSet ops -> Ast.AssignOpInSet (List.map assignOp ops) and binaryOp op = rewrap op no_isos (match Ast0.unwrap op with Ast0.Arith op' -> Ast.Arith (mcode op') | Ast0.Logical op' -> Ast.Logical (mcode op') | Ast0.MetaBinary(mv, c, _) -> Ast.MetaBinary(mcode mv, binaryOpconstraint c, unitary, false)) and binaryOpconstraint = function | Ast0.BinaryOpNoConstraint -> Ast.BinaryOpNoConstraint | Ast0.BinaryOpInSet ops -> Ast.BinaryOpInSet (List.map binaryOp ops) 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.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)) 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.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, declaration_dots 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) -> let allminus = check_allminus.VT0.combiner_rec_declaration d in Ast.UnInit(get_option mcode stg,typeC allminus ty,ident id, mcode sem) | Ast0.FunProto(fi,name,lp,params,va,rp,sem) -> let fi = List.map fninfo fi in let name = ident name in let lp = mcode lp in let params = parameter_list params in let va = match va with | None -> None | Some (comma,ellipsis) -> Some(mcode comma,mcode ellipsis) in let rp = mcode rp in let sem = mcode sem in Ast.FunProto(fi,name,lp,params,va,rp,sem) | Ast0.MacroDecl(stg,name,lp,args,rp,sem) -> (* this would seem to need allminus... *) let stg = get_option mcode stg in 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(stg,name,lp,args,rp,sem) | Ast0.MacroDeclInit(stg,name,lp,args,rp,eq,ini,sem) -> (* this would seem to need allminus... *) let stg = get_option mcode stg in 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(stg,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.Ddots(dots,whencode) -> failwith "should not be possible" | Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls) | Ast0.OptDecl(decl) -> Ast.OptDecl(declaration decl)) and annotated_decl bef d = rewrap d (do_isos (Ast0.get_iso d)) (match Ast0.unwrap d with Ast0.Ddots(dots,whencode) -> (* structure definitions only *) let dots = mcode dots in let whencode = get_option (fun (_,_,b) -> declaration b) whencode in Ast.Ddots(dots,whencode) | _ -> (* for decls where there is no bef information needed *) let bef = match bef with None -> (* fake, no change here *) let bot = Ast0.default_token_info in Ast0.CONTEXT (ref(Ast.NOTHING,bot,bot)) | Some bef -> bef in let allminus = check_allminus.VT0.combiner_rec_declaration d in Ast.DElem(convert_allminus_mcodekind allminus bef,allminus, declaration d)) and declaration_dots l = dots (annotated_decl None) l (* --------------------------------------------------------------------- *) (* Initialiser *) and strip_idots initlist = let isminus mc = match Ast0.get_mcode_mcodekind mc with Ast0.MINUS _ -> true | _ -> false in let l = Ast0.unwrap initlist in 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) 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 (fun (_,_,b) -> initialiser b) 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 (fun (_,_,b) -> initialiser b) whencode in Ast.Idots(dots,whencode) | Ast0.OptIni(ini) -> Ast.OptIni(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.OptParam(param) -> Ast.OptParam(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) -> Ast.Atomic(rewrap_rule_elem s (Ast.Decl(annotated_decl (Some bef) 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.unwrap 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.Exec(exec,lang,code,sem) -> Ast.Atomic (rewrap_rule_elem s (Ast.Exec(mcode exec,mcode lang,dots exec_code code,mcode sem))) | Ast0.MetaStmt(name,_) -> Ast.Atomic(rewrap_rule_elem s (Ast.MetaStmt(mcode name,unitary,seqible,false))) | Ast0.MetaStmtList(name,lenname,_) -> Ast.Atomic(rewrap_rule_elem s (Ast.MetaStmtList(mcode name,do_lenname lenname, 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.TopId(id) -> Ast.Atomic(rewrap_rule_elem s (Ast.TopId(ident id))) | Ast0.Disj(_,rule_elem_dots_list,_,_) -> Ast.Disj(List.map (function x -> statement_dots seqible x) rule_elem_dots_list) | Ast0.Conj(_,rule_elem_dots_list,_,_) -> Ast.Conj(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.FunDecl((_,bef),fi,name,lp,params,va,rp,lbrace,body,rbrace, (_,aft)) -> let fi = List.map fninfo fi in let name = ident name in let lp = mcode lp in let params = parameter_list params in let newva = match va with | None -> None | Some (comma, ellipsis) -> Some (mcode comma, mcode ellipsis) 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,newva,rp)), tokenwrap lbrace s (Ast.SeqStart(lbrace)), body, tokenwrap rbrace s (Ast.SeqEnd(rbrace)), ([],[],[],convert_allminus_mcodekind allminus aft)) | 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)) 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.OptDParam(dp) -> Ast.OptDParam(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 (process_list seqible isos (Ast0.unwrap d)) (* 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) | Ast0.Conj(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 = collect_decls (Ast0.unwrap d) in let process l d = let (decls,other) = collect_decls l in (rewrap d no_isos (List.map (statement seqible) decls), rewrap d no_isos (process_list seqible (do_isos (Ast0.get_iso d)) other)) in process x (Ast0.unwrap d) *) 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) -> Ast.ForDecl(annotated_decl (Some bef) 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 exec_code c = rewrap c no_isos (match Ast0.unwrap c with Ast0.ExecEval(colon,id) -> Ast.ExecEval(mcode colon,expression id) | Ast0.ExecToken(tok) -> Ast.ExecToken(mcode tok) | Ast0.ExecDots(dots) -> Ast.ExecDots(mcode dots)) 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.AnnDeclDotsTag(declaration_dots d) | Ast0.DotsCaseTag(d) -> failwith "not possible" | Ast0.IdentTag(d) -> Ast.IdentTag(ident d) | Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d) | Ast0.AssignOpTag d -> Ast.AssignOpTag(assignOp d) | Ast0.BinaryOpTag d -> Ast.BinaryOpTag(binaryOp 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.StringFragmentTag(d) -> Ast.StringFragmentTag(string_fragment 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" | Ast0.WhenTag _ -> 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.4/parsing_cocci/iso_pattern.ml0000644000175000017500000031470612614153277020313 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 "" let verbose_iso = ref true (* --------------------------------------------------------------------- *) 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 mcode mcode donothing donothing donothing 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.StringFragmentTag(d1),Ast0.StringFragmentTag(d2)) -> (strip_info.VT0.rebuilder_rec_string_fragment d1) = (strip_info.VT0.rebuilder_rec_string_fragment 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 (* it would be nice if this would go to standard error *) 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 assignOp_equal op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with | Ast0.SimpleAssign _, Ast0.SimpleAssign _ -> true | Ast0.OpAssign o1, Ast0.OpAssign o2 -> mcode_equal o1 o2 | Ast0.MetaAssign (mv1, _, _), Ast0.MetaAssign (mv2, _, _) -> mcode_equal mv1 mv2 | _, _ -> false let binaryOp_equal op1 op2 = match (Ast0.unwrap op1, Ast0.unwrap op2) with | Ast0.Arith o1, Ast0.Arith o2 -> mcode_equal o1 o2 | Ast0.Logical o1, Ast0.Logical o2 -> mcode_equal o1 o2 | Ast0.MetaBinary (mv1, _, _), Ast0.MetaBinary (mv2, _, _) -> mcode_equal mv1 mv2 | _, _ -> false 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 || (* 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 || (* everything is context for sgrep *) (match Ast0.unwrap s with Ast0.Disj(starter,statement_dots_list,mids,ender) -> (* need for conj? *) List.for_all (function x -> match Ast0.unwrap 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 check_assignOp_mcode op1 op2 binding = match (Ast0.unwrap op1, Ast0.unwrap op2) with Ast0.SimpleAssign o1, Ast0.SimpleAssign o2 -> check_mcode o1 o2 binding | Ast0.OpAssign o1, Ast0.OpAssign o2 -> check_mcode o1 o2 binding | Ast0.MetaAssign(mv1,_,_), Ast0.MetaAssign(mv2,_,_) -> check_mcode mv1 mv2 binding | _ -> Fail(NonMatch) in let check_binaryOp_mcode op1 op2 binding = match (Ast0.unwrap op1, Ast0.unwrap op2) with Ast0.Arith o1, Ast0.Arith o2 -> check_mcode o1 o2 binding | Ast0.Logical o1, Ast0.Logical o2 -> check_mcode o1 o2 binding | Ast0.MetaBinary(mv1,_,_), Ast0.MetaBinary(mv2,_,_) -> check_mcode mv1 mv2 binding | _ -> Fail(NonMatch) in let match_dots matcher is_list_matcher do_list_match d1 d2 = match_list matcher is_list_matcher (do_list_match d2) (Ast0.unwrap d1) (Ast0.unwrap d2) 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 = Ast0.rewrap pattern 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 = Ast0.lub_pure (if Ast0.get_pos m = [] then Ast0.PureContext else Ast0.Impure) (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 assignOp r k e = bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e)) (match Ast0.unwrap e with Ast0.MetaAssign(_, _, pure) -> pure | _ -> Ast0.Impure) in let binaryOp r k e = bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e)) (match Ast0.unwrap e with Ast0.MetaBinary(_, _, 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 mcode mcode donothing donothing donothing donothing donothing donothing ident expression assignOp binaryOp typeC init param decl stmt donothing 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,lenname,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) || not(context_required) || 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)) -> match_ident ida idb | (_,Ast0.OptIdent(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) | (Ast.GlobalID,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) || not(context_required) || 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 assignOp_equal opa opb then conjunct_many_bindings [check_assignOp_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 binaryOp_equal opa opb then conjunct_many_bindings [check_binaryOp_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,_,_),_) | (Ast0.ConjExpr(_,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)) -> check_mcode d d1 | (Ast0.Edots(ed,None),Ast0.Edots(ed1,Some (wh,e,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.WhenTag(wh,Some e,Ast0.ExprTag wc)) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Edots(_,Some _),_) -> failwith "whencode not allowed in a pattern1" | (Ast0.OptExp(expa),Ast0.OptExp(expb)) -> match_expr expa expb | (_,Ast0.OptExp(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 varargs_equal (comma1, ellipsis1) (comma2, ellipsis2) = let c1 = Ast0_cocci.unwrap_mcode comma1 and e1 = Ast0_cocci.unwrap_mcode ellipsis1 and c2 = Ast0_cocci.unwrap_mcode comma2 and e2 = Ast0_cocci.unwrap_mcode ellipsis2 in return (c1="," && e1="......" && c2=c1 && e2=e1) and match_typeC pattern t = match Ast0.unwrap pattern with Ast0.MetaType(name,pure) -> add_pure_binding name pure pure_sp_code.VT0.combiner_rec_typeC (function ty -> Ast0.TypeCTag ty) t | up -> if not(checks_needed) || not(context_required) || 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.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)) -> match_typeC tya tyb | (_,Ast0.OptType(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) || not(context_required) || 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.FunProto(fninfo1,name1,lp1,params1,va1a,rp1,sem1), Ast0.FunProto(fninfo,name,lp,params,va1b,rp,sem)) -> conjunct_many_bindings [check_mcode lp1 lp; check_mcode rp1 rp; check_mcode sem1 sem; match_fninfo fninfo1 fninfo; match_ident name1 name; match_dots match_param is_plist_matcher do_plist_match params1 params; match_option varargs_equal va1a va1b ] | (Ast0.MacroDecl(stga,namea,lp1,argsa,rp1,sc1), Ast0.MacroDecl(stgb,nameb,lp,argsb,rp,sc)) -> if bool_match_option mcode_equal stga stgb then 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] else return false | (Ast0.MacroDeclInit(stga,namea,lp1,argsa,rp1,eq1,ini1,sc1), Ast0.MacroDeclInit(stgb,nameb,lp,argsb,rp,eq,ini,sc)) -> if bool_match_option mcode_equal stga stgb then 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] else return false | (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 (wh,ee,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.WhenTag (wh,Some ee,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)) -> match_decl decla declb | (_,Ast0.OptDecl(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) || not(context_required) || 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 (wh,e,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.WhenTag(wh,Some e,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)) -> match_init ia ib | (_,Ast0.OptIni(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) || not(context_required) || 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)) -> check_mcode d1 d | (Ast0.OptParam(parama),Ast0.OptParam(paramb)) -> match_param parama paramb | (_,Ast0.OptParam(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(_,_) -> return false (* ... is not a single statement *) | Ast0.MetaStmtList(_,_,_) -> return false (* ... is not a single statement, needs {} *) | _ -> 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) || not(context_required) || is_context s then match (up,Ast0.unwrap s) with (Ast0.FunDecl(_,fninfoa,namea,lp1,paramsa,vaa,rp1,lb1,bodya,rb1,_), Ast0.FunDecl(_,fninfob,nameb,lp,paramsb,vab,rp,lb,bodyb,rb,_)) -> conjunct_many_bindings [check_mcode lp1 lp; match_option varargs_equal vaa vab; 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) || is_minus s || (is_context s && List.for_all is_pure_context (Ast0.unwrap 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.Exec(e1,l1,codea,sc1),Ast0.Exec(e2,l2,codeb,sc2)) -> failwith "exec not supported in patterns" | (Ast0.Disj(_,statement_dots_lista,_,_),_) | (Ast0.Conj(_,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) || is_minus s || (is_context s && List.for_all is_pure_context (Ast0.unwrap 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)) -> (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 (wh,e,wc) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.WhenTag(wh,Some e,Ast0.DotsStmtTag wc))) | Ast0.WhenAlways (wh,e,wc) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.WhenTag(wh,Some e,Ast0.StmtTag wc))) | Ast0.WhenNotTrue (wh,e,wc) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.WhenTag(wh,Some e,Ast0.IsoWhenTTag wc))) | Ast0.WhenNotFalse (wh,e,wc) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.WhenTag(wh,Some e,Ast0.IsoWhenFTag wc))) | Ast0.WhenModifier(wh,x) -> conjunct_bindings prev (add_multi_dot_binding d (Ast0.WhenTag(wh,None,Ast0.IsoWhenTag x)))) (return true) wc) else (Printf.printf "warning: not applying iso because of whencode"; return false)) | (Ast0.Dots(_,_::_),_) -> failwith "whencode not allowed in a pattern3" | (Ast0.OptStm(rea),Ast0.OptStm(reb)) -> match_statement rea reb | (_,Ast0.OptStm(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) || not(context_required) || 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.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.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 [] -> (* 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 mcode mcode dots dots dots dots dots dots donothing expression donothing donothing donothing initialiser donothing declaration statement donothing 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,va,rp,lbrace,body,rbrace, (aftinfo,aftmc)) -> Ast0.FunDecl ((info,copy_mcodekind mc), fninfo,name,lp,params,va,rp,lbrace,body,rbrace, (aftinfo,copy_mcodekind aftmc)) | 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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing statement donothing 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(_,_) -> 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(_,_) -> 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. Model to know whether new code will be -. *) let instantiate bindings mv_bindings model = 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 = 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)) -> Ast0.unwrap exp | 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 xs) in let rec plist r = 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)) -> Ast0.unwrap param | 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 xs) in let rec slist r = function [] -> [] | [x] -> (match Ast0.unwrap x with Ast0.MetaStmtList(name,lenname,pure) -> (match lookup name bindings mv_bindings with Common.Left(Ast0.DotsStmtTag(stm)) -> Ast0.unwrap stm | 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 xs) in let dots list_fn r k d = Ast0.rewrap d (list_fn r (Ast0.unwrap d)) 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 true 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 oldop = (* only propagate ! if they, ie model and oldop, have the same modification and no + code on the old one (the new one from the iso surely has no + code) *) (* This is not ideal, because the model is the top level term, and this is a subterm, so minus minus is only detected when the whole matched term is minus. Not sure what to do in general, because not clear where the ! comes from. Be more flexible for !, because it doesn't really matter *) !Flag.sgrep_mode2 || match (Ast0.get_mcodekind model,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 get_binaryOp_mcodekind op = match Ast0.unwrap op with Ast0.Logical o -> Ast0.get_mcode_mcodekind o | Ast0.Arith o -> Ast0.get_mcode_mcodekind o | Ast0.MetaBinary(mv,_,_) -> Ast0.get_mcode_mcodekind mv in let get_op op = Ast0.unwrap_mcode op 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 get_op op = Ast.Not && same_modif (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 let v = same_modif (get_binaryOp_mcodekind op) in v -> let reb model nop = let nop = Ast0.rewrap_mcode model nop in Ast0.rewrap op (Ast0.Logical nop) in let k1 x = k (Ast0.rewrap e x) in (match Ast0.unwrap op with Ast0.Logical op' when get_op op' = Ast.Inf -> k1 (Ast0.Binary(e1,reb op' Ast.SupEq,e2)) | Ast0.Logical op' when get_op op' = Ast.Sup -> k1 (Ast0.Binary(e1,reb op' Ast.InfEq,e2)) | Ast0.Logical op' when get_op op' = Ast.InfEq -> k1 (Ast0.Binary(e1,reb op' Ast.Sup,e2)) | Ast0.Logical op' when get_op op' = Ast.SupEq -> k1 (Ast0.Binary(e1,reb op' Ast.Inf,e2)) | Ast0.Logical op' when get_op op' = Ast.Eq -> k1 (Ast0.Binary(e1,reb op' Ast.NotEq,e2)) | Ast0.Logical op' when get_op op' = Ast.NotEq -> k1 (Ast0.Binary(e1,reb op' Ast.Eq,e2)) | Ast0.Logical op' when get_op op' = Ast.AndLog -> k1 (Ast0.Binary(negate_reb e e1 idcont, reb op' Ast.OrLog, negate_reb e e2 idcont)) | Ast0.Logical op' when get_op op' = Ast.OrLog -> k1 (Ast0.Binary(negate_reb e e1 idcont, reb op' Ast.AndLog, negate_reb e e2 idcont)) | _ -> let rewrap_binaryOp_mcode op x = match Ast0.unwrap op with Ast0.Arith o -> Ast0.rewrap_mcode o x | Ast0.Logical o -> Ast0.rewrap_mcode o x | Ast0.MetaBinary (mv,_,_) -> Ast0.rewrap_mcode mv x in Ast0.rewrap e (Ast0.Unary(k res, rewrap_binaryOp_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)) | Ast0.ConjExpr(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.ConjExpr(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.WhenTag(wh,Some ee,Ast0.ExprTag exp) -> Ast0.rewrap e (Ast0.Edots(d,Some (wh,ee,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.WhenTag(wh,Some ee,Ast0.DeclTag(exp)) -> Ast0.rewrap e (Ast0.Ddots(d,Some (wh,ee,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.WhenTag(wh,Some ee,Ast0.DotsStmtTag(stms)) -> Ast0.WhenNot (wh,ee,stms) | Ast0.WhenTag(wh,Some ee,Ast0.StmtTag(stm)) -> Ast0.WhenAlways (wh,ee,stm) | Ast0.WhenTag(wh,Some ee,Ast0.IsoWhenTTag(stm)) -> Ast0.WhenNotTrue (wh,ee,stm) | Ast0.WhenTag(wh,Some ee,Ast0.IsoWhenFTag(stm)) -> Ast0.WhenNotFalse (wh,ee,stm) | Ast0.WhenTag(wh,None,Ast0.IsoWhenTag(x)) -> Ast0.WhenModifier(wh,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))) | _ -> e in V0.flat_rebuilder mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode (dots elist) donothing (dots plist) (dots slist) donothing donothing identfn exprfn donothing donothing tyfn initfn paramfn declfn stmtfn donothing 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) | Ast0.MIXED(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 *) (* Allowed because of possibility of metavar as model of macro | 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 merge_plus_before model_mcode e_mcode = match model_mcode with Ast0.MINUS(mc) -> merge_plus model_mcode e_mcode | Ast0.CONTEXT(mc) -> let (mba,tb,ta) = !mc in (match mba with Ast.NOTHING | Ast.BEFORE _ -> merge_plus model_mcode e_mcode | Ast.AFTER(a,it1) -> failwith "before cell should only contain before modifications" | Ast.BEFOREAFTER(b1,a,it1) -> failwith "before cell should only contain before modifications") | Ast0.MIXED(_) -> failwith "not possible 8" | Ast0.PLUS _ -> failwith "not possible 9" let merge_plus_after model_mcode e_mcode = match model_mcode with Ast0.MINUS(mc) -> merge_plus model_mcode e_mcode | Ast0.CONTEXT(mc) -> let (mba,tb,ta) = !mc in (match mba with Ast.NOTHING | Ast.AFTER _ -> merge_plus model_mcode e_mcode | Ast.BEFORE(b1,it1) -> failwith "after cell should only contain before modifications" | Ast.BEFOREAFTER(b1,a,it1) -> failwith "after cell should only contain before modifications") | 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(_) -> (* This is possible if the model of an isomorphism is a single metavariable, and this metavariable matches mixed code. Previously, this failed with impossible if not in sgrep mode. *) e | 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 || other_ecount = 0, icount = 0 || other_icount = 0, dcount = 0 || 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),_,_,_,_,_,_,_,_,_,(aftinfo,aft)) -> (match Ast0.unwrap e with Ast0.FunDecl((info,bef1),_,_,_,_,_,_,_,_,_,(aftinfo,aft1)) -> merge_plus_before bef bef1; merge_plus_after aft aft1 | _ -> let mc = Ast0.get_mcodekind e in merge_plus_before bef mc; merge_plus_after aft mc) | Ast0.Decl((info,bef),_) -> (match Ast0.unwrap e with Ast0.Decl((info,bef1),_) -> merge_plus_before bef bef1 | _ -> merge_plus_before 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_after aft aft1 | _ -> merge_plus_after 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.MetaBinaryOperatorDecl(ar,nm) -> (nm,function nm -> Ast.MetaBinaryOperatorDecl(ar,nm)) | Ast.MetaAssignmentOperatorDecl(ar,nm) -> (nm,function nm -> Ast.MetaAssignmentOperatorDecl(ar,nm)) | 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.MetaGlobalIdExpDecl(ar,nm,ty) -> (nm,function nm -> Ast.MetaGlobalIdExpDecl(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,nm1) -> (nm,function nm -> Ast.MetaStmListDecl(ar,nm,nm1)) | 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)) | Ast.MetaScriptDecl(cell,nm) -> failwith "not relevant to isos" 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 e (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 _ when !verbose_iso -> 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.whitespace = ""; 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.whitespace = ""; 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 [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 (fun b mv_b model -> (instantiate b mv_b model).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 (fun b mv_b model -> (instantiate b mv_b model).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 (fun b mv_b model -> (instantiate b mv_b model).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 (fun b mv_b model -> (instantiate b mv_b model).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 [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 (fun b mv_b model -> (instantiate b mv_b model).VT0.rebuilder_rec_statement_dots) (function s -> Ast0.DotsStmtTag s) (function x -> Ast0.rewrap e [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 || ((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 mcode mcode donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing donothing let rec 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.AssignOpTag(d) -> Ast0.AssignOpTag(rewrap.VT0.rebuilder_rec_assignOp d) | Ast0.BinaryOpTag(d) -> Ast0.BinaryOpTag(rewrap.VT0.rebuilder_rec_binaryOp 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.StringFragmentTag(d) -> Ast0.StringFragmentTag(rewrap.VT0.rebuilder_rec_string_fragment 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 *) | Ast0.WhenTag(a,e,b) -> rewrap_anything b (* --------------------------------------------------------------------- *) 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.4/parsing_cocci/git_grep.mli0000644000175000017500000000045712614153277017730 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val interpret : string -> string list -> string -> string list option coccinelle-1.0.4/parsing_cocci/parse_cocci.mli0000644000175000017500000000262612614153277020402 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) exception Bad_virt of string val parse : string -> (string, string) Common.either Common.set (* iso files *) * Ast0_cocci.parsed_rule list (* rules *) * string list (* virtuals *) * Ast_cocci.metavar list (* metavariables *) 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 * string list) option(*cocci-grep/git 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.4/main.ml0000644000175000017500000013544412614153277014105 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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_spacing = ref false let test_okfailed = ref false let test_regression_okfailed = ref false let expected_score_file = ref "" let expected_spacing_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 let parmap_cores = ref (None : int option) let parmap_chunk_size = ref (None : int option) (*****************************************************************************) (* 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: " ^ Filename.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 (string_of_int 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"; "--include-headers-for-types", Arg.Set FC.include_headers_for_types, " use only type information from header files"; "--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-gitgrep", Arg.Unit (function _ -> Flag.scanner := Flag.GitGrep), " works with -dir, works on git tree subdirectories"; "--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: "; "--parse-handler", Arg.String (fun f -> let f' = Prepare_ocamlcocci.prepare_simple f in Prepare_ocamlcocci.load_file f'), " Loads the file containing the OCaml code in charge of parse errors reporting"; "--print-options-only", Arg.Unit (fun () -> ()), " print selected options and exit"; "--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, " "; "--debug-parse-cocci", Arg.Set Flag_parsing_cocci.debug_parse_cocci, " "; ]; (* 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 := (if x = 0 then None else Some x)), " timeout in seconds, 0 for no timeout"; "--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 Flag_parsing_c.ifdef_to_if, " convert ifdef to if (experimental)"; "--no-ifdef-to-if", Arg.Clear Flag_parsing_c.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, " "; "--itu", Arg.Set Flag_parsing_c.exts_ITU, " Experimental extensions for handling #ifdef developed at ITU.dk"; "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " treat cpp symbol as defined in #ifdef"; "--undefined", Arg.String (Flag_parsing_c.add Flag_parsing_c.undefined), " treat cpp symbol as undefined in #ifdef"; "--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, " run the semantic patch even if the C file contains no relevant tokens"; "--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"; "--indent", Arg.Set_int Flag_parsing_c.indent, " default indent, in spaces (no tabs)"; "-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"; "--jobs", Arg.Int (function x -> parmap_cores := Some x), " the number of cores to be used by parmap"; "-j", Arg.Int (function x -> parmap_cores := Some x), " the number of cores to be used"; "--chunksize", Arg.Int (function x -> parmap_chunk_size := Some x), " the size of work chunks for parallelism"; ]; "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-spacing", Arg.Set test_spacing, " check that the result matches the .res file exactly"; "--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"; "--expected-spacing-score-file", Arg.Set_string expected_spacing_score_file, " which score file to compare with in --test-spacing"; "--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 = "--rule-dependencies" 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) let all_string_option_names = List.fold_left (function prev -> function (_,Arg.Unit _,_) -> prev | (nm,_,_) -> nm :: prev) [] all_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 *) (* was pr2, but that doesn't always get generated *) Printf.eprintf "%s\n%!" (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 (let filelist = glimpse_res +> List.filter (fun file -> List.mem (Common.filesuffix file) suffixes) in if filelist <> [] then begin let firstfile = List.hd filelist in if Filename.is_relative firstfile || Filename.is_implicit firstfile then List.map (fun file -> dir ^ Filename.dir_sep ^ file) filelist else filelist end else [] ) | _ -> 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_filter (_,_,query,_) dir = match query with None -> pr2 "no inferred keywords"; None | Some (q1,q2,_) -> let res = Test_parsing_c.get_files dir +> List.filter (Cocci_grep.interpret (q1,q2)) in Printf.eprintf "%d files match\n" (List.length res); Some res let gitgrep_filter ((_,_,query,_) as x) dir = match query with None -> pr2 "no inferred keywords"; None | Some (_,_,query) -> let suffixes = if !Flag.include_headers then "'*.[ch]'" else "'*.c'" in match Git_grep.interpret dir query suffixes with Some res -> Printf.eprintf "%d files match\n" (List.length res); Some res | None -> coccigrep_filter x dir 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, "", (Flag.Glimpse|Flag.IdUtils|Flag.CocciGrep|Flag.GitGrep), [] -> let interpreter = match !Flag.scanner with Flag.Glimpse -> glimpse_filter | Flag.IdUtils -> idutils_filter | Flag.CocciGrep -> coccigrep_filter | Flag.GitGrep -> gitgrep_filter | _ -> failwith "impossible" in let files = match interpreter constants x with None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) | true, s, (Flag.Glimpse|Flag.IdUtils|Flag.CocciGrep|Flag.GitGrep), _ when s <> "" -> failwith "--use-xxx filters do not work with --kbuild" (* normal *) | true, "", _, _ -> Test_parsing_c.get_files (String.concat " " (x::xs)) +> List.map (fun x -> [x]) (* kbuild *) | true, kbuild_info_file,_,_ -> let dirs = Common.cmd_to_list ("find "^(String.concat " " (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 ncores = match !parmap_cores with | Some x when x <= 0 -> succ (Parmap.get_default_ncores ()) | Some x -> x | None -> 0 in let chunksize = match !parmap_chunk_size with | Some x when x > 0 -> x | Some _ | None -> 1 in let seq_fold merge op z l = List.fold_left op z l in let par_fold merge op z l = let prefix = Filename.chop_extension (Filename.basename !cocci_file) in (if Sys.file_exists prefix then failwith (Printf.sprintf "Directory %s used for temporary files already exists and should be removed." prefix)); let clean _ = let files = Array.to_list(Sys.readdir prefix) in let (stdouts,stderrs) = List.partition (function x -> Str.string_match (Str.regexp "stdout") x 0) files in List.iter (function x -> Common.file_to_stdout (prefix^"/"^x)) stdouts; List.iter (function x -> Common.file_to_stderr (prefix^"/"^x)) stderrs; let _ = Sys.command (Printf.sprintf "rm -rf %s" prefix) in () in let res = try Parmap.parfold ~init:(fun id -> Parmap.redirect ~path:prefix ~id) ~ncores ~chunksize (fun x y -> op y x) (Parmap.L l) z merge with e -> (Printf.eprintf "exception on %s: %s\n" prefix (Dumper.dump e); clean(); raise e) in clean(); res in let (actual_fold, run_in_parallel) = if ncores <= 1 then (seq_fold, false) else if Cocci.has_finalize cocci_infos then begin pr2 "warning: parallel mode is disabled due to a finalize"; (seq_fold, false) end else (par_fold, true) in let outfiles = Common.profile_code "Main.outfiles computation" (fun () -> let res = infiles +> actual_fold (@) (fun prev cfiles -> if (not !Flag.worth_trying_opt) || Cocci.worth_trying cfiles constants then begin pr2 ("HANDLING: " ^ (String.concat " " 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 (String.concat " " 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 = [] || outfiles = [] || not !FC.show_diff || !inplace_modif then begin (if !inplace_modif then generate_outfiles outfiles x xs); debug_restart virt_rules virt_ids; 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 debug_restart virt_rules virt_ids = if !Flag_parsing_cocci.debug_parse_cocci then begin Printf.fprintf stderr "Starting a new iteration with:\nVirtual rules: %s\n" (String.concat " " virt_rules); Printf.fprintf stderr "Virtual identifiers: %s\n\n" (String.concat ", " (List.map (function (a,b) -> Printf.sprintf "%s: %s" a b) virt_ids)) end 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/"^Filename.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 && xs=[] -> Common.command2 ("cp " ^outfile^ " " ^ !output_file) | [infile, None] when infile = x && xs=[] -> Common.command2 ("cp " ^infile^ " " ^ !output_file) | [] -> failwith ("-o can not be applied because there are no " ^ "modified files") | _ -> 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 = Read_options.read_options all_string_option_names arglist in let arglist = fix_idutils arglist in (if List.mem "--print-options-only" arglist then begin Printf.eprintf "options: %s\n" (String.concat " " arglist); raise (UnixExit 0) end); 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) && not (List.mem "--rule-dependencies" arglist) in if (Common.inter_set arglist ["--cocci-file";"--sp-file";"--sp";"--test";"--testall"; "--test-okfailed";"--test-regression-okfailed"]) <> [] || 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; let uses_distribution = (!distrib_index <> None) || (!distrib_max <> None) || !mod_distrib in let uses_parmap = (!parmap_cores <> None) || (!parmap_chunk_size <> None) in if uses_distribution && uses_parmap then begin pr2 "error: distribution and parallelism are not compatible"; exit 1 end; (* 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_spacing -> (if !FC.include_path = [] then FC.include_path := ["tests/include"]); let score_file = if !expected_spacing_score_file <> "" then !expected_spacing_score_file else "tests/SCORE_spacing_expected.sexp" in Testing.test_spacing 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 | [] when !action = "--rule-dependencies" -> Testing.test_rule_dependencies !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.4/credits.txt0000644000175000017500000000076412614153277015021 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.4/authors.txt0000644000175000017500000000202512614153277015041 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.4/tests/0000755000175000017500000000000012614155375013757 5ustar eugeneugencoccinelle-1.0.4/tests/signed.c0000644000175000017500000000006512614153277015374 0ustar eugeneugenint main() { signed x; unsigned a; return x; } coccinelle-1.0.4/tests/as_stm.res0000644000175000017500000000007312614153277015757 0ustar eugeneugenint main () { #ifdef BEFORE if (f()) return 15; #endif } coccinelle-1.0.4/tests/memset.cocci0000644000175000017500000000176312614153277016261 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.4/tests/posiso.res0000644000175000017500000000020012614153277015775 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.4/tests/switch.cocci0000644000175000017500000000001612614153277016256 0ustar eugeneugen@@ @@ - f(); coccinelle-1.0.4/tests/destroy.c0000644000175000017500000000027612614153277015620 0ustar eugeneugenstatic void wlcore_nvs_cb(const struct firmware *fw, void *context) { if (ret) goto out_irq; goto out; out_irq: free_irq(wl->irq, wl); #ifdef foo out: release_firmware(fw); #endif } coccinelle-1.0.4/tests/ab.c0000644000175000017500000000006112614153277014501 0ustar eugeneugenint main () { foo = 5; a = 12; xxx = 12; } coccinelle-1.0.4/tests/rptr.res0000644000175000017500000000005412614153277015457 0ustar eugeneugenint foo(struct resource *r) { return 1; } coccinelle-1.0.4/tests/remove_call.cocci0000644000175000017500000000024512614153277017251 0ustar eugeneugen@@ identifier FN; type T; identifier x; expression y; @@ ( - T x = <+... FN(...) ...+>; | - y = <+... FN(...) ...+>; | - FN(...); | - return <+... FN(...) ...+>; ) coccinelle-1.0.4/tests/end_commas.cocci0000644000175000017500000000015212614153277017063 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, ..., + .dev = { .name = E, } }; coccinelle-1.0.4/tests/sw.cocci0000644000175000017500000000003012614153277015402 0ustar eugeneugen@@ @@ - f(...) { ... } coccinelle-1.0.4/tests/endnl.cocci0000644000175000017500000000020112614153277016051 0ustar eugeneugen@@ expression e; @@ + #ifdef FOO + call(e); + #endif foo(e); @@ expression e; @@ bar(e); + #ifdef BAR + call(e); + #endif coccinelle-1.0.4/tests/rems.cocci0000644000175000017500000000002712614153277015725 0ustar eugeneugen@@ @@ - if (...) a(); coccinelle-1.0.4/tests/arg.res0000644000175000017500000000007112614153277015240 0ustar eugeneugenint main () { foo(); foo(1); foo(2); foo(1,2); } coccinelle-1.0.4/tests/decl_star.c0000644000175000017500000000005712614153277016064 0ustar eugeneugenint main () { int *x; int x; return x; } coccinelle-1.0.4/tests/incdir.cocci0000644000175000017500000000003112614153277016222 0ustar eugeneugen@@ char *x; @@ - x + 12 coccinelle-1.0.4/tests/bigrepl.c0000644000175000017500000000042112614153277015543 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.4/tests/smallfn.cocci0000644000175000017500000000004512614153277016413 0ustar eugeneugen@@ statement S; @@ { S } +foo(); coccinelle-1.0.4/tests/cst_null.cocci0000644000175000017500000000034412614153277016604 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.4/tests/trailwhite.cocci0000644000175000017500000000004512614153277017133 0ustar eugeneugen@@ type T; expression E; @@ -(T) E coccinelle-1.0.4/tests/rem1.cocci0000644000175000017500000000003412614153277015621 0ustar eugeneugen@@ @@ - if (...) { foo(); }coccinelle-1.0.4/tests/remparam.res0000644000175000017500000000027012614153277016274 0ustar eugeneugenstatic irqreturn_t snd_ad1889_interrupt(void *dev_id, int x ) { return IRQ_HANDLED; } static irqreturn_t snd_ad1889_interrupt(void *dev_id ) { return IRQ_HANDLED; } coccinelle-1.0.4/tests/condexp.c0000644000175000017500000000040612614153277015562 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.4/tests/metaops.c0000644000175000017500000000065512614153277015600 0ustar eugeneugenint p1() { int x = 0; int y = 1; x = x + y; x = x * y; x = x / y; x = x - y; x = x && y; x = x || y; x = x == y; x = x != y; x = x > y; x = x < y; x = x >= y; x = x <= y; x = x % y; x = x | y; x = x & y; x = x ^ y; x = x << y; x = x >> y; return 42; } int p2() { int x = 0; int y = 1; x = 1; x += 2; x -= 3; x *= 4; x /= 5; x %= 6; x |= 7; x &= 8; x ^= 9; x <<= 10; x >>= 11; return 42; } coccinelle-1.0.4/tests/topdec_ver2.res0000644000175000017500000000021412614153277016702 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.4/tests/minusdots_ver1.res0000644000175000017500000000002512614153277017450 0ustar eugeneugenvoid main(int i) { } coccinelle-1.0.4/tests/62.res0000644000175000017500000000050412614153277014717 0ustar eugeneugenstatic struct usb_driver carl9170_driver = { .id_table = carl9170_usb_ids, #if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,27)) .soft_unbind = 1, #endif #ifdef CONFIG_PM .reset_resume = carl9170_usb_resume, #endif /* CONFIG_PM */ #if (LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0)) .disable_hub_initiated_lpm = 1, #endif }; coccinelle-1.0.4/tests/wierdinit.c0000644000175000017500000000021112614153277016112 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.4/tests/labels_metastatement.c0000644000175000017500000000025212614153277020316 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.4/tests/ifadd.res0000644000175000017500000000013312614153277015535 0ustar eugeneugenint main() { while (y) { if (x) { one(); two(); foo(); } } } coccinelle-1.0.4/tests/lid.cocci0000644000175000017500000000004612614153277015530 0ustar eugeneugen@@ local idexpression x; @@ - x + 12 coccinelle-1.0.4/tests/header_modif.h0000644000175000017500000000002012614153277016525 0ustar eugeneugen int foo(int); coccinelle-1.0.4/tests/cast.cocci0000644000175000017500000000004612614153277015712 0ustar eugeneugen@@ struct xxx *E; @@ - E->foo = 12; coccinelle-1.0.4/tests/retmacro.res0000644000175000017500000000153112614153277016305 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.4/tests/switch.res0000644000175000017500000000010312614153277015764 0ustar eugeneugenint main () { switch (x) { default: break; case X: } } coccinelle-1.0.4/tests/wierd_argument.c0000644000175000017500000000037112614153277017137 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.4/tests/toplevel_macrostmt.res0000644000175000017500000000010712614153277020412 0ustar eugeneugenvoid main(int i) { } module_param(x, int, y); MODULE_AUTHOR("me"); coccinelle-1.0.4/tests/fieldsmin.res0000644000175000017500000000003612614153277016442 0ustar eugeneugenstruct foo x = { .c = 3, }; coccinelle-1.0.4/tests/stm6.c0000644000175000017500000000005712614153277015015 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/metastatement2.c0000644000175000017500000000010012614153277017046 0ustar eugeneugenvoid main(int i) { f(); { replace(); replace(); } g(); } coccinelle-1.0.4/tests/exp.c0000644000175000017500000000014312614153277014714 0ustar eugeneugenint main(int i) { int k = foo(); if(1) { foo(); } else { foo(); } foo(); } coccinelle-1.0.4/tests/disjexpr.cocci0000644000175000017500000000010012614153277016577 0ustar eugeneugen@@ identifier fld; symbol v; @@ ( - v.fld + v->fld | - v + *v ) coccinelle-1.0.4/tests/attradd.cocci0000644000175000017500000000021312614153277016377 0ustar eugeneugen@@ identifier f; @@ char + __attribute__((aligned(1))) f; @@ identifier f; @@ f(...) { ... } + // some comment + // some other comment coccinelle-1.0.4/tests/test12.res0000644000175000017500000000007012614153277015610 0ustar eugeneugenvoid main(int foo) { f(1, 2); foo(); g(2); } coccinelle-1.0.4/tests/struct.c0000644000175000017500000000022512614153277015445 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.4/tests/ifdef2.res0000644000175000017500000000045712614153277015636 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.4/tests/param_end.res0000644000175000017500000000036512614153277016423 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.4/tests/null.cocci0000644000175000017500000000142112614153277015730 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.4/tests/ret.c0000644000175000017500000000011312614153277014707 0ustar eugeneugenint f(int x) { int x; f(); if (E) { return 0; } g(); return 0; } coccinelle-1.0.4/tests/a_and_e.cocci0000644000175000017500000000007212614153277016325 0ustar eugeneugen@@ expression X, Y; @@ g(); + f(Y, 0); ... f(X,Y); coccinelle-1.0.4/tests/mini_null_ref.cocci0000644000175000017500000000022512614153277017601 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.4/tests/gilles-question.c0000644000175000017500000000010612614153277017243 0ustar eugeneugenvoid main(int i) { f(0); if(1) { g(0); } g(0); } coccinelle-1.0.4/tests/ifields.cocci0000644000175000017500000000055012614153277016377 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; @s@ identifier obj; identifier vtbl; initializer list[object.nilla] E; @@ static struct IFaceImpl obj = { E, - &vtbl, + { &vtbl, 4, }, ..., }; coccinelle-1.0.4/tests/b2.res0000644000175000017500000000026512614153277014777 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.4/tests/badexp1.cocci0000644000175000017500000000010112614153277016274 0ustar eugeneugen@@ expression x; @@ foo(x); ... + 3 + x(...,y,...) + * 27 coccinelle-1.0.4/tests/orexp.res0000644000175000017500000000002412614153277015622 0ustar eugeneugenint main() { 4; } coccinelle-1.0.4/tests/starprint.res0000644000175000017500000000011012614153277016507 0ustar eugeneugentypedef int *LPINT; int foo(int *x, int **y) { return *x == **y; } coccinelle-1.0.4/tests/addif.cocci0000644000175000017500000000025412614153277016030 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + /* some comment */ + int xxx() { + /* a comment by itself */ + return 12;/* another comment */ } + #endif int f(...) { ... } coccinelle-1.0.4/tests/multistruct.res0000644000175000017500000000002212614153277017062 0ustar eugeneugen struct three z; coccinelle-1.0.4/tests/ar.c0000644000175000017500000000026712614153277014531 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.4/tests/video_ver2.c0000644000175000017500000000176612614153277016200 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.4/tests/bad_define.res0000644000175000017500000000000012614153277016517 0ustar eugeneugencoccinelle-1.0.4/tests/iterprint.cocci0000644000175000017500000000032312614153277016776 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.4/tests/ip2.c0000644000175000017500000000027012614153277014613 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.4/tests/replace_typedef.res0000644000175000017500000000020012614153277017614 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.4/tests/return_implicit.res0000644000175000017500000000005512614153277017702 0ustar eugeneugenvoid main(void) { foo(); return -ENODEV; } coccinelle-1.0.4/tests/armatch.c0000644000175000017500000000011412614153277015535 0ustar eugeneugenint main () { int foo[4]; int *x; return sizeof(foo) + sizeof(x); } coccinelle-1.0.4/tests/same_expr.cocci0000644000175000017500000000003612614153277016742 0ustar eugeneugen@@ expression E; @@ - f(E,E);coccinelle-1.0.4/tests/gotobreak.cocci0000644000175000017500000000013212614153277016731 0ustar eugeneugen@@ identifier config; @@ config(...) { <... - return; + return 0; ...> } coccinelle-1.0.4/tests/hd.res0000644000175000017500000000005412614153277015063 0ustar eugeneugen#include "hd.h" int f(int x) { return x; } coccinelle-1.0.4/tests/condexp.cocci0000644000175000017500000000022512614153277016417 0ustar eugeneugen@@ identifier displayname; @@ ( -XDisplayName(NULL) +getenv("DISPLAY") | -XDisplayName(displayname) +displayname ? displayname : getenv("DISPLAY") ) coccinelle-1.0.4/tests/retmacro.cocci0000644000175000017500000000010312614153277016566 0ustar eugeneugen@@ expression E, E1; @@ - sizeof(E)/sizeof(E[E1]) + ARRAY_SIZE(E) coccinelle-1.0.4/tests/test9.c0000644000175000017500000000026012614153277015170 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.4/tests/minstruct.res0000644000175000017500000000020212614153277016513 0ustar eugeneugenstatic struct i2c_client client_template = { .dev = { .name = "(unset)", }, .id = -1, .driver = &i2c_driver_videotext }; coccinelle-1.0.4/tests/inherited.c0000644000175000017500000000010512614153277016071 0ustar eugeneugenvoid main(int i) { g(1); //f(2); h(2); h2(2); foo(1); } coccinelle-1.0.4/tests/define_exp.res0000644000175000017500000000015712614153277016602 0ustar eugeneugen#define IRQ_T(info) ((info->flags & ASYNC_SHARE_IRQ) ? \ IRQF_SHARED : IRQF_DISABLED) void main(int i) { } coccinelle-1.0.4/tests/switch_label.c0000644000175000017500000000016312614153277016562 0ustar eugeneugenint main () { switch (event) { case CS_EVENT_CARD_REMOVAL: one(); two(); three(); break; } } coccinelle-1.0.4/tests/metaops0.c0000644000175000017500000000065512614153277015660 0ustar eugeneugenint p1() { int x = 0; int y = 1; x = x + y; x = x * y; x = x / y; x = x - y; x = x && y; x = x || y; x = x == y; x = x != y; x = x > y; x = x < y; x = x >= y; x = x <= y; x = x % y; x = x | y; x = x & y; x = x ^ y; x = x << y; x = x >> y; return 42; } int p2() { int x = 0; int y = 1; x = 1; x += 2; x -= 3; x *= 4; x /= 5; x %= 6; x |= 7; x &= 8; x ^= 9; x <<= 10; x >>= 11; return 42; } coccinelle-1.0.4/tests/const1.cocci0000644000175000017500000000011012614153277016157 0ustar eugeneugen@@ identifier func;@@ func (...) { - const char *i; + float i; ... } coccinelle-1.0.4/tests/dc_close.c0000644000175000017500000000030012614153277015666 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.4/tests/stm2.cocci0000644000175000017500000000004612614153277015645 0ustar eugeneugen@@ statement S; @@ f(); - S g(); coccinelle-1.0.4/tests/compare.res0000644000175000017500000000072212614153277016120 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.4/tests/pb_distribute_type3.cocci0000644000175000017500000000012112614153277020735 0ustar eugeneugen@@ type T; //fresh identifier y; @@ foo(...) { T + y, x; ... } coccinelle-1.0.4/tests/twoproto.res0000644000175000017500000000023712614153277016370 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.4/tests/bigin.c0000644000175000017500000000041012614153277015205 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.4/tests/smallfn.c0000644000175000017500000000041612614153277015557 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.4/tests/const_adding.res0000644000175000017500000000013312614153277017122 0ustar eugeneugenvoid main(int i) { const struct file_operations a; const struct file_operations b; } coccinelle-1.0.4/tests/type_annotated.c0000644000175000017500000000023412614153277017137 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.4/tests/strid.c0000644000175000017500000000005512614153277015247 0ustar eugeneugenint main () { struct foo *a; print(a); } coccinelle-1.0.4/tests/test5.res0000644000175000017500000000113312614153277015533 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.4/tests/inherited_ver1.res0000644000175000017500000000011012614153277017371 0ustar eugeneugenvoid main(int i) { //g(1); f(2); hh(2); hh22(2); bar(1); } coccinelle-1.0.4/tests/failing_andany.c0000644000175000017500000000047312614153277017071 0ustar eugeneugenstatic int smc_probe1(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { request_irq(irq_flags); register_netdev(dev); } static int smc_probe2(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { request_irq(dev); register_netdev(dev); } coccinelle-1.0.4/tests/minenum.c0000644000175000017500000000003212614153277015565 0ustar eugeneugenenum h { x, a, z, q, b }; coccinelle-1.0.4/tests/tup.cocci0000644000175000017500000000052712614153277015574 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.4/tests/varargs2.res0000644000175000017500000000006012614153277016214 0ustar eugeneugenstatic void f(char *fmt, ...) { return NULL; } coccinelle-1.0.4/tests/castdecl.cocci0000644000175000017500000000005012614153277016535 0ustar eugeneugen@@ @@ -long +int @@ @@ -unsigned char coccinelle-1.0.4/tests/noty2.c0000644000175000017500000000015412614153277015175 0ustar eugeneugenmain () { foo(); return; } int main2 () { foo(); return; } blah_t main3 () { foo(); return; } coccinelle-1.0.4/tests/nstruct.c0000644000175000017500000000006712614153277015627 0ustar eugeneugenstruct saa5249_device { struct i2c_client *client; }; coccinelle-1.0.4/tests/warnon.cocci0000644000175000017500000000010612614153277016261 0ustar eugeneugen@@ //identifier f; expression E; @@ * WARN_ON(E && !irqs_disabled()) coccinelle-1.0.4/tests/b2.c0000644000175000017500000000023312614153277014423 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.4/tests/headers.res0000644000175000017500000000072512614153277016110 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.4/tests/allex3.res0000644000175000017500000000017312614153277015662 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } goto out; } return 15; out: } coccinelle-1.0.4/tests/addfield.c0000644000175000017500000000007712614153277015662 0ustar eugeneugenstruct i2c_client I = { .name = E, .foo = 16, }; coccinelle-1.0.4/tests/deref.c0000644000175000017500000000010612614153277015204 0ustar eugeneugenint main () { int **q; foo(*q+12); xxx(q[0]+12); yyy(q+12); } coccinelle-1.0.4/tests/addbefore.c0000644000175000017500000000011112614153277016026 0ustar eugeneugenint main () { if (x) { goto out; } after(); out: return 0; } coccinelle-1.0.4/tests/axnet.cocci0000644000175000017500000000043512614153277016101 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.4/tests/jloop1.cocci0000644000175000017500000000021312614153277016160 0ustar eugeneugen@@ @@ // TODO: Marche pas void cpu_idle(...) { <... - int idle = pm_idle; <... - idle(); + nkidle(); ...> ...> } coccinelle-1.0.4/tests/video_ver3.c0000644000175000017500000000116012614153277016165 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.4/tests/type_ver2.c0000644000175000017500000000005012614153277016034 0ustar eugeneugenint foo() { int x[10]; return 0; } coccinelle-1.0.4/tests/filtercst.cocci0000644000175000017500000000061512614153277016761 0ustar eugeneugen// run --parse-cocci on this. Should give some filtering tokens. // No execution test. @r@ identifier f = {g_malloc,g_malloc0,g_new,g_new0}; expression x; expression list es; statement S1,S2; @@ ( + x = f(es); -if ((x = f(es)) == NULL) -S1 else S2 | + x = f(es); -if ((x = f(es)) != NULL) S1 -else S2 | + x = f(es); -if ((x = f(es)) == NULL) -S1 | + x = f(es); -if ((x = f(es)) != NULL) S1 )coccinelle-1.0.4/tests/constty.cocci0000644000175000017500000000004412614153277016461 0ustar eugeneugen@@ type T; const T x; @@ - f(x,T); coccinelle-1.0.4/tests/stm1.cocci0000644000175000017500000000007212614153277015643 0ustar eugeneugen@@ statement S; @@ f(); S g(); @script:python@ @@ coccinelle-1.0.4/tests/inclifdef.c0000644000175000017500000000010312614153277016037 0ustar eugeneugen#include #ifdef CONFIG #include #endif coccinelle-1.0.4/tests/stm2.c0000644000175000017500000000005712614153277015011 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/array_size.res0000644000175000017500000000012212614153277016634 0ustar eugeneugen#define MAX_SETUP_STRINGS ARRAY_SIZE(setup_strings) #define SETUP_BUFFER_SIZE 200 coccinelle-1.0.4/tests/anon.cocci0000644000175000017500000000055312614153277015716 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.4/tests/a_and_e_ver1.res0000644000175000017500000000014112614153277016770 0ustar eugeneugenvoid main(int i) { g(); f(2, 0); if(1) f(1,2); else f(2,2); // return 1; } coccinelle-1.0.4/tests/partial.cocci0000644000175000017500000000005512614153277016414 0ustar eugeneugen@@ statement S; @@ - PAGE_SIZE + PAGE_SIZE2 coccinelle-1.0.4/tests/stm4.c0000644000175000017500000000005712614153277015013 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/smallfn.res0000644000175000017500000000101212614153277016117 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.4/tests/multiplus.c0000644000175000017500000000063612614153277016165 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.4/tests/typedef_double.c0000644000175000017500000000021212614153277017107 0ustar eugeneugentypedef struct stlpcibrd { unsigned short vendid; unsigned short devid; int brdtype; } stlpcibrd_t; int main () { sema_init(x); } coccinelle-1.0.4/tests/decmeta.c0000644000175000017500000000015712614153277015527 0ustar eugeneugenint main () { decimal(TEN,FIVE) x1; decimal(10,5) x2; decimal(20,5) x3; return x1 + x2 + x3 + 6 + 7; } coccinelle-1.0.4/tests/enum.cocci0000644000175000017500000000012312614153277015720 0ustar eugeneugen@@ expression *E; @@ ( E == - 0 + NULL | E != - 0 + NULL | E = - 0 + NULL ) coccinelle-1.0.4/tests/print_return.cocci0000644000175000017500000000017312614153277017514 0ustar eugeneugen@@ expression E; identifier config; @@ config(struct pcmcia_device *link) { ... + return bar(); - return 0; } coccinelle-1.0.4/tests/badpost.cocci0000644000175000017500000000021312614153277016410 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.4/tests/shared_brace.c0000644000175000017500000000017112614153277016523 0ustar eugeneugen int __init ixj_init(void) { if (pci_present()) { if ((probe = ixj_probe_pci(&cnt)) < 0) { return probe; } } } coccinelle-1.0.4/tests/arraysz.cocci0000644000175000017500000000012112614153277016445 0ustar eugeneugen@ disable all @ type T; const T[] E; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) coccinelle-1.0.4/tests/ifdefmeta2.cocci0000644000175000017500000000004712614153277016767 0ustar eugeneugen@@ expression E,E1; @@ -E1=alloca(E); coccinelle-1.0.4/tests/structfoo.c0000644000175000017500000000005612614153277016153 0ustar eugeneugenstruct foo my_foo[] = { .a = 1, .u.b = 42, }; coccinelle-1.0.4/tests/enum.res0000644000175000017500000000032312614153277015433 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.4/tests/regexp3.cocci0000644000175000017500000000175612614153277016346 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.4/tests/video1_ver1.c0000644000175000017500000002501312614153277016247 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.4/tests/unelse.c0000644000175000017500000000017112614153277015414 0ustar eugeneugenstatic short find_control(u16 control_index) { if (!*pI) return 0; else { HPI_DEBUG_LOG(three, one); } } coccinelle-1.0.4/tests/switchtest.cocci0000644000175000017500000000044312614153277017162 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.4/tests/comment_brace2.res0000644000175000017500000000016712614153277017355 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ { release_region(); continue; } return 0; } coccinelle-1.0.4/tests/test0.c0000644000175000017500000000005512614153277015161 0ustar eugeneugenint main(int i) { f(1); f(2); f(1); } coccinelle-1.0.4/tests/makes_a_loop.c0000644000175000017500000000037412614153277016557 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.4/tests/ty.res0000644000175000017500000000006312614153277015124 0ustar eugeneugenint main () { const struct foo x; return 12; } coccinelle-1.0.4/tests/ty1.cocci0000644000175000017500000000010712614153277015473 0ustar eugeneugen@@ type T; identifier fn; @@ fn(...) { T x; - foo(int,T); } coccinelle-1.0.4/tests/ifadd.cocci0000644000175000017500000000005312614153277016025 0ustar eugeneugen@@ @@ if (...) { ... + foo(); // two(); } coccinelle-1.0.4/tests/initializer_many_fields.cocci0000644000175000017500000000005712614153277021657 0ustar eugeneugen@@ @@ *struct foo x = { .b = 15, .c = 22, }; coccinelle-1.0.4/tests/type.cocci0000644000175000017500000000010612614153277015736 0ustar eugeneugen@@ type T; @@ foo(...) { <... - T x; + T *x; ...> } coccinelle-1.0.4/tests/branchparen.cocci0000644000175000017500000000003012614153277017234 0ustar eugeneugen@@ @@ + foo(); xxx();coccinelle-1.0.4/tests/dropenderr.c0000644000175000017500000000013712614153277016267 0ustar eugeneugenint main () { if (x) goto end; if (x) goto end2; return 0; end: end2: return -1; } coccinelle-1.0.4/tests/metahex.res0000644000175000017500000000001712614153277016122 0ustar eugeneugenint main() { } coccinelle-1.0.4/tests/strid2.c0000644000175000017500000000020612614153277015327 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.4/tests/format2.cocci0000644000175000017500000000024312614153277016331 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.4/tests/nestplus.c0000644000175000017500000000007312614153277015777 0ustar eugeneugenint foo() { if (x) { xxx(); return;} yyy(); xxx(); } coccinelle-1.0.4/tests/paren1.c0000644000175000017500000000004312614153277015305 0ustar eugeneugenint main () { return (x) && y; } coccinelle-1.0.4/tests/getc.res0000644000175000017500000000011512614153277015410 0ustar eugeneugenint IFoo_QueryInterface(int *iface, long *riid, void **ppv) { return 12; } coccinelle-1.0.4/tests/minusall.res0000644000175000017500000000000012614153277016303 0ustar eugeneugencoccinelle-1.0.4/tests/reserved.cocci0000644000175000017500000000017512614153277016602 0ustar eugeneugen@@ expression type; expression error; expression list; @@ - f(type,type); - f(list,list,list); - f(error,error,error,error);coccinelle-1.0.4/tests/elsify.res0000644000175000017500000000007112614153277015762 0ustar eugeneugenint main () { if (x) rc = 1; else rc = 2; } coccinelle-1.0.4/tests/twoproto.cocci0000644000175000017500000000027012614153277016654 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.4/tests/decl2.cocci0000644000175000017500000000017612614153277015755 0ustar eugeneugen// pb: foo doesn't get added @@ identifier ioctl, cmd, arg; @@ ioctl(int cmd, void *arg) { ... - x + y ... } coccinelle-1.0.4/tests/hil1.cocci0000644000175000017500000000002012614153277015605 0ustar eugeneugen@@ @@ - 12 + 5 coccinelle-1.0.4/tests/reserved.c0000644000175000017500000000012712614153277015741 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.4/tests/metaops0.res0000644000175000017500000000065512614153277016227 0ustar eugeneugenint p1() { int x = 0; int y = 1; x = x + y; x = x * y; x = x / y; x = x - y; x = x && y; x = x || y; x = x == y; x = x != y; x = x > y; x = x < y; x = x >= y; x = x <= y; x = x % y; x = x | y; x = x & y; x = x ^ y; x = x << y; x = x >> y; return 42; } int p2() { int x = 0; int y = 1; x = 1; x += 2; x -= 3; x *= 4; x /= 5; x %= 6; x |= 7; x &= 8; x ^= 9; x <<= 10; x >>= 11; return 42; } coccinelle-1.0.4/tests/return.c0000644000175000017500000000015412614153277015441 0ustar eugeneugenvoid foo(int y) { int x; if (x) { aaa(); bbb(); return; } if (x) { aaa(); bbb(); return; } ccc(); } coccinelle-1.0.4/tests/kr.res0000644000175000017500000000004512614153277015104 0ustar eugeneugenint a(x) b c; { y = (j) r; } coccinelle-1.0.4/tests/ppos.cocci0000644000175000017500000000055512614153277015746 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.4/tests/cards.res0000644000175000017500000000000712614153277015562 0ustar eugeneugenint x; coccinelle-1.0.4/tests/dropf.res0000644000175000017500000000005212614153277015600 0ustar eugeneugenint main() { x = f(1 + 3) + f(3 + 3); } coccinelle-1.0.4/tests/multi_inc.c0000644000175000017500000000006312614153277016104 0ustar eugeneugen#include "multi_inc1.h" int main () { f(xxx); } coccinelle-1.0.4/tests/switch_case.c0000644000175000017500000000015512614153277016417 0ustar eugeneugenvoid main(void) { switch(1) { case CASE1: case1(); break; case CASE2: case2(); break; } } coccinelle-1.0.4/tests/attradd.c0000644000175000017500000000003212614153277015540 0ustar eugeneugenint main () { char f; } coccinelle-1.0.4/tests/expopt3_ver2.c0000644000175000017500000000020112614153277016453 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.4/tests/const1.c0000644000175000017500000000006612614153277015333 0ustar eugeneugenvoid foo(int j) { const char *i; int i; i++; } coccinelle-1.0.4/tests/three_types.cocci0000644000175000017500000000061512614153277017315 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.4/tests/memory.c0000644000175000017500000000017112614153277015431 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.4/tests/expopt.c0000644000175000017500000000005312614153277015437 0ustar eugeneugenint main() { int *x; f(x); *x = 7; } coccinelle-1.0.4/tests/julia10.res0000644000175000017500000000004312614153277015733 0ustar eugeneugenint main(int x) { f(); g(); } coccinelle-1.0.4/tests/remparam.cocci0000644000175000017500000000012512614153277016562 0ustar eugeneugen@@ identifier fn, regs; @@ fn (..., - struct pt_regs *regs, ...) { ... } coccinelle-1.0.4/tests/serio.cocci0000644000175000017500000000052412614153277016102 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.4/tests/km.res0000644000175000017500000000012712614153277015100 0ustar eugeneugenint main() { int *data = kzalloc(element->string.length + 1, GFP_KERNEL); foo(); } coccinelle-1.0.4/tests/macro.c0000644000175000017500000000025612614153277015226 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.4/tests/multivars.c0000644000175000017500000000006712614153277016153 0ustar eugeneugenvoid main(int i) { f(1+2+v.field1,1+2+v.field1); } coccinelle-1.0.4/tests/video_ver1.c0000644000175000017500000000200312614153277016160 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.4/tests/mult.c0000644000175000017500000000006712614153277015106 0ustar eugeneugen// doesn't match int main() { xxx(27); goo(27); } coccinelle-1.0.4/tests/useless_cast.cocci0000644000175000017500000000007512614153277017457 0ustar eugeneugen@r@ type T; identifier x; T E; @@ T x = - (T) E; coccinelle-1.0.4/tests/int2bool-local.cocci0000644000175000017500000000372312614153277017605 0ustar eugeneugen/* match all explicit boolean functions */ @boolean_function@ identifier fbool; typedef bool; @@ bool fbool(...) { ... } /* match variables eligible for boolean conversion */ @eligible_var exists@ identifier f, boolean_function.fbool; typedef u1, u2, u4, u8, u16, u32; local idexpression {int, u8, u1, u2, u4, u16, u32, char} x; identifier xname; expression e1, e2; position p; binary operator bop = { &&, ||, ==, !=, <, <=, >, >= }; @@ f@p(...) { ...when any ( x@xname = 1; | x@xname = 0; | x@xname = (e1) ? 0 : 1; | x@xname = (e2) ? 1 : 0; | x@xname = fbool(...); | x@xname = e1 bop e2 ) ...when any } /* match all acceptable complex assignement */ @valid_assign exists@ identifier eligible_var.f, boolean_function.fbool; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; expression e1, e2; position p; binary operator bop = { &&, ||, ==, !=, <, <=, >, >= }; @@ f(...) { ...when any ( x@p = (e1) ? 0 : 1; | x@p = (e1) ? 1 : 0; | x@p = fbool(...); | x@p = e1 bop e2 ) ...when any } /* match any expression where x is used as an int */ @badvar1 exists@ identifier eligible_var.f; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; expression e1 != {0, 1}, e2; position p != {valid_assign.p}; binary operator bop = { +, -, *, /, &, |, %, ^, <<, >> }; assignment operator aop = { +=, -=, *=, /=, %=, |=, &=, ^=, <<=, >>= }; @@ f(...) { ...when any ( x@p = e1; | x aop e2 | e2 aop x | x++ | ++x | x-- | --x | x bop e2 | e2 bop x | ~x | return x; ) ...when any } @depends on !badvar1@ identifier eligible_var.f; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; identifier eligible_var.xname; type t; expression e; @@ f(...) { ... ( ++ bool xname = false; - t xname = 0; | ++ bool xname = true; - t xname = 1; | ++ bool xname; - t xname; ) <... ( x = - 1 + true | x = - 0 + false | - x = (e) ? 1 : 0 + x = (e) ? true : false | - x = (e) ? 0 : 1 + x = (e) ? false : true ) ...> } coccinelle-1.0.4/tests/static.cocci0000644000175000017500000000007012614153277016244 0ustar eugeneugen@@ statement S; identifier f; @@ static f(...) { - S } coccinelle-1.0.4/tests/rem2.res0000644000175000017500000000004212614153277015332 0ustar eugeneugenint main () { xxx(); yyy(); } coccinelle-1.0.4/tests/as_stm_pos.cocci0000644000175000017500000000036512614153277017133 0ustar eugeneugen@r@ position p1,p2; statement s; @@ 12@p1@s@p2 @script:ocaml@ p1 << r.p1; p2 << r.p2; @@ let p1 = List.hd p1 in let p2 = List.hd p2 in Printf.printf "%d %d %d\n" p1.line p1.col p1.col_end; Printf.printf "%d %d %d\n" p2.line p2.col p2.col_end coccinelle-1.0.4/tests/badcomma.cocci0000644000175000017500000000010112614153277016513 0ustar eugeneugen@@ @@ - struct usb_serial_device_type + struct usb_serial_driver coccinelle-1.0.4/tests/exp.res0000644000175000017500000000014312614153277015263 0ustar eugeneugenint main(int i) { int k = bar(); if(1) { bar(); } else { bar(); } bar(); } coccinelle-1.0.4/tests/introbrace.c0000644000175000017500000000016112614153277016250 0ustar eugeneugenint main() { if (x) rc = request_threaded_irq(a, b); else rc = request_threaded_irq(a, b); } coccinelle-1.0.4/tests/badfree.cocci0000644000175000017500000000021112614153277016342 0ustar eugeneugen@@ expression x; expression E; expression f; @@ free(x); ... WHEN != x = E + printf("possible use after free!!\n"); f(...,x,...); coccinelle-1.0.4/tests/braces.cocci0000644000175000017500000000003212614153277016212 0ustar eugeneugen@@ @@ - { foo(); - } coccinelle-1.0.4/tests/dc_close.cocci0000644000175000017500000000037712614153277016542 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.4/tests/enum2.cocci0000644000175000017500000000004612614153277016006 0ustar eugeneugen@@ expression *E; @@ E = - 0 + NULL coccinelle-1.0.4/tests/edots.cocci0000644000175000017500000000004112614153277016071 0ustar eugeneugen@@ identifier x; @@ - x[...] + xcoccinelle-1.0.4/tests/nocast.c0000644000175000017500000000015612614153277015413 0ustar eugeneugenint main (unsigned int __nocast gfp_mask, int x) { buf = kmalloc(sizeof *send_buf + buf_size, gfp_mask); } coccinelle-1.0.4/tests/localid.cocci0000644000175000017500000000017512614153277016372 0ustar eugeneugen@@ local idexpression int x; @@ - f(x); @@ idexpression int x; @@ - f(x); + g(x); @@ idexpression x; @@ - f(x); + h(x); coccinelle-1.0.4/tests/fn_todo.res0000644000175000017500000000051212614153277016117 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.4/tests/not_converted.cocci0000644000175000017500000000107012614153277017627 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.4/tests/pb_distribute_type.c0000644000175000017500000000016112614153277020020 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.4/tests/edots_ver1.res0000644000175000017500000000006512614153277016545 0ustar eugeneugenvoid main(int i) { foo; bar; f(foo + bar); } coccinelle-1.0.4/tests/constrem.res0000644000175000017500000000000112614153277016312 0ustar eugeneugen coccinelle-1.0.4/tests/protox.res0000644000175000017500000000005312614153277016022 0ustar eugeneugenint f(int x); int f(int x) { return 12; } coccinelle-1.0.4/tests/match_init.cocci0000644000175000017500000000005212614153277017074 0ustar eugeneugen@@ expression x; @@ -x = 3 +a=12 ... f(x)coccinelle-1.0.4/tests/multichars.res0000644000175000017500000000007512614153277016646 0ustar eugeneugenint main () { f('XYZ',12); f('X\nY',12); f('\n',12); } coccinelle-1.0.4/tests/nocast.cocci0000644000175000017500000000016712614153277016253 0ustar eugeneugen@@ identifier f, gfp; type T; @@ f(..., - T gfp + gfp_t gfp , ...) { ... kmalloc(...,gfp) ... } coccinelle-1.0.4/tests/td.cocci0000644000175000017500000000005012614153277015362 0ustar eugeneugen@@ type T; @@ T { - int a; + int b; }; coccinelle-1.0.4/tests/addif2.c0000644000175000017500000000010512614153277015247 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.4/tests/ip2.cocci0000644000175000017500000000010712614153277015450 0ustar eugeneugen@@ statement s1, s2; @@ if(...) +{trace("ifelel"); s1 +} else s2 coccinelle-1.0.4/tests/pb_distribute_type2.res0000644000175000017500000000016612614153277020456 0ustar eugeneugenint foo() { int *x; return 0; } int foo() { int **x; return 0; } int foo() { int (*x)[45]; return 0; } coccinelle-1.0.4/tests/double_lines.c0000644000175000017500000000010212614153277016557 0ustar eugeneugenint main () { test(); foo(); foo(); foo(); endtest(); } coccinelle-1.0.4/tests/test12.cocci0000644000175000017500000000006612614153277016104 0ustar eugeneugen@@ expression X, Y; @@ - f(X) + f(X, Y) ... g(Y) coccinelle-1.0.4/tests/addaft.res0000644000175000017500000000010612614153277015711 0ustar eugeneugenint main () { foo(); bar(); foo(); bar(); foo(); bar(); } coccinelle-1.0.4/tests/keep_comma.c0000644000175000017500000000013012614153277016214 0ustar eugeneugenint main () { foo(); snd_assert(!atomic_read(&substream->runtime->mmap_count), ); } coccinelle-1.0.4/tests/tydisj.cocci0000644000175000017500000000036312614153277016270 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.4/tests/badexp.c0000644000175000017500000000004212614153277015361 0ustar eugeneugenint main() { foo(a); b = a; } coccinelle-1.0.4/tests/const1bis.cocci0000644000175000017500000000013012614153277016657 0ustar eugeneugen@disable add_signed@ identifier func;@@ func (...) { - const int i; + float i; ... } coccinelle-1.0.4/tests/testand.c0000644000175000017500000000007212614153277015563 0ustar eugeneugenint main () { f(1,2,3,4); f(3,4,8,9); f(8,9,3,4); } coccinelle-1.0.4/tests/headers.cocci0000644000175000017500000000030212614153277016366 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.4/tests/ctr_unit_test.c0000644000175000017500000000060612614153277017012 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.4/tests/minstruct.cocci0000644000175000017500000000014512614153277017010 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, + .dev = { .name = E, }, }; coccinelle-1.0.4/tests/metaops0.cocci0000644000175000017500000000017612614153277016514 0ustar eugeneugen@@ expression e1, e2; binary operator op1; @@ * e1 op1 e2 @@ expression e1, e2; assignment operator aop; @@ * e1 aop e2 coccinelle-1.0.4/tests/badzero.c0000644000175000017500000000023212614153277015545 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.4/tests/as_stm.cocci0000644000175000017500000000011512614153277016243 0ustar eugeneugen@r@ statement S; @@ f()@S @@ statement r.S; @@ + #ifdef BEFORE S + #endif coccinelle-1.0.4/tests/addbeforeafter.res0000644000175000017500000000013712614153277017427 0ustar eugeneugenint main () { if (x) { foo(); goto out; bar(); } after(); out: return 0; } coccinelle-1.0.4/tests/param.c0000644000175000017500000000002712614153277015221 0ustar eugeneugenvoid foo() { return; } coccinelle-1.0.4/tests/pb_distribute_type.res0000644000175000017500000000016612614153277020374 0ustar eugeneugenint foo() { int *x; return 0; } int foo() { int **x; return 0; } int foo() { int (*x)[45]; return 0; } coccinelle-1.0.4/tests/double_switch.c0000644000175000017500000000070412614153277016756 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.4/tests/mdeclp.c0000644000175000017500000000006012614153277015362 0ustar eugeneugenint one() { return 1; } int two() { return 1; } coccinelle-1.0.4/tests/lvalue.res0000644000175000017500000000006012614153277015755 0ustar eugeneugenint main() { f(x) = f(x) + 1; *f(x) = 12; } coccinelle-1.0.4/tests/positionc.c0000644000175000017500000000037312614153277016134 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.4/tests/define_chip_t.c0000644000175000017500000000054212614153277016703 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.4/tests/lvalue.cocci0000644000175000017500000000002212614153277016242 0ustar eugeneugen@@ @@ - x + f(x) coccinelle-1.0.4/tests/badexp1.c0000644000175000017500000000004112614153277015441 0ustar eugeneugenint main() { foo(a); a(y); } coccinelle-1.0.4/tests/testprint.cocci0000644000175000017500000000017012614153277017012 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.4/tests/ctr_unit_test.cocci0000644000175000017500000000250712614153277017652 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.4/tests/test8.cocci0000644000175000017500000000016512614153277016031 0ustar eugeneugen@@ identifier bar; identifier i; identifier func; @@ func( + char i, int bar) { ... - int i; ... } coccinelle-1.0.4/tests/retest.res0000644000175000017500000000007412614153277016000 0ustar eugeneugenint main () { foo(); if (f(x)) return 3; bar(); } coccinelle-1.0.4/tests/null_bool.c0000644000175000017500000000020712614153277016106 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.4/tests/positions3.cocci0000644000175000017500000000042212614153277017070 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.4/tests/anon.res0000644000175000017500000000062012614153277015422 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.4/tests/pb_distribute_type2.c0000644000175000017500000000016112614153277020102 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.4/tests/ret2.c0000644000175000017500000000011312614153277014771 0ustar eugeneugenint main() { if (foo()) xxx(); xxx(); if (foo()) return; return; } coccinelle-1.0.4/tests/toplevel_struct.res0000644000175000017500000000365112614153277017734 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.4/tests/dropbr.cocci0000644000175000017500000000005312614153277016246 0ustar eugeneugen@@ @@ if (...) - { - bar( + foo( ); - } coccinelle-1.0.4/tests/a3d.c0000644000175000017500000000054612614153277014576 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.4/tests/posmult.c0000644000175000017500000000017212614153277015625 0ustar eugeneugenint main() { int *x = NULL; int *y = NULL; if (r) x = ALLOC(); y = ALLOC(); if (!x) return; if (!y) return; } coccinelle-1.0.4/tests/pt_regs_summary0000644000175000017500000001044412614153277017124 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.4/tests/structfoo.cocci0000644000175000017500000000013612614153277017010 0ustar eugeneugen@@ declarer name FOO; @@ - struct foo my_foo[] = { - .a = 1, - .u.b = 42, - }; + FOO(1, 42); coccinelle-1.0.4/tests/eb1.cocci0000644000175000017500000000050712614153277015431 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.4/tests/local.res0000644000175000017500000000005212614153277015560 0ustar eugeneugenint f(int a, int b, int yy) { return 0; } coccinelle-1.0.4/tests/formatlist.c0000644000175000017500000000043412614153277016307 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.4/tests/tyex.c0000644000175000017500000000024512614153277015114 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.4/tests/pb_distribute_type.cocci0000644000175000017500000000007512614153277020662 0ustar eugeneugen@@ type T; @@ foo(...) { - T x; + T *x; ... } coccinelle-1.0.4/tests/local.cocci0000644000175000017500000000014212614153277016047 0ustar eugeneugen@@ local function f; identifier x, y; @@ f( + int a, int b, - int x, int y ) { ... } coccinelle-1.0.4/tests/structfoo.res0000644000175000017500000000001412614153277016514 0ustar eugeneugenFOO(1, 42); coccinelle-1.0.4/tests/const_adding.cocci0000644000175000017500000000020712614153277017413 0ustar eugeneugen@@ identifier I; @@ ( const struct file_operations I; | + const struct file_operations I; ) //- const struct file_operations I; coccinelle-1.0.4/tests/yloop.cocci0000644000175000017500000000027112614153277016122 0ustar eugeneugen@@ identifier buffer; identifier hostptr; @@ arxescsi_proc_info ( + struct Scsi_Host *hostptr, char *buffer) { ... - hostptr = scsi_host_hn_get(hostno); ... } coccinelle-1.0.4/tests/labels_metastatement2.cocci0000644000175000017500000000007412614153277021240 0ustar eugeneugen@@ statement S; @@ if (x) S // if S1 else S2 + else foo();coccinelle-1.0.4/tests/rule3.cocci0000644000175000017500000000041012614153277016005 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.4/tests/exp.cocci0000644000175000017500000000002612614153277015552 0ustar eugeneugen@@ @@ - foo() + bar()coccinelle-1.0.4/tests/string.cocci0000644000175000017500000000010712614153277016264 0ustar eugeneugen@@ identifier I; @@ - MODULE_PARM(I, "i"); + module_param(I, int, 0); coccinelle-1.0.4/tests/initializer_iso.c0000644000175000017500000000037312614153277017322 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.4/tests/invert.res0000644000175000017500000000003512614153277015776 0ustar eugeneugenint main () { x = z + y; } coccinelle-1.0.4/tests/strid2.cocci0000644000175000017500000000012312614153277016163 0ustar eugeneugen@r@ expression struct *a; @@ -a +f(a,12) @s@ expression enum *a; @@ -a +f(a,12) coccinelle-1.0.4/tests/metaops.cocci0000644000175000017500000000057412614153277016436 0ustar eugeneugen@@ expression e1, e2; binary operator op1 = { -, *, /, %, |, &, ^, <<, >>, &&, ||, ==, !=, >, >=, <, <= } ; binary operator op2 = + ; @@ ( - e1 op1 e2 + e1 + e2 | - e1 op2 e2 + e1 - e2 ) @@ expression e1, e2; assignment operator aop1 = { +=, -=, *=, /=, %=, |=, &=, ^=, <<=, >>= }; assignment operator aop2 = = ; @@ ( - e1 aop1 e2 + e1 = e2 | - e1 aop2 e2 + e1 += e2 ) coccinelle-1.0.4/tests/disjexpr.c0000644000175000017500000000005312614153277015750 0ustar eugeneugenint main (int i) { f(v.fld, v, v.fld2); } coccinelle-1.0.4/tests/addfield.cocci0000644000175000017500000000016512614153277016516 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, ..., + .dev = { .name = E, }, }; coccinelle-1.0.4/tests/foura.cocci0000644000175000017500000000011012614153277016064 0ustar eugeneugen@ rule1 @ expression E; @@ h(E); @ rule2 extends rule1 @ @@ - i(E); coccinelle-1.0.4/tests/shadow.c0000644000175000017500000000006012614153277015403 0ustar eugeneugenstruct foo bar; struct foo bar = { .a = 12 }; coccinelle-1.0.4/tests/dropcom.cocci0000644000175000017500000000002612614153277016421 0ustar eugeneugen@@ @@ - main() {...} coccinelle-1.0.4/tests/test_exec.cocci0000644000175000017500000000121412614153277016741 0ustar eugeneugen@@ constant n, pr; idexpression decimal(n,pr) i; @@ +{ EXEC SQL ... :i ...; +} @r exists@ constant n, pr; idexpression decimal(n,pr) i; identifier f; position p; @@ f(...) { ... when any EXEC@p SQL ... :i ...; ... when any } @@ constant r.n, r.pr; idexpression decimal(n,pr) r.i; identifier r.f; position r.p; statement S; fresh identifier tmp = "__exec__"; @@ f(...) { <... { ++ char tmp[64]; ... when != S ++decToString(i, tmp); EXEC@p SQL ...; ++stringToDec(tmp, &i); } ...> } @@ identifier i,tmp; @@ decToString(i, tmp); ... when != stringToDec(...); EXEC SQL ... : -i +tmp ...; /* @@ @@ { - { ... - } } */ coccinelle-1.0.4/tests/na.cocci0000644000175000017500000000006112614153277015353 0ustar eugeneugen@r @ expression E; constant C; @@ - !E & C + 12 coccinelle-1.0.4/tests/type_ver2.res0000644000175000017500000000005112614153277016404 0ustar eugeneugenint foo() { int *x[10]; return 0; } coccinelle-1.0.4/tests/change_type.c0000644000175000017500000000007412614153277016411 0ustar eugeneugenint main () { struct foo *x; return (struct blah *)x; } coccinelle-1.0.4/tests/ifdefmeta3.c0000644000175000017500000000014412614153277016130 0ustar eugeneugenint main () { f(); if (foo) { one(); #ifdef ONE two(); #endif three(); } g(); } coccinelle-1.0.4/tests/hd.c0000644000175000017500000000006312614153277014514 0ustar eugeneugen#include "hd.h" int f(int x, int y) { return x; } coccinelle-1.0.4/tests/rule19a.cocci0000644000175000017500000000023112614153277016236 0ustar eugeneugen@@ identifier interrupt; statement S; @@ interrupt(...) { ... ( + spin_unlock(&cs->lock); return; | S + spin_unlock(&cs->lock); ) } coccinelle-1.0.4/tests/max.cocci0000644000175000017500000000023212614153277015542 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.4/tests/addbefore.res0000644000175000017500000000012412614153277016401 0ustar eugeneugenint main () { if (x) { foo(); goto out; } after(); out: return 0; } coccinelle-1.0.4/tests/log.res0000644000175000017500000000032712614153277015254 0ustar eugeneugenstatic struct var_t vars[] = { { CAPS_START, .u.s = {"\x01+35p" } }, { CAPS_STOP, .u.s = {"\x01-35p" } }, { CAPS_STOP, .u.s = {45 } }, { RATE, .u.n = {"\x01%ds", 8, 0, 9, 0, 0, NULL } }, }; int main () { } coccinelle-1.0.4/tests/test6.cocci0000644000175000017500000000007612614153277016030 0ustar eugeneugen@@ expression X; @@ - f(X) + f(X, "foo") //error words = [f]coccinelle-1.0.4/tests/testand2.res0000644000175000017500000000016612614153277016220 0ustar eugeneugenint main () { f(1,2,3,4); m(3,4,80,9); g(8,9,3,4); } int main () { f(1,2,3,4); g(8,9,3,4); f(3,4,8,9); } coccinelle-1.0.4/tests/const_implicit_iso.cocci0000644000175000017500000000005112614153277020646 0ustar eugeneugen@@ identifier x; @@ - int x; + float x; coccinelle-1.0.4/tests/match_const.c0000644000175000017500000000001512614153277016420 0ustar eugeneugenconst int x; coccinelle-1.0.4/tests/operators.cocci0000644000175000017500000000507112614153277017001 0ustar eugeneugen/* match all explicit boolean functions */ @boolean_function@ identifier fbool; typedef bool; @@ bool fbool(...) { ... } /* match variables eligible for boolean conversion */ @eligible_var exists@ identifier f, boolean_function.fbool; typedef u1, u2, u4, u8, u16, u32; local idexpression {int, u8, u1, u2, u4, u16, u32, char} x; identifier xname; expression e1, e2; position p; @@ f@p(...) { ...when any ( x@xname = 1; | x@xname = 0; | x@xname = (e1) ? 0 : 1; | x@xname = (e2) ? 1 : 0; | x@xname = fbool(...); | x@xname = fbool(...); | x@xname = e1 && ... | x@xname = e1 || ... | x@xname = e1 == e2 | x@xname = e1 != e2 | x@xname = e1 < e2 | x@xname = e1 <= e2 | x@xname = e1 > e2 | x@xname = e1 >= e2 ) ...when any } /* match all acceptable complex assignement */ @valid_assign exists@ identifier eligible_var.f, boolean_function.fbool; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; expression e1, e2; position p; @@ f(...) { ...when any ( x@p = (e1) ? 0 : 1; | x@p = (e1) ? 1 : 0; | x@p = fbool(...); | x@p = e1 && ... | x@p = e1 || ... | x@p = e1 == e2 | x@p = e1 != e2 | x@p = e1 < e2 | x@p = e1 <= e2 | x@p = e1 > e2 | x@p = e1 >= e2 ) ...when any } /* match any expression where x is used as an int */ @badvar1 exists@ identifier eligible_var.f; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; expression e1 != {0, 1}, e2; position p != {valid_assign.p}; binary operator op = { <<, *, ==, !=, <=, +, -, /, %, >>, &, |, ^, >=, >, <, &&, || }; assignment operator op2 = { =, +=, -=, *=, /=, %=, &=, |=, ^=, <<=, >>= }; @@ f(...) { ...when any ( x@p = e1; | x += e2 | e2 += x | x *= e2 | e2 *= x | x -= e2 | e2 -= x | x /= e2 | e2 /= x | e2 %= x | x %= e2 | x &= e2 | e2 &= x | x |= e2 | e2 |= x | x ^= e2 | e2 ^= x | x <<= e2 | e2 <<= x | x >>= e2 | e2 >>= x | x++ | ++x | x-- | --x | x + e2 | x - e2 | e2 - x | x & e2 | x | e2 | x * e2 | x / e2 | e2 / x | x % e2 | e2 % x | ~x | e2 ^ x | x ^ e2 | x << e2 | e2 << x | x >> e2 | e2 >> x | return x; ) ...when any } @depends on !badvar1@ identifier eligible_var.f; local idexpression {int, u8, u1, u2, u4, u16, u32, char} eligible_var.x; identifier eligible_var.xname; type t; expression e; @@ f(...) { ... ( ++ bool xname = false; - t xname = 0; | ++ bool xname = true; - t xname = 1; | ++ bool xname; - t xname; ) <... ( x = - 1 + true | x = - 0 + false | - x = (e) ? 1 : 0 + x = (e) ? true : false | - x = (e) ? 0 : 1 + x = (e) ? false : true ) ...> } coccinelle-1.0.4/tests/varargs2.c0000644000175000017500000000004212614153277015645 0ustar eugeneugenstatic void f(char *fmt, ...) { } coccinelle-1.0.4/tests/minusall.cocci0000644000175000017500000000002712614153277016603 0ustar eugeneugen@@ @@ - f(...) { ... }coccinelle-1.0.4/tests/bad_typedef.cocci0000644000175000017500000000024212614153277017224 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.4/tests/swap3.c0000644000175000017500000000060312614153277015156 0ustar eugeneugenstatic void __ar955x_tx_iq_cal_sort(struct ath_hw *ah, struct coeff *coeff, int i, int nmeasurement) { int im, ix, iy, temp; for (iy = ix + 1; iy <= MAXIQCAL - 1; iy++) { // if ( iy <= MAXIQCAL - 1) { if (coeff->mag_coeff[i][im][iy] < coeff->mag_coeff[i][im][ix]) { swap(coeff->mag_coeff[i][im][ix], coeff->mag_coeff[i][im][iy], temp); } } } coccinelle-1.0.4/tests/define_exp.c0000644000175000017500000000015312614153277016227 0ustar eugeneugen#define IRQ_T(info) ((info->flags & ASYNC_SHARE_IRQ) ? \ SA_SHIRQ : SA_INTERRUPT) void main(int i) { } coccinelle-1.0.4/tests/fnty.cocci0000644000175000017500000000050312614153277015736 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.4/tests/ar.cocci0000644000175000017500000000010512614153277015356 0ustar eugeneugen@@ struct foo *x; @@ - x->y = 12; @@ struct foo x; @@ - x.y = 12; coccinelle-1.0.4/tests/null_type.cocci0000644000175000017500000000004012614153277016765 0ustar eugeneugen@@ expression *X; @@ - X + f(X)coccinelle-1.0.4/tests/armatch.cocci0000644000175000017500000000010112614153277016367 0ustar eugeneugen@@ type T; T[] x; expression y; @@ ( sizeof(x) | * sizeof(y) )coccinelle-1.0.4/tests/edots_ver1.c0000644000175000017500000000011512614153277016172 0ustar eugeneugenvoid main(int i) { foo[45]; bar[45+v.field]; f(foo[45] + bar[45]); } coccinelle-1.0.4/tests/struct_typedef.res0000644000175000017500000000035212614153277017535 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.4/tests/regexp.res0000644000175000017500000000062312614153277015764 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.4/tests/ret2.cocci0000644000175000017500000000005312614153277015632 0ustar eugeneugen@@ @@ - return; @@ @@ + bar(); xxx(); coccinelle-1.0.4/tests/exitc.c0000644000175000017500000000006612614153277015240 0ustar eugeneugenint main () { f(a1); f(a2); f(done); f(a4); } coccinelle-1.0.4/tests/defaultscript.c0000644000175000017500000000012612614153277016772 0ustar eugeneugenint main () { one(12); one(nothing); other(nothing); other(12); return x; } coccinelle-1.0.4/tests/p9.cocci0000644000175000017500000000010412614153277015303 0ustar eugeneugen@@ fresh identifier i = "v"; type T; @@ f(...,T + i ,...) {...} coccinelle-1.0.4/tests/pb_tag_symbols.cocci0000644000175000017500000000015712614153277017767 0ustar eugeneugen@@ identifier arg; identifier v; expression E1;//, E2; @@ - if(copy_from_user(v,arg) != 0) return E1; else { }coccinelle-1.0.4/tests/useless_cast.res0000644000175000017500000000052412614153277017167 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.4/tests/allex3.cocci0000644000175000017500000000014412614153277016147 0ustar eugeneugen@exists@ expression e,e1; @@ if (e) { ... when forall when != e1 - return e1; } return 15; coccinelle-1.0.4/tests/kmalloc.c0000644000175000017500000000040012614153277015536 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.4/tests/addtrace.res0000644000175000017500000000055412614153277016244 0ustar eugeneugenshort VerDate(char *pcDate) { short sRetour = 0; if ( pcDate == 0 ) { trace("ifth"); { sRetour = 1; } } trace("endif"); if ( pcDate == 0 ) { trace("ifth"); sRetour = 1; } trace("endif"); if ( pcDate == 0 ) { trace("ifth"); { sRetour = 1; return sRetour; } } trace("endif"); return sRetour; } coccinelle-1.0.4/tests/doubleswitch.cocci0000644000175000017500000000002012614153277017444 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/cptr.c0000644000175000017500000000004012614153277015064 0ustar eugeneugenstatic const char *str = "..."; coccinelle-1.0.4/tests/signed.res0000644000175000017500000000006512614153277015743 0ustar eugeneugenint main() { signed y; unsigned b; return x; } coccinelle-1.0.4/tests/ty_tyexp.c0000644000175000017500000000012412614153277016004 0ustar eugeneugenvoid main(double z) { int x; int y; } int main(int z) { } int main2(int z); coccinelle-1.0.4/tests/of.res0000644000175000017500000000055412614153277015101 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.4/tests/testifdef.cocci0000644000175000017500000000025612614153277016740 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.4/tests/struct.cocci0000644000175000017500000000030312614153277016300 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.4/tests/fields.cocci0000644000175000017500000000007212614153277016225 0ustar eugeneugen@@ @@ struct foo x = { + .a = 1, + .b = 2, + .c = 3, }; coccinelle-1.0.4/tests/change_type.res0000644000175000017500000000005612614153277016760 0ustar eugeneugenint main () { struct foo *x; return 42; } coccinelle-1.0.4/tests/asm.c0000644000175000017500000000043412614153277014703 0ustar eugeneugen! IS'' a test ! you do or don't have to save g[2,3,4], so save them to be safe. /* For Emacs we have a separate interface which corresponds to the normal strftime function and does not have the extra information whether the TP arguments comes from a `gmtime' call or not. */ coccinelle-1.0.4/tests/send_pci10000644000175000017500000000227212614153277015551 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.4/tests/headers.c0000644000175000017500000000100312614153277015527 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.4/tests/fortest.res0000644000175000017500000000023712614153277016161 0ustar eugeneugenint main() { bar(); foo(); bar(); foo(); bar(); foo(); bar(); foo(); bar(); foo(); bar(); foo(); bar(); foo(); bar(); foo(); } coccinelle-1.0.4/tests/ptrar.res0000644000175000017500000000015512614153277015622 0ustar eugeneugenint main () { struct foo *x; struct foo y[12]; *12 = 4; *20 = 2; a = sizeof 20; b = sizeof 12; } coccinelle-1.0.4/tests/proto_ver1.c0000644000175000017500000000042112614153277016217 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.4/tests/fn_todo.c0000644000175000017500000000054212614153277015553 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.4/tests/incpos.c0000644000175000017500000000011712614153277015414 0ustar eugeneugen#include #include "two" #include #include "four" #include coccinelle-1.0.4/tests/type_ver1.res0000644000175000017500000000005412614153277016406 0ustar eugeneugenint foo() { struct foo *x; return 0; } coccinelle-1.0.4/tests/fsh.res0000644000175000017500000000004412614153277015247 0ustar eugeneugenint main () { f(c); g(foo-c); } coccinelle-1.0.4/tests/decl_split.cocci0000644000175000017500000000011412614153277017076 0ustar eugeneugen@@ symbol i, x, y; @@ int func(int i) { - int x, y; //- int x; }coccinelle-1.0.4/tests/topdec_ver2.c0000644000175000017500000000020612614153277016334 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.4/tests/bad_ptr_print.cocci0000644000175000017500000000004312614153277017604 0ustar eugeneugen@@ expression E; @@ - f(E) + g(E) coccinelle-1.0.4/tests/kr.c0000644000175000017500000000005612614153277014537 0ustar eugeneugenint a(x) b c; { y = (j) r; foo(); } coccinelle-1.0.4/tests/nest.cocci0000644000175000017500000000036012614153277015730 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.4/tests/test2.c0000644000175000017500000000010212614153277015154 0ustar eugeneugenvoid main() { f(1,2,3); if(1) g(1); else g(1); } coccinelle-1.0.4/tests/ifzz.res0000644000175000017500000000014312614153277015451 0ustar eugeneugenif 0 char c; #endif size_t foo(void) { size_t i = 1; #if 0 TRACE("\n"); #endif return i; } coccinelle-1.0.4/tests/video4.cocci0000644000175000017500000000020512614153277016147 0ustar eugeneugen@@ identifier v; identifier fld; expression E; @@ struct foo v; m(); <... f(E); <... * v.fld ...> g(E); ...> n(); coccinelle-1.0.4/tests/multi_func.c0000644000175000017500000000015612614153277016271 0ustar eugeneugenvoid fn1(int i) { foo_lock(); i++; } void fn2(int i) { foo_unlock(); i++; } void fn3(int i) { i++; } coccinelle-1.0.4/tests/doundo.cocci0000644000175000017500000000006712614153277016253 0ustar eugeneugen@@ @@ - foo(); + xxx(); @@ @@ - xxx(); + new_foo(); coccinelle-1.0.4/tests/of.cocci0000644000175000017500000000036412614153277015367 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.4/tests/longconst.cocci0000644000175000017500000000051712614153277016771 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.4/tests/four.cocci0000644000175000017500000000035612614153277015737 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.4/tests/gilles-question.res0000644000175000017500000000006412614153277017615 0ustar eugeneugenvoid main(int i) { f(0); if(1) { } } coccinelle-1.0.4/tests/param.res0000644000175000017500000000000112614153277015560 0ustar eugeneugen coccinelle-1.0.4/tests/comments.c0000644000175000017500000000003412614153277015744 0ustar eugeneugen int main() { return 0; } coccinelle-1.0.4/tests/incdir.c0000644000175000017500000000006412614153277015372 0ustar eugeneugen#include "sub/incdir2.c" int main () { foo(x); } coccinelle-1.0.4/tests/multidecl3.cocci0000644000175000017500000000013512614153277017024 0ustar eugeneugen@@ type T; symbol i; @@ - T i; @@ type T; identifier s; @@ struct s { ... - T i; ... }; coccinelle-1.0.4/tests/opt.c0000644000175000017500000000003112614153277014716 0ustar eugeneugenint main () { yyy(); } coccinelle-1.0.4/tests/comment.c0000644000175000017500000000010012614153277015553 0ustar eugeneugenvoid f(int i) { x = 1/* comment*/ ; x = /* comment*/1 ; } coccinelle-1.0.4/tests/unl.cocci0000644000175000017500000000010212614153277015547 0ustar eugeneugen@@ expression e; statement S; @@ - if (e) S + if (unlikely(e)) S coccinelle-1.0.4/tests/tyex.res0000644000175000017500000000032212614153277015457 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.4/tests/testifdef.c0000644000175000017500000023411512614153277016105 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.4/tests/test_s.cocci0000644000175000017500000000012712614153277016261 0ustar eugeneugen@@ statement S1,S2; expression E; @@ if ( - E + 12 ) { S1 S2 } coccinelle-1.0.4/tests/bad_zero.cocci0000644000175000017500000000072312614153277016547 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.4/tests/a3d.res0000644000175000017500000000056512614153277015146 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.4/tests/fun.c0000644000175000017500000000003312614153277014706 0ustar eugeneugenint f(int x) { return x; } coccinelle-1.0.4/tests/trailwhite.c0000644000175000017500000000024612614153277016300 0ustar eugeneugenint main() { if (rep.nEvents) { if (! (tc = (XTimeCoord *) Xmalloc( (unsigned) (nbytes = (long) rep.nEvents * sizeof(XTimeCoord))))) { return; } } } coccinelle-1.0.4/tests/string.res0000644000175000017500000000004412614153277015775 0ustar eugeneugenMODULE_PARM(suppress_pollack, "x"); coccinelle-1.0.4/tests/error.c0000644000175000017500000000030212614153277015246 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.4/tests/decl_star.cocci0000644000175000017500000000004612614153277016720 0ustar eugeneugen@@ type T; symbol x; @@ - T x; + T y;coccinelle-1.0.4/tests/neststruct.cocci0000644000175000017500000000014212614153277017173 0ustar eugeneugen@r@ type T1; T1 *x; expression E,E2; @@ - x = kmalloc(sizeof(E),E2) + x = kzalloc(sizeof(E), E2) coccinelle-1.0.4/tests/ifd.cocci0000644000175000017500000000010212614153277015513 0ustar eugeneugen@@ @@ + #ifdef 0 + #ifdef 10 foo(); ... bar(); + #endif + #endif coccinelle-1.0.4/tests/idstr.cocci0000644000175000017500000000022412614153277016103 0ustar eugeneugen@a disable drop_cast@ format d =~ "08x"; position p; @@ printf@p("...%@d@...",...) @d @ position a.p; expression s; @@ printf@p( - s + "y" ,...) coccinelle-1.0.4/tests/ifelse.cocci0000644000175000017500000000240712614153277016232 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.4/tests/mdecl.cocci0000644000175000017500000000067412614153277016053 0ustar eugeneugen@script:ocaml r@ foo; rv; stm; stm1; unbound; @@ foo := Coccilib.make_ident "one"; rv := Coccilib.make_expr "x < 0"; stm := Coccilib.make_stmt "if (c < 0) return 12;"; stm1 := Coccilib.make_stmt_with_env "int c;" "if (c) return 12;" @@ identifier r.foo; expression r.rv; statement r.stm; expression r.unbound; @@ - foo() { stm ... return rv; } @@ identifier r.foo; expression r.rv; statement r.stm1; @@ - foo() { ... stm1 ... return rv; } coccinelle-1.0.4/tests/three.cocci0000644000175000017500000000076112614153277016073 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.4/tests/xfield.cocci0000644000175000017500000000010312614153277016225 0ustar eugeneugen@@ declarer name FOO; expression a,b,c; @@ - FOO(a,b,c); + int x; coccinelle-1.0.4/tests/argument.cocci0000644000175000017500000000006412614153277016602 0ustar eugeneugen@@ @@ - f(1,2,3); + g(3, 2, 1); @@ @@ - h(...); coccinelle-1.0.4/tests/anon.c0000644000175000017500000000060512614153277015056 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.4/tests/typedef.res0000644000175000017500000000054512614153277016135 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.4/tests/addfield.res0000644000175000017500000000014012614153277016220 0ustar eugeneugenstruct i2c_client I = { .foo = 16, .dev = { .name = E, }, }; coccinelle-1.0.4/tests/post.c0000644000175000017500000000016612614153277015112 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.4/tests/dropbr.c0000644000175000017500000000005212614153277015407 0ustar eugeneugenint main () { if (a) { bar(); } } coccinelle-1.0.4/tests/expopt3_ver1.c0000644000175000017500000000025512614153277016463 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.4/tests/cptr.res0000644000175000017500000000004712614153277015442 0ustar eugeneugenstatic const char * const str = "..."; coccinelle-1.0.4/tests/expopt3_ver2.res0000644000175000017500000000020412614153277017025 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.4/tests/arparam.c0000644000175000017500000000010612614153277015542 0ustar eugeneugenint main(int q[1024]) { return 12; } int fn(int q[]) { return 12; } coccinelle-1.0.4/tests/minenum1.cocci0000644000175000017500000000007512614153277016513 0ustar eugeneugen@@ @@ enum h { ..., - a, - z, + qq, ..., b, ... }; coccinelle-1.0.4/tests/multitypedef.c0000644000175000017500000000025012614153277016632 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.4/tests/positions3.c0000644000175000017500000000024312614153277016233 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.4/tests/regexp.cocci0000644000175000017500000000111512614153277016250 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.4/tests/bad_define.c0000644000175000017500000000002012614153277016152 0ustar eugeneugen#define x a + b coccinelle-1.0.4/tests/find_long.cocci0000644000175000017500000000010312614153277016711 0ustar eugeneugen@ C @ long E1; int E2; @@ ( - E1; + (long)E1; | - E2; + (int)E2; ) coccinelle-1.0.4/tests/disjexpr_ver2.res0000644000175000017500000000005612614153277017260 0ustar eugeneugenint main (int i) { f(v->fld, v->fld2, *v); } coccinelle-1.0.4/tests/incl.c0000644000175000017500000000016712614153277015053 0ustar eugeneugen#include #include #include #ifdef FOO #include #endif FOO coccinelle-1.0.4/tests/deref.cocci0000644000175000017500000000003412614153277016042 0ustar eugeneugen@@ int * x; @@ - x+12 + 12 coccinelle-1.0.4/tests/scope_problem.cocci0000644000175000017500000000013112614153277017604 0ustar eugeneugen@@ identifier a; expression E; @@ - int a; ... - foo(a); <... - a = E; ...>coccinelle-1.0.4/tests/cast_iso.c0000644000175000017500000000033612614153277015730 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.4/tests/three_types.c0000644000175000017500000000031012614153277016447 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.4/tests/ifreturn6.res0000644000175000017500000000016412614153277016416 0ustar eugeneugenint main () { if (x) { blah(); goto end; } else blah(); later(); end: xxx(); end2: return 12; } coccinelle-1.0.4/tests/expopt3.res0000644000175000017500000000024212614153277016071 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.4/tests/elsify.cocci0000644000175000017500000000012012614153277016244 0ustar eugeneugen@@ expression e,e1,e2; @@ if (e) - GOTO(e1); -else GOTO(e2); + e1; +else e2; coccinelle-1.0.4/tests/ifreturn4.c0000644000175000017500000000026012614153277016042 0ustar eugeneugenint GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else if(iFlag_Code==WARNING) { return WARNING; } else { return_ERREUR; } return 0; } coccinelle-1.0.4/tests/type_annotated_fields.cocci0000644000175000017500000000024112614153277021321 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.4/tests/empty.c0000644000175000017500000000027212614153277015261 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.4/tests/arg.cocci0000644000175000017500000000012712614153277015531 0ustar eugeneugen//@@ //@@ // // foo(... //- ,bar() // ) @@ @@ foo(..., - bar(), ...) coccinelle-1.0.4/tests/fnty.res0000644000175000017500000000021512614153277015447 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.4/tests/ifd.c0000644000175000017500000000010712614153277014662 0ustar eugeneugenint main () { one(); foo(); one(); one(); bar(); one(); } coccinelle-1.0.4/tests/decl_space.c0000644000175000017500000000005312614153277016202 0ustar eugeneugenint main () { int *x = y; int x = y; } coccinelle-1.0.4/tests/na.res0000644000175000017500000000014712614153277015071 0ustar eugeneugen#define FOO 10 void foo() { int i; if (12) return; 12; !i & !FOO; 12; 12; !i & !100; } coccinelle-1.0.4/tests/skip.res0000644000175000017500000000002712614153277015436 0ustar eugeneugenint main () { h(); } coccinelle-1.0.4/tests/pcim.cocci0000644000175000017500000000021412614153277015705 0ustar eugeneugen@@ expression E1,E2,E3; @@ - pci_map_single(E1, + dma_map_single( + &E1->dev, E2, E3, - PCI_DMA_FROMDEVICE) + DMA_FROM_DEVICE)coccinelle-1.0.4/tests/longlongint.cocci0000644000175000017500000000010512614153277017306 0ustar eugeneugen@@ type T; identifier x,y; @@ - unsigned T x; - T y; ... when any coccinelle-1.0.4/tests/bus.res0000644000175000017500000000006312614153277015261 0ustar eugeneugenint main () { struct foo *dev; c1(); c2(); } coccinelle-1.0.4/tests/ioctl.cocci0000644000175000017500000000236012614153277016073 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.4/tests/protoassert.res0000644000175000017500000000024212614153277017054 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.4/tests/csw.cocci0000644000175000017500000000010412614153277015547 0ustar eugeneugen@@ @@ switch (x) { - case FOO: ... break; - case XYZ: ... break; } coccinelle-1.0.4/tests/bad_iso_example.c0000644000175000017500000000004712614153277017236 0ustar eugeneugenint main() { if ((x = 3)) return; } coccinelle-1.0.4/tests/type1.c0000644000175000017500000000004412614153277015162 0ustar eugeneugenint foo() { int x; return 0; } coccinelle-1.0.4/tests/remove_call.c0000644000175000017500000000014412614153277016411 0ustar eugeneugenint main () { int x = 3 + FN() + FN(); x = 3 + FN() + FN(); FN(); return 3 + FN() + FN(); } coccinelle-1.0.4/tests/line_before_last.cocci0000644000175000017500000000002012614153277020244 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/befS.res0000644000175000017500000000037512614153277015355 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.4/tests/foura.res0000644000175000017500000000004012614153277015577 0ustar eugeneugenint main () { f(1); h(2); } coccinelle-1.0.4/tests/fnptr.cocci0000644000175000017500000000003612614153277016110 0ustar eugeneugen@@ @@ - SA_INTERRUPT + foo() coccinelle-1.0.4/tests/const_adding.c0000644000175000017500000000012512614153277016554 0ustar eugeneugenvoid main(int i) { const struct file_operations a; struct file_operations b; } coccinelle-1.0.4/tests/nestone.res0000644000175000017500000000005112614153277016140 0ustar eugeneugenint foo() { if (x) { xxx(); return;} } coccinelle-1.0.4/tests/julia10.cocci0000644000175000017500000000005212614153277016222 0ustar eugeneugen@@ statement S; @@ f(); - S g(); - S coccinelle-1.0.4/tests/x.cocci0000644000175000017500000000006112614153277015224 0ustar eugeneugen@@ @@ + 25 + x + + 4 ... + 125 + x + + 48 coccinelle-1.0.4/tests/62.c0000644000175000017500000000032112614153277014345 0ustar eugeneugenstatic struct usb_driver carl9170_driver = { .id_table = carl9170_usb_ids, .soft_unbind = 1, #ifdef CONFIG_PM .reset_resume = carl9170_usb_resume, #endif /* CONFIG_PM */ .disable_hub_initiated_lpm = 1, }; coccinelle-1.0.4/tests/sizeptr.c0000644000175000017500000000017412614153277015624 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.4/tests/a.c0000644000175000017500000000011012614153277014332 0ustar eugeneugenint main () { int a; f(a); h(a); { int a; g(a); r(a); } } coccinelle-1.0.4/tests/x.c0000644000175000017500000000005712614153277014373 0ustar eugeneugenint main () { foo(x); foo(x); foo(x); } coccinelle-1.0.4/tests/addifelse.c0000644000175000017500000000062612614153277016046 0ustar eugeneugenstatic void rfcomm_l2data_ready(struct sock *sk) { BT_DBG("%p", sk); rfcomm_schedule(); } static int rfcomm_l2sock_create(struct socket **sock) { int err; BT_DBG(""); err = sock_create_kern(PF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP, sock); if (!err) { struct sock *sk = (*sock)->sk; sk->sk_data_ready = rfcomm_l2data_ready; sk->sk_state_change = rfcomm_l2state_change; } return err; } coccinelle-1.0.4/tests/test4.cocci0000644000175000017500000000010112614153277016013 0ustar eugeneugen@@ expression X,Y; @@ f(...,X,Y,...); ... - h(X); ... g(X); coccinelle-1.0.4/tests/xloop.c0000644000175000017500000000010012614153277015252 0ustar eugeneugenint main (int x) { f(); for (x=0; x!=10; x++) h(); g(); } coccinelle-1.0.4/tests/typeof.cocci0000644000175000017500000000006212614153277016264 0ustar eugeneugen@@ type T; T E; @@ - f(E); ... - f(sizeof(T)); coccinelle-1.0.4/tests/rcu3.cocci0000644000175000017500000000014212614153277015631 0ustar eugeneugen@@ type T; identifier I; expression E2; @@ - list_entry(I,T,E2) + list_entry(_X(I), T, E2) coccinelle-1.0.4/tests/b1.c0000644000175000017500000000016212614153277014423 0ustar eugeneugenint main () { while (1) { if (x > 1 ) { foo(); break; } } while (1) if (x > 1 ) { foo(); break; } } coccinelle-1.0.4/tests/macro_int16.res0000644000175000017500000000014112614153277016607 0ustar eugeneugen#define INT16 int //typedef int INT16; void main(void) { INT16 a, b, c; c = a - b; } coccinelle-1.0.4/tests/mdeclp.cocci0000644000175000017500000000017312614153277016225 0ustar eugeneugen@script:ocaml r@ p; @@ p := make_position "mdeclp.c" "one" 1 4 1 7 @@ position r.p; identifier f; @@ - f@p(...) { ... } coccinelle-1.0.4/tests/max.c0000644000175000017500000000005012614153277014702 0ustar eugeneugenint main () { if (x < 25) return i; } coccinelle-1.0.4/tests/mincom.res0000644000175000017500000000021512614153277015751 0ustar eugeneugenint main () { if (rc == LS_NONE_FIRST_DE) { /* It is not "ls -{a}l" operation, no need statahead for it. */ a(); b(); } } coccinelle-1.0.4/tests/symbol.cocci0000644000175000017500000000012712614153277016265 0ustar eugeneugen@f@ constant symbol; symbol f; @@ - f = symbol; @symbol@ // symbol g; @@ int g = 0; coccinelle-1.0.4/tests/list_test.cocci0000644000175000017500000000140512614153277016772 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.4/tests/testand.res0000644000175000017500000000007412614153277016134 0ustar eugeneugenint main () { f(1,2,3,4); f(4,4,15,9); f(15,9,4,4); } coccinelle-1.0.4/tests/rem2.c0000644000175000017500000000006212614153277014765 0ustar eugeneugenint main () { xxx(); if (x) foo(); yyy(); } coccinelle-1.0.4/tests/video1bis.cocci0000644000175000017500000000015612614153277016647 0ustar eugeneugen@@ identifier arg; identifier v; statement S1; @@ - if (copy_from_user(v,arg,sizeof(v)) != 0) S1 else {} coccinelle-1.0.4/tests/nl.res0000644000175000017500000000005512614153277015102 0ustar eugeneugenint main() { if (y) return; y = y + 1; } coccinelle-1.0.4/tests/delete_function.c0000644000175000017500000000013312614153277017266 0ustar eugeneugenint first () { return 0; } int foo() { a(); a(); a(); } int last () { return 0; } coccinelle-1.0.4/tests/ifdefmeta1.c0000644000175000017500000000032112614153277016123 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.4/tests/if2.c0000644000175000017500000000010512614153277014576 0ustar eugeneugenint main(int x) { for(x=1;x>1;x++) { xxx(2); xxx(1); } } coccinelle-1.0.4/tests/test10.cocci0000644000175000017500000000007512614153277016102 0ustar eugeneugen@@ expression X; @@ f(X) ... g(X) ... - h(X) + h(X, X) coccinelle-1.0.4/tests/change.res0000644000175000017500000000022312614153277015713 0ustar eugeneugenint main () { foo(); blah(one, two); this_type = g_type_register_static(LASSO_TYPE_NODE, "LassoProvider", &this_info, 0); } coccinelle-1.0.4/tests/rcu3.res0000644000175000017500000000037712614153277015354 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.4/tests/inc.cocci0000644000175000017500000000013512614153277015530 0ustar eugeneugen@@ expression X; @@ - #define foo X + #define foobar X @@ expression T; @@ - #define xxx T coccinelle-1.0.4/tests/end_commas.c0000644000175000017500000000015412614153277016227 0ustar eugeneugenstatic struct i2c_client client_template = { .name = "adv7175_client", .driver = &i2c_driver_adv7175 }; coccinelle-1.0.4/tests/noty.c0000644000175000017500000000006212614153277015111 0ustar eugeneugenint main(int *x) { if (NULL == x) { return; } } coccinelle-1.0.4/tests/tdnl.res0000644000175000017500000000013612614153277015432 0ustar eugeneugenvoid main() { unknown_tyepdef_1 td1; td1.attr = (unknown_typedef_2) td2.attr; } coccinelle-1.0.4/tests/inclifdef.cocci0000644000175000017500000000007112614153277016701 0ustar eugeneugen@@ @@ #include + #include coccinelle-1.0.4/tests/multi_inc2.h0000644000175000017500000000001112614153277016164 0ustar eugeneugenint xxx; coccinelle-1.0.4/tests/typedef_double.cocci0000644000175000017500000000027412614153277017755 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.4/tests/julia10.c0000644000175000017500000000006112614153277015364 0ustar eugeneugenint main(int x) { f(); h(); g(); h(); } coccinelle-1.0.4/tests/switchdecl.cocci0000644000175000017500000000023412614153277017110 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.4/tests/remstruct.c0000644000175000017500000000043412614153277016153 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.4/tests/regexp2.c0000644000175000017500000000015012614153277015472 0ustar eugeneugen int main(void) { int t0 = FOO; int t1 = BAR; int t2 = FOOBAR; int t3 = BARFOOBAR; int t4 = BARFOO; } coccinelle-1.0.4/tests/expnest.res0000644000175000017500000000011512614153277016154 0ustar eugeneugenint main() { x = 3 + 4; x = f() + 15; x = 15 + g(); x = f() - g(); } coccinelle-1.0.4/tests/bitfield.c0000644000175000017500000000033512614153277015705 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.4/tests/topdec.res0000644000175000017500000000024512614153277015750 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.4/tests/undef1.cocci0000644000175000017500000000004012614153277016134 0ustar eugeneugen@@ identifier x; @@ - #undef x coccinelle-1.0.4/tests/test2.cocci0000644000175000017500000000007612614153277016024 0ustar eugeneugen@@ expression X,Y; @@ f(...,X,Y,...); ... - g(X); + h(X); coccinelle-1.0.4/tests/type_iso.cocci0000644000175000017500000000005512614153277016613 0ustar eugeneugen@@ struct SHT fops; @@ - fops.proc_info = 1;coccinelle-1.0.4/tests/ifadd.c0000644000175000017500000000011612614153277015167 0ustar eugeneugenint main() { while (y) { if (x) { one(); two(); } } } coccinelle-1.0.4/tests/addtoo.res0000644000175000017500000000010612614153277015740 0ustar eugeneugenint main () { bar(); foo(); bar(); foo(); bar(); foo(); } coccinelle-1.0.4/tests/loop.res0000644000175000017500000000004712614153277015443 0ustar eugeneugenint main() { while (1) { x : 15; } } coccinelle-1.0.4/tests/ben.c0000644000175000017500000000074612614153277014675 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.4/tests/const.c0000644000175000017500000000007312614153277015250 0ustar eugeneugenvoid foo(const char *text) { strcat(buf->data, text); } coccinelle-1.0.4/tests/mdecl.res0000644000175000017500000000015012614153277015551 0ustar eugeneugen int one () { return x < 0; } int one () { return rvw; } int two () { if (c < 0) return 21; return y; } coccinelle-1.0.4/tests/test8.c0000644000175000017500000000011712614153277015170 0ustar eugeneugenvoid main(int foo) { float k; int i; float j; { j++; } } coccinelle-1.0.4/tests/topdec.c0000644000175000017500000000023712614153277015402 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.4/tests/csw.c0000644000175000017500000000036412614153277014721 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.4/tests/destroy.res0000644000175000017500000000053412614153277016164 0ustar eugeneugenstatic void wlcore_nvs_cb(const struct firmware *fw, void *context) { if (ret) goto out_irq; goto out; out_irq: #if LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,31) free_irq(wl->irq, wl); #else compat_free_threaded_irq(&private->irq_compat); compat_destroy_threaded_irq(&wl->irq_compat); #endif #ifdef foo out: release_firmware(fw); #endif } coccinelle-1.0.4/tests/bugloop.res0000644000175000017500000000062412614153277016142 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(freezing(current))) { refrigerator(); } } } coccinelle-1.0.4/tests/dropenderr.res0000644000175000017500000000010112614153277016625 0ustar eugeneugenint main () { if (x) {} if (x) {} return 0; return -1; } coccinelle-1.0.4/tests/ifdefmeta.res0000644000175000017500000000105012614153277016411 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.4/tests/const_implicit_iso.res0000644000175000017500000000005312614153277020361 0ustar eugeneugenvoid main(double y) { const float x; } coccinelle-1.0.4/tests/extra.c0000644000175000017500000000025612614153277015250 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.4/tests/varargs.res0000644000175000017500000000015712614153277016141 0ustar eugeneugen static void fas216_log_command(FAS216_Info *info, int level, struct scsi_cmnd *SCpnt, char *fmt, ...) {} coccinelle-1.0.4/tests/minfn.res0000644000175000017500000000013412614153277015576 0ustar eugeneugenint main () { return first; } int main () { return third; } int main () { return fifth; } coccinelle-1.0.4/tests/longline2.res0000644000175000017500000000154112614153277016363 0ustar eugeneugenint main() { f(sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,a, 1111111111111111111111111111111111111, 111111111111111111111111, 111, shdkjsdsdhkjsa,x,y,z); f(sdhfkjdkdsahksadsdhjkdsa, sahdjshdkjsahdkjhsakjdsh, a, 1111111111111111111111111111111111111, 111111111111111111111111, 111, shdkjsdsdhkjsa, x, y, z); f(sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa); f(a,1111111111111111111111111111111111111, 111111111111111111111111, 111, sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa, shdkjsdsdhkjsa); f(a,1111111111111111111111111111111111111, 111111111111111111111111, 111, sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa, shdkjsdsdhkjsa, sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa); } coccinelle-1.0.4/tests/match_no_meta.res0000644000175000017500000000005112614153277017263 0ustar eugeneugenvoid main(int i) { foo(1); bar(2); } coccinelle-1.0.4/tests/cptr.cocci0000644000175000017500000000014412614153277015727 0ustar eugeneugen@@ identifier str; expression E; @@ -static const char *str +static const char * const str = E; coccinelle-1.0.4/tests/ifzer.cocci0000644000175000017500000000002012614153277016067 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/nest3.cocci0000644000175000017500000000017012614153277016012 0ustar eugeneugen@@ identifier i; identifier func; @@ - int i; <... when != i - for (i = ...; i < ...; i++) f(...); + f(1); ...> coccinelle-1.0.4/tests/check_order2.c0000644000175000017500000000032512614153277016454 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.4/tests/test_s.c0000644000175000017500000000067512614153277015433 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.4/tests/inc.res0000644000175000017500000000002112614153277015233 0ustar eugeneugen#define foobar 3 coccinelle-1.0.4/tests/multipath.cocci0000644000175000017500000000020712614153277016766 0ustar eugeneugen@@ constant char [] c; identifier f; @@ f(..., - c, + "KERN_ERR %s: %s: redirecting sector %llu to another IO path\n", __func__, ...) coccinelle-1.0.4/tests/badfree.c0000644000175000017500000000006712614153277015515 0ustar eugeneugenint main() { free(x); if (a) { foo(a,x,b); } } coccinelle-1.0.4/tests/ifend.cocci0000644000175000017500000000004312614153277016042 0ustar eugeneugen@@ @@ - #include coccinelle-1.0.4/tests/pmac.res0000644000175000017500000000034112614153277015407 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.4/tests/struct.res0000644000175000017500000000016612614153277016020 0ustar eugeneugenstruct foo { int x; struct bar first; int y; struct xxx second; int z; }; int main() { struct foo *a; } coccinelle-1.0.4/tests/addtoo.c0000644000175000017500000000023012614153277015367 0ustar eugeneugenint main () { if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); foo(); } coccinelle-1.0.4/tests/doublepos.c0000644000175000017500000000005612614153277016117 0ustar eugeneugenint main() { f(1,2); f(1,5); f(6,5); } coccinelle-1.0.4/tests/isoif.c0000644000175000017500000000013312614153277015230 0ustar eugeneugenint main () { if (x == NULL) one(); else two(); if (x != NULL) three(); else four(); } coccinelle-1.0.4/tests/double.c0000644000175000017500000000027512614153277015400 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.4/tests/fieldcount.cocci0000644000175000017500000000024512614153277017115 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.4/tests/failing_andany.cocci0000644000175000017500000000126212614153277017724 0ustar eugeneugen/* This test case shows that the andany optimization doesn't work. This optmization requires that the left argument of the conjunction have at most one match. This will always be true because every function has only one starting open brace. But the pattern inside can be matched according to two environments, as illustrated in smc_probe1. That is, the rule should somehow fail and go to the naive implementation of the rule, but it is not clear if that can be done efficiently. For the moment, the two matches from the function body are not compatible, and the complete match fails. */ @@ identifier fn,i,c2!=__badcall__; type T; @@ fn(...,T i,...) { <... - c2(...,i,...); ...> } coccinelle-1.0.4/tests/noa.c0000644000175000017500000000014512614153277014677 0ustar eugeneugenint main () { if (x) { a(); } else { a(); } } int tochange () { if (x) { a(); } else { x(); } } coccinelle-1.0.4/tests/rets.cocci0000644000175000017500000000004312614153277015732 0ustar eugeneugen@@ statement S; @@ foo(); - S + S coccinelle-1.0.4/tests/size_t.cocci0000644000175000017500000000061212614153277016254 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.4/tests/inclifdef.res0000644000175000017500000000013412614153277016412 0ustar eugeneugen#include #include #ifdef CONFIG #include #endif coccinelle-1.0.4/tests/tydisj.c0000644000175000017500000000006512614153277015431 0ustar eugeneugenint64_t foo() { int64_t a; int i; return i << 20; } coccinelle-1.0.4/tests/unelse.res0000644000175000017500000000015412614153277015764 0ustar eugeneugenstatic short find_control(u16 control_index) { if (!*pI) return 0; HPI_DEBUG_LOG(three, one); } coccinelle-1.0.4/tests/gcc_min_max.cocci0000644000175000017500000000062412614153277017226 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.4/tests/hd.cocci0000644000175000017500000000006212614153277015351 0ustar eugeneugen@@ @@ - f(int x, int y) { + f(int x){ ... } coccinelle-1.0.4/tests/bad_ptr_print.res0000644000175000017500000000013012614153277017312 0ustar eugeneugenstatic inline int tester(struct usb_endpoint_descriptor *epd) { g((struct foo *)x); } coccinelle-1.0.4/tests/iterator.cocci0000644000175000017500000000014412614153277016610 0ustar eugeneugen@@ iterator list_for_each; expression E1, E2; statement S; @@ - list_for_each(E1, E2) - S + foo();coccinelle-1.0.4/tests/wierdinit.cocci0000644000175000017500000000007712614153277016762 0ustar eugeneugen@@ typedef dev_link_t; @@ - dev_link_t + struct pcmcia_device coccinelle-1.0.4/tests/isococci.cocci0000644000175000017500000000006012614153277016547 0ustar eugeneugen@@ identifier x; @@ - if(x > 0) { return ...; }coccinelle-1.0.4/tests/multitypedef.res0000644000175000017500000000024212614153277017202 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.4/tests/nest.res0000644000175000017500000000020712614153277015441 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.4/tests/ifdef5.res0000644000175000017500000000061012614153277015630 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.4/tests/incpos1.cocci0000644000175000017500000000144612614153277016341 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.4/tests/free_ver5.c0000644000175000017500000000010312614153277015776 0ustar eugeneugenint main () { #ifdef FOO free(foo); #else x = foo->x; #endif } coccinelle-1.0.4/tests/threea.cocci0000644000175000017500000000016412614153277016231 0ustar eugeneugen@ rule1 @ expression E; @@ f(E); //@ rule2 extends rule1 @ //@@ // //- h(E); @ rule3 extends rule1 @ @@ - q(E); coccinelle-1.0.4/tests/pa.res0000644000175000017500000000036512614153277015075 0ustar eugeneugenchar *parse_args(const char *doing, char *args, const struct kernel_param *params, unsigned num, s16 min_level, s16 max_level, void *arg, int (*unknown)(char *param, char *val, const char *doing, void *arg)) { return 0; } coccinelle-1.0.4/tests/constrem.cocci0000644000175000017500000000006412614153277016612 0ustar eugeneugen@@ identifier d; @@ -int d; @@ @@ - int (*f)(int);coccinelle-1.0.4/tests/metastatement_if.res0000644000175000017500000000011712614153277020021 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } } coccinelle-1.0.4/tests/addif1.cocci0000644000175000017500000000014312614153277016106 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + int xxx() { + return 12; } + #endif int f(...) { ... } coccinelle-1.0.4/tests/nameless.res0000644000175000017500000000014012614153277016273 0ustar eugeneugentypedef union { int foo; } t_foo; typedef struct __COCCI__TMP__STRUCTNAME__ { int foo; } t_foo; coccinelle-1.0.4/tests/inhmet.res0000644000175000017500000000003112614153277015747 0ustar eugeneugenint main () { foo(); } coccinelle-1.0.4/tests/pb_distribute_type4.cocci0000644000175000017500000000010212614153277020735 0ustar eugeneugen@@ type T; @@ foo(...) { - T + float x; ... } coccinelle-1.0.4/tests/regexp.c0000644000175000017500000000011612614153277015412 0ustar eugeneugenint main(void) { int foo; int bar; int foobar; int barfoobar; int barfoo; } coccinelle-1.0.4/tests/param_end.cocci0000644000175000017500000000017712614153277016713 0ustar eugeneugen@@ identifier one; @@ one (... - ,int x ,...) { ... } @@ identifier one; @@ one (..., - int y, ...) { ... } coccinelle-1.0.4/tests/cards.c0000644000175000017500000000007612614153277015221 0ustar eugeneugenMODULE_PARM(io, "1-" __MODULE_STRING(MAX_CARDS) "i"); int x; coccinelle-1.0.4/tests/comadd.res0000644000175000017500000000010312614153277015712 0ustar eugeneugen// some comment // some other comment int main () { return 12; } coccinelle-1.0.4/tests/swap3.cocci0000644000175000017500000000037712614153277016024 0ustar eugeneugen@ok exists@ type t1; identifier tmp; expression i1,i2; position p; @@ t1 tmp@p; ... swap(i1, i2, tmp); @@ expression i1,i2; identifier tmp; type ok.t1; position ok.p; @@ -t1 tmp@p; <... when strict when != tmp swap(i1, i2, tmp); ...> ?t1 tmp; coccinelle-1.0.4/tests/nestone.cocci0000644000175000017500000000017412614153277016435 0ustar eugeneugen@one disable all@ identifier foo; statement S; @@ foo(...) { <+... xxx(); ...+> } @two depends on one@ @@ - yyy(); coccinelle-1.0.4/tests/video.c0000644000175000017500000000203512614153277015230 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.4/tests/comment_brace.c0000644000175000017500000000013512614153277016717 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ continue; return 0; } coccinelle-1.0.4/tests/endif.cocci0000644000175000017500000000005112614153277016041 0ustar eugeneugen@@ statement S; @@ x = 1; S + foo();coccinelle-1.0.4/tests/gotobreak.c0000644000175000017500000000045012614153277016076 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.4/tests/test5_ver1.c0000644000175000017500000000113012614153277016116 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.4/tests/introbrace.cocci0000644000175000017500000000014012614153277017103 0ustar eugeneugen@@ identifier ret; @@ ret = request_threaded_irq(...); +ret = compat_request_threaded_irq(12); coccinelle-1.0.4/tests/sizeof.c0000644000175000017500000000013612614153277015421 0ustar eugeneugenint main (int param) { int i = sizeof(3); int j = sizeof 3; int k = sizeof (int *); } coccinelle-1.0.4/tests/fns.cocci0000644000175000017500000000152512614153277015551 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.4/tests/const1bis.c0000644000175000017500000000006412614153277016027 0ustar eugeneugenvoid foo(int j) { const int i; int i; i++; } coccinelle-1.0.4/tests/insdef.res0000644000175000017500000000004412614153277015737 0ustar eugeneugen#define TABINFOGEN #include coccinelle-1.0.4/tests/dropbr.res0000644000175000017500000000004412614153277015757 0ustar eugeneugenint main () { if (a) foo(); } coccinelle-1.0.4/tests/longline2.cocci0000644000175000017500000000015312614153277016650 0ustar eugeneugen@@ identifier f; @@ f(...,a, + 1111111111111111111111111111111111111,111111111111111111111111,111, ...) coccinelle-1.0.4/tests/const.cocci0000644000175000017500000000014712614153277016110 0ustar eugeneugen@@ @@ void foo(char *text) { - strcat(buf->data, text); + strcat_safe(buf->data, buf->len, text); } coccinelle-1.0.4/tests/ifelse.c0000644000175000017500000000055012614153277015371 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.4/tests/test10_ver1.c0000644000175000017500000000011012614153277016167 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); //g(1); h(1); h(1); } coccinelle-1.0.4/tests/nest3.c0000644000175000017500000000013112614153277015151 0ustar eugeneugenvoid main(int i) { int i; char j;//int j; for (i = 1; i < XXX; i++) f(i); } coccinelle-1.0.4/tests/const.res0000644000175000017500000000011212614153277015611 0ustar eugeneugenvoid foo(const char *text) { strcat_safe(buf->data, buf->len, text); } coccinelle-1.0.4/tests/nameless.cocci0000644000175000017500000000010012614153277016556 0ustar eugeneugen@name_all_structs@ @@ struct + __COCCI__TMP__STRUCTNAME__ {...} coccinelle-1.0.4/tests/mem.cocci0000644000175000017500000000023212614153277015533 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.4/tests/return_implicit.c0000644000175000017500000000003412614153277017330 0ustar eugeneugenvoid main(void) { foo(); } coccinelle-1.0.4/tests/toplevel_struct_modif.c0000644000175000017500000000333712614153277020544 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.4/tests/nestplus.cocci0000644000175000017500000000021312614153277016631 0ustar eugeneugen@one disable all@ identifier foo; statement S; @@ foo(...) { <+... { ... return; } ...+> } @two depends on one@ @@ - yyy(); coccinelle-1.0.4/tests/km.cocci0000644000175000017500000000024112614153277015364 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.4/tests/deref.res0000644000175000017500000000007612614153277015561 0ustar eugeneugenint main () { int **q; foo(12); xxx(12); yyy(q+12); } coccinelle-1.0.4/tests/addifdef.c0000644000175000017500000000022312614153277015645 0ustar eugeneugen#ifdef FOO int one () { return 1; } #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(3,6,1) */ /* comment about two */ int two () { return 2; } coccinelle-1.0.4/tests/used_after_ver1.c0000644000175000017500000000031312614153277017175 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.4/tests/substruct.res0000644000175000017500000000011312614153277016522 0ustar eugeneugenstruct a { int a; } x[2] = { { DECLARE_A(7), }, { DECLARE_A(17), }, }; coccinelle-1.0.4/tests/undef2.c0000644000175000017500000000003212614153277015300 0ustar eugeneugen#define foo 12 #undef foo coccinelle-1.0.4/tests/testand2.cocci0000644000175000017500000000021012614153277016475 0ustar eugeneugen@@ identifier f; @@ ( - f + m (...,3,...); ... g(...,3,...); & f(..., - 8 + 80 ,...); ... g(...,8,...); ) coccinelle-1.0.4/tests/sizeof.res0000644000175000017500000000014312614153277015766 0ustar eugeneugenint main (int param) { int i = sizeof(int); int j = sizeof(int); int k = sizeof (int *); } coccinelle-1.0.4/tests/varargs3.c0000644000175000017500000000021612614153277015651 0ustar eugeneugenstatic int foo(char *fmt, ...) { return 0; } static int bar(int x, y) { return x+y; } static int baz(FILE *stream, ...) { return 1; } coccinelle-1.0.4/tests/substruct.c0000644000175000017500000000007712614153277016164 0ustar eugeneugenstruct a { int a; } x[2] = { { .a = 7, }, { .a = 17, }, }; coccinelle-1.0.4/tests/proto_ver2.c0000644000175000017500000007113212614153277016227 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.4/tests/bigrepl.res0000644000175000017500000000070212614153277016114 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.4/tests/changei.res0000644000175000017500000000012412614153277016064 0ustar eugeneugentypedef struct xxx istruct; int xxx (int xxx) { char xxx; return xxx + xxx; } coccinelle-1.0.4/tests/incpos1.res0000644000175000017500000000012112614153277016037 0ustar eugeneugen#include #include "two" #include #include "four" #include coccinelle-1.0.4/tests/stm3.res0000644000175000017500000000005112614153277015353 0ustar eugeneugenint main(int x) { f(); g(); g(); } coccinelle-1.0.4/tests/type_infer.c0000644000175000017500000000020112614153277016257 0ustar eugeneugenint __init snd_pmac_awacs_init(struct snd_pmac *chip) { struct awacs_amp *amp = kmalloc(sizeof(*amp)); memset(sizeof(*amp)); } coccinelle-1.0.4/tests/braces.res0000644000175000017500000000022512614153277015727 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.4/tests/hd.h0000644000175000017500000000002512614153277014517 0ustar eugeneugenint f(int x, int y); coccinelle-1.0.4/tests/retest.c0000644000175000017500000000007112614153277015426 0ustar eugeneugenint main () { foo(); if (x) return 3; bar(); } coccinelle-1.0.4/tests/badzero.res0000644000175000017500000000021012614153277016110 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.4/tests/badwhen.res0000644000175000017500000000013212614153277016075 0ustar eugeneugenint main () { f(); if (foo()) return; g(); } int second() { if (xfoo()) return; } coccinelle-1.0.4/tests/justremove.res0000644000175000017500000000005412614153277016673 0ustar eugeneugenint main () { foo(); foo(); foo(); } coccinelle-1.0.4/tests/define_param.res0000644000175000017500000000042112614153277017100 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.4/tests/array_init.c0000644000175000017500000000012612614153277016262 0ustar eugeneugenstatic int term[MAX_ECARDS] = { 1, 1, 1, 1, 1, 1, 1, 1 }; MODULE_PARM(term, "1-8i"); coccinelle-1.0.4/tests/longlongint.c0000644000175000017500000000021412614153277016451 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.4/tests/decl_split.c0000644000175000017500000000004712614153277016245 0ustar eugeneugenint func(int i) { int x, y; } coccinelle-1.0.4/tests/test3.c0000644000175000017500000000012012614153277015155 0ustar eugeneugenvoid main() { /* a comment */ f(3); if(1) g(1); else g(2); } coccinelle-1.0.4/tests/ifdefmeta3.cocci0000644000175000017500000000005712614153277016771 0ustar eugeneugen@@ statement S; @@ f(); - S + xxx(); g(); coccinelle-1.0.4/tests/enum.c0000644000175000017500000000032012614153277015061 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.4/tests/badtypedef.c0000644000175000017500000000016412614153277016232 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.4/tests/edots.c0000644000175000017500000000012112614153277015232 0ustar eugeneugenvoid main(int i) { foo[45]; bar[45+v.field]; // f(foo[45] + bar[45]); } coccinelle-1.0.4/tests/incdir2.c0000644000175000017500000000001112614153277015444 0ustar eugeneugenchar *x; coccinelle-1.0.4/tests/posiso.cocci0000644000175000017500000000023212614153277016271 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.4/tests/iterprint.c0000644000175000017500000000014112614153277016136 0ustar eugeneugenint main () { for(bit = 0; bit < size; bit++) { if (test_bit(bit, bitmap)) x = 12; } } coccinelle-1.0.4/tests/notest.res0000644000175000017500000000011012614153277015775 0ustar eugeneugenint main() { struct foo *x; x = FN(); if (12) return; return; } coccinelle-1.0.4/tests/y2.c0000644000175000017500000000043112614153277014452 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.4/tests/fortype.res0000644000175000017500000000010012614153277016150 0ustar eugeneugenint main () { for (char * p = 0; y!=10; y++) return y; } coccinelle-1.0.4/tests/paren1.cocci0000644000175000017500000000001712614153277016144 0ustar eugeneugen@@ @@ - x && y coccinelle-1.0.4/tests/retval2.res0000644000175000017500000000072412614153277016053 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.4/tests/bad_parsing.c0000644000175000017500000000003212614153277016366 0ustar eugeneugenint main () { starting( coccinelle-1.0.4/tests/array_init.res0000644000175000017500000000007312614153277016632 0ustar eugeneugenstatic int term[MAX_ECARDS] = { 1, 1, 1, 1, 1, 1, 1, 1 }; coccinelle-1.0.4/tests/initializer.res0000644000175000017500000000011712614153277017013 0ustar eugeneugenstruct SHT var = { .f1 = toto1, .foo = 12, .foo2 = 12, .f3 = toto3, }; coccinelle-1.0.4/tests/metastatement2.cocci0000644000175000017500000000003612614153277017714 0ustar eugeneugen@@ statement S; @@ f(); - S coccinelle-1.0.4/tests/include.c0000644000175000017500000000017412614153277015547 0ustar eugeneugen #include #include #include #include void main(int i) { i++; } coccinelle-1.0.4/tests/array_init.cocci0000644000175000017500000000023012614153277017114 0ustar eugeneugen@ rule3 @ identifier I; type T; expression E; @@ T I[E]; @@ identifier rule3.I; expression str; declarer name MODULE_PARM; @@ - MODULE_PARM(I,str); coccinelle-1.0.4/tests/defe.cocci0000644000175000017500000000006312614153277015662 0ustar eugeneugen@@ identifier id; expression E; @@ * #define id E coccinelle-1.0.4/tests/castdecl.res0000644000175000017500000000040712614153277016254 0ustar eugeneugenint main() { int i1, i2; int i3; int lType = (int)TYPE_OBJ_DS_REPORT, lNuPageBloc = 0L; char c1 = 'a', c2 = 'b'; char c3 = 'c'; i1 = 11; i2 = 22; i3 = 33; printf("%d + %d = %d\n", i1, i2, i1 + i2); printf("'%c', '%c', '%c'\n", c1, c2, c3); } coccinelle-1.0.4/tests/decl2.c0000644000175000017500000000014512614153277015113 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { if (x) { return 0; } else { return 0; } } coccinelle-1.0.4/tests/unfree.res0000644000175000017500000000025012614153277015752 0ustar eugeneugenstatic void mppe_free(void *arg) { struct ppp_mppe_state *state = (struct ppp_mppe_state *) arg; if (state) { kfree(state->sha1_digest); kfree(state); } } coccinelle-1.0.4/tests/mincom.c0000644000175000017500000000022112614153277015377 0ustar eugeneugenint main () { if (rc == LS_NONE_FIRST_DE) /* It is not "ls -{a}l" operation, no need statahead for it. */ GOTO(out, rc = -EAGAIN); } coccinelle-1.0.4/tests/format.c0000644000175000017500000000016312614153277015412 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.4/tests/branchparen.res0000644000175000017500000000013012614153277016746 0ustar eugeneugenint main () { if (x) { foo(); xxx(); } else { foo(); xxx(); } } coccinelle-1.0.4/tests/ifdef1.cocci0000644000175000017500000000014712614153277016120 0ustar eugeneugen@ Exemple1@ @@ #include + #ifdef CONFIG_NKERNEL + #include + #endif coccinelle-1.0.4/tests/bigrepl.cocci0000644000175000017500000000011412614153277016400 0ustar eugeneugen@@ @@ - foo() + call(to, a, very, complicated, function, with, many, args) coccinelle-1.0.4/tests/branchparen.c0000644000175000017500000000006612614153277016407 0ustar eugeneugenint main () { if (x) xxx(); else xxx(); } coccinelle-1.0.4/tests/remaft.cocci0000644000175000017500000000002512614153277016233 0ustar eugeneugen@@ @@ - a(); - b(); coccinelle-1.0.4/tests/addif2.res0000644000175000017500000000021112614153277015614 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.4/tests/comments.res0000644000175000017500000000021112614153277016310 0ustar eugeneugen int main() { // Calls foo() foo(); return 0; } /** Some info about @foo() @return void */ void foo() { /* Do nothing */ } coccinelle-1.0.4/tests/zero.cocci0000644000175000017500000000005512614153277015737 0ustar eugeneugen@@ expression E1, E2; @@ - memset(E1,0,E2); coccinelle-1.0.4/tests/strangeorder.c0000644000175000017500000000043612614153277016624 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.4/tests/fix_flow_need.res0000644000175000017500000000011312614153277017274 0ustar eugeneugenvoid main(int i) { foobar(); if(1) { foo(); } foobar(); } coccinelle-1.0.4/tests/test11_ver1.c0000644000175000017500000000007012614153277016175 0ustar eugeneugenvoid main(int i) { f(1); g(1); //g(1); h(1); } coccinelle-1.0.4/tests/memory.res0000644000175000017500000000016512614153277016003 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.4/tests/multivars.cocci0000644000175000017500000000004712614153277017007 0ustar eugeneugen@@ expression X; @@ - f(X,X); + h(X); coccinelle-1.0.4/tests/addif.res0000644000175000017500000000044712614153277015545 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.4/tests/pb_distribute_type4.c0000644000175000017500000000016112614153277020104 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.4/tests/ifdef5.c0000644000175000017500000000031212614153277015260 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/com.c0000644000175000017500000000012712614153277014700 0ustar eugeneugenint main() { foo(); /* a comment */ foo(); /* a comment */ foo(); bar(); } coccinelle-1.0.4/tests/invert.cocci0000644000175000017500000000007712614153277016273 0ustar eugeneugen@@ binary operator b; expression e1,e2; @@ - e1 b e2 + e2 b e1coccinelle-1.0.4/tests/undef.c0000644000175000017500000000020712614153277015222 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.4/tests/julia7.res0000644000175000017500000000010712614153277015662 0ustar eugeneugenint main(int x) { foo(); if (x) {after(); return 0;} after(); } coccinelle-1.0.4/tests/remstruct.res0000644000175000017500000000012712614153277016521 0ustar eugeneugenint hello ( String input ) { String input = input.lowercase(); printf(input); } coccinelle-1.0.4/tests/y.cocci0000644000175000017500000000020012614153277015220 0ustar eugeneugen@ rule1 @ expression E; @@ + xxx(E); foo(E); @@ expression F; @@ xxx(F); @@ expression rule1.E; @@ foo(E); + yyy(E); coccinelle-1.0.4/tests/julia7.cocci0000644000175000017500000000025712614153277016157 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.4/tests/ifafter.cocci0000644000175000017500000000020312614153277016373 0ustar eugeneugen@@ identifier lbl1,lbl2; expression e,e1,e2; @@ + e1=e2; if (e) - GOTO(lbl1,e1=e2); -GOTO(lbl2,e1=e2); + goto lbl1; +goto lbl2; coccinelle-1.0.4/tests/minstruct.c0000644000175000017500000000016512614153277016154 0ustar eugeneugenstatic struct i2c_client client_template = { .name = "(unset)", .id = -1, .driver = &i2c_driver_videotext }; coccinelle-1.0.4/tests/reserved.res0000644000175000017500000000006312614153277016307 0ustar eugeneugenint main() { f(1,2); f(2,3,2); f(3,4,3,3); } coccinelle-1.0.4/tests/pragmatest.cocci0000644000175000017500000000033112614153277017124 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.4/tests/gilles-question.cocci0000644000175000017500000000003512614153277020102 0ustar eugeneugen@@ @@ f(0); ... - g(0); coccinelle-1.0.4/tests/comadd.c0000644000175000017500000000003512614153277015347 0ustar eugeneugenint main () { return 12; } coccinelle-1.0.4/tests/parameters_dots.res0000644000175000017500000000003612614153277017664 0ustar eugeneugenvoid main(int i) { g(3); } coccinelle-1.0.4/tests/decmeta.cocci0000644000175000017500000000037312614153277016365 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.4/tests/longconst.res0000644000175000017500000000074212614153277016502 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.4/tests/whitespace.c0000644000175000017500000000005412614153277016255 0ustar eugeneugenint main () { foo(sizeof (struct xxx)); } coccinelle-1.0.4/tests/test1.c0000644000175000017500000000017012614153277015160 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { // h(3); h(3); } else { h(4); } } coccinelle-1.0.4/tests/changetype.c0000644000175000017500000000004612614153277016251 0ustar eugeneugenint main () { static int a, b, c; } coccinelle-1.0.4/tests/format.cocci0000644000175000017500000000003512614153277016246 0ustar eugeneugen@@ @@ - "...%d..." + "blah" coccinelle-1.0.4/tests/localid.res0000644000175000017500000000007312614153277016100 0ustar eugeneugenint c; int main () { int a; f(a+1); h(b); g(c); } coccinelle-1.0.4/tests/devlink.res0000644000175000017500000000042712614153277016130 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.4/tests/sgrep.cocci0000644000175000017500000000006712614153277016103 0ustar eugeneugen@@ @@ - f(); ... g(); @@ @@ x(); ... - y(); coccinelle-1.0.4/tests/multidecl.cocci0000644000175000017500000000046412614153277016746 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.4/tests/const1bis.res0000644000175000017500000000006012614153277016372 0ustar eugeneugenvoid foo(int j) { float i; int i; i++; } coccinelle-1.0.4/tests/binop.c0000644000175000017500000000021612614153277015230 0ustar eugeneugenvoid main() { int i = 0; int j = 0; if( (i = j) + 0 ) { i = j; } if( (i = j) + 0 != 0 ) { i = j; } } coccinelle-1.0.4/tests/sizeof_julia.cocci0000644000175000017500000000012712614153277017443 0ustar eugeneugen@@ identifier arg; identifier v; @@ - copy_from_user(&v,arg,sizeof(v)) + foo() coccinelle-1.0.4/tests/if2.cocci0000644000175000017500000000013312614153277015435 0ustar eugeneugen@@ expression E; @@ - for(...;...;...) { xxx(2); <... - xxx(E); ...> - } coccinelle-1.0.4/tests/metaops.res0000644000175000017500000000065412614153277016146 0ustar eugeneugenint p1() { int x = 0; int y = 1; x += x - y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; x += x + y; return 42; } int p2() { int x = 0; int y = 1; x += 1; x = 2; x = 3; x = 4; x = 5; x = 6; x = 7; x = 8; x = 9; x = 10; x = 11; return 42; } coccinelle-1.0.4/tests/free.cocci0000644000175000017500000000123712614153277015704 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.4/tests/macro_int16.cocci0000644000175000017500000000007612614153277017105 0ustar eugeneugen@testint16@ int E1, E2, E3; @@ - E1 = E2 + E3; +E1 = E2 - E3; coccinelle-1.0.4/tests/ifreturn.cocci0000644000175000017500000000006112614153277016613 0ustar eugeneugen@@ statement s; @@ if (...) +{ + blah(); s +} coccinelle-1.0.4/tests/topdec_ver1.c0000644000175000017500000000017712614153277016342 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.4/tests/foura.c0000644000175000017500000000005012614153277015231 0ustar eugeneugenint main () { f(1); h(2); i(2); } coccinelle-1.0.4/tests/endpos.cocci0000644000175000017500000000047212614153277016253 0ustar eugeneugenvirtual lines @r@ position p; identifier f; @@ f(...) { ... }@p @script:ocaml depends on lines@ p << r.p; f << r.f; @@ Printf.printf "%s: %s\n" f (String.concat " " (List.map (function x -> string_of_int (x.line)) p)) @s@ position p; identifier f; @@ f (...) { +f(); ... } +int f() { return 0; } coccinelle-1.0.4/tests/include.cocci0000644000175000017500000000004512614153277016402 0ustar eugeneugen@@ @@ -#include coccinelle-1.0.4/tests/join.c0000644000175000017500000000012412614153277015056 0ustar eugeneugenint main(int i) { f(0); if(1) { g(2); } else { g(3); } h(4); } coccinelle-1.0.4/tests/nstruct.cocci0000644000175000017500000000014512614153277016462 0ustar eugeneugen@@ identifier I; expression E; @@ struct i2c_client I = { - .name = E, + .dev = { .name = E, }, }; coccinelle-1.0.4/tests/incl.cocci0000644000175000017500000000015012614153277015701 0ustar eugeneugen@@ @@ + #include "before.h" #include @@ @@ #include + #include "after.h" coccinelle-1.0.4/tests/return.cocci0000644000175000017500000000037612614153277016305 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.4/tests/return.res0000644000175000017500000000025112614153277016006 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.4/tests/ifdef6a.res0000644000175000017500000000037312614153277016000 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.4/tests/pb_cfg.c0000644000175000017500000000012212614153277015335 0ustar eugeneugenvoid main(int i) { f(1); goto return_0; f(1); label1: f(2); return; } coccinelle-1.0.4/tests/bigin.cocci0000644000175000017500000000002712614153277016047 0ustar eugeneugen@@ @@ +bar(); foo(); coccinelle-1.0.4/tests/incompatible_value.cocci0000644000175000017500000000016312614153277020622 0ustar eugeneugen@ r1 @ expression E; identifier fn; @@ fn(...) { <... f(E) ...> } @@ expression r1.E; @@ - g(E) + h(E) coccinelle-1.0.4/tests/pa.c0000644000175000017500000000033412614153277014522 0ustar eugeneugenchar *parse_args(const char *doing, char *args, const struct kernel_param *params, unsigned num, s16 min_level, s16 max_level, int (*unknown)(char *param, char *val, const char *doing)) { return 0; } coccinelle-1.0.4/tests/opt.res0000644000175000017500000000002012614153277015263 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/stm7.res0000644000175000017500000000005712614153277015365 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/62.cocci0000644000175000017500000000070212614153277015206 0ustar eugeneugen//drivers/net/wireless/ath/carl9170/usb.c //drivers/net/wireless/p54/p54usb.c //drivers/net/wireless/ath/ath9k/hif_usb.c @@ identifier backport_driver; @@ struct usb_driver backport_driver = { +#if (LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0)) .disable_hub_initiated_lpm = 1, +#endif }; @@ identifier backport_driver; @@ struct usb_driver backport_driver = { +#if (LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,27)) .soft_unbind = 1, +#endif }; coccinelle-1.0.4/tests/inline.c0000644000175000017500000000004312614153277015375 0ustar eugeneugeninline void foo(int x) { return; } coccinelle-1.0.4/tests/edots.res0000644000175000017500000000010112614153277015577 0ustar eugeneugenvoid main(int i) { foo; bar; // f(foo[45] + bar[45]); } coccinelle-1.0.4/tests/rptr.c0000644000175000017500000000011312614153277015104 0ustar eugeneugenint foo(struct resource *r) { if (r == NULL) return 0; return 1; } coccinelle-1.0.4/tests/notest.c0000644000175000017500000000011012614153277015426 0ustar eugeneugenint main() { struct foo *x; x = FN(); if (!x) return; return; } coccinelle-1.0.4/tests/a_and_e.c0000644000175000017500000000012612614153277015467 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(3,4); // return 1; } coccinelle-1.0.4/tests/cast.c0000644000175000017500000000005712614153277015056 0ustar eugeneugenint main () { ((struct xxx *)E)->foo = 12; } coccinelle-1.0.4/tests/memory.cocci0000644000175000017500000000006612614153277016272 0ustar eugeneugen@@ expression E; @@ - if (E) { BUG(); } + BUG_ON(E); coccinelle-1.0.4/tests/format.res0000644000175000017500000000013212614153277015755 0ustar eugeneugenint main () { printf("blah", 1); printf("blah", 1, 2); printf("one two three\n"); } coccinelle-1.0.4/tests/slen.c0000644000175000017500000000025612614153277015066 0ustar eugeneugenint main() { if (x) { one(); } if (x) { one(); two(); three(); } if (x) { one(); two(); three(); four(); five(); } end(); } coccinelle-1.0.4/tests/string.c0000644000175000017500000000004412614153277015426 0ustar eugeneugenMODULE_PARM(suppress_pollack, "x"); coccinelle-1.0.4/tests/request_irq_sgrep.cocci0000644000175000017500000000327212614153277020527 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.4/tests/switchdecl.c0000644000175000017500000000020412614153277016247 0ustar eugeneugenvoid f(void) { switch (2) { int x; int x; case 2: x=y; break; case 4: j++; break; } } coccinelle-1.0.4/tests/nestone.c0000644000175000017500000000006212614153277015573 0ustar eugeneugenint foo() { if (x) { xxx(); return;} yyy(); } coccinelle-1.0.4/tests/inner2.cocci0000644000175000017500000000015512614153277016156 0ustar eugeneugen@@ identifier ty,x; expression a; initializer list is; @@ struct ty x = {is, - .i = a, + foo(a), ...}; coccinelle-1.0.4/tests/dec.cocci0000644000175000017500000000010012614153277015502 0ustar eugeneugen@@ symbol x,y,z; @@ f(int x) { + int z; int y; return x; } coccinelle-1.0.4/tests/dbg.res0000644000175000017500000000023612614153277015226 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.4/tests/ifend.res0000644000175000017500000000014612614153277015557 0ustar eugeneugen#ifdef VORTEX_DEBUG static int vortex_debug = VORTEX_DEBUG; #else static int vortex_debug = 1; #endif coccinelle-1.0.4/tests/twoproto.c0000644000175000017500000000037112614153277016020 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.4/tests/if.c0000644000175000017500000000040112614153277014513 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.4/tests/ac.c0000644000175000017500000000070212614153277014504 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.4/tests/constx.c0000644000175000017500000000014112614153277015434 0ustar eugeneugenint main() { foo(12); foo(x); foo(CONSTANT); foo('a'); foo("string"); foo(1.0001); } coccinelle-1.0.4/tests/ifdef4.c0000644000175000017500000000031212614153277015257 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/attrs2groups.c0000644000175000017500000000103712614153277016602 0ustar eugeneugenstatic ssize_t devspec_show(struct device *dev, struct device_attribute *attr, char *buf) { return 42; } static ssize_t name_show(struct device *dev, struct device_attribute *attr, char *buf) { return 0; } static ssize_t modalias_show(struct device *dev, struct device_attribute *attr, char *buf) { return 1; } struct device_attribute ibmebus_bus_device_attrs[] = { __ATTR_RO(devspec), __ATTR_RO(name), __ATTR_RO(modalias), __ATTR_NULL }; struct bus_type ibmebus_bus_type = { .dev_attrs = ibmebus_bus_device_attrs, }; coccinelle-1.0.4/tests/spacing.cocci0000644000175000017500000000031712614153277016405 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.4/tests/bugon.c0000644000175000017500000000011612614153277015232 0ustar eugeneugenstatic void b44_tx(struct b44 *bp) { if (unlikely(skb == NULL)) BUG(); } coccinelle-1.0.4/tests/twomatch.cocci0000644000175000017500000000016012614153277016603 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.4/tests/hex.c0000644000175000017500000000003212614153277014701 0ustar eugeneugenint main() { f(0x00); } coccinelle-1.0.4/tests/bad_subsumption.c0000644000175000017500000000165312614153277017325 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.4/tests/multidec.c0000644000175000017500000000011712614153277015727 0ustar eugeneugenint main () { int x = 3,z; int x = 12; int x = 12,y; int x = 12 , y; } coccinelle-1.0.4/tests/minusall.c0000644000175000017500000000006512614153277015747 0ustar eugeneugenstatic int f () { int x = 12; int y; return x + y; } coccinelle-1.0.4/tests/cst.c0000644000175000017500000000014612614153277014714 0ustar eugeneugenint main(int x) { emu10k1_t *emu = snd_magic_cast(1, 2, return -ENXIO); int z = 12; return y; } coccinelle-1.0.4/tests/noret.res0000644000175000017500000000034612614153277015623 0ustar eugeneugenmain (int x, int q); static xmain (int x, int q); inline ymain (int x, int q); main (int x, int q) { return 12; } // foo static xmain (int y, int q) { return 12; } // xxx inline ymain (int y, int q) { return 12; } // xxx coccinelle-1.0.4/tests/topdec.cocci0000644000175000017500000000013112614153277016231 0ustar eugeneugen@@ identifier I; @@ + static const struct ethtool_ops I; - static struct ethtool_ops I; coccinelle-1.0.4/tests/typeof.res0000644000175000017500000000006112614153277015774 0ustar eugeneugenint main() { int x; f(sizeof(struct foo)); } coccinelle-1.0.4/tests/threea.res0000644000175000017500000000003012614153277015732 0ustar eugeneugenint main() { f(12); } coccinelle-1.0.4/tests/longlongint.res0000644000175000017500000000003312614153277017017 0ustar eugeneugenint main() { return 0; } coccinelle-1.0.4/tests/expopt3_ver1.res0000644000175000017500000000026212614153277017030 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.4/tests/test1.res0000644000175000017500000000020412614153277015525 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { // h(3); h(1, 3, 2); } else { h(1, 4, 2); } } coccinelle-1.0.4/tests/decl1.cocci0000644000175000017500000000021012614153277015741 0ustar eugeneugen@@ statement S; identifier ioctl, cmd, arg; symbol x; @@ ioctl(int cmd, void *arg) { ... int x; + foo(); S ... } coccinelle-1.0.4/tests/bus.cocci0000644000175000017500000000016712614153277015555 0ustar eugeneugen@r exists@ type t; t *dev; identifier f,fld; @@ -dev->\(probe@fld\|remove@fld\)(...) +c1() ... when any -f(...) +c2() coccinelle-1.0.4/tests/desc.c0000644000175000017500000000015312614153277015037 0ustar eugeneugenMODULE_PARM_DESC(devices, "number of dsp devices allocated by the driver"); module_param(devices, int, 0); coccinelle-1.0.4/tests/test_unsigned_meta.cocci0000644000175000017500000000036212614153277020642 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.4/tests/ifdef5.cocci0000644000175000017500000000036712614153277016130 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.4/tests/arraysz.res0000644000175000017500000000053612614153277016170 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.4/tests/badtypedef.cocci0000644000175000017500000000021412614153277017064 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.4/tests/labels_metastatement_ver1.c0000644000175000017500000000004412614153277021252 0ustar eugeneugenint foo(int i) { if(1) x = 3; } coccinelle-1.0.4/tests/doundo.res0000644000175000017500000000014212614153277015756 0ustar eugeneugens8 *noevent; int main() { const s8 (*queue_priority_mapping)[2]; s8 *noevent; new_foo(); } coccinelle-1.0.4/tests/allex.cocci0000644000175000017500000000024412614153277016065 0ustar eugeneugen@exists@ expression e; statement S; @@ if (e) { ... when forall return ...; } ... -if (e) S /* shows that the previous rule did not apply */ @@ @@ - 15 + 200coccinelle-1.0.4/tests/labels_metastatement_ver1.res0000644000175000017500000000010712614153277021621 0ustar eugeneugenint foo(int i) { if(1) { x = 3; foo(); } foo(); } coccinelle-1.0.4/tests/sizestar.c0000644000175000017500000000030412614153277015763 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.4/tests/fp.res0000644000175000017500000000004012614153277015070 0ustar eugeneugenint main(int (*x)(int,int)) { } coccinelle-1.0.4/tests/define_exp.cocci0000644000175000017500000000010412614153277017061 0ustar eugeneugen@@ @@ ( - SA_INTERRUPT + IRQF_DISABLED | - SA_SHIRQ + IRQF_SHARED ) coccinelle-1.0.4/tests/overshoot.c0000644000175000017500000000010112614153277016142 0ustar eugeneugenint main () { a(); s(); d(); f(); b(); b(); q(); } coccinelle-1.0.4/tests/rcu3_ver1.c0000644000175000017500000000067712614153277015745 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.4/tests/decl_space.res0000644000175000017500000000005312614153277016551 0ustar eugeneugenint main () { int *x = g; int x = g; } coccinelle-1.0.4/tests/dec.res0000644000175000017500000000006612614153277015226 0ustar eugeneugenint f(int x) { int z; static int y; return x; } coccinelle-1.0.4/tests/decl.res0000644000175000017500000000010212614153277015371 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { foo(); return 0; } coccinelle-1.0.4/tests/stm4.cocci0000644000175000017500000000004612614153277015647 0ustar eugeneugen@@ statement S; @@ f(); S + g(); coccinelle-1.0.4/tests/test5_ver1.res0000644000175000017500000000113012614153277016465 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.4/tests/twomatch.c0000644000175000017500000000005212614153277015745 0ustar eugeneugenint main() { bar(12,1); xxx(12,1); } coccinelle-1.0.4/tests/multichars.c0000644000175000017500000000007512614153277016277 0ustar eugeneugenint main () { f('XYZ',ab); f('X\nY',ab); f('\n',ab); } coccinelle-1.0.4/tests/vpos.res0000644000175000017500000000006312614153277015457 0ustar eugeneugenint main() { f(2); if (x) { } else { } } coccinelle-1.0.4/tests/ifif.cocci0000644000175000017500000000023112614153277015671 0ustar eugeneugen@@ @@ +#ifdef FOO1 +#ifdef FOO2 foo(); +#endif /* FOO1 */ +#endif /* FOO2 */ ... +#ifdef BAR1 +#ifdef BAR2 bar(); +#endif /* BAR1 */ +#endif /* BAR2 */ coccinelle-1.0.4/tests/proto.c0000644000175000017500000000045512614153277015271 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.4/tests/bad_kfree.c0000644000175000017500000000046012614153277016024 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.4/tests/zero.res0000644000175000017500000000002012614153277015440 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/stat.res0000644000175000017500000000000012614153277015432 0ustar eugeneugencoccinelle-1.0.4/tests/rule19a.c0000644000175000017500000000067112614153277015410 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.4/tests/cards.cocci0000644000175000017500000000012612614153277016053 0ustar eugeneugen@@ identifier I; expression str; declarer name MODULE_PARM; @@ - MODULE_PARM(I,str); coccinelle-1.0.4/tests/bad_typedef.res0000644000175000017500000000035612614153277016743 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.4/tests/nl.cocci0000644000175000017500000000001712614153277015367 0ustar eugeneugen@@ @@ - x + y coccinelle-1.0.4/tests/stm10_ver1.res0000644000175000017500000000010412614153277016365 0ustar eugeneugenint main(int x) { f(); { replace(); replace();} h(); g(); } coccinelle-1.0.4/tests/attrs2groups.res0000644000175000017500000000114412614153277017150 0ustar eugeneugenstatic ssize_t devspec_show(struct device *dev, struct device_attribute *attr, char *buf) { return 42; } static BUG(); NOBUG(); static ssize_t name_show(struct device *dev, struct device_attribute *attr, char *buf) { return 0; } static BUG(); NOBUG(); static ssize_t modalias_show(struct device *dev, struct device_attribute *attr, char *buf) { return 1; } static BUG(); NOBUG(); struct device_attribute ibmebus_bus_device_attrs[] = { __ATTR_RO(devspec), __ATTR_RO(name), __ATTR_RO(modalias), __ATTR_NULL }; struct bus_type ibmebus_bus_type = { .dev_attrs = ibmebus_bus_device_attrs, }; coccinelle-1.0.4/tests/of.c0000644000175000017500000000046412614153277014532 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.4/tests/param1_ver1.c0000644000175000017500000000004212614153277016234 0ustar eugeneugenvoid foo(int x,int y) { return; } coccinelle-1.0.4/tests/ab.res0000644000175000017500000000006112614153277015050 0ustar eugeneugenint main () { foo = 5; b = 12; xxx = 12; } coccinelle-1.0.4/tests/argument.c0000644000175000017500000000006412614153277015744 0ustar eugeneugenvoid main(int i){ f(1,2,3); h(1,2); h(); } coccinelle-1.0.4/tests/b1.cocci0000644000175000017500000000007712614153277015266 0ustar eugeneugen@@ @@ while(...) { <... foo(); + bar(); break; ...> } coccinelle-1.0.4/tests/p9.c0000644000175000017500000000004712614153277014453 0ustar eugeneugenint f(int, int, int x) { return x; } coccinelle-1.0.4/tests/ppos.c0000644000175000017500000000053612614153277015107 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.4/tests/varargs.cocci0000644000175000017500000000007112614153277016423 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.4/tests/void.c0000644000175000017500000000012612614153277015062 0ustar eugeneugenint xbar(void) { return; } // this is some info about bar int bar(void) { return; } coccinelle-1.0.4/tests/join.cocci0000644000175000017500000000017612614153277015723 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.4/tests/bad_noputm10000644000175000017500000001276112614153277016121 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.4/tests/metastatement_if.cocci0000644000175000017500000000006012614153277020305 0ustar eugeneugen @@ expression E1; statement S; @@ - if(E1) - Scoccinelle-1.0.4/tests/miniswap.c0000644000175000017500000000016212614153277015750 0ustar eugeneugenstatic void swap_refcount_rec(void *a, void *b, int size) { struct ocfs2_refcount_rec *l, tmp; swap(l,tmp); } coccinelle-1.0.4/tests/array_size.c0000644000175000017500000000014112614153277016266 0ustar eugeneugen#define MAX_SETUP_STRINGS (sizeof(setup_strings) / sizeof(char *)) #define SETUP_BUFFER_SIZE 200 coccinelle-1.0.4/tests/define_param.c0000644000175000017500000000047512614153277016542 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.4/tests/testand.cocci0000644000175000017500000000011212614153277016414 0ustar eugeneugen@@ identifier f; @@ ( f(..., - 3 + 4 ,...) & f(..., - 8 + 15 ,...) ) coccinelle-1.0.4/tests/tdnl.c0000644000175000017500000000014712614153277015065 0ustar eugeneugenvoid main() { unknown_tyepdef_1 td1; td1.attr = (unknown_typedef_2) td2.attr; foo(); } coccinelle-1.0.4/tests/type.res0000644000175000017500000000004512614153277015451 0ustar eugeneugenint foo() { int *x; return 0; } coccinelle-1.0.4/tests/ifields.res0000644000175000017500000000040012614153277016102 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.4/tests/rems1.cocci0000644000175000017500000000001612614153277016004 0ustar eugeneugen@@ @@ - a(); coccinelle-1.0.4/tests/minusdots.c0000644000175000017500000000013512614153277016146 0ustar eugeneugenvoid main(int i) { if (!hostptr) { if (hostptr) { return -ESRCH; } } } coccinelle-1.0.4/tests/substruct.cocci0000644000175000017500000000006412614153277017016 0ustar eugeneugen@@ expression E; @@ { - .a = E, + DECLARE_A(E), } coccinelle-1.0.4/tests/same_expr.c0000644000175000017500000000005112614153277016101 0ustar eugeneugenvoid main(int i) { f(1,1); f(1,2); } coccinelle-1.0.4/tests/test11.c0000644000175000017500000000012112614153277015235 0ustar eugeneugenvoid main(int i) { f(1); g(1); g(1); // if comment then simpler h(1); } coccinelle-1.0.4/tests/inline.cocci0000644000175000017500000000003412614153277016233 0ustar eugeneugen@@ @@ - foo(int x) { ... } coccinelle-1.0.4/tests/bugloop.c0000644000175000017500000000064612614153277015577 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.4/tests/break.res0000644000175000017500000000066512614153277015564 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.4/tests/fortest.c0000644000175000017500000000037712614153277015617 0ustar eugeneugenint main() { for(x=0; x!=10; x++) y = 12; for(x=0; x!=10; ) y = 12; for(x=0; ; x++) y = 12; for(x=0; ; ) y = 12; for( ; x!=10; x++) y = 12; for( ; x!=10; ) y = 12; for( ; ; x++) y = 12; for( ; ; ) y = 12; } coccinelle-1.0.4/tests/check_order2.cocci0000644000175000017500000000015412614153277017312 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.4/tests/getc.cocci0000644000175000017500000000022112614153277015675 0ustar eugeneugen@@ typedef VOID; typedef LPVOID; typedef PVOID; {void *, VOID *, LPVOID, PVOID} ppv; identifier QI =~ "_QueryInterface$"; @@ - QI(..., ppv) + 12 coccinelle-1.0.4/tests/ifbr.c0000644000175000017500000000004512614153277015043 0ustar eugeneugenint main () { if (x) return; } coccinelle-1.0.4/tests/fieldsmin.c0000644000175000017500000000006212614153277016072 0ustar eugeneugenstruct foo x = { .a = 1, .b = 2, .c = 3, }; coccinelle-1.0.4/tests/ab.cocci0000644000175000017500000000001712614153277015340 0ustar eugeneugen@@ @@ - a + b coccinelle-1.0.4/tests/noa.cocci0000644000175000017500000000010512614153277015531 0ustar eugeneugen@exists@ identifier f; @@ -f +has_no_a (...) { ... when != a() }coccinelle-1.0.4/tests/exitp.res0000644000175000017500000000006612614153277015624 0ustar eugeneugenint main () { g(a1); g(a2); g(done); g(a4); } coccinelle-1.0.4/tests/pdbgg.c0000644000175000017500000000773212614153277015216 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.4/tests/expopt3.cocci0000644000175000017500000000020312614153277016355 0ustar eugeneugen@@ identifier v,fld; @@ - struct video_tuner v; + struct video_tuner *v; <... ( - v.fld + v->fld | - v + *v ) ...>coccinelle-1.0.4/tests/mincom.cocci0000644000175000017500000000003712614153277016242 0ustar eugeneugen@@ @@ -GOTO(...); +a(); +b(); coccinelle-1.0.4/tests/format2.res0000644000175000017500000000004712614153277016044 0ustar eugeneugenint main () { foo("blah %x blah"); } coccinelle-1.0.4/tests/assign.cocci0000644000175000017500000000005612614153277016245 0ustar eugeneugen@@ expression E; @@ x = - E + E + 25 coccinelle-1.0.4/tests/allex.c0000644000175000017500000000020112614153277015220 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } } if (x) return 15; out: return rc; } coccinelle-1.0.4/tests/badwhen.cocci0000644000175000017500000000005212614153277016365 0ustar eugeneugen@@ @@ -f(); ... when != false foo() -g();coccinelle-1.0.4/tests/spl.cocci0000644000175000017500000000062512614153277015561 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.4/tests/boolr.res0000644000175000017500000000003612614153277015605 0ustar eugeneugenint main() { int b; } coccinelle-1.0.4/tests/empty.iso0000644000175000017500000000000012614153277015616 0ustar eugeneugencoccinelle-1.0.4/tests/labels_metastatement.res0000644000175000017500000000034312614153277020666 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.4/tests/parse_field.c0000644000175000017500000000013412614153277016375 0ustar eugeneugenvoid blk_queue_prep_rq(struct request_queue *q, prep_rq_fn *pfn) { q->prep_rq_fn = pfn; } coccinelle-1.0.4/tests/retval.res0000644000175000017500000000023612614153277015767 0ustar eugeneugenint main () { if (retval1) { foo(); return 3; } return 6; } int second () { if (retval1) { foo(); goto out; } out: return 6; } coccinelle-1.0.4/tests/type_annotated_fields.c0000644000175000017500000000152612614153277020472 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.4/tests/bad_typedef.c0000644000175000017500000000034612614153277016373 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.4/tests/serio.c0000644000175000017500000000024112614153277015240 0ustar eugeneugen#include #include #include static void serio_init_port(struct serio *serio) { init_MUTEX(&serio->drv_sem); } coccinelle-1.0.4/tests/delete_function.res0000644000175000017500000000007212614153277017637 0ustar eugeneugenint first () { return 0; } int last () { return 0; } coccinelle-1.0.4/tests/allex.res0000644000175000017500000000020212614153277015570 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } } if (x) return 200; out: return rc; } coccinelle-1.0.4/tests/badwhen.c0000644000175000017500000000015012614153277015526 0ustar eugeneugenint main () { f(); if (foo()) return; g(); } int second() { f(); if (xfoo()) return; g(); } coccinelle-1.0.4/tests/spaces.res0000644000175000017500000000003612614153277015746 0ustar eugeneugenint main () { foo(x + y); } coccinelle-1.0.4/tests/addifelse2.res0000644000175000017500000000107012614153277016471 0ustar eugeneugen#if LINUX_VERSION_CODE < KERNEL_VERSION(3,15,0) static void backport_rfcomm_l2data_ready(struct sock *sk, int unused) { rfcomm_l2data_ready(sk); } #else static void rfcomm_l2data_ready(struct sock *sk) { BT_DBG("%p", sk); rfcomm_schedule(); } #endif static int rfcomm_l2sock_create(struct socket **sock) { int err; BT_DBG(""); err = sock_create_kern(PF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP, sock); if (!err) { struct sock *sk = (*sock)->sk; sk->sk_data_ready = rfcomm_l2data_ready; sk->sk_state_change = rfcomm_l2state_change; } return err; } coccinelle-1.0.4/tests/cst_null.res0000644000175000017500000000155012614153277016315 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.4/tests/multi_func.cocci0000644000175000017500000000011612614153277017123 0ustar eugeneugen@@ @@ fn1(int i) { - foo_lock(); ... } fn2(int i) { - foo_unlock(); } coccinelle-1.0.4/tests/disjid.cocci0000644000175000017500000000012512614153277016224 0ustar eugeneugen@@ symbol x,y,z; @@ \(foo\|bar\)(int \(x\|y\), int z) { - return 0; + return 1; } coccinelle-1.0.4/tests/three_types.res0000644000175000017500000000030212614153277017017 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.4/tests/exitp.cocci0000644000175000017500000000021612614153277016110 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.4/tests/retmac.c0000644000175000017500000000070212614153277015374 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.4/tests/pragmatest1.cocci0000644000175000017500000000003112614153277017202 0ustar eugeneugen@@ @@ - #pragma xxx ... coccinelle-1.0.4/tests/metahex.cocci0000644000175000017500000000004412614153277016411 0ustar eugeneugen@@ expression E; @@ - f(E); - g(E);coccinelle-1.0.4/tests/optional_qualifier.c0000644000175000017500000000002412614153277020004 0ustar eugeneugenint a; const int b; coccinelle-1.0.4/tests/multitype.cocci0000644000175000017500000000013612614153277017014 0ustar eugeneugen@ rule1 @ type T; T *E; identifier fld; @@ f(E->fld) @@ rule1.T *E; @@ - g(E) + g(E, NULL) coccinelle-1.0.4/tests/kmc.res0000644000175000017500000000034612614153277015246 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.4/tests/mini_null_ref.c0000644000175000017500000000065012614153277016745 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.4/tests/mult.cocci0000644000175000017500000000015012614153277015735 0ustar eugeneugen@ rule1 @ expression E; @@ - xxx(E); - yyy(); + bar(); @ rule2 extends rule1 @ @@ - goo(E); + har(); coccinelle-1.0.4/tests/ifdef6.res0000644000175000017500000000037312614153277015637 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.4/tests/longint.cocci0000644000175000017500000000014012614153277016425 0ustar eugeneugen@ rule2 @ identifier I; expression E; @@ MODULE_PARM(I, E); @@ identifier rule2.I; @@ int I; coccinelle-1.0.4/tests/cr.cocci0000644000175000017500000000003612614153277015363 0ustar eugeneugen@@ @@ - f1(); - f2(); + f3(); coccinelle-1.0.4/tests/format2.c0000644000175000017500000000011012614153277015464 0ustar eugeneugenint main () { foo("blah %x blah"); foo("blah %1x blah %2x blah"); } coccinelle-1.0.4/tests/inner.c0000644000175000017500000000004012614153277015227 0ustar eugeneugenstruct ty x[] = { { a, }}; coccinelle-1.0.4/tests/const_array.res0000644000175000017500000000105112614153277017012 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.4/tests/multr.cocci0000644000175000017500000000012312614153277016117 0ustar eugeneugen@ rule1 @ expression x; @@ foo(x); @@ expression rule1.x; @@ xxx(); + foo(x); coccinelle-1.0.4/tests/pragmatest.res0000644000175000017500000000022412614153277016636 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.4/tests/ifend.c0000644000175000017500000000020112614153277015200 0ustar eugeneugen#ifdef VORTEX_DEBUG static int vortex_debug = VORTEX_DEBUG; #else static int vortex_debug = 1; #endif #include coccinelle-1.0.4/tests/proto2.c0000644000175000017500000000045512614153277015353 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.4/tests/addifelse2.c0000644000175000017500000000062612614153277016130 0ustar eugeneugenstatic void rfcomm_l2data_ready(struct sock *sk) { BT_DBG("%p", sk); rfcomm_schedule(); } static int rfcomm_l2sock_create(struct socket **sock) { int err; BT_DBG(""); err = sock_create_kern(PF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP, sock); if (!err) { struct sock *sk = (*sock)->sk; sk->sk_data_ready = rfcomm_l2data_ready; sk->sk_state_change = rfcomm_l2state_change; } return err; } coccinelle-1.0.4/tests/varargs2.cocci0000644000175000017500000000011012614153277016477 0ustar eugeneugen@@ identifier fct; parameter p; @@ fct(p,......) { ... + return NULL; } coccinelle-1.0.4/tests/testand2.c0000644000175000017500000000016512614153277015650 0ustar eugeneugenint main () { f(1,2,3,4); f(3,4,8,9); g(8,9,3,4); } int main () { f(1,2,3,4); g(8,9,3,4); f(3,4,8,9); } coccinelle-1.0.4/tests/nestseq.res0000644000175000017500000000006212614153277016151 0ustar eugeneugenint main () { f(); g(12); h(); xxx(12); } coccinelle-1.0.4/tests/list_test.c0000644000175000017500000000343712614153277016143 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.4/tests/keep_comma.cocci0000644000175000017500000000003112614153277017052 0ustar eugeneugen@@ @@ - foo(); + xxx(); coccinelle-1.0.4/tests/ifdef2.cocci0000644000175000017500000000023612614153277016120 0ustar eugeneugen@ Exemple2 @ @@ #include + #ifdef CONFIG_NKERNEL + #include + #include + unsigned long maxsize = 0; + #endif coccinelle-1.0.4/tests/longint.c0000644000175000017500000000016012614153277015571 0ustar eugeneugen MODULE_PARM(cm206_base, "i"); /* base */ static void do_cm206_request(request_queue_t * q) { long int i; } coccinelle-1.0.4/tests/b2.cocci0000644000175000017500000000011012614153277015253 0ustar eugeneugen@@ @@ if(...) { <... foo(); + bar(); brk(); ...> } else aaa(); coccinelle-1.0.4/tests/expopt.cocci0000644000175000017500000000007512614153277016301 0ustar eugeneugen@@ expression E; @@ f(E); ... ( - *E + E | - E + *E ) coccinelle-1.0.4/tests/ip2.res0000644000175000017500000000041112614153277015157 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.4/tests/pragmatest1.c0000644000175000017500000000005112614153277016346 0ustar eugeneugen#pragma xxx a b c #pragma xxx (a, b, c) coccinelle-1.0.4/tests/proto.cocci0000644000175000017500000000022712614153277016124 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.4/tests/metaline.cocci0000644000175000017500000000045612614153277016563 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.4/tests/cr.c0000644000175000017500000000007112614153277014524 0ustar eugeneugenint main(void) { #if ! HAVE_XYZ f1(); f2(); #endif } coccinelle-1.0.4/tests/sizeof.cocci0000644000175000017500000000011212614153277016251 0ustar eugeneugen@@ expression X; //type X; @@ //- sizeof(...) - sizeof(X) + sizeof(int) coccinelle-1.0.4/tests/orexp.c0000644000175000017500000000003512614153277015255 0ustar eugeneugenint main() { bar(12+12); } coccinelle-1.0.4/tests/test3.cocci0000644000175000017500000000011312614153277016015 0ustar eugeneugen@@ expression X,Y; @@ f(X); ... - g(Y); + h(X, Y); //error words = [f]coccinelle-1.0.4/tests/line_before_last.c0000644000175000017500000000015312614153277017415 0ustar eugeneugenint main () { foo(); xxx(); } int main () { xxx(); foo(); } int main () { xxx(); foo(); } coccinelle-1.0.4/tests/ifif.res0000644000175000017500000000024312614153277015405 0ustar eugeneugenint main () { #ifdef FOO1 #ifdef FOO2 foo(); #endif /* FOO1 */ #endif /* FOO2 */ xxx(); #ifdef BAR1 #ifdef BAR2 bar(); #endif /* BAR1 */ #endif /* BAR2 */ } coccinelle-1.0.4/tests/badpos.res0000644000175000017500000000021612614153277015740 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.4/tests/delp.res0000644000175000017500000000004212614153277015411 0ustar eugeneugenint main () { return foo; } coccinelle-1.0.4/tests/addtoo.cocci0000644000175000017500000000005212614153277016227 0ustar eugeneugen@@ statement S; @@ + bar(); - S foo(); coccinelle-1.0.4/tests/parameters_dots.c0000644000175000017500000000006712614153277017321 0ustar eugeneugenvoid main(int i) { f(1); g(3); f(1,2); f(); } coccinelle-1.0.4/tests/inherited.res0000644000175000017500000000010512614153277016440 0ustar eugeneugenvoid main(int i) { g(1); //f(2); h(2); h2(2); bar(1); } coccinelle-1.0.4/tests/post.res0000644000175000017500000000010712614153277015454 0ustar eugeneugenint main() { f(4, 3, 5); f(4, 3, 5); h(4, 3, 5); h(4, 3, 5); } coccinelle-1.0.4/tests/sp.res0000644000175000017500000000007312614153277015113 0ustar eugeneugenstruct name { unsigned long gcr; struct pci_dev *pci; }; coccinelle-1.0.4/tests/test10.c0000644000175000017500000000014512614153277015242 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.4/tests/multitype.c0000644000175000017500000000012512614153277016154 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { foo_t * x; f(x->a); g(x); } coccinelle-1.0.4/tests/befS.cocci0000644000175000017500000000004112614153277015632 0ustar eugeneugen@@ statement S; @@ + foo(); S coccinelle-1.0.4/tests/wrongcheck.res0000644000175000017500000000006512614153277016624 0ustar eugeneugenint main () { if (err == sizeof(buffer)) return; } coccinelle-1.0.4/tests/as_stm.c0000644000175000017500000000004612614153277015410 0ustar eugeneugenint main () { if (f()) return 15; } coccinelle-1.0.4/tests/noa.res0000644000175000017500000000014512614153277015246 0ustar eugeneugenint main () { if (x) { a(); } else { a(); } } int has_no_a () { if (x) { a(); } else { x(); } } coccinelle-1.0.4/tests/constructor.res0000644000175000017500000000024012614153277017052 0ustar eugeneugenint main () { changed_imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask); } coccinelle-1.0.4/tests/overshoot.cocci0000644000175000017500000000023412614153277017007 0ustar eugeneugen@aaa@ identifier f; @@ a(); <... -ff(); +g(); ...> b(); @bbb@ identifier f; @@ a(); <... -f(); +g(); ...> b(); @xxx@ identifier f; @@ a(); ... -b(); coccinelle-1.0.4/tests/minusdots.cocci0000644000175000017500000000015112614153277017002 0ustar eugeneugen@@ identifier ptr; //statement S; @@ // body could be S instead of { ... } - if (!ptr) - { - ... - } coccinelle-1.0.4/tests/binop.cocci0000644000175000017500000000013412614153277016065 0ustar eugeneugen@@ identifier i, i2; statement S; constant c; @@ + i = i2; if( - (i = i2) + i + c) S coccinelle-1.0.4/tests/ifreturn.res0000644000175000017500000000074612614153277016336 0ustar eugeneugenint main () { if (x) { blah(); { return 1; } } return 12; } int main () { if (a) { blah(); { if (x) { blah(); { return 1; } } b(); } } return 12; } int main () { if (a) { blah(); { if (b) { blah(); { if (x) { return 1; } else { return 1; } } } b(); } } return 12; } coccinelle-1.0.4/tests/unl.res0000644000175000017500000000021112614153277015261 0ustar eugeneugenint main () { if (unlikely(new_pe == NULL)) { return NULL; } } int main () { if (unlikely(new_pe == NULL)) return NULL; } coccinelle-1.0.4/tests/stm1.c0000644000175000017500000000005712614153277015010 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/isotest.res0000644000175000017500000000006712614153277016166 0ustar eugeneugenvoid main(int i) { char j; // = 1; j++; } coccinelle-1.0.4/tests/initializer.cocci0000644000175000017500000000016312614153277017303 0ustar eugeneugen@@ identifier name1, name2; @@ struct SHT var = { .f1 = name1, - .f2 = name2, + .foo = 12, + .foo2 = 12, }; coccinelle-1.0.4/tests/test10.res0000644000175000017500000000014512614153277015611 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.4/tests/ty1.res0000644000175000017500000000003412614153277015203 0ustar eugeneugenint fn(int y) { char x; } coccinelle-1.0.4/tests/pb_params_iso.res0000644000175000017500000000024512614153277017310 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.4/tests/str_init.cocci0000644000175000017500000000006312614153277016612 0ustar eugeneugen@@ @@ struct foo x = { - ..., .xxx= 12, - ... }; coccinelle-1.0.4/tests/double_switch.cocci0000644000175000017500000000006112614153277017610 0ustar eugeneugen@s@ expression E; position p; @@ - E@p < 0 + 12 coccinelle-1.0.4/tests/bugloop.cocci0000644000175000017500000000024712614153277016432 0ustar eugeneugen@@ expression current; @@ - current->flags & PF_FREEZE + freezing(current) ... ?- refrigerator(PF_FREEZE) + refrigerator() ... ? current->flags & PF_FREEZE coccinelle-1.0.4/tests/test9_ver1.c0000644000175000017500000000026012614153277016125 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.4/tests/fun.cocci0000644000175000017500000000006112614153277015545 0ustar eugeneugen@@ @@ +struct a{int a;}; f(int x) { return x; } coccinelle-1.0.4/tests/bad_iso_example.res0000644000175000017500000000004112614153277017577 0ustar eugeneugenint main() { if (x) return; } coccinelle-1.0.4/tests/regexp3.c0000644000175000017500000000021512614153277015475 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.4/tests/multidec.cocci0000644000175000017500000000005112614153277016562 0ustar eugeneugen@@ type T; identifier x; @@ - T x = 12; coccinelle-1.0.4/tests/threea.c0000644000175000017500000000004112614153277015365 0ustar eugeneugenint main() { f(12); q(12); } coccinelle-1.0.4/tests/dc_close.res0000644000175000017500000000034112614153277016242 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.4/tests/bitfield.cocci0000644000175000017500000000020312614153277016535 0ustar eugeneugen@@ @@ struct dvb_frontend { ... - struct dvb_frontend_ops* ops; + struct dvb_frontend_ops ops; ... }; coccinelle-1.0.4/tests/a_and_e.res0000644000175000017500000000012612614153277016036 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(3,4); // return 1; } coccinelle-1.0.4/tests/nest2.cocci0000644000175000017500000000014112614153277016007 0ustar eugeneugen@@ identifier func; @@ int func(int i) { <... a(); ...> - a(); + b(); <... a(); ...> }coccinelle-1.0.4/tests/metaruleelem.cocci0000644000175000017500000000005412614153277017440 0ustar eugeneugen@@ statement S; @@ f(); - S + foo(); + S coccinelle-1.0.4/tests/str_init.res0000644000175000017500000000004012614153277016316 0ustar eugeneugenstruct foo x = { .xxx= 12, }; coccinelle-1.0.4/tests/remparam.c0000644000175000017500000000034212614153277015725 0ustar eugeneugenstatic irqreturn_t snd_ad1889_interrupt(void *dev_id, int x, struct pt_regs *regs) { return IRQ_HANDLED; } static irqreturn_t snd_ad1889_interrupt(void *dev_id, struct pt_regs *regs) { return IRQ_HANDLED; } coccinelle-1.0.4/tests/minenum1.c0000644000175000017500000000003212614153277015646 0ustar eugeneugenenum h { x, a, z, q, b }; coccinelle-1.0.4/tests/toplevel_struct.c0000644000175000017500000000363512614153277017367 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.4/tests/typedef.c0000644000175000017500000000052512614153277015564 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.4/tests/pb_tag_symbols.res0000644000175000017500000000012412614153277017472 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { } coccinelle-1.0.4/tests/ktype.c0000644000175000017500000000027712614153277015264 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.4/tests/p9.res0000644000175000017500000000005512614153277015021 0ustar eugeneugenint f(int v2, int v3, int x) { return x; } coccinelle-1.0.4/tests/pb_distribute_type3.c0000644000175000017500000000016112614153277020103 0ustar eugeneugenint foo() { int x; return 0; } int foo() { int *x; return 0; } int foo() { int x[45]; return 0; } coccinelle-1.0.4/tests/struct_metavar.res0000644000175000017500000000025112614153277017532 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.4/tests/fieldcount.c0000644000175000017500000000015212614153277016254 0ustar eugeneugenstruct foo { int a; #define FOO 12 #define BAR 20 int b; #ifdef FOO int c; #else int d; #endif }; coccinelle-1.0.4/tests/hex2.c0000644000175000017500000000004012614153277014762 0ustar eugeneugenint main() { f(4294967295); } coccinelle-1.0.4/tests/sw.res0000644000175000017500000000000112614153277015111 0ustar eugeneugen coccinelle-1.0.4/tests/a_and_e_ver1.c0000644000175000017500000000012612614153277016424 0ustar eugeneugenvoid main(int i) { g(); if(1) f(1,2); else f(2,2); // return 1; } coccinelle-1.0.4/tests/kmc.c0000644000175000017500000000036112614153277014674 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.4/tests/minusdots.res0000644000175000017500000000003012614153277016507 0ustar eugeneugenvoid main(int i) { } coccinelle-1.0.4/tests/fields.c0000644000175000017500000000006512614153277015371 0ustar eugeneugenstruct foo x = { .xa = 1, .xb = 2, .xc = 3, }; coccinelle-1.0.4/tests/badaw.cocci0000644000175000017500000000042012614153277016032 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.4/tests/print_return.res0000644000175000017500000000007312614153277017224 0ustar eugeneugenint config(struct pcmcia_device *link) { return bar(); } coccinelle-1.0.4/tests/video3.c0000644000175000017500000000203112614153277015307 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.4/tests/switchdecl.res0000644000175000017500000000017712614153277016627 0ustar eugeneugenvoid f(void) { switch (2) { int x; int x; case 2: break; case 4: j++; break; } } coccinelle-1.0.4/tests/video4.c0000644000175000017500000000021612614153277015313 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.4/tests/array.c0000644000175000017500000000022712614153277015241 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.4/tests/type_iso.c0000644000175000017500000000035112614153277015754 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.4/tests/distribute.res0000644000175000017500000000005412614153277016646 0ustar eugeneugenint main(int i) { f(g(1) * 0 * g(2)); } coccinelle-1.0.4/tests/test_unsigned_meta.res0000644000175000017500000000023612614153277020353 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.4/tests/sis.cocci0000644000175000017500000000021412614153277015553 0ustar eugeneugen@@ declarer name DECLARE_MUTEX; declarer name DEFINE_MUTEX; identifier I; //fresh identifier I1; @@ - DECLARE_MUTEX(I); + DEFINE_MUTEX(I); coccinelle-1.0.4/tests/fp.cocci0000644000175000017500000000010312614153277015357 0ustar eugeneugen@@ identifier f,g; @@ f(int (*g)(int,int)) { ... - g(); ... } coccinelle-1.0.4/tests/sw.c0000644000175000017500000000005512614153277014553 0ustar eugeneugenint f() { switch (x) { case FOO: return; } } coccinelle-1.0.4/tests/proto2.res0000644000175000017500000000040312614153277015713 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.4/tests/constructor.c0000644000175000017500000000016412614153277016510 0ustar eugeneugenint main () { imx_add_platform_device_dmamask(Ename, Eid, Eres, Enum_res, Edata, Esize_data, Edma_mask); } coccinelle-1.0.4/tests/typedef3.c0000644000175000017500000000037312614153277015650 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.4/tests/shared_brace.res0000644000175000017500000000013512614153277017072 0ustar eugeneugen int __init ixj_init(void) { if ((probe = ixj_probe_pci(&cnt)) < 0) { return probe; } } coccinelle-1.0.4/tests/addif1.c0000644000175000017500000000010512614153277015246 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.4/tests/attradd.res0000644000175000017500000000013412614153277016112 0ustar eugeneugenint main () { char __attribute__((aligned(1))) f; } // some comment // some other comment coccinelle-1.0.4/tests/defe.c0000644000175000017500000000001412614153277015020 0ustar eugeneugen#define x 3 coccinelle-1.0.4/tests/incl.res0000644000175000017500000000023612614153277015417 0ustar eugeneugen#include "before.h" #include #include #include #include "after.h" #ifdef FOO #include #endif FOO coccinelle-1.0.4/tests/test6.res0000644000175000017500000000043712614153277015542 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.4/tests/yloop.c0000644000175000017500000000026512614153277015267 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.4/tests/y2.res0000644000175000017500000000030612614153277015022 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.4/tests/multistruct.cocci0000644000175000017500000000005412614153277017356 0ustar eugeneugen@@ identifier i; @@ -struct \(one\|two\) i;coccinelle-1.0.4/tests/ws2.cocci0000644000175000017500000000007312614153277015473 0ustar eugeneugen@@ statement S; fresh identifier A; @@ - if (foo()) S + S coccinelle-1.0.4/tests/SCORE_expected.sexp0000644000175000017500000004054412614155375017423 0ustar eugeneugenAPG@@2typedef_double.res@0shared_brace.res@+ifields.res@@.array_size.res@@)test3.res@*fields.res@@)fnret.res@6const_implicit_iso.res@&62.res@@/protoassert.res@1double_assign.res@@&b1.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) -longline2.res@@&km.res@*format.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; } @-starprint.res@/change_type.res@@+testand.res@*strid2.res@)ifend.res@,comments.res@@@&ar.res@@*ifdef6.res@@(stm2.res@'max.res@@-list_test.res@@*signed.res@*ktype2.res@*elsify.res@@-minusdots.res@-doublepos.res@@1pb_params_iso.res@0multitypedef.res@=labels_metastatement_ver1.res@0double_lines.res@@2failing_andany.res bINCORRECT:diff token: request_irq VS } File , line 4, column 8, charpos = 111 around = 'request_irq', whole content = request_irq(irq_flags); File "tests/failing_andany.res", line 4, column 0, charpos = 103 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,8 +1,6 @@ static int smc_probe1(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { - request_irq(irq_flags); - register_netdev(dev); } static int smc_probe2(struct net_device *dev, void __iomem *ioaddr, +constty.res@@@6toplevel_macrostmt.res@*insdef.res@+destroy.res@@)endif.res@)allex.res@@-const1bis.res@@(bug1.res@@(skip.res@+regexp3.res@*ifdef1.res@,addifdef.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,7 +7,9 @@ a = 5; #ifdef FOO + x = 0; #else + x = 0; #endif } @@ -20,7 +22,9 @@ a = 3; #ifdef FOO + x = 0; #else + x = 0; #endif } @@ -33,6 +37,8 @@ #endif #ifdef FOO + x = 0; #else + x = 0; #endif } +julia10.res@@@)orexp.res@*allex3.res@@-fieldsmin.res@@.neststruct.res@(cast.res@@*tydisj.res@*lvalue.res@@(stm3.res@*sizeof.res@/macro_int16.res@@1bad_ptr_print.res@@'ws2.res@+smallfn.res@2minusdots_ver1.res@@,longlong.res@'arg.res@@,ty_tyexp.res@@(loop.res@'log.res@+expnest.res@'a3d.res@@2metastatement2.res@)fnptr.res@3delete_function.res@@)strid.res@@@(stm5.res@)ktype.res@'bus.res@@-iterprint.res@@.test5_ver1.res@@@-substruct.res@.ifdefmeta1.res@@*threea.res@(rcu3.res@/bad_typedef.res@*addif2.res@@)test5.res@)proto.res@)local.res@@+condexp.res@@-inclifdef.res@,constrem.res@@-param_end.res@'com.res@@)boolr.res@@-multipath.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); } ,miniswap.res@@&sp.res@'sl2.res@@.introbrace.res@)ifzer.res@+a_and_e.res@@.wrongcheck.res@'spl.res@@(rem1.res@@*static.res@(rets.res@-decl_star.res@@*topdec.res@)empty.res@@)minfn.res@+deftodo.res@@)ifadd.res@(fnty.res@*badexp.res@@)type1.res@(stm7.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") &ip.res@,argument.res@@@@4optional_storage.res@,iterator.res@@)test6.res@-minstruct.res@)exitp.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") @@@-multivars.res@(incl.res@@)binop.res@-bad_kfree.res@@+sizeptr.res@.keep_comma.res@&b2.res@@(stm4.res@)deref.res@@@)test4.res@.param_ver1.res@*braces.res@@.whitespace.res@(rptr.res@@@*remaft.res@)debug.res@,dc_close.res@@.pragmatest.res@6optional_qualifier.res@5metastatement_for.res@)const.res@@(ifbr.res@(anon.res@@*test_s.res@*retest.res@*mdeclp.res UPROBLEM exn = Yes_prepare_ocamlcocci.CompileFailure("/tmp/ocaml_cocci_e7931b.ml") @.switchdecl.res@2inherited_ver1.res@@/three_types.res@*doundo.res@@4line_before_last.res@1comment_brace.res@,bitfield.res@@-gotobreak.res@*change.res@)bugon.res@@*xfield.res@.stm10_ver1.res@,sizestar.res@.dropenderr.res@)decl2.res@0attrs2groups.res@@+typedef.res@(mdec.res@)isoif.res@'dbg.res INCORRECT:PB parsing only in generated-file 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; } *comadd.res@@@*dropbr.res@@(cptr.res@@3replace_typedef.res@-ifreturn4.res@@,varargs3.res@*ifdef3.res@@/topdec_ver2.res@+fortest.res@@&sw.res@1disjexpr_ver2.res@,cast_iso.res@@,varargs2.res@.proto_ver2.res@)noret.res@@@(post.res@.justremove.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; } *notest.res@0doubleswitch.res@@0expopt3_ver1.res@@'unl.res@@*test12.res@/longlongint.res@(ifzz.res@0a_and_e_ver1.res@@-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; } @0useless_cast.res@(stm8.res@.array_init.res@-addifelse.res@@@,str_init.res@@'eb1.res@@.formatlist.res@*endpos.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_228cc5.cmxs") @+changei.res INCORRECT:diff token: i VS xxx File , line 1, column 15, charpos = 15 around = 'i', whole content = typedef struct i xxx; File "tests/changei.res", line 1, column 15, charpos = 15 around = 'xxx', whole content = typedef struct xxx istruct; diff (result(<) vs expected_result(>)) = @@ -1,4 +1,4 @@ -typedef struct i xxx; +typedef struct xxx istruct; int xxx (int xxx) { char xxx; +badwhen.res@@,addfield.res@@@/multiremove.res@)dropf.res@@@)ptrar.res@-addbefore.res@@@&kr.res@&if.res@@(slen.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_502a0d.cmxs") @)test1.res@*mincom.res@0metaruleelem.res@'ip2.res@2int2bool-local.res@@'sis.res@@@*string.res@+headers.res@@*spaces.res@(noty.res@@(tdnl.res@+isotest.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; } /const_array.res@@,metaline.res@@8labels_metastatement.res@+fn_todo.res@)extra.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_73d1f0.cmxs") -dropparam.res@2addbeforeafter.res@@@@(vpos.res@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; } 'fsh.res@+format2.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_2e631e.cmxs") @@+localid.res@&hd.res@@/multistruct.res@(enum.res@@.ifdefmeta3.res@/constructor.res@@+oneline.res@,after_if.res@@@+badzero.res@@*double.res@+arparam.res@@(func.res@'csw.res@@/topdec_ver1.res@@(stm1.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") )noty2.res@@&td.res@*struct.res@)macro.res@)endnl.res@+bugloop.res@+addelse.res@@'ty1.res@*test11.res@,metaops0.res@6incompatible_value.res@*before.res@@*unfree.res@*test10.res@'not.res@@@&y2.res@,twomatch.res@-ifdefmeta.res@@@*regexp.res@@(zero.res@-inherited.res@,castdecl.res@*addif1.res@@,twoproto.res@(defe.res@+compare.res@@(rems.res@.proto_ver1.res@*ifgoto.res@)idstr.res@@2type_annotated.res@'ifd.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; } - - } @/branchparen.res@@'inc.res@(four.res@'exp.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; ,ifreturn.res@(decl.res@(befS.res@@(void.res@+varargs.res@6test_unsigned_meta.res@+dropcom.res@@*symbol.res@@@4pb_parsing_macro.res@+mdeclp2.res UPROBLEM exn = Yes_prepare_ocamlcocci.CompileFailure("/tmp/ocaml_cocci_dfee93.ml") @-multiplus.res@*allex2.res@@/test11_ver1.res@,multidec.res@@3toplevel_struct.res@&pa.res@/initializer.res@+dowhile.res@@)mdecl.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_b5e285.cmxs") 'kmc.res@@+expopt2.res@@7pb_distribute_type3.res ?PROBLEM exn = Failure("line 7: index 53 53 already used\n") @+devlink.res@@*unelse.res@,retmacro.res@-remstruct.res@*memory.res@1match_no_meta.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; } 3parameters_dots.res@@+include.res@'cst.res@@2struct_typedef.res@(stmt.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; -ifreturn6.res@@+incpos1.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") .distribute.res@+attradd.res@@,isococci.res@@+spacing.res@@(delp.res@@@'tup.res@'opt.res@&ab.res@@*typeof.res@(tyex.res@@)test7.res@&na.res@*invert.res@*inline.res@2comment_brace2.res@*as_stm.res@@&fp.res@@@.multichars.res@-find_long.res@@@&ty.res@-positionc.res@,nameless.res@+minenum.res@)edots.res@@1disjexpr_ver1.res@+bigrepl.res@@)test9.res@(stm6.res@)foura.res@@/localglobal.res@'fun.res@@*switch.res@0param_to_exp.res@@@*return.res@@,reserved.res@+nestone.res@@(rem2.res@@,testand2.res@(pcim.res@+ifdef6a.res@1double_switch.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; } @2wierd_argument.res@@+retval2.res@@@(cr1a.res@@,remparam.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") @@;initializer_many_fields.res@*incpos.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") @1mini_null_ref.res@*ifdef2.res@@/test10_ver1.res@@0sizeof_julia.res@+regexp2.res@(hil1.res@@)test8.res@'lid.res@@0print_return.res@,disjexpr.res@@-video1bis.res@*proto2.res@)bigin.res@*addtoo.res@@@,isotest2.res@@0define_param.res@@-null_type.res@@4metastatement_if.res@@0strangeorder.res@*inhmet.res@@@/remove_call.res@,minenum1.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") .end_commas.res@@-overshoot.res@'noa.res@+kmalloc.res@*inhpos.res@@)test2.res@@@@'top.res@-same_expr.res@@,cs_check.res@@3gilles-question.res@@.decl_space.res@&cr.res@)cards.res@@-ifreturn3.res@.define_exp.res@@(pmac.res@*ifdef4.res@@*retval.res@.match_init.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); } )exitc.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_43b13a.cmxs") 'ben.res@%a.res@@-type_ver1.res@@*protox.res@+metaops.res@,cst_null.res@*addaft.res@@@*posiso.res@+nestseq.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); } @@)param.res@@-multitype.res@.addifelse2.res@@@)test0.res@&nl.res@.ifdefmeta2.res@@(tern.res@*nocast.res@*ifdef5.res@(getc.res@/gcc_min_max.res@@(type.res@.multidecl3.res@@)swap3.res@@@/pragmatest1.res@)addif.res@@*expopt.res@@3return_implicit.res@,addtrace.res@@-structfoo.res@0expopt3_ver2.res@.edots_ver1.res@@0const_adding.res@@*disjid.res@@+partial.res@1fix_flow_need.res@.badtypedef.res@@@&of.res@'hex.res@@*constx.res@)break.res@@)stm10.res@@-longconst.res@+fortype.res@'dec.res@@@+expopt3.res@@2struct_metavar.res@@)rems1.res@7pb_distribute_type4.res@(nest.res@*julia7.res@(ifif.res@*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));") @2pb_tag_symbols.res@@+arraysz.res@@@coccinelle-1.0.4/tests/sis.c0000644000175000017500000000026212614153277014720 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.4/tests/sizeof_julia.c0000644000175000017500000000017312614153277016606 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { copy_from_user(&v, arg, sizeof(v)); } coccinelle-1.0.4/tests/mdec.c0000644000175000017500000000066512614153277015041 0ustar eugeneugenint main () { int a, b, c, d; int a, b, c, *d; int a, b, *c, d; int a, *b, c, d; int *a, b, c, d; int a, b, *c, *d; int a, *b, *c, d; int *a, *b, c, d; int *a, b, c, *d; int a, *b, c, *d; int *a, b, *c, d; int a, *b, c, *d; int *a, b, *c, d; int a, *b, *c, *d; int *a, *b, *c, d; int *a, *b, c, *d; int *a, b, *c, *d; int *a, b, c, *d; int *a, b, *c, *d; int a, *b, *c, *d; int *a, *b, c, *d; } coccinelle-1.0.4/tests/loop.cocci0000644000175000017500000000003312614153277015725 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.4/tests/com.cocci0000644000175000017500000000002012614153277015526 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/decl_star.res0000644000175000017500000000005712614153277016433 0ustar eugeneugenint main () { int *y; int y; return x; } coccinelle-1.0.4/tests/xfield.res0000644000175000017500000000010512614153277015740 0ustar eugeneugenint x; /* int y; struct foo { FOO(a,b,c); FOO(a1,b1,c1); }; */ coccinelle-1.0.4/tests/parsing_pad.c0000644000175000017500000000026412614153277016413 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.4/tests/wierd_argument.cocci0000644000175000017500000000007312614153277017774 0ustar eugeneugen@@ expression B; type T; @@ - snd_magic_cast(T,B,...) + B coccinelle-1.0.4/tests/inhmet.c0000644000175000017500000000003512614153277015404 0ustar eugeneugenint main () { x->s = 12; } coccinelle-1.0.4/tests/struct_typedef.c0000644000175000017500000000035212614153277017166 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.4/tests/macro.cocci0000644000175000017500000000007112614153277016057 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.4/tests/slen.res0000644000175000017500000000015012614153277015426 0ustar eugeneugenint main() { if (x) { one(); } if (x) { was3(); } if (x) { was5(); } end(); } coccinelle-1.0.4/tests/tern.cocci0000644000175000017500000000005712614153277015732 0ustar eugeneugen@@ expression E; @@ - return (E); + return E; coccinelle-1.0.4/tests/braces.c0000644000175000017500000000025012614153277015356 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.4/tests/param1.cocci0000644000175000017500000000004112614153277016134 0ustar eugeneugen@@ @@ - foo(int x, ...) { ... } coccinelle-1.0.4/tests/metastatement.cocci0000644000175000017500000000024512614153277017634 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.4/tests/struct_metavar.cocci0000644000175000017500000000030612614153277020022 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.4/tests/wierd_argument.res0000644000175000017500000000027112614153277017505 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.4/tests/noty.cocci0000644000175000017500000000007512614153277015753 0ustar eugeneugen@@ statement S; expression *x; @@ if (NULL == x) S + g(); coccinelle-1.0.4/tests/optional_storage.cocci0000644000175000017500000000013412614153277020327 0ustar eugeneugen@ disable optional_storage @ identifier func; @@ - int + static int func(...) { ... } coccinelle-1.0.4/tests/stm6.cocci0000644000175000017500000000004612614153277015651 0ustar eugeneugen@@ statement S; @@ + h(); S g(); coccinelle-1.0.4/tests/ifdefmeta2.c0000644000175000017500000000014512614153277016130 0ustar eugeneugenint main() { buf = alloca(3 +5 +2 ); } coccinelle-1.0.4/tests/match_no_meta.c0000644000175000017500000000006412614153277016720 0ustar eugeneugenvoid main(int i) { foo(1); bar(2); bar(3); } coccinelle-1.0.4/tests/bad_kfree.cocci0000644000175000017500000000063612614153277016667 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.4/tests/stm10.cocci0000644000175000017500000000004612614153277015724 0ustar eugeneugen@@ statement S; @@ f(); S + h(); coccinelle-1.0.4/tests/tests_firehose/0000755000175000017500000000000012614153277017004 5ustar eugeneugencoccinelle-1.0.4/tests/tests_firehose/vm_fh.result0000644000175000017500000000066312614153277021350 0ustar eugeneugen alloc=kmalloc coccinelle-1.0.4/tests/tests_firehose/vm.c0000644000175000017500000000006712614153277017575 0ustar eugeneugenint main () { x = kmalloc(); r = 15; kfree(x); } coccinelle-1.0.4/tests/tests_firehose/vm_fh.cocci0000644000175000017500000000050212614153277021102 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.4/tests/test1_ver1.c0000644000175000017500000000024412614153277016117 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.4/tests/optional_qualifier.cocci0000644000175000017500000000011312614153277020641 0ustar eugeneugen@ disable optional_qualifier @ identifier x; @@ - int + const int x; coccinelle-1.0.4/tests/ifdef1.res0000644000175000017500000000040012614153277015621 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.4/tests/ifdef6.c0000644000175000017500000000031212614153277015261 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/b1.res0000644000175000017500000000021412614153277014770 0ustar eugeneugenint main () { while (1) { if (x > 1 ) { foo(); bar(); break; } } while (1) if (x > 1 ) { foo(); bar(); break; } } coccinelle-1.0.4/tests/dropf.cocci0000644000175000017500000000004612614153277016072 0ustar eugeneugen@@ expression E; @@ - f(E) + f(E + 3)coccinelle-1.0.4/tests/mdec.res0000644000175000017500000000053412614153277015403 0ustar eugeneugenint main () { char d; char c; char b; char a; int *d; int *c; int *b; int *a; int *c, *d; int *b, *c; int *a, *b; int *a, *d; int *b, *d; int *a, *c; int *b, *d; int *a, *c; int *b, *c, *d; int *a, *b, *c; int *a, *b, *d; int *a, *c, *d; int *a, *d; int *a, *c, *d; int *b, *c, *d; int *a, *b, *d; } coccinelle-1.0.4/tests/strid.res0000644000175000017500000000006412614153277015616 0ustar eugeneugenint main () { struct foo *a; print(f(a, 12)); } coccinelle-1.0.4/tests/dowhile.c0000644000175000017500000000006712614153277015560 0ustar eugeneugenint main() { do { f(); } while (0); g(); } coccinelle-1.0.4/tests/addelse.res0000644000175000017500000000002012614153277016062 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/test11_ver1.res0000644000175000017500000000007312614153277016547 0ustar eugeneugenvoid main(int i) { f(1); g(1); //g(1); h(1, 1); } coccinelle-1.0.4/tests/typeur.h0000644000175000017500000000001012614153277015446 0ustar eugeneugenint x; coccinelle-1.0.4/tests/dep.cocci0000644000175000017500000000014112614153277015524 0ustar eugeneugen@ rule1 @ @@ - foo(); @ rule2 @ @@ - bar(); @ rule3 depends on rule1 && rule2 @ @@ - xxx(); coccinelle-1.0.4/tests/typeof.c0000644000175000017500000000011312614153277015423 0ustar eugeneugenint main() { int x; f(x); f(sizeof(struct foo)); f(sizeof(int)); } coccinelle-1.0.4/tests/param_to_exp.cocci0000644000175000017500000000012112614153277017430 0ustar eugeneugen@r@ parameter list P; expression list E; @@ main(P@E) { + foo(E); return 0; } coccinelle-1.0.4/tests/scripting/0000755000175000017500000000000012614153277015760 5ustar eugeneugencoccinelle-1.0.4/tests/scripting/array/0000755000175000017500000000000012614153277017076 5ustar eugeneugencoccinelle-1.0.4/tests/scripting/array/script4.cocci0000644000175000017500000000051612614153277021472 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.4/tests/scripting/array/script4.c0000644000175000017500000000041012614153277020625 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.4/tests/scripting/script1.c0000644000175000017500000000013412614153277017507 0ustar eugeneugenint main() { int buf[20]; int i; for (i = 0; i <= 20; ++i) buf[i] = i; f(); } coccinelle-1.0.4/tests/scripting/script6.c0000644000175000017500000000033612614153277017520 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.4/tests/scripting/script7.c0000644000175000017500000000013212614153277017513 0ustar eugeneugenint main() { int x; f(2); if (2 == 2) { x = 7; } g(2); q(x); h(); } coccinelle-1.0.4/tests/scripting/script8.cocci0000644000175000017500000000020012614153277020346 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.4/tests/scripting/script4.cocci0000644000175000017500000000042312614153277020351 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.4/tests/scripting/script6.cocci0000644000175000017500000000016512614153277020356 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... *I[E] ...> @ rule2 @ type rule1.T; @@ * T coccinelle-1.0.4/tests/scripting/script4.c0000644000175000017500000000033612614153277017516 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.4/tests/scripting/script3.cocci0000644000175000017500000000024212614153277020347 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.4/tests/scripting/script5.cocci0000644000175000017500000000040612614153277020353 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.4/tests/scripting/script2.cocci0000644000175000017500000000017712614153277020355 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.4/tests/scripting/script3.c0000644000175000017500000000033612614153277017515 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.4/tests/scripting/script5.c0000644000175000017500000000033612614153277017517 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.4/tests/scripting/script8.c0000644000175000017500000000033612614153277017522 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.4/tests/scripting/script1.cocci0000644000175000017500000000017212614153277020347 0ustar eugeneugen@ rule1 @ type T; identifier I; constant C; expression E; @@ T I[C]; <... -I[E] ...> @ script:python @ @@ print "Hello" coccinelle-1.0.4/tests/scripting/script2.c0000644000175000017500000000026312614153277017513 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.4/tests/scripting/script7.cocci0000644000175000017500000000014612614153277020356 0ustar eugeneugen@ rule1 @ expression E; @@ f(E); ... g(E); ... -h() +h(E); @ script:python @ x << rule1.E; @@ print x coccinelle-1.0.4/tests/longlong.c0000644000175000017500000000007112614153277015737 0ustar eugeneugenlong long a; int main () { long long b; return 0; } coccinelle-1.0.4/tests/addbeforeafter.cocci0000644000175000017500000000007012614153277017712 0ustar eugeneugen@@ statement S; @@ if (...) { + foo(); S + bar(); }coccinelle-1.0.4/tests/double_assign.res0000644000175000017500000000010212614153277017300 0ustar eugeneugenint main() { x = 12; x = x + 1; } int badmain() { x = 1; } coccinelle-1.0.4/tests/addif1.res0000644000175000017500000000023712614153277015623 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.4/tests/ali.cocci0000644000175000017500000000124512614153277015527 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.4/tests/multiplus.cocci0000644000175000017500000000041112614153277017012 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.4/tests/fortest.cocci0000644000175000017500000000014312614153277016444 0ustar eugeneugen@@ statement S; @@ for(...;...;...) S + foo(); @@ statement S; @@ - for(...;...;...) S + bar(); coccinelle-1.0.4/tests/allex2.cocci0000644000175000017500000000016612614153277016152 0ustar eugeneugen@exists@ expression e,e1; @@ if (e) { ... when forall when != e1 - return e1; } return 15; @@ @@ - 0 + 100 coccinelle-1.0.4/tests/sizeptr.res0000644000175000017500000000026612614153277016175 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.4/tests/gcc_min_max.c0000644000175000017500000000010512614153277016362 0ustar eugeneugenint main() { int a, b; a ? b; a >?= b; } coccinelle-1.0.4/tests/unfree.c0000644000175000017500000000030212614153277015401 0ustar eugeneugenstatic void mppe_free(void *arg) { struct ppp_mppe_state *state = (struct ppp_mppe_state *) arg; if (state) { if (state->sha1_digest) kfree(state->sha1_digest); kfree(state); } } coccinelle-1.0.4/tests/log.c0000644000175000017500000000034312614153277014703 0ustar eugeneugenstatic struct var_t vars[] = { { CAPS_START, .u.s = {"\x01+35p" } }, { CAPS_STOP, .u.s = {"\x01-35p" } }, { CAPS_STOP, .u.s = {45 } }, { RATE, .u.n = {"\x01%ds", 8, 0, 9, 0, 0, NULL } }, }; int main () { f("foo"); } coccinelle-1.0.4/tests/makes_a_loop.cocci0000644000175000017500000000070712614153277017415 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.4/tests/cast.res0000644000175000017500000000002012614153277015413 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/undef2.cocci0000644000175000017500000000003012614153277016134 0ustar eugeneugen@@ @@ - #define foo 12 coccinelle-1.0.4/tests/include/0000755000175000017500000000000012614153277015401 5ustar eugeneugencoccinelle-1.0.4/tests/include/linux/0000755000175000017500000000000012614153277016540 5ustar eugeneugencoccinelle-1.0.4/tests/include/linux/serio.h.res0000644000175000017500000000010112614153277020612 0ustar eugeneugenstruct serio { struct mutex new_lock; /* mutex for mixer */ }; coccinelle-1.0.4/tests/include/linux/serio.h0000644000175000017500000000010412614153277020025 0ustar eugeneugenstruct serio { struct semaphore drv_sem; /* mutex for mixer */ }; coccinelle-1.0.4/tests/dropparam.c0000644000175000017500000000021012614153277016100 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.4/tests/test6.c0000644000175000017500000000036512614153277015173 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.4/tests/ifgoto.cocci0000644000175000017500000000007712614153277016253 0ustar eugeneugen@@ expression e; identifier l; @@ - GOTO(l,e); + e; + goto l; coccinelle-1.0.4/tests/func.cocci0000644000175000017500000000017512614153277015716 0ustar eugeneugen@@ constant char [] c; identifier f; @@ f(..., - c + "%s crtl_request : bRequestType:0x%x bRequest:0x%x Value:0x%x\n" ,...) coccinelle-1.0.4/tests/inhpos.cocci0000644000175000017500000000023712614153277016262 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.4/tests/expnest.c0000644000175000017500000000011512614153277015605 0ustar eugeneugenint main() { x = 3 + 4; x = f() + 15; x = 15 + g(); x = f() + g(); } coccinelle-1.0.4/tests/localglobal.c0000644000175000017500000000010612614153277016372 0ustar eugeneugenint a; int main(int b) { int c; int local; return a + b + c; } coccinelle-1.0.4/tests/ip.res0000644000175000017500000000041112614153277015075 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.4/tests/formatlist.cocci0000644000175000017500000000014412614153277017143 0ustar eugeneugen@@ format list[4] d; @@ - "xyz %@d@" + "blah" @@ format list[2] d; @@ - "xyz %@d@ abc" + "blah2" coccinelle-1.0.4/tests/ws2.res0000644000175000017500000000005312614153277015202 0ustar eugeneugenint main() { goto err; err: return; } coccinelle-1.0.4/tests/not.c0000644000175000017500000000015312614153277014721 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.4/tests/rem1.res0000644000175000017500000000004212614153277015331 0ustar eugeneugenint main () { xxx(); yyy(); } coccinelle-1.0.4/tests/test12.c0000644000175000017500000000006512614153277015245 0ustar eugeneugenvoid main(int foo) { f(1); foo(); g(2); } coccinelle-1.0.4/tests/hex2.cocci0000644000175000017500000000002712614153277015625 0ustar eugeneugen@@ @@ - f(0xFFFFFFFF); coccinelle-1.0.4/tests/spacing.res0000644000175000017500000000026512614153277016120 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.4/tests/bad_subsumption.cocci0000644000175000017500000000223612614153277020161 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.4/tests/incpos1.c0000644000175000017500000000010012614153277015465 0ustar eugeneugen#include "two" #include #include "four" #include coccinelle-1.0.4/tests/endif.c0000644000175000017500000000035412614153277015211 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.4/tests/assign.c0000644000175000017500000000005512614153277015406 0ustar eugeneugenint main(int x) { int x = 100; x = 45; } coccinelle-1.0.4/tests/ifdef6a.cocci0000644000175000017500000000014212614153277016261 0ustar eugeneugen@ Exemple6@ @@ + #ifdef CONFIG_NKERNEL + #define foo(x) f(x) + #endif #include coccinelle-1.0.4/tests/type.c0000644000175000017500000000004412614153277015101 0ustar eugeneugenint foo() { int x; return 0; } coccinelle-1.0.4/tests/exitc.cocci0000644000175000017500000000021212614153277016067 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.4/tests/labels_metastatement.cocci0000644000175000017500000000004112614153277021150 0ustar eugeneugen@@ statement S; @@ S + foo(); coccinelle-1.0.4/tests/vpos.c0000644000175000017500000000011312614153277015104 0ustar eugeneugenint main() { f(2); if (x) { g(1,1); } else { g(1,2); } } coccinelle-1.0.4/tests/expopt3.c0000644000175000017500000000023612614153277015525 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.4/tests/if.res0000644000175000017500000000057712614153277015100 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.4/tests/kmalloc.res0000644000175000017500000000027612614153277016120 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.4/tests/ip.cocci0000644000175000017500000000010712614153277015366 0ustar eugeneugen@@ statement s1, s2; @@ if(...) s1 else +{trace("ifelel"); s2 +} coccinelle-1.0.4/tests/insdef.cocci0000644000175000017500000000005412614153277016227 0ustar eugeneugen@@ @@ #define TABINFOGEN +#include coccinelle-1.0.4/tests/stm2.res0000644000175000017500000000004212614153277015352 0ustar eugeneugenint main(int x) { f(); g(); } coccinelle-1.0.4/tests/km.c0000644000175000017500000000020612614153277014527 0ustar eugeneugenint main() { int *data = kmalloc(element->string.length + 1, GFP_KERNEL); foo(); memset(data, 0, element->string.length + 1); } coccinelle-1.0.4/tests/ifreturn4.cocci0000644000175000017500000000010112614153277016672 0ustar eugeneugen@@ statement s1, s2; @@ if(...) s1 else +{mwtrace(); s2 +} coccinelle-1.0.4/tests/typedef3.cocci0000644000175000017500000000037412614153277016507 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.4/tests/fortype.cocci0000644000175000017500000000015212614153277016446 0ustar eugeneugen@@ @@ - x + y @@ identifier x; statement S; expression e; @@ for ( - int x + char *p = e; ...; ...) Scoccinelle-1.0.4/tests/proto_ver2.res0000644000175000017500000007037112614153277016602 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.4/tests/disjexpr_ver2.c0000644000175000017500000000005312614153277016706 0ustar eugeneugenint main (int i) { f(v.fld, v.fld2, v); } coccinelle-1.0.4/tests/dropcom.res0000644000175000017500000000012012614153277016125 0ustar eugeneugen#ifdef XXX int one() { return 0; } #endif /* XXX */ int xyz () { return 1; } coccinelle-1.0.4/tests/scope_problem.res0000644000175000017500000000007112614153277017320 0ustar eugeneugenvoid main(int i) { if(1) { int a; a = 2; } } coccinelle-1.0.4/tests/pb_params_iso.cocci0000644000175000017500000000116512614153277017601 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.4/tests/sp.cocci0000644000175000017500000000010212614153277015373 0ustar eugeneugen@ rule0 @ type T; @@ - typedef struct + name { ... } - T ; coccinelle-1.0.4/tests/cr1a.res0000644000175000017500000000106612614153277015322 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.4/tests/oddifdef.res0000644000175000017500000000072312614153277016237 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.4/tests/td.c0000644000175000017500000000012712614153277014531 0ustar eugeneugenstruct foo {int a;}; typedef struct blah {int a;} name; typedef struct {int a;} xxx; coccinelle-1.0.4/tests/print_return.c0000644000175000017500000000010012614153277016644 0ustar eugeneugenint config(struct pcmcia_device *link) { bar(); return 0; } coccinelle-1.0.4/tests/replace_typedef.c0000644000175000017500000000017512614153277017260 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.4/tests/cst_null.c0000644000175000017500000000170012614153277015743 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.4/tests/fortype.c0000644000175000017500000000007512614153277015614 0ustar eugeneugenint main () { for (int x = 0; x!=10; x++) return x; } coccinelle-1.0.4/tests/mf.cocci0000644000175000017500000000025212614153277015361 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.4/tests/tdnl.cocci0000644000175000017500000000001512614153277015715 0ustar eugeneugen@@ @@ -foo();coccinelle-1.0.4/tests/stm4.res0000644000175000017500000000006612614153277015362 0ustar eugeneugenint main(int x) { f(); replace(); g(); g(); } coccinelle-1.0.4/tests/free.c0000644000175000017500000000300712614153277015043 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.4/tests/metaline.res0000644000175000017500000000014712614153277016271 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.4/tests/mf.c0000644000175000017500000000013012614153277014516 0ustar eugeneugenint fn1() { foo(12); } int fn2() { fn1(); bar(10); } int fn1bis() { foo(7); } coccinelle-1.0.4/tests/undef.cocci0000644000175000017500000000004012614153277016053 0ustar eugeneugen@@ identifier x; @@ - #undef x coccinelle-1.0.4/tests/bugon.cocci0000644000175000017500000000012012614153277016063 0ustar eugeneugen@disable unlikely@ expression E; @@ - if (unlikely(E)) { BUG(); } + BUG_ON(E); coccinelle-1.0.4/tests/test4.c0000644000175000017500000000011112614153277015156 0ustar eugeneugenvoid main() { f(1,2,3); h(1); if(1) g(1); else g(1); } coccinelle-1.0.4/tests/ty_tyexp.res0000644000175000017500000000014012614153277016351 0ustar eugeneugenvoid main(double z) { float x; float y; } float main(float z) { } float main2(float z); coccinelle-1.0.4/tests/ifdef1.c0000644000175000017500000000031212614153277015254 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/ifreturn3.res0000644000175000017500000000043512614153277016414 0ustar eugeneugenint GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else // blah { mwtrace(); return WARNING; } return 0; } int GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else { mwtrace(); return WARNING; } return 0; } coccinelle-1.0.4/tests/posnpb.c0000644000175000017500000000011112614153277015414 0ustar eugeneugenint main() { x = FN(); if (y) x->a = 12; else x->b = 15; } coccinelle-1.0.4/tests/ifdef4.res0000644000175000017500000000040512614153277015631 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.4/tests/stmt.c0000644000175000017500000000003612614153277015110 0ustar eugeneugenint f() { int x; xxx(); } coccinelle-1.0.4/tests/expnest.cocci0000644000175000017500000000007512614153277016450 0ustar eugeneugen@expression@ @@ <+... f() ...+> - + + - <+... g() ...+> coccinelle-1.0.4/tests/minfn.c0000644000175000017500000000030612614153277015230 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.4/tests/orexp.cocci0000644000175000017500000000007112614153277016113 0ustar eugeneugen@@ expression E, F; @@ ( - foo(E) + 4 | - bar(F) + 4 )coccinelle-1.0.4/tests/regexp3.res0000644000175000017500000000132112614153277016043 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.4/tests/disjid.c0000644000175000017500000000027112614153277015370 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.4/tests/useless_cast.c0000644000175000017500000000055712614153277016626 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.4/tests/func.res0000644000175000017500000000033612614153277015426 0ustar eugeneugenstatic int hidg_setup(struct usb_function *f, const struct usb_ctrlrequest *ctrl) { VDBG(cdev, "%s crtl_request : bRequestType:0x%x bRequest:0x%x Value:0x%x\n", ctrl->bRequestType, ctrl->bRequest, value); } coccinelle-1.0.4/tests/invert.c0000644000175000017500000000003512614153277015427 0ustar eugeneugenint main () { x = y + z; } coccinelle-1.0.4/tests/binop.res0000644000175000017500000000022612614153277015600 0ustar eugeneugenvoid main() { int i = 0; int j = 0; i = j; if(i + 0 ) { i = j; } i = j; if(i + 0 != 0 ) { i = j; } } coccinelle-1.0.4/tests/typedef3.res0000644000175000017500000000041312614153277016212 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.4/tests/idstr.c0000644000175000017500000000012512614153277015245 0ustar eugeneugenint main () { printf("arena 0x%08x, numfree = %d\n", (unsigned)dt, dt->numfree); } coccinelle-1.0.4/tests/bitfield.res0000644000175000017500000000033412614153277016253 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.4/tests/allex3.c0000644000175000017500000000020712614153277015311 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } goto out; } return 15; out: return 0; } coccinelle-1.0.4/tests/symbol.res0000644000175000017500000000005112614153277015772 0ustar eugeneugenint main() { int f = 0; return f; } coccinelle-1.0.4/tests/rem1.c0000644000175000017500000000006612614153277014770 0ustar eugeneugenint main () { xxx(); if (x) { foo(); } yyy(); } coccinelle-1.0.4/tests/expopt2.res0000644000175000017500000000005012614153277016065 0ustar eugeneugenvoid main(int i) { f(v, g(w.aa)); } coccinelle-1.0.4/tests/fp.c0000644000175000017500000000004712614153277014530 0ustar eugeneugenint main(int (*x)(int,int)) { x(); } coccinelle-1.0.4/tests/after_if.c0000644000175000017500000000020312614153277015674 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.4/tests/file.h0000644000175000017500000000003112614153277015040 0ustar eugeneugen int xmain () { f(); } coccinelle-1.0.4/tests/multidec.res0000644000175000017500000000006112614153277016274 0ustar eugeneugenint main () { int x = 3,z; int y; int y; } coccinelle-1.0.4/tests/stm5.cocci0000644000175000017500000000005512614153277015650 0ustar eugeneugen@@ statement S; @@ f(); + h(); S + g(); coccinelle-1.0.4/tests/voyager.cocci0000644000175000017500000000042412614153277016434 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.4/tests/julia7.c0000644000175000017500000000012712614153277015315 0ustar eugeneugenint main(int x) { foo(); if (x) {bar(); after(); return 0;} bar(); after(); } coccinelle-1.0.4/tests/multiplus.res0000644000175000017500000000065512614153277016535 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.4/tests/ktype2.c0000644000175000017500000000035212614153277015340 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) { memset(conf, 0, sizeof(*conf)); return; } memset(conf, 0, sizeof(*conf)); } coccinelle-1.0.4/tests/localid.c0000644000175000017500000000010312614153277015523 0ustar eugeneugenint c; int main () { int a; f(a); f(a+1); f(b); f(c); } coccinelle-1.0.4/tests/ifzz.cocci0000644000175000017500000000002312614153277015735 0ustar eugeneugen@@ @@ -int +size_t coccinelle-1.0.4/tests/disjexpr_ver1.c0000644000175000017500000000004012614153277016701 0ustar eugeneugenint main (int i) { f(v.fld); } coccinelle-1.0.4/tests/tup.res0000644000175000017500000000032412614153277015300 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.4/tests/minenum.cocci0000644000175000017500000000007512614153277016432 0ustar eugeneugen@@ @@ enum h { ..., - a, - z, + qq, ..., b, ... }; coccinelle-1.0.4/tests/type_annotated.res0000644000175000017500000000024212614153277017505 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.4/tests/remove_call.res0000644000175000017500000000002012614153277016751 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/comment_brace.cocci0000644000175000017500000000005512614153277017556 0ustar eugeneugen@@ @@ + release_region(); continue; coccinelle-1.0.4/tests/com.res0000644000175000017500000000010212614153277015240 0ustar eugeneugenint main() { /* a comment */ /* a comment */ bar(); } coccinelle-1.0.4/tests/delete_function.cocci0000644000175000017500000000005012614153277020122 0ustar eugeneugen@@ @@ -foo() { - a(); - a(); - a(); -} coccinelle-1.0.4/tests/gcc_min_max.res0000644000175000017500000000012712614153277016735 0ustar eugeneugenint main() { int a, b; min(a, b); a = min(a, b); max(a, b); a = max(a, b); } coccinelle-1.0.4/tests/dropparam.cocci0000644000175000017500000000045512614153277016751 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; @@ g (Es, - E, ...) @ rule2 disable add_signed @ parameter list[rule1.n] P; identifier x; @@ g (P, - int x, ...) { ... } coccinelle-1.0.4/tests/getc.c0000644000175000017500000000016112614153277015042 0ustar eugeneugenint IFoo_QueryInterface(int *iface, long *riid, void **ppv) { return IBar_QueryInterface(iface, riid, *ppv); } coccinelle-1.0.4/tests/test9.cocci0000644000175000017500000000023312614153277016026 0ustar eugeneugen@@ identifier func; // work with local function ? with function ? expression X,Y; @@ func(...) { ... f(X); ... - h(Y); + h(X, Y); ... } coccinelle-1.0.4/tests/isoif.res0000644000175000017500000000002012614153277015572 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/debug.res0000644000175000017500000000007012614153277015554 0ustar eugeneugenstatic int __init init_3c574_cs(void) { return 0; } coccinelle-1.0.4/tests/not_converted.c0000644000175000017500000000062512614153277016776 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.4/tests/switch_case.cocci0000644000175000017500000000023312614153277017252 0ustar eugeneugen@@ @@ - switch(1) { + switch(2) { case CASE1: case1(); case3(); //case4(); //break; case CASE2: case2(); break; } coccinelle-1.0.4/tests/distribute.cocci0000644000175000017500000000007012614153277017133 0ustar eugeneugen@@ expression E; @@ f( + g(1) * - E + 0 + * g(2) ) coccinelle-1.0.4/tests/spl.c0000644000175000017500000000034312614153277014720 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.4/tests/allbound.cocci0000644000175000017500000000014512614153277016560 0ustar eugeneugen@ rule1 @ expression E, E1; @@ ( foo(E1) | bar(E) ) @ rule2 extends rule1 @ @@ - xxx(E1) + yyy(E) coccinelle-1.0.4/tests/multidecl.c0000644000175000017500000000036212614153277016105 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.4/tests/cs_check.cocci0000644000175000017500000000013512614153277016521 0ustar eugeneugen@@ expression E1; @@ - pcmcia_get_first_tuple(handle,E1) + pcmcia_get_first_tuple(link, E1) coccinelle-1.0.4/tests/mdeclp2.cocci0000644000175000017500000000067012614153277016311 0ustar eugeneugen@initialize:ocaml@ @@ let py2cocci_pos p = let ios = int_of_string in match Str.split (Str.regexp ",") p with [fl;fn;startl;startc;endl;endc] -> make_position fl fn (ios startl) (ios startc) (ios endl) (ios endc) | _ -> failwith "bad position" @script:python a@ p; @@ coccinelle.p = "mdeclp2.c,one,1,4,1,7" @script:ocaml r@ inp << a.p; p; @@ p := py2cocci_pos inp @@ position r.p; identifier f; @@ - f@p(...) { ... } coccinelle-1.0.4/tests/addifdef.cocci0000644000175000017500000000023112614153277016502 0ustar eugeneugen@@ identifier main; @@ +#ifdef LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) int main() { ... } +#endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) */ coccinelle-1.0.4/tests/stm10.c0000644000175000017500000000011212614153277015060 0ustar eugeneugenint main(int x) { f(); if (x) replace(); g(); if (x) replace(); } coccinelle-1.0.4/tests/test0.cocci0000644000175000017500000000001712614153277016015 0ustar eugeneugen@@ @@ - f(1); coccinelle-1.0.4/tests/type_infer.cocci0000644000175000017500000000022512614153277017123 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.4/tests/test10_ver1.res0000644000175000017500000000011312614153277016541 0ustar eugeneugenvoid main(int i) { f(1); f(1); g(1); //g(1); h(1, 1); h(1); } coccinelle-1.0.4/tests/iterator.c0000644000175000017500000000041012614153277015746 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.4/tests/fsh.c0000644000175000017500000000003712614153277014702 0ustar eugeneugenint main () { f(c); g(); } coccinelle-1.0.4/tests/ty_tyexp.cocci0000644000175000017500000000002512614153277016642 0ustar eugeneugen@@ @@ - int + float coccinelle-1.0.4/tests/delp.c0000644000175000017500000000004412614153277015044 0ustar eugeneugenint main () { return (foo); } coccinelle-1.0.4/tests/destroy.cocci0000644000175000017500000000032212614153277016446 0ustar eugeneugen@@ expression irq, dev; @@ +#if LINUX_VERSION_CODE >= KERNEL_VERSION(2,6,31) free_irq(irq, dev); +#else +compat_free_threaded_irq(&private->irq_compat); +compat_destroy_threaded_irq(&dev->irq_compat); +#endif coccinelle-1.0.4/tests/check_order1.c0000644000175000017500000000010612614153277016450 0ustar eugeneugenint main () { f(one); f(two); f(three); f(four); f(five); } coccinelle-1.0.4/tests/null_type.res0000644000175000017500000000007212614153277016503 0ustar eugeneugenint main(int i) { int *x; g(f(x)); g(f(NULL)); } coccinelle-1.0.4/tests/dropenderr.cocci0000644000175000017500000000034312614153277017124 0ustar eugeneugen@@ identifier l,l1; expression e; statement S; @@ -goto l; ... l: <... when != S l1: ...> return e; @@ identifier l,l1; expression e; statement S; @@ -l: <... when != S when any // why is this needed? l1: ...> return e;coccinelle-1.0.4/tests/sis.res0000644000175000017500000000006712614153277015272 0ustar eugeneugenDEFINE_MUTEX(disconnect_sem); //int foo() { return; } coccinelle-1.0.4/tests/cs_check.c0000644000175000017500000000043312614153277015664 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.4/tests/constrem.c0000644000175000017500000000006712614153277015757 0ustar eugeneugenstatic const int a; static const int (*f)(const int); coccinelle-1.0.4/tests/hil1.res0000644000175000017500000000021612614153277015325 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.4/tests/local.c0000644000175000017500000000004412614153277015212 0ustar eugeneugenint f(int xx, int yy) { return 0; } coccinelle-1.0.4/tests/my.h0000644000175000017500000000066512614153277014563 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.4/tests/formatlist.res0000644000175000017500000000035212614153277016655 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.4/tests/find_long.c0000644000175000017500000000014512614153277016061 0ustar eugeneugenlong function() { long a; int b; a + b; b + a; return a; } coccinelle-1.0.4/tests/static.res0000644000175000017500000000005412614153277015757 0ustar eugeneugenstatic inline int i8042_read_data(void) { } coccinelle-1.0.4/tests/define_chip_t.cocci0000644000175000017500000000013512614153277017537 0ustar eugeneugen@ rule1 @ type T; @@ - #define chip_t T @@ typedef chip_t; type rule1.T; @@ - chip_t + T coccinelle-1.0.4/tests/multidecl3.res0000644000175000017500000000013312614153277016533 0ustar eugeneugenint main () { int k, r; } struct foo { int k, r; }; int main () { } struct foo { }; coccinelle-1.0.4/tests/mini_null_ref.res0000644000175000017500000000067512614153277017323 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.4/tests/exitp.c0000644000175000017500000000006612614153277015255 0ustar eugeneugenint main () { f(a1); f(a2); f(done); f(a4); } coccinelle-1.0.4/tests/metastatement.c0000644000175000017500000000005512614153277016775 0ustar eugeneugenvoid main(int i) { g(1); g(2); f(1); } coccinelle-1.0.4/tests/param.cocci0000644000175000017500000000003212614153277016053 0ustar eugeneugen@@ @@ - foo(...) { ... } coccinelle-1.0.4/tests/decl.c0000644000175000017500000000007112614153277015027 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { return 0; } coccinelle-1.0.4/tests/multi_func1.c0000644000175000017500000000024412614153277016350 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.4/tests/rets.c0000644000175000017500000000004612614153277015077 0ustar eugeneugenint main () { foo(); return 12; } coccinelle-1.0.4/tests/incompatible_value.res0000644000175000017500000000010412614153277020326 0ustar eugeneugenint main() { f(1); f(2); } int main() { g(1); g(2); } coccinelle-1.0.4/tests/bus.c0000644000175000017500000000007412614153277014714 0ustar eugeneugenint main () { struct foo *dev; dev->probe(); foo(); } coccinelle-1.0.4/tests/metaruleelem.c0000644000175000017500000000007712614153277016607 0ustar eugeneugenint main(int x) { f(); if(1) { replace(); } g(); } coccinelle-1.0.4/tests/zero.c0000644000175000017500000000037012614153277015101 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.4/tests/oneline.res0000644000175000017500000000003612614153277016121 0ustar eugeneugenint main () { g(); g(); } coccinelle-1.0.4/tests/tydisj.res0000644000175000017500000000007512614153277016001 0ustar eugeneugenint64_t foo() { int64_t a; int i; xxx(); return i << 20; } coccinelle-1.0.4/tests/ifbr.res0000644000175000017500000000004512614153277015412 0ustar eugeneugenint main () { if (x) return; } coccinelle-1.0.4/tests/disjexpr.res0000644000175000017500000000005612614153277016322 0ustar eugeneugenint main (int i) { f(v->fld, *v, v->fld2); } coccinelle-1.0.4/tests/changetype.cocci0000644000175000017500000000006612614153277017111 0ustar eugeneugen@@ identifier x; typedef bool; @@ ++ bool x; - int x;coccinelle-1.0.4/tests/ar.res0000644000175000017500000000016712614153277015077 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.4/tests/send_pci20000644000175000017500000000223112614153277015545 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.4/tests/test11.res0000644000175000017500000000012112614153277015604 0ustar eugeneugenvoid main(int i) { f(1); g(1); g(1); // if comment then simpler h(1); } coccinelle-1.0.4/tests/const_array.c0000644000175000017500000000115412614153277016447 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.4/tests/include.res0000644000175000017500000000010612614153277016111 0ustar eugeneugen #include #include void main(int i) { i++; } coccinelle-1.0.4/tests/ktype.res0000644000175000017500000000023512614153277015625 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.4/tests/debug.cocci0000644000175000017500000000010112614153277016036 0ustar eugeneugen@@ identifier init; @@ init(...) { - DEBUG(...); ... } coccinelle-1.0.4/tests/partial.c0000644000175000017500000000017312614153277015557 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.4/tests/ifields.c0000644000175000017500000000036012614153277015540 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.4/tests/starprint.c0000644000175000017500000000011212614153277016142 0ustar eugeneugentypedef int *LPINT; int foo(LPINT x, LPINT *y) { return *x == **y; } coccinelle-1.0.4/tests/addaft.cocci0000644000175000017500000000005212614153277016200 0ustar eugeneugen@@ statement S; @@ foo(); - S + bar(); coccinelle-1.0.4/tests/unelse.cocci0000644000175000017500000000006512614153277016254 0ustar eugeneugen@@ @@ if (...) { ... return ...; } -else { ... -} coccinelle-1.0.4/tests/metastatement2.res0000644000175000017500000000004412614153277017424 0ustar eugeneugenvoid main(int i) { f(); g(); } coccinelle-1.0.4/tests/constty.res0000644000175000017500000000010612614153277016171 0ustar eugeneugenint main () { const int x; int y; f(y,int); f(x,const int); } coccinelle-1.0.4/tests/eb1.c0000644000175000017500000000011012614153277014561 0ustar eugeneugenint func() { int c; Packet p1,p2; int y; a = 3; return x+y; } coccinelle-1.0.4/tests/nestseq.cocci0000644000175000017500000000007112614153277016440 0ustar eugeneugen@@ expression E; @@ f(); <... g(E) ...> h(); + xxx(E); coccinelle-1.0.4/tests/gotobreak.res0000644000175000017500000000045212614153277016447 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.4/tests/skip.cocci0000644000175000017500000000013312614153277015723 0ustar eugeneugen@ rule1 @ expression E; @@ f(E) @@ @@ - g(); + h(); @@ expression rule1.E; @@ - f(E); coccinelle-1.0.4/tests/multivars.res0000644000175000017500000000005612614153277016520 0ustar eugeneugenvoid main(int i) { h(1 + 2 + v.field1); } coccinelle-1.0.4/tests/noty2.res0000644000175000017500000000012112614153277015536 0ustar eugeneugenmain () { return; } int main2 () { return; } blah_t main3 () { return; } coccinelle-1.0.4/tests/strangeorder.cocci0000644000175000017500000000013012614153277017451 0ustar eugeneugen@@ expression *E; identifier f; statement S1; @@ if (E == NULL) +{ + E = NULL; S1 +} coccinelle-1.0.4/tests/test2.res0000644000175000017500000000010212614153277015523 0ustar eugeneugenvoid main() { f(1,2,3); if(1) h(1); else h(1); } coccinelle-1.0.4/tests/addifelse2.cocci0000644000175000017500000000103212614153277016756 0ustar eugeneugen@ sk_data_ready_assigned @ struct sock *sk; identifier drv_data_ready; @@ sk->sk_data_ready = drv_data_ready; @ sk_data_ready_declared depends on sk_data_ready_assigned @ identifier sk; identifier sk_data_ready_assigned.drv_data_ready; fresh identifier backport_drv_data_ready = "backport_" ## drv_data_ready; @@ +#if LINUX_VERSION_CODE < KERNEL_VERSION(3,15,0) +static void backport_drv_data_ready(struct sock *sk, int unused) +{ + drv_data_ready(sk); +} +#else + drv_data_ready(struct sock *sk) { ... } +#endif coccinelle-1.0.4/tests/inner.cocci0000644000175000017500000000017112614153277016072 0ustar eugeneugen@@ identifier ty,x; expression a; initializer list is; @@ struct ty x[] = {..., {is, - a + .i = foo(a) ,...}, ...}; coccinelle-1.0.4/tests/pb_params_iso.c0000644000175000017500000000020512614153277016735 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.4/tests/cr.res0000644000175000017500000000006112614153277015072 0ustar eugeneugenint main(void) { #if ! HAVE_XYZ f3(); #endif } coccinelle-1.0.4/tests/tadb.c0000644000175000017500000000017412614153277015036 0ustar eugeneugenstatic int adbhid_kbd_event() { } static void adbhid_input_register() { adbhid[id]->input.event = adbhid_kbd_event; } coccinelle-1.0.4/tests/not.res0000644000175000017500000000013412614153277015267 0ustar eugeneugenint main() { int x; f(20); this(foo,x); bar(12,x); foo(12,x); f(20); f(20); } coccinelle-1.0.4/tests/void.res0000644000175000017500000000021612614153277015431 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.4/tests/protox.cocci0000644000175000017500000000070312614153277016313 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.4/tests/stm5.c0000644000175000017500000000005712614153277015014 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/y.c0000644000175000017500000000004512614153277014371 0ustar eugeneugenint main() { foo(12); bar(80); } coccinelle-1.0.4/tests/test_s.res0000644000175000017500000000067112614153277015776 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.4/tests/skip.c0000644000175000017500000000004712614153277015071 0ustar eugeneugenint main () { f(1); f(2); g(); } coccinelle-1.0.4/tests/param_to_exp.res0000644000175000017500000000006512614153277017150 0ustar eugeneugenint main (int x, int y) { foo(x, y); return 0; } coccinelle-1.0.4/tests/typeur.c0000644000175000017500000000007212614153277015451 0ustar eugeneugen#include "typeur.h" int main () { int y; f(x + y); } coccinelle-1.0.4/tests/param_ver1.res0000644000175000017500000000000112614153277016515 0ustar eugeneugen coccinelle-1.0.4/tests/endnl.res0000644000175000017500000000050512614153277015571 0ustar eugeneugenint main () { #ifdef FOO call(1); #endif foo(1); bar(2); #ifdef BAR call(2); #endif one: #ifdef FOO call(3); #endif foo(3); two: bar(4); #ifdef BAR call(4); #endif three: xxx(5); #ifdef X #endif #ifdef FOO call(6); #endif foo(6); #ifdef X #endif bar(7); #ifdef BAR call(7); #endif #ifdef X #endif } coccinelle-1.0.4/tests/csw.res0000644000175000017500000000007512614153277015267 0ustar eugeneugenint main() { switch (x) { case MID: mid(); break; } } coccinelle-1.0.4/tests/func.c0000644000175000017500000000033612614153277015057 0ustar eugeneugenstatic int hidg_setup(struct usb_function *f, const struct usb_ctrlrequest *ctrl) { VDBG(cdev, "hid_setup crtl_request : bRequestType:0x%x bRequest:0x%x " "Value:0x%x\n", ctrl->bRequestType, ctrl->bRequest, value); } coccinelle-1.0.4/tests/badpos.cocci0000644000175000017500000000005212614153277016225 0ustar eugeneugen@@ struct pt_regs *regs; @@ - regs + xxx coccinelle-1.0.4/tests/bug1.res0000644000175000017500000000022712614153277015330 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.4/tests/posmult.cocci0000644000175000017500000000071012614153277016461 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.4/tests/null_type.c0000644000175000017500000000006412614153277016135 0ustar eugeneugenint main(int i) { int *x; g(x); g(NULL); } coccinelle-1.0.4/tests/match_init.res0000644000175000017500000000021512614153277016606 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.4/tests/befS.c0000644000175000017500000000022012614153277014773 0ustar eugeneugenint main () { xxx(); if(y) { rrr(); } } int main () { xxx(); if(y) rrr(); } int d() {} int main2 () { yyy(); xxx(); } coccinelle-1.0.4/tests/remstruct.cocci0000644000175000017500000000017412614153277017012 0ustar eugeneugen@@ @@ - static struct irqchip mpuio_irq_chip = { - ... - }; @@ @@ - static struct irqchip xxx = { - .a = 12, - ... - }; coccinelle-1.0.4/tests/toplevel_struct.cocci0000644000175000017500000000124312614153277020216 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.4/tests/stmt.res0000644000175000017500000000004712614153277015461 0ustar eugeneugenint f() { int x; foo(); xxx(); } coccinelle-1.0.4/tests/changei.cocci0000644000175000017500000000005112614153277016352 0ustar eugeneugen@identifier@ identifier i; @@ - i + xxx coccinelle-1.0.4/tests/dbg1.c0000644000175000017500000000012312614153277014733 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { DBG("PCI"); } coccinelle-1.0.4/tests/andparen.c0000644000175000017500000000006012614153277015706 0ustar eugeneugenint main() { if (foo() && (x < 12)) return; } coccinelle-1.0.4/tests/spaces.cocci0000644000175000017500000000004712614153277016237 0ustar eugeneugen@@ expression E; @@ - foo(E) + foo(E) coccinelle-1.0.4/tests/testprint.c0000644000175000017500000000017012614153277016154 0ustar eugeneugenvoid main(int foo) { f(1); x(); g(2); x(); if(1) { // h(3); h(3); } else { h(4); } } coccinelle-1.0.4/tests/match_no_meta.cocci0000644000175000017500000000011212614153277017550 0ustar eugeneugen@ rule1 @ @@ foo(1); bar(2); @ rule2 depends on rule1 @ @@ - bar(3);coccinelle-1.0.4/tests/cs_check.res0000644000175000017500000000043112614153277016231 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.4/tests/mdeclp2.res0000644000175000017500000000003112614153277016011 0ustar eugeneugen int two() { return 1; } coccinelle-1.0.4/tests/twomatch.res0000644000175000017500000000004612614153277016317 0ustar eugeneugenint main() { bar(12,1); yyy(); } coccinelle-1.0.4/tests/minusdots_ver1.c0000644000175000017500000000006712614153277017107 0ustar eugeneugenvoid main(int i) { if (!hostptr) { i++; } } coccinelle-1.0.4/tests/double_assign.c0000644000175000017500000000011412614153277016734 0ustar eugeneugenint main() { x = 12; x = x + 1; } int badmain() { x = 12; x = 1; } coccinelle-1.0.4/tests/disjid.res0000644000175000017500000000027112614153277015737 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.4/tests/toplevel_macrostmt.cocci0000644000175000017500000000017612614153277020707 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.4/tests/ifdef6.cocci0000644000175000017500000000014212614153277016120 0ustar eugeneugen@ Exemple6@ @@ #include + #ifdef CONFIG_NKERNEL + #define foo(x) f(x) + #endif coccinelle-1.0.4/tests/proto2.cocci0000644000175000017500000000024212614153277016203 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.4/tests/pb_parsing_macro.res0000644000175000017500000000012212614153277017771 0ustar eugeneugen#define FOO_METH_TEST(a) prefix_##a void FOO_METH_TEST(foo)(int x){ malloc(x); } coccinelle-1.0.4/tests/switch.c0000644000175000017500000000011412614153277015417 0ustar eugeneugenint main () { switch (x) { default: break; case X: f(); } } coccinelle-1.0.4/tests/ldecl.cocci0000644000175000017500000000007312614153277016043 0ustar eugeneugen@test@ int E1, E2; int E3; @@ E3 = - E1 + E2 + E1 - E2 coccinelle-1.0.4/tests/addifelse.cocci0000644000175000017500000000103112614153277016673 0ustar eugeneugen@ sk_data_ready_assigned @ struct sock *sk; identifier drv_data_ready; @@ sk->sk_data_ready = drv_data_ready; @ sk_data_ready_declared depends on sk_data_ready_assigned @ identifier sk; identifier sk_data_ready_assigned.drv_data_ready; fresh identifier backport_drv_data_ready = "backport_" ## drv_data_ready; @@ +#if LINUX_VERSION_CODE >= KERNEL_VERSION(3,15,0) drv_data_ready(struct sock *sk) { ... } +#else +static void backport_drv_data_ready(struct sock *sk, int unused) +{ + drv_data_ready(sk); +} +#endif coccinelle-1.0.4/tests/strid.cocci0000644000175000017500000000005712614153277016107 0ustar eugeneugen@r@ identifier x; struct x *a; @@ -a +f(a,12) coccinelle-1.0.4/tests/ifdefmeta.cocci0000644000175000017500000000010612614153277016701 0ustar eugeneugen@@ expression E; @@ -alloca(E) +malloc(E) ... -alloca(E) +malloc(E) coccinelle-1.0.4/tests/multi_inc1.h0000644000175000017500000000003012614153277016164 0ustar eugeneugen#include "multi_inc2.h" coccinelle-1.0.4/tests/arg.c0000644000175000017500000000012012614153277014664 0ustar eugeneugenint main () { foo(bar()); foo(1,bar()); foo(bar(),2); foo(1,bar(),2); } coccinelle-1.0.4/tests/ifreturn.c0000644000175000017500000000045412614153277015763 0ustar eugeneugenint main () { if (x) { return 1; } return 12; } int main () { if (a) { if (x) { return 1; } b(); } return 12; } int main () { if (a) { if (b) { if (x) { return 1; } else { return 1; } } b(); } return 12; } coccinelle-1.0.4/tests/ifdef4.cocci0000644000175000017500000000021512614153277016117 0ustar eugeneugen@ Exemple4 @ @@ init_IRQ(...) { <... + #ifdef CONFIG_NKERNEL + if(irq < IRQ_LIMIT) + #endif *desc = irq_desc; ...> } coccinelle-1.0.4/tests/optional_storage.res0000644000175000017500000000011412614153277020036 0ustar eugeneugenstatic int foo1(void) { } static int foo2(void) { } float foo2(void) { } coccinelle-1.0.4/tests/rems.res0000644000175000017500000000003612614153277015436 0ustar eugeneugenint main () { x(); y(); } coccinelle-1.0.4/tests/arparam.res0000644000175000017500000000014612614153277016115 0ustar eugeneugeng(int q[1024]) { return 12; } int main(int q[1024]) { return 12; } int fn(int q[]) { return 12; } coccinelle-1.0.4/tests/test11.cocci0000644000175000017500000000007512614153277016103 0ustar eugeneugen@@ expression X; @@ f(X) ... g(X) ... - h(X) + h(X, X) coccinelle-1.0.4/tests/multidecl3.c0000644000175000017500000000027512614153277016173 0ustar eugeneugenint main () { int *i, i[12], i, k, r; } struct foo { int *i, i[12], i, k, r; int *i, i[12], i; int *i; }; int main () { int *i, i[12], i; } struct foo { int *i, i[12], i; }; coccinelle-1.0.4/tests/addifelse.res0000644000175000017500000000107012614153277016407 0ustar eugeneugen#if LINUX_VERSION_CODE >= KERNEL_VERSION(3,15,0) static void rfcomm_l2data_ready(struct sock *sk) { BT_DBG("%p", sk); rfcomm_schedule(); } #else static void backport_rfcomm_l2data_ready(struct sock *sk, int unused) { rfcomm_l2data_ready(sk); } #endif static int rfcomm_l2sock_create(struct socket **sock) { int err; BT_DBG(""); err = sock_create_kern(PF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP, sock); if (!err) { struct sock *sk = (*sock)->sk; sk->sk_data_ready = rfcomm_l2data_ready; sk->sk_state_change = rfcomm_l2state_change; } return err; } coccinelle-1.0.4/tests/decl1.c0000644000175000017500000000011312614153277015105 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { int x; int y; return 0; } coccinelle-1.0.4/tests/varargs3.res0000644000175000017500000000021612614153277016220 0ustar eugeneugenstatic int foo(char *fmt, ...) { return 0; } static int bar(int x, y) { return x+y; } static int baz(FILE *stream, ...) { return 1; } coccinelle-1.0.4/tests/decl.cocci0000644000175000017500000000017312614153277015670 0ustar eugeneugen// pb: foo doesn't get added @@ identifier ioctl; symbol cmd,arg; @@ ioctl(int cmd, void *arg) { + foo(); ... } coccinelle-1.0.4/tests/expopt2.c0000644000175000017500000000004512614153277015522 0ustar eugeneugenvoid main(int i) { f(v, w.aa); } coccinelle-1.0.4/tests/pci_noputm.cocci0000644000175000017500000000335112614153277017137 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.4/tests/stm6.res0000644000175000017500000000006612614153277015364 0ustar eugeneugenint main(int x) { f(); h(); replace(); g(); } coccinelle-1.0.4/tests/longline2.c0000644000175000017500000000104612614153277016014 0ustar eugeneugenint main() { f(sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,a,shdkjsdsdhkjsa,x,y,z); f(sdhfkjdkdsahksadsdhjkdsa, sahdjshdkjsahdkjhsakjdsh, a, shdkjsdsdhkjsa, x, y, z); f(sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa); f(a,sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa); f(a,sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa, sdhfkjdkdsahksadsdhjkdsa,sahdjshdkjsahdkjhsakjdsh,aaaaaaaaaaaaaaaaaaaa,shdkjsdsdhkjsa); } coccinelle-1.0.4/tests/constructor.cocci0000644000175000017500000000132512614153277017346 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.4/tests/nl.c0000644000175000017500000000005512614153277014533 0ustar eugeneugenint main() { if (x) return; x = x + 1; } coccinelle-1.0.4/tests/ws2.c0000644000175000017500000000007212614153277014634 0ustar eugeneugenint main() { if (foo()) goto err; err: return; } coccinelle-1.0.4/tests/notest.cocci0000644000175000017500000000011212614153277016266 0ustar eugeneugen@n2@ expression x; @@ x = FN(...) ... when strict when any - !x + 12 coccinelle-1.0.4/tests/test8.res0000644000175000017500000000011612614153277015536 0ustar eugeneugenvoid main(char i, int foo) { float k; float j; { j++; } } coccinelle-1.0.4/tests/pmac.c0000644000175000017500000000037012614153277015042 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.4/tests/int2bool-local.res0000644000175000017500000000102712614153277017311 0ustar eugeneugenint nxnypz1(){ bool z; int x, y; x = 1; y = 0; z = false; if (x) return x; return y; } int nxny2(){ int x, y; x = 1; y = 4; if (x) return x; return y; } int nxny3() { int x; int y; x = (true)? 0 : 1; y = 4; return x; } int px4() { bool x; x = false; return 4; } int nxny5() { int x; int y; x = 0; y = 1; x = x + y; return 42; } int pxpy6() { bool x; bool y; x = false; y = true; x = x && y; return 42; } int nxny7() { int x; int y; x = 0; y = 1; x += y; return 42; } coccinelle-1.0.4/tests/sp.c0000644000175000017500000000012112614153277014536 0ustar eugeneugentypedef struct { unsigned long gcr; struct pci_dev *pci; } snd_card_als4000_t; coccinelle-1.0.4/tests/spacing.c0000644000175000017500000000010712614153277015544 0ustar eugeneugentypedef int *foo; int f(int x) { one(); if (x) { two(); } } coccinelle-1.0.4/tests/retval.c0000644000175000017500000000040412614153277015415 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.4/tests/comment_brace.res0000644000175000017500000000016612614153277017272 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ { release_region(); continue; } return 0; } coccinelle-1.0.4/tests/ifdefmeta1.cocci0000644000175000017500000000004712614153277016766 0ustar eugeneugen@@ expression E,E1; @@ -E1=alloca(E); coccinelle-1.0.4/tests/video1.c0000644000175000017500000000203012614153277015304 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.4/tests/bad_define_parse.cocci0000644000175000017500000000002312614153277020205 0ustar eugeneugen@@ @@ - f() + g() coccinelle-1.0.4/tests/soc.c0000644000175000017500000000025612614153277014711 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.4/tests/mdeclp2.c0000644000175000017500000000006012614153277015444 0ustar eugeneugenint one() { return 1; } int two() { return 1; } coccinelle-1.0.4/tests/indecl.c0000644000175000017500000000014412614153277015357 0ustar eugeneugenint x; int y = 0; int main () { int xx; int yy = 0; } struct yyy { int xxx; int yyy; }; coccinelle-1.0.4/tests/incompatible_value.c0000644000175000017500000000010412614153277017757 0ustar eugeneugenint main() { f(1); f(2); } int main() { g(1); g(2); } coccinelle-1.0.4/tests/end_commas.res0000644000175000017500000000017212614153277016576 0ustar eugeneugenstatic struct i2c_client client_template = { .driver = &i2c_driver_adv7175, .dev = { .name = "adv7175_client", } }; coccinelle-1.0.4/tests/inhmet.cocci0000644000175000017500000000016012614153277016241 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.4/tests/fns.c0000644000175000017500000000037012614153277014710 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.4/tests/wrongcheck.cocci0000644000175000017500000000025512614153277017114 0ustar eugeneugen@r@ expression e1,e2; identifier f; statement S1,S2; @@ e1 = f(..., -e2 +blah ,...); if (e2 == NULL || ...) S1 else S2 @depends on !r@ expression e1,e2; @@ - e1 = e2; coccinelle-1.0.4/tests/wrongcheck.c0000644000175000017500000000021212614153277016247 0ustar eugeneugenint main () { err = si476x_core_i2c_xfer(core, SI476X_I2C_RECV, buffer, sizeof(buffer)); if (err == sizeof(buffer)) return; } coccinelle-1.0.4/tests/stm3.c0000644000175000017500000000005712614153277015012 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/insdef.c0000644000175000017500000000002312614153277015365 0ustar eugeneugen#define TABINFOGEN coccinelle-1.0.4/tests/andparen.cocci0000644000175000017500000000032312614153277016546 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.4/tests/deftodo.c0000644000175000017500000000041312614153277015544 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.4/tests/cr1.cocci0000644000175000017500000000052212614153277015444 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.4/tests/break.cocci0000644000175000017500000000020112614153277016035 0ustar eugeneugen@@ @@ while(...) { <... foo(); + bar(); break; ...> } @@ @@ while(...) { <... xxx(); + bar(); continue; ...> }coccinelle-1.0.4/tests/axnet.c0000644000175000017500000000045112614153277015241 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.4/tests/bad_define.cocci0000644000175000017500000000033512614153277017021 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.4/tests/ifreturn3.c0000644000175000017500000000036112614153277016043 0ustar eugeneugenint GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else // blah return WARNING; return 0; } int GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else return WARNING; return 0; } coccinelle-1.0.4/tests/kmc.cocci0000644000175000017500000000016512614153277015534 0ustar eugeneugen@r@ identifier E; statement S; expression x1; int ret; @@ if (...) { ... when != kfree(E) - return ret; } coccinelle-1.0.4/tests/pb_distribute_type2.cocci0000644000175000017500000000007212614153277020741 0ustar eugeneugen@@ type T; @@ foo(...) { T + * x; ... } coccinelle-1.0.4/tests/assert.c0000644000175000017500000000051712614153277015426 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.4/tests/badpos.c0000644000175000017500000000024712614153277015375 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.4/tests/oneline.cocci0000644000175000017500000000002512614153277016406 0ustar eugeneugen@@ @@ - f(); + g(); coccinelle-1.0.4/tests/metastatement_for.cocci0000644000175000017500000000007712614153277020505 0ustar eugeneugen @@ expression E1,E2,E3; statement S; @@ - for(E1; E2; E3) - Scoccinelle-1.0.4/tests/addif2.cocci0000644000175000017500000000012512614153277016107 0ustar eugeneugen@@ identifier f; @@ + #ifdef FOO + int/*foo*/ xxx; + #endif int f(...) { ... } coccinelle-1.0.4/tests/constx.res0000644000175000017500000000022512614153277016006 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.4/tests/used_after.cocci0000644000175000017500000000030512614153277017077 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.4/tests/ty.c0000644000175000017500000000005512614153277014556 0ustar eugeneugenint main () { struct foo x; return 12; } coccinelle-1.0.4/tests/ifreturn4.res0000644000175000017500000000036412614153277016416 0ustar eugeneugenint GetExitCode (int iFlag_Code) { if(iFlag_Code==OK) { return OK; } else { mwtrace(); if(iFlag_Code==WARNING) { return WARNING; } else { mwtrace(); { return_ERREUR; } } } return 0; } coccinelle-1.0.4/tests/ptrar.c0000644000175000017500000000015512614153277015253 0ustar eugeneugenint main () { struct foo *x; struct foo y[12]; *y = 4; *x = 2; a = sizeof x; b = sizeof "foo"; } coccinelle-1.0.4/tests/used_after.c0000644000175000017500000000017212614153277016243 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.4/tests/fnty.c0000644000175000017500000000021412614153277015077 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.4/tests/allbound.c0000644000175000017500000000004612614153277015722 0ustar eugeneugenint main () { foo(27); xxx(27); } coccinelle-1.0.4/tests/dec.c0000644000175000017500000000005512614153277014655 0ustar eugeneugenint f(int x) { static int y; return x; } coccinelle-1.0.4/tests/test7.res0000644000175000017500000000016612614153277015542 0ustar eugeneugenvoid main() { if(1) { f(1, "foo"); f(1, "bar"); } f(3, "foo"); f(3, "bar"); /* nice comment */ } coccinelle-1.0.4/tests/signed.cocci0000644000175000017500000000010412614153277016224 0ustar eugeneugen@@ @@ - signed x; + signed y; @@ @@ - unsigned a; + unsigned b; coccinelle-1.0.4/tests/ifbr.cocci0000644000175000017500000000021012614153277015673 0ustar eugeneugen@@ expression test; expression E; @@ if (test) { ... ( + pci_dev_put(); return; | + pci_dev_put(); return ret; ) } coccinelle-1.0.4/tests/before.res0000644000175000017500000000006612614153277015735 0ustar eugeneugenint main () { blah(); one(); blah(); foo(); } coccinelle-1.0.4/tests/isotest.cocci0000644000175000017500000000003712614153277016452 0ustar eugeneugen@@ identifier id; @@ - int id;coccinelle-1.0.4/tests/disjexpr_ver1.res0000644000175000017500000000004112614153277017251 0ustar eugeneugenint main (int i) { f(v->fld); } coccinelle-1.0.4/tests/topdec_ver1.res0000644000175000017500000000020512614153277016701 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.4/tests/dectest.cocci0000644000175000017500000000015012614153277016407 0ustar eugeneugen@@ expression e1,e2; @@ decimal( -e1 +e2 , -e2 +e1 ) @@ expression e1,e2; @@ - decimal(e1) + char coccinelle-1.0.4/tests/allex2.res0000644000175000017500000000017312614153277015661 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } } return 15; out: return 100; } coccinelle-1.0.4/tests/multiremove.c0000644000175000017500000000026512614153277016475 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.4/tests/y2.cocci0000644000175000017500000000016712614153277015316 0ustar eugeneugen@@ //local function interrupt; identifier interrupt, cs; @@ interrupt(...) { ... - if (!cs) { ... return; } ... } coccinelle-1.0.4/tests/test6_ver1.c0000644000175000017500000000036312614153277016126 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.4/tests/proto.res0000644000175000017500000000017012614153277015632 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.4/tests/comment_brace2.cocci0000644000175000017500000000005512614153277017640 0ustar eugeneugen@@ @@ + release_region(); continue; coccinelle-1.0.4/tests/longconst.c0000644000175000017500000000061112614153277016126 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.4/tests/isotest.c0000644000175000017500000000007612614153277015617 0ustar eugeneugenvoid main(int i) { char j; int i; // = 1; j++; } coccinelle-1.0.4/tests/ben.cocci0000644000175000017500000000045012614153277015523 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.4/tests/bug1.cocci0000644000175000017500000000030312614153277015612 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.4/tests/shared_brace.cocci0000644000175000017500000000011612614153277017360 0ustar eugeneugen@@ type T; identifier x; statement S; @@ - if (pci_present()) { ... - } coccinelle-1.0.4/tests/inherited.cocci0000644000175000017500000000025312614153277016733 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.4/tests/multi_func1.cocci0000644000175000017500000000145512614153277017213 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.4/tests/na.c0000644000175000017500000000020312614153277014513 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.4/tests/localglobal.cocci0000644000175000017500000000012212614153277017226 0ustar eugeneugen@@ local idexpression x; @@ -x +local @@ global idexpression x; @@ -x +global coccinelle-1.0.4/tests/multi_inc.cocci0000644000175000017500000000002612614153277016741 0ustar eugeneugen@@ int E; @@ - f(E); coccinelle-1.0.4/tests/change_type.cocci0000644000175000017500000000012412614153277017243 0ustar eugeneugen@@ identifier i1,i2; struct i1 *e; @@ ( (struct i1 *)e | - (struct i2 *)e + 42 ) coccinelle-1.0.4/tests/test5.c0000644000175000017500000000113312614153277015164 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.4/tests/dowhile.res0000644000175000017500000000004712614153277016125 0ustar eugeneugenint main() { do { } while (0); } coccinelle-1.0.4/tests/overshoot.res0000644000175000017500000000006412614153277016521 0ustar eugeneugenint main () { a(); g();g();g(); b(); q(); } coccinelle-1.0.4/tests/pb_parsing_macro.cocci0000644000175000017500000000005512614153277020265 0ustar eugeneugen@@ expression E; @@ -alloca(E) +malloc(E) coccinelle-1.0.4/tests/iterator.res0000644000175000017500000000016112614153277016320 0ustar eugeneugenvoid pcibios_report_status(u_int status_mask, int warn) { struct list_head *l; foo(); } coccinelle-1.0.4/tests/pragmatest.c0000644000175000017500000000030312614153277016265 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.4/tests/dep.c0000644000175000017500000000003112614153277014664 0ustar eugeneugenint main () { xxx(); } coccinelle-1.0.4/tests/line_before_last.res0000644000175000017500000000011712614153277017764 0ustar eugeneugenint main () { xxx(); } int main () { xxx(); } int main () { xxx(); } coccinelle-1.0.4/tests/rems1.c0000644000175000017500000000004512614153277015150 0ustar eugeneugenint main () { x(); a(); y(); } coccinelle-1.0.4/tests/td.res0000644000175000017500000000012712614153277015100 0ustar eugeneugenstruct foo {int b;}; typedef struct blah {int b;} name; typedef struct {int b;} xxx; coccinelle-1.0.4/tests/ifdefmeta1.res0000644000175000017500000000001712614153277016474 0ustar eugeneugenint main() { } coccinelle-1.0.4/tests/param_end.c0000644000175000017500000000045112614153277016050 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.4/tests/comments.cocci0000644000175000017500000000023712614153277016607 0ustar eugeneugen@@ @@ int main() { ... + // Calls foo() + foo(); return 0; } +/** + Some info about @foo() + @return void +*/ +void foo() { + /* Do nothing */ +} coccinelle-1.0.4/tests/elsify.c0000644000175000017500000000010512614153277015411 0ustar eugeneugenint main () { if (x) GOTO(rc = 1); else GOTO(rc = 2); } coccinelle-1.0.4/tests/replace_typedef.cocci0000644000175000017500000000026312614153277020114 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.4/tests/varargs.c0000644000175000017500000000014312614153277015565 0ustar eugeneugen static void fas216_log_command(FAS216_Info *info, int level, Scsi_Cmnd *SCpnt, char *fmt, ...) {} coccinelle-1.0.4/tests/isotest2.c0000644000175000017500000000007212614153277015675 0ustar eugeneugenvoid main(int i) { char j; int i = 1; j++; } coccinelle-1.0.4/tests/rems1.res0000644000175000017500000000003612614153277015517 0ustar eugeneugenint main () { x(); y(); } coccinelle-1.0.4/tests/stm7.cocci0000644000175000017500000000010712614153277015650 0ustar eugeneugen// seems to loop! @@ statement S; @@ f(); S @script:python@ @@ coccinelle-1.0.4/tests/optional_storage.c0000644000175000017500000000010512614153277017467 0ustar eugeneugenint foo1(void) { } static int foo2(void) { } float foo2(void) { } coccinelle-1.0.4/tests/a.cocci0000644000175000017500000000013012614153277015172 0ustar eugeneugen@@ expression a; @@ -f(a); ... -g(a); @@ idexpression int a; @@ -h(a); ... -r(a); coccinelle-1.0.4/tests/empty.res0000644000175000017500000000025112614153277015625 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.4/tests/spl.res0000644000175000017500000000044512614153277015272 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.4/tests/ifafter.c0000644000175000017500000000013212614153277015536 0ustar eugeneugenint main() { if (e) GOTO(lbl1,e1=e2); GOTO(lbl2,e1=e2); lbl1: lbl2: return 0; } coccinelle-1.0.4/tests/after_if.cocci0000644000175000017500000000013112614153277016532 0ustar eugeneugen@@ identifier I; @@ + static const struct ethtool_ops I; - static struct ethtool_ops I; coccinelle-1.0.4/tests/boolr.c0000644000175000017500000000006712614153277015242 0ustar eugeneugenint main() { bool i3, i4, i5; int b; } coccinelle-1.0.4/tests/symbol.c0000644000175000017500000000006312614153277015426 0ustar eugeneugenint main() { int f = 0; f = 3; return f; } coccinelle-1.0.4/tests/array_size.cocci0000644000175000017500000000013612614153277017130 0ustar eugeneugen@ rule1 using "empty.iso" @ expression E; type T; @@ - (sizeof(E)/sizeof(T)) + ARRAY_SIZE(E) coccinelle-1.0.4/tests/whitespace.res0000644000175000017500000000005712614153277016627 0ustar eugeneugenint main () { foo(sizeof(struct xxx), 12); } coccinelle-1.0.4/tests/keep_comma.res0000644000175000017500000000013012614153277016563 0ustar eugeneugenint main () { xxx(); snd_assert(!atomic_read(&substream->runtime->mmap_count), ); } coccinelle-1.0.4/tests/nest.c0000644000175000017500000000013112614153277015066 0ustar eugeneugenvoid info_func(int i) { foo(); while (x) { 1+hostno+xxx; 2+hostno+xxx; } } coccinelle-1.0.4/tests/mdeclp.res0000644000175000017500000000003112614153277015727 0ustar eugeneugen int two() { return 1; } coccinelle-1.0.4/tests/protoassert.c0000644000175000017500000000014512614153277016507 0ustar eugeneugenstatic unsigned mii_rd(ioaddr_t ioaddr, u_char phyaddr, u_char phyreg); int init(void) { foo(); } coccinelle-1.0.4/tests/type_ver1.c0000644000175000017500000000005312614153277016036 0ustar eugeneugenint foo() { struct foo x; return 0; } coccinelle-1.0.4/tests/bad_iso_example.cocci0000644000175000017500000000026712614153277020100 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.4/tests/swap3.res0000644000175000017500000000057512614153277015535 0ustar eugeneugenstatic void __ar955x_tx_iq_cal_sort(struct ath_hw *ah, struct coeff *coeff, int i, int nmeasurement) { int im, ix, iy; for (iy = ix + 1; iy <= MAXIQCAL - 1; iy++) { // if ( iy <= MAXIQCAL - 1) { if (coeff->mag_coeff[i][im][iy] < coeff->mag_coeff[i][im][ix]) { swap(coeff->mag_coeff[i][im][ix], coeff->mag_coeff[i][im][iy], temp); } } } coccinelle-1.0.4/tests/yellow.c0000644000175000017500000000530012614153277015433 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.4/tests/stm8.c0000644000175000017500000000005712614153277015017 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/cr1.c0000644000175000017500000000076412614153277014616 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.4/tests/justremove.cocci0000644000175000017500000000004112614153277017156 0ustar eugeneugen@@ statement S; @@ - S foo(); coccinelle-1.0.4/tests/four.c0000644000175000017500000000005012614153277015070 0ustar eugeneugenint main () { f(1); h(2); i(2); } coccinelle-1.0.4/tests/multiremove.res0000644000175000017500000000011712614153277017040 0ustar eugeneugenint main () { if (x) { xyz1(); } if (x) { xyz2(); } if (x) { xyz3(); } } coccinelle-1.0.4/tests/toplevel_struct_modif.cocci0000644000175000017500000000032012614153277021367 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.4/tests/compare.cocci0000644000175000017500000000007112614153277016404 0ustar eugeneugen@@ typedef Scsi_Cmnd; @@ - Scsi_Cmnd + struct scsi_cmnd coccinelle-1.0.4/tests/bad_assign.cocci0000644000175000017500000000264112614153277017055 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.4/tests/retmacro.c0000644000175000017500000000156112614153277015741 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.4/tests/multitype.res0000644000175000017500000000013312614153277016522 0ustar eugeneugentypedef struct foo { int a; } foo_t; int main() { foo_t * x; f(x->a); g(x, NULL); } coccinelle-1.0.4/tests/wierdinit.res0000644000175000017500000000022212614153277016463 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.4/tests/break.c0000644000175000017500000000061612614153277015211 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.4/tests/addbeforeafter.c0000644000175000017500000000011112614153277017050 0ustar eugeneugenint main () { if (x) { goto out; } after(); out: return 0; } coccinelle-1.0.4/tests/kr.cocci0000644000175000017500000000002012614153277015364 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/regexp2.res0000644000175000017500000000104012614153277016040 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.4/tests/fix_flow_need.c0000644000175000017500000000012412614153277016727 0ustar eugeneugenvoid main(int i) { foobar(); if(1) { foo(); } bar(); foobar(); } coccinelle-1.0.4/tests/cast_iso.cocci0000644000175000017500000000020612614153277016562 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.4/tests/isococci.c0000644000175000017500000000005312614153277015713 0ustar eugeneugen void f(int i) { if(x > 0) return x; } coccinelle-1.0.4/tests/void.cocci0000644000175000017500000000013312614153277015716 0ustar eugeneugen@@ @@ + int foo(void) { return; } int bar(void) { return; } + int foo(void) { return; } coccinelle-1.0.4/tests/optional_qualifier.res0000644000175000017500000000003212614153277020352 0ustar eugeneugenconst int a; const int b; coccinelle-1.0.4/tests/ifzz.c0000644000175000017500000000013512614153277015103 0ustar eugeneugenif 0 char c; #endif int foo(void) { int i = 1; #if 0 TRACE("\n"); #endif return i; } coccinelle-1.0.4/tests/argument.res0000644000175000017500000000004412614153277016311 0ustar eugeneugenvoid main(int i){ g(3, 2, 1); } coccinelle-1.0.4/tests/double_switch.res0000644000175000017500000000070412614153277017325 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.4/tests/minenum1.res0000644000175000017500000000003012614153277016213 0ustar eugeneugenenum h { x, qq, q, b }; coccinelle-1.0.4/tests/incpos.res0000644000175000017500000000014012614153277015757 0ustar eugeneugen#include #include #include "two" #include #include "four" #include coccinelle-1.0.4/tests/sizeptr.cocci0000644000175000017500000000021012614153277016451 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.4/tests/minenum.res0000644000175000017500000000003012614153277016132 0ustar eugeneugenenum h { x, qq, q, b }; coccinelle-1.0.4/tests/video1bis.c0000644000175000017500000000034012614153277016004 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.4/tests/expopt4.c0000644000175000017500000000010112614153277015515 0ustar eugeneugenvoid xxx(void) { xxx(1); } void main(void) { f((int) 1); } coccinelle-1.0.4/tests/request_irq.cocci0000644000175000017500000000224512614153277017326 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.4/tests/double_assign.cocci0000644000175000017500000000035312614153277017577 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.4/tests/neststruct.c0000644000175000017500000000036612614153277016345 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.4/tests/inhpos.c0000644000175000017500000000003012614153277015413 0ustar eugeneugenint main () { g(3); } coccinelle-1.0.4/tests/ifdefmeta.c0000644000175000017500000000152112614153277016045 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.4/tests/arraysz.c0000644000175000017500000000055612614153277015623 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.4/tests/noty2.cocci0000644000175000017500000000002012614153277016023 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/sl2.cocci0000644000175000017500000000021412614153277015455 0ustar eugeneugen@r@ statement list ss; @@ main(...) { - ss + something(); + others(); + more(); } @@ statement list r.ss; @@ other(...) { + ss ... } coccinelle-1.0.4/tests/match_const.cocci0000644000175000017500000000005312614153277017260 0ustar eugeneugen@r@ type T; identifier I; @@ - const T I; coccinelle-1.0.4/tests/miniswap.res0000644000175000017500000000015512614153277016321 0ustar eugeneugenstatic void swap_refcount_rec(void *a, void *b, int size) { struct ocfs2_refcount_rec *l; swap(l,tmp); } coccinelle-1.0.4/tests/before.cocci0000644000175000017500000000003712614153277016222 0ustar eugeneugen@@ statement S; @@ +blah(); S coccinelle-1.0.4/tests/pragmatest1.res0000644000175000017500000000000212614153277016711 0ustar eugeneugen coccinelle-1.0.4/tests/ifgoto.res0000644000175000017500000000010512614153277015754 0ustar eugeneugenint main () { if (x) { a = 3; goto l; } l: return; } coccinelle-1.0.4/tests/detect_alloc.cocci0000644000175000017500000000013712614153277017403 0ustar eugeneugen@@ type T; identifier f; T *x; @@ * T *f(...) { ... x = kmalloc(...); ... return x; } coccinelle-1.0.4/tests/post.cocci0000644000175000017500000000017612614153277015751 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.4/tests/ifdefmeta3.res0000644000175000017500000000004712614153277016501 0ustar eugeneugenint main () { f(); xxx(); g(); } coccinelle-1.0.4/tests/pb_parsing_macro.c0000644000175000017500000000012212614153277017422 0ustar eugeneugen#define FOO_METH_TEST(a) prefix_##a void FOO_METH_TEST(foo)(int x){ alloca(x); } coccinelle-1.0.4/tests/cst.cocci0000644000175000017500000000030612614153277015550 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.4/tests/dectest.c0000644000175000017500000000163312614153277015560 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.4/tests/match_init.c0000644000175000017500000000021212614153277016234 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.4/tests/constty.c0000644000175000017500000000012212614153277015620 0ustar eugeneugenint main () { const int x; int y; f(x,int); f(y,int); f(x,const int); } coccinelle-1.0.4/tests/introbrace.res0000644000175000017500000000031312614153277016616 0ustar eugeneugenint main() { if (x) { rc = request_threaded_irq(a, b); rc = compat_request_threaded_irq(12); } else { rc = request_threaded_irq(a, b); rc = compat_request_threaded_irq(12); } } coccinelle-1.0.4/tests/constx.cocci0000644000175000017500000000005612614153277016277 0ustar eugeneugen@@ constant X; @@ - foo(X); + foobar(X, X); coccinelle-1.0.4/tests/tern.c0000644000175000017500000000007612614153277015075 0ustar eugeneugenint main () { return (wc >= 0 && wc <= 0x7f ? wc : 0x7f); } coccinelle-1.0.4/tests/param_to_exp.c0000644000175000017500000000005012614153277016573 0ustar eugeneugenint main (int x, int y) { return 0; } coccinelle-1.0.4/tests/inline.res0000644000175000017500000000000112614153277015736 0ustar eugeneugen coccinelle-1.0.4/tests/pb_tag_symbols.c0000644000175000017500000000022312614153277017123 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.4/tests/cst.res0000644000175000017500000000010412614153277015255 0ustar eugeneugenint main(int x) { emu10k1_t *emu = 4; int z = 12; return y; } coccinelle-1.0.4/tests/typedef.cocci0000644000175000017500000000027512614153277016424 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.4/tests/metastatement_for.c0000644000175000017500000000016512614153277017645 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } if (i == 0) { printf("%d", i); } } coccinelle-1.0.4/tests/str_init.c0000644000175000017500000000012012614153277015746 0ustar eugeneugenstruct foo x = { .aaa = 5, .rrr = 1, .xxx= 12, .bbb = 2, .ccc = 4, }; coccinelle-1.0.4/tests/test0.res0000644000175000017500000000003512614153277015526 0ustar eugeneugenint main(int i) { f(2); } coccinelle-1.0.4/tests/protoassert.cocci0000644000175000017500000000017212614153277017345 0ustar eugeneugen@@ @@ + static struct pcmcia_driver ZZZ_driver = { + .owner = THIS_MODULE, + }; int init (...) { - foo(); } coccinelle-1.0.4/tests/compare.c0000644000175000017500000000075412614153277015556 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.4/tests/static.c0000644000175000017500000000010312614153277015403 0ustar eugeneugenstatic inline int i8042_read_data(void) { return jazz_kh->data; } coccinelle-1.0.4/tests/addelse.c0000644000175000017500000000005112614153277015517 0ustar eugeneugenint main () { if (x == 12) return 6; } coccinelle-1.0.4/tests/isotest2.res0000644000175000017500000000005512614153277016245 0ustar eugeneugenvoid main(int i) { char j; j++; } coccinelle-1.0.4/tests/initializer_many_fields.c0000644000175000017500000000003512614153277021015 0ustar eugeneugen struct foo x = { .a = 12 }; coccinelle-1.0.4/tests/struct_metavar.c0000644000175000017500000000033012614153277017161 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.4/tests/const_array.cocci0000644000175000017500000000020112614153277017275 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.4/tests/bad_define_parse.c0000644000175000017500000000042512614153277017355 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.4/tests/tup.c0000644000175000017500000000037012614153277014732 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.4/tests/ktype2.res0000644000175000017500000000024512614153277015710 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.4/tests/ifdef3.cocci0000644000175000017500000000036412614153277016123 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.4/tests/retval2.c0000644000175000017500000000072312614153277015503 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.4/tests/addaft.c0000644000175000017500000000023012614153277015340 0ustar eugeneugenint main () { foo(); if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); } coccinelle-1.0.4/tests/ifdef6a.c0000644000175000017500000000031212614153277015422 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/eb1.res0000644000175000017500000000033612614153277015142 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.4/tests/initializer.c0000644000175000017500000000010312614153277016437 0ustar eugeneugenstruct SHT var = { .f1 = toto1, .f2 = toto2, .f3 = toto3, }; coccinelle-1.0.4/tests/ifreturn6.cocci0000644000175000017500000000010212614153277016675 0ustar eugeneugen@@ statement s,s1; @@ if (...) s else - s1 + blah(); +later(); coccinelle-1.0.4/tests/type1.res0000644000175000017500000000004512614153277015532 0ustar eugeneugenint foo() { int *x; return 0; } coccinelle-1.0.4/tests/oddifdef.cocci0000644000175000017500000000003712614153277016524 0ustar eugeneugen@@ @@ - x = 0; ... - x = 0; coccinelle-1.0.4/tests/idstr.res0000644000175000017500000000007212614153277015615 0ustar eugeneugenint main () { printf("y", (unsigned)dt, dt->numfree); } coccinelle-1.0.4/tests/ifdefmeta2.res0000644000175000017500000000001712614153277016475 0ustar eugeneugenint main() { } coccinelle-1.0.4/tests/hil1.c0000644000175000017500000000021712614153277014757 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.4/tests/ifreturn3.cocci0000644000175000017500000000010112614153277016671 0ustar eugeneugen@@ statement s1, s2; @@ if(...) s1 else +{mwtrace(); s2 +} coccinelle-1.0.4/tests/stm10.res0000644000175000017500000000012112614153277015427 0ustar eugeneugenint main(int x) { f(); if (x) replace(); h(); g(); if (x) replace(); } coccinelle-1.0.4/tests/test4.res0000644000175000017500000000010112614153277015524 0ustar eugeneugenvoid main() { f(1,2,3); if(1) g(1); else g(1); } coccinelle-1.0.4/tests/dbg.c0000644000175000017500000000021512614153277014654 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.4/tests/metaruleelem.res0000644000175000017500000000011112614153277017143 0ustar eugeneugenint main(int x) { f(); foo(); if (1) { replace(); } g(); } coccinelle-1.0.4/tests/isococci.res0000644000175000017500000000002412614153277016260 0ustar eugeneugen void f(int i) { } coccinelle-1.0.4/tests/fsh.cocci0000644000175000017500000000012712614153277015540 0ustar eugeneugen@r@ identifier x; @@ f(x); @@ fresh identifier a = "foo-" ## r.x; @@ - g(); + g(a); coccinelle-1.0.4/tests/isoif.cocci0000644000175000017500000000012712614153277016071 0ustar eugeneugen@r@ expression x,E; position p1,p2; statement S1,S2; @@ -if (x@p2 == NULL) S1 else S2 coccinelle-1.0.4/tests/test9.res0000644000175000017500000000026612614153277015545 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.4/tests/ifgoto.c0000644000175000017500000000007112614153277015407 0ustar eugeneugenint main () { if (x) GOTO(l,a = 3); l: return; } coccinelle-1.0.4/tests/jloop1.c0000644000175000017500000000055612614153277015334 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.4/tests/doublepos.res0000644000175000017500000000004412614153277016463 0ustar eugeneugenint main() { f(1,5); f(6,5); } coccinelle-1.0.4/tests/neststruct.res0000644000175000017500000000036612614153277016714 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.4/tests/lvalue.c0000644000175000017500000000004712614153277015413 0ustar eugeneugenint main() { x = x + 1; *x = 12; } coccinelle-1.0.4/tests/fix_flow_need.cocci0000644000175000017500000000005712614153277017572 0ustar eugeneugen@@ @@ ... if(1) { foo(); } - bar(); ... coccinelle-1.0.4/tests/unfree.cocci0000644000175000017500000000005012614153277016237 0ustar eugeneugen@@ expression e; @@ -if (e) kfree(e);coccinelle-1.0.4/tests/labels_metastatement3.cocci0000644000175000017500000000004012614153277021232 0ustar eugeneugen@@ statement S; @@ + foo(); Scoccinelle-1.0.4/tests/fnptr.c0000644000175000017500000000056312614153277015257 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.4/tests/metastatement_if.c0000644000175000017500000000016512614153277017455 0ustar eugeneugenvoid main(void) { int i; for (i = 0; i < 10; i++) { printf("%d", i); } if (i == 0) { printf("%d", i); } } coccinelle-1.0.4/tests/comment_brace2.c0000644000175000017500000000013712614153277017003 0ustar eugeneugenint main () { while ((inw(base) & 0xad00) != 0) /* data status */ continue; return 0; } coccinelle-1.0.4/tests/decl_ver1.c0000644000175000017500000000043312614153277015766 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.4/tests/badtypedef.res0000644000175000017500000000016412614153277016601 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.4/tests/test3.res0000644000175000017500000000012612614153277015532 0ustar eugeneugenvoid main() { /* a comment */ f(3); if(1) h(3, 1); else h(3, 2); } coccinelle-1.0.4/tests/change.cocci0000644000175000017500000000003612614153277016204 0ustar eugeneugen@@ @@ foo(); +blah(one, two);coccinelle-1.0.4/tests/multi_func1_ver2.c0000644000175000017500000000004112614153277017301 0ustar eugeneugenint main() { foo(); bar(); } coccinelle-1.0.4/tests/incdir.res0000644000175000017500000000006512614153277015742 0ustar eugeneugen#include "sub/incdir2.c" int main () { foo(12); } coccinelle-1.0.4/tests/top.res0000644000175000017500000000003112614153277015265 0ustar eugeneugenmodule_param(I, int, 0); coccinelle-1.0.4/tests/ty1.c0000644000175000017500000000005512614153277014637 0ustar eugeneugenint fn(int y) { char x; foo(int,char); } coccinelle-1.0.4/tests/test5.cocci0000644000175000017500000000006112614153277016021 0ustar eugeneugen@@ expression X; @@ f(X); ... - g(X); + h(X); coccinelle-1.0.4/tests/bug1.c0000644000175000017500000000021312614153277014754 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.4/tests/expopt2.cocci0000644000175000017500000000014312614153277016357 0ustar eugeneugen@@ identifier v,w; identifier fld; @@ f(v, ( - v.fld + v->fld | - w.aa + g(w.aa) ) ) coccinelle-1.0.4/tests/SCORE_expected_orig.sexp0000644000175000017500000004054412614155375020443 0ustar eugeneugenAPG@@2typedef_double.res@0shared_brace.res@+ifields.res@@.array_size.res@@)test3.res@*fields.res@@)fnret.res@6const_implicit_iso.res@&62.res@@/protoassert.res@1double_assign.res@@&b1.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) -longline2.res@@&km.res@*format.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; } @-starprint.res@/change_type.res@@+testand.res@*strid2.res@)ifend.res@,comments.res@@@&ar.res@@*ifdef6.res@@(stm2.res@'max.res@@-list_test.res@@*signed.res@*ktype2.res@*elsify.res@@-minusdots.res@-doublepos.res@@1pb_params_iso.res@0multitypedef.res@=labels_metastatement_ver1.res@0double_lines.res@@2failing_andany.res bINCORRECT:diff token: request_irq VS } File , line 4, column 8, charpos = 111 around = 'request_irq', whole content = request_irq(irq_flags); File "tests/failing_andany.res", line 4, column 0, charpos = 103 around = '}', whole content = } diff (result(<) vs expected_result(>)) = @@ -1,8 +1,6 @@ static int smc_probe1(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { - request_irq(irq_flags); - register_netdev(dev); } static int smc_probe2(struct net_device *dev, void __iomem *ioaddr, +constty.res@@@6toplevel_macrostmt.res@*insdef.res@+destroy.res@@)endif.res@)allex.res@@-const1bis.res@@(bug1.res@@(skip.res@+regexp3.res@*ifdef1.res@,addifdef.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,7 +7,9 @@ a = 5; #ifdef FOO + x = 0; #else + x = 0; #endif } @@ -20,7 +22,9 @@ a = 3; #ifdef FOO + x = 0; #else + x = 0; #endif } @@ -33,6 +37,8 @@ #endif #ifdef FOO + x = 0; #else + x = 0; #endif } +julia10.res@@@)orexp.res@*allex3.res@@-fieldsmin.res@@.neststruct.res@(cast.res@@*tydisj.res@*lvalue.res@@(stm3.res@*sizeof.res@/macro_int16.res@@1bad_ptr_print.res@@'ws2.res@+smallfn.res@2minusdots_ver1.res@@,longlong.res@'arg.res@@,ty_tyexp.res@@(loop.res@'log.res@+expnest.res@'a3d.res@@2metastatement2.res@)fnptr.res@3delete_function.res@@)strid.res@@@(stm5.res@)ktype.res@'bus.res@@-iterprint.res@@.test5_ver1.res@@@-substruct.res@.ifdefmeta1.res@@*threea.res@(rcu3.res@/bad_typedef.res@*addif2.res@@)test5.res@)proto.res@)local.res@@+condexp.res@@-inclifdef.res@,constrem.res@@-param_end.res@'com.res@@)boolr.res@@-multipath.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); } ,miniswap.res@@&sp.res@'sl2.res@@.introbrace.res@)ifzer.res@+a_and_e.res@@.wrongcheck.res@'spl.res@@(rem1.res@@*static.res@(rets.res@-decl_star.res@@*topdec.res@)empty.res@@)minfn.res@+deftodo.res@@)ifadd.res@(fnty.res@*badexp.res@@)type1.res@(stm7.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") &ip.res@,argument.res@@@@4optional_storage.res@,iterator.res@@)test6.res@-minstruct.res@)exitp.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") @@@-multivars.res@(incl.res@@)binop.res@-bad_kfree.res@@+sizeptr.res@.keep_comma.res@&b2.res@@(stm4.res@)deref.res@@@)test4.res@.param_ver1.res@*braces.res@@.whitespace.res@(rptr.res@@@*remaft.res@)debug.res@,dc_close.res@@.pragmatest.res@6optional_qualifier.res@5metastatement_for.res@)const.res@@(ifbr.res@(anon.res@@*test_s.res@*retest.res@*mdeclp.res UPROBLEM exn = Yes_prepare_ocamlcocci.CompileFailure("/tmp/ocaml_cocci_e7931b.ml") @.switchdecl.res@2inherited_ver1.res@@/three_types.res@*doundo.res@@4line_before_last.res@1comment_brace.res@,bitfield.res@@-gotobreak.res@*change.res@)bugon.res@@*xfield.res@.stm10_ver1.res@,sizestar.res@.dropenderr.res@)decl2.res@0attrs2groups.res@@+typedef.res@(mdec.res@)isoif.res@'dbg.res INCORRECT:PB parsing only in generated-file 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; } *comadd.res@@@*dropbr.res@@(cptr.res@@3replace_typedef.res@-ifreturn4.res@@,varargs3.res@*ifdef3.res@@/topdec_ver2.res@+fortest.res@@&sw.res@1disjexpr_ver2.res@,cast_iso.res@@,varargs2.res@.proto_ver2.res@)noret.res@@@(post.res@.justremove.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; } *notest.res@0doubleswitch.res@@0expopt3_ver1.res@@'unl.res@@*test12.res@/longlongint.res@(ifzz.res@0a_and_e_ver1.res@@-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; } @0useless_cast.res@(stm8.res@.array_init.res@-addifelse.res@@@,str_init.res@@'eb1.res@@.formatlist.res@*endpos.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_228cc5.cmxs") @+changei.res INCORRECT:diff token: i VS xxx File , line 1, column 15, charpos = 15 around = 'i', whole content = typedef struct i xxx; File "tests/changei.res", line 1, column 15, charpos = 15 around = 'xxx', whole content = typedef struct xxx istruct; diff (result(<) vs expected_result(>)) = @@ -1,4 +1,4 @@ -typedef struct i xxx; +typedef struct xxx istruct; int xxx (int xxx) { char xxx; +badwhen.res@@,addfield.res@@@/multiremove.res@)dropf.res@@@)ptrar.res@-addbefore.res@@@&kr.res@&if.res@@(slen.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_502a0d.cmxs") @)test1.res@*mincom.res@0metaruleelem.res@'ip2.res@2int2bool-local.res@@'sis.res@@@*string.res@+headers.res@@*spaces.res@(noty.res@@(tdnl.res@+isotest.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; } /const_array.res@@,metaline.res@@8labels_metastatement.res@+fn_todo.res@)extra.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_73d1f0.cmxs") -dropparam.res@2addbeforeafter.res@@@@(vpos.res@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; } 'fsh.res@+format2.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_2e631e.cmxs") @@+localid.res@&hd.res@@/multistruct.res@(enum.res@@.ifdefmeta3.res@/constructor.res@@+oneline.res@,after_if.res@@@+badzero.res@@*double.res@+arparam.res@@(func.res@'csw.res@@/topdec_ver1.res@@(stm1.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") )noty2.res@@&td.res@*struct.res@)macro.res@)endnl.res@+bugloop.res@+addelse.res@@'ty1.res@*test11.res@,metaops0.res@6incompatible_value.res@*before.res@@*unfree.res@*test10.res@'not.res@@@&y2.res@,twomatch.res@-ifdefmeta.res@@@*regexp.res@@(zero.res@-inherited.res@,castdecl.res@*addif1.res@@,twoproto.res@(defe.res@+compare.res@@(rems.res@.proto_ver1.res@*ifgoto.res@)idstr.res@@2type_annotated.res@'ifd.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; } - - } @/branchparen.res@@'inc.res@(four.res@'exp.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; ,ifreturn.res@(decl.res@(befS.res@@(void.res@+varargs.res@6test_unsigned_meta.res@+dropcom.res@@*symbol.res@@@4pb_parsing_macro.res@+mdeclp2.res UPROBLEM exn = Yes_prepare_ocamlcocci.CompileFailure("/tmp/ocaml_cocci_dfee93.ml") @-multiplus.res@*allex2.res@@/test11_ver1.res@,multidec.res@@3toplevel_struct.res@&pa.res@/initializer.res@+dowhile.res@@)mdecl.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_b5e285.cmxs") 'kmc.res@@+expopt2.res@@7pb_distribute_type3.res ?PROBLEM exn = Failure("line 7: index 53 53 already used\n") @+devlink.res@@*unelse.res@,retmacro.res@-remstruct.res@*memory.res@1match_no_meta.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; } 3parameters_dots.res@@+include.res@'cst.res@@2struct_typedef.res@(stmt.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; -ifreturn6.res@@+incpos1.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") .distribute.res@+attradd.res@@,isococci.res@@+spacing.res@@(delp.res@@@'tup.res@'opt.res@&ab.res@@*typeof.res@(tyex.res@@)test7.res@&na.res@*invert.res@*inline.res@2comment_brace2.res@*as_stm.res@@&fp.res@@@.multichars.res@-find_long.res@@@&ty.res@-positionc.res@,nameless.res@+minenum.res@)edots.res@@1disjexpr_ver1.res@+bigrepl.res@@)test9.res@(stm6.res@)foura.res@@/localglobal.res@'fun.res@@*switch.res@0param_to_exp.res@@@*return.res@@,reserved.res@+nestone.res@@(rem2.res@@,testand2.res@(pcim.res@+ifdef6a.res@1double_switch.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; } @2wierd_argument.res@@+retval2.res@@@(cr1a.res@@,remparam.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") @@;initializer_many_fields.res@*incpos.res pPROBLEM exn = Failure("Semantic patch uses python, but Coccinelle has been compiled without Python support") @1mini_null_ref.res@*ifdef2.res@@/test10_ver1.res@@0sizeof_julia.res@+regexp2.res@(hil1.res@@)test8.res@'lid.res@@0print_return.res@,disjexpr.res@@-video1bis.res@*proto2.res@)bigin.res@*addtoo.res@@@,isotest2.res@@0define_param.res@@-null_type.res@@4metastatement_if.res@@0strangeorder.res@*inhmet.res@@@/remove_call.res@,minenum1.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") .end_commas.res@@-overshoot.res@'noa.res@+kmalloc.res@*inhpos.res@@)test2.res@@@@'top.res@-same_expr.res@@,cs_check.res@@3gilles-question.res@@.decl_space.res@&cr.res@)cards.res@@-ifreturn3.res@.define_exp.res@@(pmac.res@*ifdef4.res@@*retval.res@.match_init.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); } )exitc.res TPROBLEM exn = Yes_prepare_ocamlcocci.LinkFailure("/tmp/ocaml_cocci_43b13a.cmxs") 'ben.res@%a.res@@-type_ver1.res@@*protox.res@+metaops.res@,cst_null.res@*addaft.res@@@*posiso.res@+nestseq.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); } @@)param.res@@-multitype.res@.addifelse2.res@@@)test0.res@&nl.res@.ifdefmeta2.res@@(tern.res@*nocast.res@*ifdef5.res@(getc.res@/gcc_min_max.res@@(type.res@.multidecl3.res@@)swap3.res@@@/pragmatest1.res@)addif.res@@*expopt.res@@3return_implicit.res@,addtrace.res@@-structfoo.res@0expopt3_ver2.res@.edots_ver1.res@@0const_adding.res@@*disjid.res@@+partial.res@1fix_flow_need.res@.badtypedef.res@@@&of.res@'hex.res@@*constx.res@)break.res@@)stm10.res@@-longconst.res@+fortype.res@'dec.res@@@+expopt3.res@@2struct_metavar.res@@)rems1.res@7pb_distribute_type4.res@(nest.res@*julia7.res@(ifif.res@*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));") @2pb_tag_symbols.res@@+arraysz.res@@@coccinelle-1.0.4/tests/delp.cocci0000644000175000017500000000005012614153277015677 0ustar eugeneugen@@ expression E; @@ return - ( E - ) ; coccinelle-1.0.4/tests/a.res0000644000175000017500000000011012614153277014701 0ustar eugeneugenint main () { int a; f(a); h(a); { int a; g(a); r(a); } } coccinelle-1.0.4/tests/ifdef2.c0000644000175000017500000000031212614153277015255 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/stm7.c0000644000175000017500000000005712614153277015016 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/decl_space.cocci0000644000175000017500000000014212614153277017037 0ustar eugeneugen@@ type T; symbol x, y; @@ - T *x = y; + T *x = g; @@ type T; @@ - T x = y; + T x = g; coccinelle-1.0.4/tests/stm8.cocci0000644000175000017500000000004712614153277015654 0ustar eugeneugen@@ statement S; @@ f(); - S + g();S coccinelle-1.0.4/tests/posiso.c0000644000175000017500000000027412614153277015441 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.4/tests/inherited_ver1.c0000644000175000017500000000010512614153277017026 0ustar eugeneugenvoid main(int i) { //g(1); f(2); h(2); h2(2); foo(1); } coccinelle-1.0.4/tests/ret.cocci0000644000175000017500000000013512614153277015551 0ustar eugeneugen@@ expression E; identifier x; @@ f(...) { + spin_lock(); ... + spin_unlock(); }coccinelle-1.0.4/tests/failing_andany.res0000644000175000017500000000032312614153277017432 0ustar eugeneugenstatic int smc_probe1(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { } static int smc_probe2(struct net_device *dev, void __iomem *ioaddr, unsigned long irq_flags) { } coccinelle-1.0.4/tests/rptr.cocci0000644000175000017500000000005412614153277015746 0ustar eugeneugen@@ expression *r; statement S; @@ -if(!r) S coccinelle-1.0.4/tests/oneline.c0000644000175000017500000000003612614153277015552 0ustar eugeneugenint main () { f(); f(); } coccinelle-1.0.4/tests/empty.cocci0000644000175000017500000000070612614153277016121 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.4/tests/addif.c0000644000175000017500000000010512614153277015165 0ustar eugeneugenstatic int foo() { return 12; } static int bar() { return 12; } coccinelle-1.0.4/tests/fnptr.res0000644000175000017500000000055412614153277015626 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.4/tests/badaw.c0000644000175000017500000000137712614153277015210 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.4/tests/const_implicit_iso.c0000644000175000017500000000005112614153277020010 0ustar eugeneugenvoid main(double y) { const int x; } coccinelle-1.0.4/tests/metahex.c0000644000175000017500000000004212614153277015551 0ustar eugeneugenint main() { f(3); g(0x03); } coccinelle-1.0.4/tests/remaft.res0000644000175000017500000000011412614153277015743 0ustar eugeneugenint main() { #ifdef BLAH #endif c() #ifdef BLAH ; #else + 4; #endif } coccinelle-1.0.4/tests/typedef_double.res0000644000175000017500000000021212614153277017456 0ustar eugeneugentypedef struct stlpcibrd { unsigned short vendid; unsigned short devid; int brdtype; } stlpcibrd_t; int main () { sema_init(x); } coccinelle-1.0.4/tests/ifzer.res0000644000175000017500000000035612614153277015614 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.4/tests/macro.res0000644000175000017500000000031212614153277015566 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.4/tests/proto_ver1.res0000644000175000017500000000015212614153277016567 0ustar eugeneugenvoid bch_l2l1(struct PStack *st, int pr, void *arg); void bch_empty_fifo(struct BCState *bcs, int count); coccinelle-1.0.4/tests/a3d.cocci0000644000175000017500000000015112614153277015424 0ustar eugeneugen@@ struct input_dev E; @@ - E.idbus + E.id.bustype @@ struct gameport E; @@ - E.idbus + E.id.bustype coccinelle-1.0.4/tests/endpos.c0000644000175000017500000000022412614153277015410 0ustar eugeneugenint main () { if (x) { foo(); return -1; } if (x) { foo(); goto out; } call(); return 0; out: print(); return -1; } coccinelle-1.0.4/tests/positionc.cocci0000644000175000017500000000110112614153277016760 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.4/tests/xloop.cocci0000644000175000017500000000003312614153277016115 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.4/tests/iterprint.res0000644000175000017500000000010212614153277016502 0ustar eugeneugenint main () { for_each_set_bit(bit, bitmap, size) x = 12; } coccinelle-1.0.4/tests/before.c0000644000175000017500000000004212614153277015360 0ustar eugeneugenint main () { one(); foo(); } coccinelle-1.0.4/tests/three.c0000644000175000017500000000065112614153277015233 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.4/tests/condexp.res0000644000175000017500000000043112614153277016127 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.4/tests/multi_func1.res0000644000175000017500000000021612614153277016716 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.4/tests/oddifdef.c0000644000175000017500000000072312614153277015670 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.4/tests/extra.cocci0000644000175000017500000000126112614153277016103 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 := make_ident (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.4/tests/ty.cocci0000644000175000017500000000003412614153277015411 0ustar eugeneugen@@ @@ + const struct foo coccinelle-1.0.4/tests/top.cocci0000644000175000017500000000015512614153277015563 0ustar eugeneugen@@ declarer name MODULE_PARM; declarer name module_param; @@ - MODULE_PARM(...); + module_param(I, int, 0); coccinelle-1.0.4/tests/dropf.c0000644000175000017500000000004212614153277015230 0ustar eugeneugenint main() { x = f(1) + f(3); } coccinelle-1.0.4/tests/fnret.res0000644000175000017500000000000112614153277015576 0ustar eugeneugen coccinelle-1.0.4/tests/deftodo.res0000644000175000017500000000041312614153277016113 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.4/tests/retest.cocci0000644000175000017500000000007212614153277016265 0ustar eugeneugen@@ expression e; statement S; @@ - if (e) S + if (f(e)) Scoccinelle-1.0.4/tests/ktype2.cocci0000644000175000017500000000022512614153277016175 0ustar eugeneugen@r@ 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.4/tests/video1bis.res0000644000175000017500000000022212614153277016352 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { if (cmd == VIDIOCGTUNER) { struct video_tuner v; } } coccinelle-1.0.4/tests/null_bool.cocci0000644000175000017500000000003012614153277016736 0ustar eugeneugen@@ @@ - x != NULL + 12 coccinelle-1.0.4/tests/ben.res0000644000175000017500000000063612614153277015242 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.4/tests/max.res0000644000175000017500000000005012614153277015251 0ustar eugeneugenint main () { if (x < 25) return 3; } coccinelle-1.0.4/tests/test7.cocci0000644000175000017500000000007312614153277016026 0ustar eugeneugen@@ expression X; @@ - f(X); + f(X, "foo"); + f(X, "bar"); coccinelle-1.0.4/tests/array.cocci0000644000175000017500000000324512614153277016102 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.4/tests/match_const.res0000644000175000017500000000000012614153277016761 0ustar eugeneugencoccinelle-1.0.4/tests/multipath.res0000644000175000017500000000044612614153277016504 0ustar eugeneugenstatic void multipathd(struct md_thread *thread) { for (;;) { if ((mp_bh->path = multipath_map (conf))<0) { printk("KERN_ERR %s: %s: redirecting sector %llu to another IO path\n", __func__, bdevname(bio->bi_bdev,b), (unsigned long long)bio->bi_iter.bi_sector); } } } coccinelle-1.0.4/tests/int2bool-local.c0000644000175000017500000000077112614153277016747 0ustar eugeneugenint nxnypz1(){ int x, y, z; x = 1; y = 0; z = 0; if (x) return x; return y; } int nxny2(){ int x, y; x = 1; y = 4; if (x) return x; return y; } int nxny3() { int x; int y; x = (true)? 0 : 1; y = 4; return x; } int px4() { int x; x = 0; return 4; } int nxny5() { int x; int y; x = 0; y = 1; x = x + y; return 42; } int pxpy6() { int x; int y; x = 0; y = 1; x = x && y; return 42; } int nxny7() { int x; int y; x = 0; y = 1; x += y; return 42; } coccinelle-1.0.4/tests/param_ver1.c0000644000175000017500000000003412614153277016154 0ustar eugeneugenvoid foo(int x) { return; } coccinelle-1.0.4/tests/param1.c0000644000175000017500000000003412614153277015300 0ustar eugeneugenvoid foo(int x) { return; } coccinelle-1.0.4/tests/null.c0000644000175000017500000000042312614153277015073 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.4/tests/type_annotated.cocci0000644000175000017500000000007012614153277017773 0ustar eugeneugen@@ struct foo x; //expression x; @@ - x.foo + x.newfoococcinelle-1.0.4/tests/inhpos.res0000644000175000017500000000002012614153277015761 0ustar eugeneugenint main () { } coccinelle-1.0.4/tests/deftodo.cocci0000644000175000017500000000113112614153277016400 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.4/tests/video3.cocci0000644000175000017500000000065412614153277016156 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.4/tests/stm5.res0000644000175000017500000000007512614153277015363 0ustar eugeneugenint main(int x) { f(); h(); replace(); g(); g(); } coccinelle-1.0.4/tests/hmt.cocci0000644000175000017500000000004012614153277015542 0ustar eugeneugen@@ @@ - machine_is_frodo() +12 coccinelle-1.0.4/tests/null_ver11.c0000644000175000017500000000672712614153277016126 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.4/tests/sys.iso0000644000175000017500000000020412614153277015304 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.4/tests/doublepos.cocci0000644000175000017500000000025112614153277016752 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.4/tests/hmt.c0000644000175000017500000000030512614153277014710 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.4/tests/sizeof_julia.res0000644000175000017500000000013612614153277017154 0ustar eugeneugenstatic int typhoon_ioctl(struct video_device *dev, unsigned int cmd, void *arg) { foo(); } coccinelle-1.0.4/tests/stm10_ver1.c0000644000175000017500000000007512614153277016025 0ustar eugeneugenint main(int x) { f(); { replace(); replace();} g(); } coccinelle-1.0.4/tests/multipath.c0000644000175000017500000000044012614153277016127 0ustar eugeneugenstatic void multipathd(struct md_thread *thread) { for (;;) { if ((mp_bh->path = multipath_map (conf))<0) { printk(KERN_ERR "multipath: %s: redirecting sector %llu" " to another IO path\n", bdevname(bio->bi_bdev,b), (unsigned long long)bio->bi_iter.bi_sector); } } } coccinelle-1.0.4/tests/ifreturn6.c0000644000175000017500000000015412614153277016046 0ustar eugeneugenint main () { if (x) { blah(); goto end; } else goto end2; end: xxx(); end2: return 12; } coccinelle-1.0.4/tests/addelse.cocci0000644000175000017500000000017012614153277016357 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.4/tests/pb_cfg.cocci0000644000175000017500000000002012614153277016170 0ustar eugeneugen@@ @@ -f(...); coccinelle-1.0.4/tests/bugon.res0000644000175000017500000000007612614153277015606 0ustar eugeneugenstatic void b44_tx(struct b44 *bp) { BUG_ON(skb == NULL); } coccinelle-1.0.4/tests/undef1.c0000644000175000017500000000006412614153277015304 0ustar eugeneugen#define foo 12 #define foo 12 #undef foo #undef foo coccinelle-1.0.4/tests/same_expr.res0000644000175000017500000000004012614153277016446 0ustar eugeneugenvoid main(int i) { f(1,2); } coccinelle-1.0.4/tests/castdecl.c0000644000175000017500000000043512614153277015706 0ustar eugeneugenint main() { long i1, i2; long i3; long lType = (long)TYPE_OBJ_DS_REPORT, lNuPageBloc = 0L; unsigned char c1 = 'a', c2 = 'b'; unsigned char c3 = 'c'; i1 = 11; i2 = 22; i3 = 33; printf("%d + %d = %d\n", i1, i2, i1 + i2); printf("'%c', '%c', '%c'\n", c1, c2, c3); } coccinelle-1.0.4/tests/inner2.c0000644000175000017500000000004012614153277015311 0ustar eugeneugenstruct ty x = { .i = a, }; coccinelle-1.0.4/tests/cr1a.c0000644000175000017500000000074212614153277014753 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.4/tests/log.cocci0000644000175000017500000000021312614153277015535 0ustar eugeneugen@@ char [] c; expression f; statement S1,S2; format list d; @@ ... when != if(...) S1 else S2 ( f(...,"%@d@"@c,...); | -f(...,c,...); ) coccinelle-1.0.4/tests/dropcom.c0000644000175000017500000000015512614153277015566 0ustar eugeneugen#ifdef XXX int one() { return 0; } #endif /* XXX */ int main () { return 1; } int xyz () { return 1; } coccinelle-1.0.4/tests/ldecl.c0000644000175000017500000000010112614153277015175 0ustar eugeneugen int main(){ int a, b; int c = a + b; return 0; } coccinelle-1.0.4/tests/noty.res0000644000175000017500000000007112614153277015460 0ustar eugeneugenint main(int *x) { if (NULL == x) { return; } g(); } coccinelle-1.0.4/tests/sl2.res0000644000175000017500000000021712614153277015171 0ustar eugeneugenint main () { something(); others(); more(); } int other () { one(); two(); one(); two(); one(); two(); one(); two(); } coccinelle-1.0.4/tests/rets.res0000644000175000017500000000004612614153277015446 0ustar eugeneugenint main () { foo(); return 12; } coccinelle-1.0.4/tests/badprint.c0000644000175000017500000000013012614153277015717 0ustar eugeneugen#define PRINTK(x) printk x #include "foo.h" int main () { printk("some stuff\n"); } coccinelle-1.0.4/tests/sgrep.c0000644000175000017500000000007112614153277015240 0ustar eugeneugenint main() { f(); x(); a(); g(); if (q) y(); } coccinelle-1.0.4/tests/after_if.res0000644000175000017500000000021112614153277016242 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.4/tests/bug_expopt.cocci0000644000175000017500000000017512614153277017137 0ustar eugeneugen@@ identifier x; // struct xx struc; @@ ( - sprintf | - strlcpy | - strcpy | - strcat | - snprintf ) - (x->devfs_name, ...); coccinelle-1.0.4/tests/sl2.c0000644000175000017500000000015212614153277014620 0ustar eugeneugenint main () { one(); two(); one(); two(); } int other () { one(); two(); one(); two(); } coccinelle-1.0.4/tests/null_bool.res0000644000175000017500000000021312614153277016452 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.4/tests/top.c0000644000175000017500000000004412614153277014722 0ustar eugeneugenMODULE_PARM(suppress_pollack, "i"); coccinelle-1.0.4/tests/badcomma.c0000644000175000017500000000015012614153277015661 0ustar eugeneugenstatic struct usb_serial_device_type cp2101_device = { .owner = THIS_MODULE, .name = "CP2101", }; coccinelle-1.0.4/tests/justremove.c0000644000175000017500000000023112614153277016321 0ustar eugeneugenint main () { if (x) { a(); b(); c(); } foo(); while (x) { a(); if (b()) continues; c(); } foo(); r(); foo(); } coccinelle-1.0.4/tests/test_unsigned_meta.c0000644000175000017500000000013412614153277020001 0ustar eugeneugenint main () { unsigned int x; signed int y; unsigned char q; char m; return 0; } coccinelle-1.0.4/tests/miniswap.cocci0000644000175000017500000000023312614153277016605 0ustar eugeneugen@@ expression i; identifier tmp; type t1; position p; @@ ( -t1 tmp@p = 0; | -t1 tmp@p; ) <... when strict when != tmp swap(i,tmp); ...> ?t1 tmp; coccinelle-1.0.4/tests/strid2.res0000644000175000017500000000022412614153277015676 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.4/tests/dropparam.res0000644000175000017500000000017512614153277016461 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.4/tests/decl2.res0000644000175000017500000000014512614153277015462 0ustar eugeneugenstatic int az_ioctl(int cmd, void *arg) { if (y) { return 0; } else { return 0; } } coccinelle-1.0.4/tests/fields.res0000644000175000017500000000012312614153277015733 0ustar eugeneugenstruct foo x = { .a = 1, .b = 2, .c = 3, .xa = 1, .xb = 2, .xc = 3, }; coccinelle-1.0.4/tests/regexp2.cocci0000644000175000017500000000142212614153277016333 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.4/tests/xfield.c0000644000175000017500000000011512614153277015372 0ustar eugeneugenFOO(a2,b2,c2); /* int y; struct foo { FOO(a,b,c); FOO(a1,b1,c1); }; */ coccinelle-1.0.4/tests/rems.c0000644000175000017500000000005412614153277015067 0ustar eugeneugenint main () { x(); if (x) a(); y(); } coccinelle-1.0.4/tests/find_long.res0000644000175000017500000000016512614153277016432 0ustar eugeneugenlong function() { long a; int b; (long)(a + b); (long)(b + a); return a; } coccinelle-1.0.4/tests/devlink.c0000644000175000017500000000035712614153277015563 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.4/tests/cr1a.cocci0000644000175000017500000000052212614153277015605 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.4/tests/dbg1.cocci0000644000175000017500000000004612614153277015575 0ustar eugeneugen@@ statement S1; @@ S1 + E = NULL; coccinelle-1.0.4/tests/boolr.cocci0000644000175000017500000000012112614153277016067 0ustar eugeneugen@@identifier i, f; typedef bool;@@ f() { ... when any -bool i; ... when any } coccinelle-1.0.4/tests/parsing_pad.cocci0000644000175000017500000000007512614153277017251 0ustar eugeneugen@@ identifier x; @@ //- void* x; //+ int* x; - void* + int* coccinelle-1.0.4/tests/whitespace.cocci0000644000175000017500000000005512614153277017114 0ustar eugeneugen@@ expression E; @@ - foo(E); + foo(E, 12); coccinelle-1.0.4/tests/partial.res0000644000175000017500000000017412614153277016127 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.4/tests/video2.cocci0000644000175000017500000000030012614153277016141 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.4/tests/parameters_dots.cocci0000644000175000017500000000002012614153277020144 0ustar eugeneugen@@ @@ - f(...); coccinelle-1.0.4/tests/lid.res0000644000175000017500000000007212614153277015240 0ustar eugeneugenint main () { int a; static int b; f(12); f(b); } coccinelle-1.0.4/tests/sizestar.cocci0000644000175000017500000000010512614153277016620 0ustar eugeneugen@@ expression E1,E2,E3; @@ - kzalloc(E1 * E2,E3) + kzalloc(E1,E2,E3)coccinelle-1.0.4/tests/four.res0000644000175000017500000000003012614153277015435 0ustar eugeneugenint main () { f(1); } coccinelle-1.0.4/tests/remaft.c0000644000175000017500000000013212614153277015374 0ustar eugeneugenint main() { #ifdef BLAH a(); #endif b(); c() #ifdef BLAH ; #else + 4; #endif } coccinelle-1.0.4/tests/bad_ptr_print.c0000644000175000017500000000013012614153277016743 0ustar eugeneugenstatic inline int tester(struct usb_endpoint_descriptor *epd) { f((struct foo *)x); } coccinelle-1.0.4/tests/ifb.c0000644000175000017500000000017212614153277014662 0ustar eugeneugenint main () { if (a) { if (x) { a = 3; if (m) goto foo; b = 4; foo: c = 6; } } } coccinelle-1.0.4/tests/pb_distribute_type4.res0000644000175000017500000000016212614153277020454 0ustar eugeneugenint foo() { float x; return 0; } int foo() { float x; return 0; } int foo() { float x; return 0; } coccinelle-1.0.4/tests/rcu3.c0000644000175000017500000000036712614153277015004 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.4/tests/dowhile.cocci0000644000175000017500000000003312614153277016407 0ustar eugeneugen@@ @@ - f(); ... - g(); coccinelle-1.0.4/tests/double_lines.cocci0000644000175000017500000000002012614153277017414 0ustar eugeneugen@@ @@ - foo(); coccinelle-1.0.4/tests/pcim.c0000644000175000017500000000022312614153277015047 0ustar eugeneugenint main () { ctx->sensePA = pci_map_single(adapter->dev, cmd->sense_buffer, SCSI_SENSE_BUFFERSIZE, PCI_DMA_FROMDEVICE); } coccinelle-1.0.4/tests/expopt.res0000644000175000017500000000005212614153277016005 0ustar eugeneugenint main() { int *x; f(x); x = 7; } coccinelle-1.0.4/tests/isotest2.cocci0000644000175000017500000000007512614153277016536 0ustar eugeneugen@@ identifier id; expression e; @@ ... - int id = e; ...coccinelle-1.0.4/tests/addifdef.res0000644000175000017500000000055312614153277016222 0ustar eugeneugen#ifdef FOO #ifdef LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) int one () { return 1; } #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) */ #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(3,6,1) */ #ifdef LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) /* comment about two */ int two () { return 2; } #endif /* LINUX_VERSION_CODE >= KERNEL_VERSION(3,5,0) */ coccinelle-1.0.4/tests/multichars.cocci0000644000175000017500000000002112614153277017124 0ustar eugeneugen@@ @@ - ab + 12 coccinelle-1.0.4/tests/comment.cocci0000644000175000017500000000001612614153277016417 0ustar eugeneugen@@ @@ - 1 + 2coccinelle-1.0.4/tests/localglobal.res0000644000175000017500000000012312614153277016740 0ustar eugeneugenint a; int main(int b) { int c; int local; return global + local + local; } coccinelle-1.0.4/tests/ifzer.c0000644000175000017500000000036612614153277015246 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.4/tests/allex2.c0000644000175000017500000000017112614153277015310 0ustar eugeneugenint main () { int rc; if (x) { if (y) { rc = 12; goto out; } } return 15; out: return 0; } coccinelle-1.0.4/tests/video1.cocci0000644000175000017500000000074312614153277016153 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.4/tests/positionc.res0000644000175000017500000000025512614153277016502 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.4/tests/dbg.cocci0000644000175000017500000000011112614153277015505 0ustar eugeneugen@@ idexpression *E; statement S1; @@ if (E != NULL) S1 + else E = NULL; coccinelle-1.0.4/tests/jloop1.res0000644000175000017500000000052712614153277015701 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.4/tests/bug_expopt.c0000644000175000017500000000260012614153277016274 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.4/tests/loop.c0000644000175000017500000000006512614153277015074 0ustar eugeneugenint main() { f(); while (1) { x : 15; } g(); } coccinelle-1.0.4/tests/metaline.c0000644000175000017500000000015212614153277015716 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.4/tests/badexp.cocci0000644000175000017500000000006612614153277016225 0ustar eugeneugen@@ expression x; @@ foo(x); ... + 3 + x + * 27 coccinelle-1.0.4/tests/starprint.cocci0000644000175000017500000000004512614153277017005 0ustar eugeneugen@@ typedef LPINT; @@ - LPINT + int * coccinelle-1.0.4/tests/changei.c0000644000175000017500000000011312614153277015513 0ustar eugeneugentypedef struct i istruct; int main (int x) { char c; return x + c; } coccinelle-1.0.4/tests/multiremove.cocci0000644000175000017500000000013212614153277017324 0ustar eugeneugen@@ expression x; expression list e1,e2; @@ -if (x) { <+... \(foo(e1);\|bar(e2);\) ...+> }coccinelle-1.0.4/tests/inc.c0000644000175000017500000000003412614153277014670 0ustar eugeneugen#define foo 3 #define xxx 4 coccinelle-1.0.4/tests/debug.c0000644000175000017500000000012712614153277015210 0ustar eugeneugenstatic int __init init_3c574_cs(void) { DEBUG(0, "%s\n", version); return 0; } coccinelle-1.0.4/tests/longlong.cocci0000644000175000017500000000005312614153277016575 0ustar eugeneugen@@ identifier x; @@ - long long + int x;coccinelle-1.0.4/tests/test1.cocci0000644000175000017500000000013012614153277016012 0ustar eugeneugen@ rule1 @ expression X,Y,Z; @@ f(X); ... g(Z); ... - h(Y); + h(X, Y, Z); coccinelle-1.0.4/tests/macro_int16.c0000644000175000017500000000014112614153277016240 0ustar eugeneugen#define INT16 int //typedef int INT16; void main(void) { INT16 a, b, c; c = a + b; } coccinelle-1.0.4/tests/stmt.cocci0000644000175000017500000000012612614153277015746 0ustar eugeneugen@@ statement S, S1; identifier f; @@ f (...) { ... when != S1 + foo(); S ... } coccinelle-1.0.4/tests/varargs3.cocci0000644000175000017500000000007212614153277016507 0ustar eugeneugen@@ identifier fct; parameter p; @@ *fct(p,......) { ... } coccinelle-1.0.4/tests/dbg1.res0000644000175000017500000000013712614153277015307 0ustar eugeneugen static inline void alloc_resource(struct pci_dev *dev, int idx) { DBG("PCI"); E = NULL; } coccinelle-1.0.4/tests/list_test.res0000644000175000017500000000262312614153277016506 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.4/tests/badzero.cocci0000644000175000017500000000053212614153277016406 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.4/tests/fnret.cocci0000644000175000017500000000014612614153277016077 0ustar eugeneugen@@ @@ // if int x is replaced by ..., there is a todo in transformation.ml - foo(int x) { return; } coccinelle-1.0.4/tests/comadd.cocci0000644000175000017500000000011612614153277016205 0ustar eugeneugen@@ identifier f; @@ +// some comment +// some other comment f(...) { ... } coccinelle-1.0.4/tests/minfn.cocci0000644000175000017500000000005612614153277016070 0ustar eugeneugen@@ @@ - f(...) { ... } @@ @@ - #define x 3 coccinelle-1.0.4/tests/header_modif.cocci0000644000175000017500000000006712614153277017371 0ustar eugeneugen@@ identifier x; @@ - int + float foo(int x) { ... }coccinelle-1.0.4/tests/test1_ver2.c0000644000175000017500000000025012614153277016115 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.4/tests/rcu2.cocci0000644000175000017500000001007112614153277015632 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.4/tests/not_converted_ver1.c0000644000175000017500000000417412614153277017736 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.4/tests/nameless.c0000644000175000017500000000010512614153277015725 0ustar eugeneugentypedef union { int foo; } t_foo; typedef struct { int foo; } t_foo; coccinelle-1.0.4/tests/incpos.cocci0000644000175000017500000000144612614153277016260 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.4/tests/kmalloc.cocci0000644000175000017500000000016612614153277016405 0ustar eugeneugen@@ expression x; expression E1,E2; type T; @@ x = - (T)kmalloc(E1,E2) + kzalloc(E1, E2) ... - memset(x,0,E1);coccinelle-1.0.4/tests/hex.res0000644000175000017500000000001712614153277015253 0ustar eugeneugenint main() { } coccinelle-1.0.4/tests/stat.cocci0000644000175000017500000000012012614153277015724 0ustar eugeneugen@@ expression YYY; identifier dev_info; @@ - static dev_info_t dev_info = YYY; coccinelle-1.0.4/tests/nest2.c0000644000175000017500000000004612614153277015155 0ustar eugeneugenint f(int i) { a(); a(); a(); } coccinelle-1.0.4/tests/mdecl.c0000644000175000017500000000032012614153277015201 0ustar eugeneugenint one () { if (c < 0) return 12; return x < 0; } int one () { return x < 0; } int one () { return rvw; } int two () { if (c < 0) return 21; return y; } int one () { int c; if (c) return 12; return x < 0; } coccinelle-1.0.4/tests/nestseq.c0000644000175000017500000000004712614153277015605 0ustar eugeneugenint main () { f(); g(12); h(); } coccinelle-1.0.4/tests/multitypedef.cocci0000644000175000017500000000023112614153277017467 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.4/tests/fieldsmin.cocci0000644000175000017500000000007112614153277016730 0ustar eugeneugen@@ @@ struct foo x = { - .a = 1, - .b = 2, .c = 3, }; coccinelle-1.0.4/tests/stat.c0000644000175000017500000000005312614153277015073 0ustar eugeneugenstatic dev_info_t dev_info = "orinoco_cs"; coccinelle-1.0.4/tests/longlong.res0000644000175000017500000000005512614153277016310 0ustar eugeneugenint a; int main () { int b; return 0; } coccinelle-1.0.4/tests/ifdef3.c0000644000175000017500000000031212614153277015256 0ustar eugeneugen#include #include #include #include void init_IRQ(void) { for (irq = 0; irq < IRQS; irq++) { *desc = irq_desc; uselessCall(); } } coccinelle-1.0.4/tests/define_param.cocci0000644000175000017500000000034012614153277017367 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.4/tests/if.cocci0000644000175000017500000000030212614153277015351 0ustar eugeneugen@exists@ expression x; @@ f(x); + after(); ... when != true x == NULL || ... g(x); + after(); @exists@ expression x; @@ +before(); f(x); ... when != false x == NULL || ... +before(); g(x); coccinelle-1.0.4/tests/vpos.cocci0000644000175000017500000000025712614153277015753 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.4/tests/doubleswitch.res0000644000175000017500000000037312614153277017170 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.4/tests/endpos.res0000644000175000017500000000027212614153277015762 0ustar eugeneugenint main () { main(); if (x) { foo(); return -1; } if (x) { foo(); goto out; } call(); return 0; out: print(); return -1; } int main() { return 0; } coccinelle-1.0.4/tests/badexp.res0000644000175000017500000000005112614153277015730 0ustar eugeneugenint main() { foo(a); b = 3 +a* 27; } coccinelle-1.0.4/tests/test_exec.c0000644000175000017500000000054712614153277016113 0ustar eugeneugenint main () { decimal(1,6) dec1; decimal(2,8) dec2; int d1,d2; EXEC SQL select A, B from TAB1 into :d1, :d2 where :d1 > :d2; EXEC SQL select A, B from TAB1 into :dec1, :dec2 where :dec1 > :dec2; EXEC SQL select A, B from TAB1 into :dec1, :dec2 where :dec1 > :dec2; if (x) EXEC SQL select A, B from TAB1 into :dec1, :dec2 where :dec1 > :dec2; } coccinelle-1.0.4/tests/ifdef3.res0000644000175000017500000000061012614153277015626 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.4/tests/initializer_many_fields.res0000644000175000017500000000003512614153277021364 0ustar eugeneugen struct foo x = { .a = 12 }; coccinelle-1.0.4/tests/defaultscript.cocci0000644000175000017500000000227712614153277017641 0ustar eugeneugen@r@ identifier f; expression e; position p; @@ ( other | f@p ) ( ( nothing | e ) ); @script:ocaml@ f << r.f; e << r.e; p << r.p; @@ Printf.printf "all matched: %s %s %s %d\n" f e (List.hd p).file (List.hd p).line @script:ocaml@ f << r.f = "no function"; e << r.e = "no argument"; p << r.p = []; @@ match p with [] -> Printf.printf "no pos: %s %s\n" f e | p::_ -> Printf.printf "all matched: %s %s %s %d\n" f e p.file p.line @script:ocaml@ f << r.f; e << r.e = "no argument"; p << r.p = []; @@ match p with [] -> Printf.printf "fn required: no pos: %s %s\n" f e | p::_ -> Printf.printf "fn required: all matched: %s %s %s %d\n" f e p.file p.line @script:python@ f << r.f; e << r.e; p << r.p; @@ print "py: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) @script:python@ f << r.f = "no function"; e << r.e = "no argument"; p << r.p = []; @@ if not p: print "py: no pos: %s %s" % (f,e) else: print "py: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) @script:python@ f << r.f; e << r.e = "no argument"; p << r.p = []; @@ if not p: print "py: fun required: no pos: %s %s" % (f,e) else: print "py: fun required: all matched: %s %s %s %s" % (f,e,p[0].file,p[0].line) coccinelle-1.0.4/tests/bigin.res0000644000175000017500000000042112614153277015556 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.4/tests/slen.cocci0000644000175000017500000000036312614153277015723 0ustar eugeneugen@rr@ statement list [3] ss; @@ { ss } @@ statement list [3] ss; @@ { - ss + was3(); } @r@ statement list [n] ss; @@ { ss } @script:ocaml@ n << r.n; @@ if not(n=5) then include_match false @@ statement list r.ss; @@ { - ss + was5(); } coccinelle-1.0.4/tests/expopt4.cocci0000644000175000017500000000021712614153277016363 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.4/tests/nocast.res0000644000175000017500000000013512614153277015757 0ustar eugeneugenint main (gfp_t gfp_mask, int x) { buf = kmalloc(sizeof *send_buf + buf_size, gfp_mask); } coccinelle-1.0.4/tests/change.c0000644000175000017500000000017712614153277015354 0ustar eugeneugenint main () { foo(); this_type = g_type_register_static(LASSO_TYPE_NODE, "LassoProvider", &this_info, 0); } coccinelle-1.0.4/tests/noret.cocci0000644000175000017500000000014212614153277016104 0ustar eugeneugen@@ expression e; @@ return - e + 12 ; @@ identifier main; @@ main(... + , int q ) { ... } coccinelle-1.0.4/tests/protox.c0000644000175000017500000000005312614153277015453 0ustar eugeneugenint f(int x); int f(int x) { return 12; } coccinelle-1.0.4/tests/ifif.c0000644000175000017500000000005312614153277015035 0ustar eugeneugenint main () { foo(); xxx(); bar(); } coccinelle-1.0.4/tests/pcim.res0000644000175000017500000000024112614153277015416 0ustar eugeneugenint main () { ctx->sensePA = dma_map_single(&adapter->dev->dev, cmd->sense_buffer, SCSI_SENSE_BUFFERSIZE, DMA_FROM_DEVICE); } coccinelle-1.0.4/tests/double.res0000644000175000017500000000027712614153277015751 0ustar eugeneugenstatic 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.4/tests/as_stm_pos.c0000644000175000017500000000004612614153277016271 0ustar eugeneugenint main () { if (12) return 100; } coccinelle-1.0.4/tests/defe.res0000644000175000017500000000001412614153277015367 0ustar eugeneugen#define x 3 coccinelle-1.0.4/tests/voyager.c0000644000175000017500000000024412614153277015576 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.4/tests/unl.c0000644000175000017500000000016512614153277014722 0ustar eugeneugenint main () { if (new_pe == NULL) { return NULL; } } int main () { if (new_pe == NULL) return NULL; } coccinelle-1.0.4/tests/switchtest.c0000644000175000017500000000020412614153277016317 0ustar eugeneugenvoid f(void) { switch (2) { int x; int y; case 2: i++; break; case 4: j++; break; } } coccinelle-1.0.4/tests/opt.cocci0000644000175000017500000000012712614153277015562 0ustar eugeneugen@ disable all @ identifier f; @@ f (...) { ... ( - xxx(); | ?- yyy(); ) ... } coccinelle-1.0.4/tests/ip.c0000644000175000017500000000027012614153277014531 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.4/tests/pb_distribute_type3.res0000644000175000017500000000017712614153277020461 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.4/tests/serio.res0000644000175000017500000000024212614153277015610 0ustar eugeneugen#include #include #include static void serio_init_port(struct serio *serio) { mutex_init(&serio->new_lock); } coccinelle-1.0.4/tests/tern.res0000644000175000017500000000007412614153277015442 0ustar eugeneugenint main () { return wc >= 0 && wc <= 0x7f ? wc : 0x7f; } coccinelle-1.0.4/tests/scope_problem.c0000644000175000017500000000014312614153277016751 0ustar eugeneugenvoid main(int i) { int a; foo(a); a = 1; if(1) { int a; a = 2; } a = 3; } coccinelle-1.0.4/tests/ifd.res0000644000175000017500000000015012614153277015227 0ustar eugeneugenint main () { one(); #ifdef 0 #ifdef 10 foo(); one(); one(); bar(); #endif #endif one(); } coccinelle-1.0.4/tests/test7.c0000644000175000017500000000011012614153277015160 0ustar eugeneugenvoid main() { if(1) { f(1); } f(3); /* nice comment */ } coccinelle-1.0.4/tests/mdec.cocci0000644000175000017500000000023012614153277015663 0ustar eugeneugen@r exists@ identifier x; identifier f; @@ f(...) { ... when any - int x; ... when any } @@ identifier r.f,r.x; @@ f(...) { ++ char x; ... when any } coccinelle-1.0.4/tests/exitc.res0000644000175000017500000000006612614153277015607 0ustar eugeneugenint main () { g(a1); g(a2); g(done); g(a4); } coccinelle-1.0.4/tests/spaces.c0000644000175000017500000000003612614153277015377 0ustar eugeneugenint main () { foo(x + y); } coccinelle-1.0.4/tests/type1.cocci0000644000175000017500000000010512614153277016016 0ustar eugeneugen@@ identifier q; @@ foo(...) { int + * q; ... } coccinelle-1.0.4/tests/multistruct.c0000644000175000017500000000005612614153277016522 0ustar eugeneugenstruct one x; struct two y; struct three z; coccinelle-1.0.4/tests/retval.cocci0000644000175000017500000000030412614153277016252 0ustar eugeneugen@@ symbol retval1, retval2; @@ if (retval1) { - if (retval2 != -ENODEV) { ... return ...; - } - ... } coccinelle-1.0.4/tests/toplevel_macrostmt.c0000644000175000017500000000010012614153277020034 0ustar eugeneugenvoid main(int i) { } MODULE_PARM(x,y); MODULE_AUTHOR("me"); coccinelle-1.0.4/tests/hex.cocci0000644000175000017500000000001612614153277015541 0ustar eugeneugen@@ @@ - f(0); coccinelle-1.0.4/tests/stm3.cocci0000644000175000017500000000004612614153277015646 0ustar eugeneugen@@ statement S; @@ f(); - S + g(); coccinelle-1.0.4/tests/tyex.cocci0000644000175000017500000000060012614153277015745 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.4/tests/extra.res0000644000175000017500000000065712614153277015624 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.4/tests/endnl.c0000644000175000017500000000022712614153277015223 0ustar eugeneugenint main () { foo(1); bar(2); one: foo(3); two: bar(4); three: xxx(5); #ifdef X #endif foo(6); #ifdef X #endif bar(7); #ifdef X #endif } coccinelle-1.0.4/tests/ali.c0000644000175000017500000000075212614153277014673 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.4/tests/doundo.c0000644000175000017500000000013612614153277015412 0ustar eugeneugens8 *noevent; int main() { const s8 (*queue_priority_mapping)[2]; s8 *noevent; foo(); } coccinelle-1.0.4/tests/addtrace.cocci0000644000175000017500000000010712614153277016525 0ustar eugeneugen@@ statement s1; @@ if(...) +{trace("ifth"); s1 +} +trace("endif"); coccinelle-1.0.4/tests/indecl.cocci0000644000175000017500000000024712614153277016221 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.4/tests/noret.c0000644000175000017500000000027112614153277015251 0ustar eugeneugenmain (int x); static xmain (int x); inline ymain (int x); main (int x) { return x; } // foo static xmain (int y) { return y; } // xxx inline ymain (int y) { return y; } // xxx coccinelle-1.0.4/tests/video2.c0000644000175000017500000000060212614153277015310 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.4/tests/sizestar.res0000644000175000017500000000030312614153277016331 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.4/tests/return_implicit.cocci0000644000175000017500000000013012614153277020163 0ustar eugeneugen@@ identifier fn; @@ fn(...) { foo(...); ... - return; + return -ENODEV; }coccinelle-1.0.4/tests/lid.c0000644000175000017500000000007112614153277014670 0ustar eugeneugenint main () { int a; static int b; f(a); f(b); } coccinelle-1.0.4/tests/ptrar.cocci0000644000175000017500000000007612614153277016113 0ustar eugeneugen@@ type T; T[] e; @@ - e + 12 @@ type T; T *e; @@ - e + 20 coccinelle-1.0.4/tests/decl_split.res0000644000175000017500000000002512614153277016610 0ustar eugeneugenint func(int i) { } coccinelle-1.0.4/tests/addtrace.c0000644000175000017500000000033112614153277015666 0ustar eugeneugenshort VerDate(char *pcDate) { short sRetour = 0; if ( pcDate == 0 ) { sRetour = 1; } if ( pcDate == 0 ) sRetour = 1; if ( pcDate == 0 ) { sRetour = 1; return sRetour; } return sRetour; } coccinelle-1.0.4/tests/ktype.cocci0000644000175000017500000000022412614153277016112 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.4/tests/double.cocci0000644000175000017500000000016512614153277016234 0ustar eugeneugen@@ expression E; @@ ( - (!skb_queue_len(E)) + skb_queue_empty(E) | - (skb_queue_len(E) == 0) + skb_queue_empty(E) ) coccinelle-1.0.4/tests/posnpb.cocci0000644000175000017500000000174612614153277016271 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.4/tests/cast_iso.res0000644000175000017500000000022512614153277016274 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.4/tests/struct_typedef.cocci0000644000175000017500000000023512614153277020024 0ustar eugeneugen@@ @@ - struct dvb_frontend { + struct dvb2_frontend{ ... - struct dvb_frontend_ops* ops; + struct dvb_frontend_ops ops; ... }; coccinelle-1.0.4/tests/slow.c0000644000175000017500000000273212614153277015112 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.4/tests/pa.cocci0000644000175000017500000000120512614153277015356 0ustar eugeneugen@ parse_mod @ identifier name, args, params, num, level_min, level_max; identifier unknown, param, val, doing; type s16; @@ char *parse_args(const char *name, char *args, const struct kernel_param *params, unsigned num, s16 level_min, s16 level_max, + void *arg, int (*unknown)(char *param, char *val, const char *doing + , void *arg )) { ... } coccinelle-1.0.4/tests/video.cocci0000644000175000017500000000073712614153277016075 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.4/tests/attrs2groups.cocci0000644000175000017500000000022012614153277017431 0ustar eugeneugen@@ identifier f; declarer name NOBUG; @@ f(...) { ... } + NOBUG(); @@ identifier f; declarer name BUG; @@ f(...) { ... } + static BUG(); coccinelle-1.0.4/tests/retval2.cocci0000644000175000017500000000037412614153277016343 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.4/tests/check_order1.cocci0000644000175000017500000000010312614153277017303 0ustar eugeneugen@r@ expression E; @@ f(E); @script:python@ E << r.E; @@ print E coccinelle-1.0.4/tests/double_lines.res0000644000175000017500000000004712614153277017136 0ustar eugeneugenint main () { test(); endtest(); } coccinelle-1.0.4/tests/rem2.cocci0000644000175000017500000000003012614153277015616 0ustar eugeneugen@@ @@ - if (...) foo();coccinelle-1.0.4/tests/fn_todo.cocci0000644000175000017500000000023112614153277016404 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.4/tests/sys.cocci0000644000175000017500000000017212614153277015576 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.4/tests/metastatement_for.res0000644000175000017500000000010312614153277020204 0ustar eugeneugenvoid main(void) { int i; if (i == 0) { printf("%d", i); } } coccinelle-1.0.4/tests/devlink.cocci0000644000175000017500000000007712614153277016420 0ustar eugeneugen@@ typedef dev_link_t; @@ - dev_link_t + struct pcmcia_device coccinelle-1.0.4/tests/fnret.c0000644000175000017500000000004312614153277015235 0ustar eugeneugenstatic void foo(int x) { return; } coccinelle-1.0.4/tests/distribute.c0000644000175000017500000000004012614153277016272 0ustar eugeneugenint main(int i) { f(1+1); } coccinelle-1.0.4/tests/doubleswitch.c0000644000175000017500000000040712614153277016617 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.4/tests/stm8.res0000644000175000017500000000006612614153277015366 0ustar eugeneugenint main(int x) { f(); g(); replace(); g(); } coccinelle-1.0.4/tests/initializer_iso.cocci0000644000175000017500000000056312614153277020161 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.4/tests/arparam.cocci0000644000175000017500000000013012614153277016375 0ustar eugeneugen@@ identifier f,x; expression e; @@ + g(int x[e]) { return 12; } f (int x[e]) { ... } coccinelle-1.0.4/tests/stm1.res0000644000175000017500000000005712614153277015357 0ustar eugeneugenint main(int x) { f(); replace(); g(); } coccinelle-1.0.4/tests/addbefore.cocci0000644000175000017500000000005712614153277016675 0ustar eugeneugen@@ statement S; @@ if (...) { + foo(); S }coccinelle-1.0.4/tests/not.cocci0000644000175000017500000000013012614153277015552 0ustar eugeneugen@@ expression x != foo; identifier y != {foo,bar}; expression a; @@ - y(x,a); + f(20); coccinelle-1.0.4/tests/endif.res0000644000175000017500000000043112614153277015554 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.4/tests/multr.c0000644000175000017500000000006012614153277015261 0ustar eugeneugenint main() { foo(12); } int q() { xxx(); } coccinelle-1.0.4/tests/bad_kfree.res0000644000175000017500000000045612614153277016400 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.4/tests/fun.res0000644000175000017500000000006112614153277015256 0ustar eugeneugenstruct a { int a; }; int f(int x) { return x; } coccinelle-1.0.4/tests/header_modif.c0000644000175000017500000000006012614153277016524 0ustar eugeneugen#include "header_modif.h" int foo(int i) { } coccinelle-1.0.4/tests/pmac.cocci0000644000175000017500000000004112614153277015673 0ustar eugeneugen@@ type T; @@ - #define chip_t T coccinelle-1.0.4/tests/strangeorder.res0000644000175000017500000000046412614153277017174 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.4/Makefile0000644000175000017500000004750312614153277014265 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr ############################################################################# # 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 # We inherit the version information *after* the user has run # ./configure but in the absence of that the build system has # a few dependencies on the version information, we need a default # setting then prior to the user running ./configure, this provides # that, but will only be set if the user hasn't already run ./configure # # The only thing we can do is assume that the user relying on this # variable then was going to make a release, this means we don't # tell them that the tree is dirty. VERSION?=$(shell MAKE_COCCI_RELEASE="y" ./version.sh) CCVERSION=$(shell cat scripts/coccicheck/README | egrep -o '[[:digit:]]+\.[[:digit:]]+\.[[:digit:]]+' | head -n1) ############################################################################## # Variables ############################################################################## TARGET=spatch PRJNAME=coccinelle ML_FILES=flag_cocci.ml cocci.ml testing.ml $(LEXER_SOURCES:.mll=.ml) \ read_options.ml main.ml MLI_FILES=cocci.mli testing.mli 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 #tools/spgen/source 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) $(PARMAPDIR) $(INCLIBS) ############################################################################## # Generic variables ############################################################################## # sort to remove duplicates INCLUDESET=$(sort $(INCLUDEDIRS)) INCLUDES=$(INCLUDESET:%=-I %) OBJS= $(ML_FILES:.ml=.cmo) OPTOBJS= $(ML_FILES:.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 opt-compil .PHONY:: $(MAKESUBDIRS:%=%.all) $(MAKESUBDIRS:%=%.opt) subdirs.all subdirs.opt .PHONY:: byte-only opt-only pure-byte tools .PHONY:: copy-stubs install-stubs install install-man install-python install-common # 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 $(TARGET_SPATCH)" $(MAKE) $(TARGET_SPATCH) @$(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 # aliases for "byte" and "opt-compil" opt opt-only: Makefile.config opt-compil byte-only: Makefile.config byte 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 ./configure: ./configure.ac @echo Please run ./autogen to update configure @false # 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 ./autogen and ./configure $(CONFIGURE_FLAGS) to generate it." @false 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 $(MAKE) BYTECODE_EXTRA="" byte-only sed -i '1 s,^#!.*$$,#!/usr/bin/ocamlrun,g' spatch # copies the stubs libraries (if any) to the root directory 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 ############################################################################## # Build version information ############################################################################## version.ml: @$(ECHO) "version.ml is missing. Run ./configure to generate it. Run ./autogen first if ./configure does not exist." @false ############################################################################## # Build documentation ############################################################################## .PHONY:: docs docs: @$(MAKE) -C docs || ($(ECHO) "Warning: ignored the failed construction of the manual" 1>&2) # @$(MAKE) docs -C tools/spgen/documentation @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 @$(ECHO) "Finished building manuals" clean:: Makefile.config # $(MAKE) -C docs clean $(MAKE) -C ocaml cleandoc # $(MAKE) clean -C tools/spgen/documentation ############################################################################## # 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.cmi $(MKDIR_P) $(DESTDIR)$(BINDIR) $(MKDIR_P) $(DESTDIR)$(LIBDIR) $(MKDIR_P) $(DESTDIR)$(LIBDIR)/ocaml $(INSTALL_DATA) standard.h $(DESTDIR)$(LIBDIR) $(INSTALL_DATA) standard.iso $(DESTDIR)$(LIBDIR) $(INSTALL_DATA) ocaml/*.cmi $(DESTDIR)$(LIBDIR)/ocaml/ 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/pycocci.1 $(DESTDIR)$(MANDIR)/man1/ # $(INSTALL_DATA) docs/spgen.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}${LIBDIR}/python" $(MKDIR_P) $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/*.py \ $(DESTDIR)$(LIBDIR)/python/coccilib $(INSTALL_DATA) python/coccilib/coccigui/*.py \ $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/coccigui/pygui.glade \ $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui $(INSTALL_DATA) python/coccilib/coccigui/pygui.gladep \ $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui install-stubs: $(MKDIR_P) $(DESTDIR)$(LIBDIR) @if test -f ./bundles/pycaml/dllpycaml_stubs.so; then \ cp -fv ./bundles/pycaml/dllpycaml_stubs.so $(DESTDIR)$(LIBDIR); fi @if test -f ./bundles/pcre/dllpcre_stubs.so; then \ cp -fv ./bundles/pcre/dllpcre_stubs.so $(DESTDIR)$(LIBDIR); fi install: install-common install-man install-stubs $(PYTHON_INSTALL_TARGET) rm -f $(DESTDIR)$(LIBDIR)/spatch rm -f $(DESTDIR)$(LIBDIR)/spatch.opt rm -f $(DESTDIR)$(BINDIR)/pycocci # @$(MAKE) install -s -C tools/spgen/source $(INSTALL_PROGRAM) tools/pycocci $(DESTDIR)$(BINDIR) @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)$(LIBDIR) $(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)$(LIBDIR) $(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)$(LIBDIR)/dllpycaml_stubs.so rm -f $(DESTDIR)$(LIBDIR)/dllpcre_stubs.so rm -f $(DESTDIR)$(LIBDIR)/spatch rm -f $(DESTDIR)$(LIBDIR)/spatch.opt rm -f $(DESTDIR)$(LIBDIR)/standard.h rm -f $(DESTDIR)$(LIBDIR)/standard.iso rm -f $(DESTDIR)$(LIBDIR)/ocaml/*.cmi rm -f $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui/* rm -f $(DESTDIR)$(LIBDIR)/python/coccilib/*.py # @$(MAKE) uninstall -C tools/spgen/source rmdir --ignore-fail-on-non-empty -p \ $(DESTDIR)$(LIBDIR)/python/coccilib/coccigui rmdir --ignore-fail-on-non-empty $(DESTDIR)$(LIBDIR)/ocaml rmdir $(DESTDIR)$(LIBDIR) rm -f $(DESTDIR)$(MANDIR)/man1/spatch.1 rm -f $(DESTDIR)$(MANDIR)/man3/Coccilib.3cocci # rm -f $(DESTDIR)$(MANDIR)/man1/spgen.1 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) "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 . ############################################################################## # Misc rules ############################################################################## ############################################################################## # 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 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 version @touch .depend @$(MAKE) depend depend: Makefile.config version @$(ECHO) "Constructing '.depend'" @rm -f .depend @set -e; for i in $(MAKESUBDIRS); do $(MAKE) -C $$i depend; done $(OCAMLDEP_CMD) $(MLI_FILES) $(ML_FILES) > .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 for i in `find . -name '*.in'`; do rm -f `echo $$i | sed "s/\.in$$//"`; done @echo "Run './configure' again prior to building coccinelle." @echo "If ./configure does not exist, run ./autogen first." # 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) -include .depend endif endif endif endif endif endif endif endif endif endif endif include Makefile.common coccinelle-1.0.4/testing.ml0000644000175000017500000004523512614153277014634 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 = Printf.sprintf "%s/%s" Config.get_temp_dir_name (Filename.basename cfile) in pr2 (Printf.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. * *) (* If extra test is provided, then all failing tests with the standard comparison are considered ok, and only the correct result are subjected to the extra test *) let testall_bis extra_test 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 let (correct, diffxs) = match extra_test with None -> (correct, diffxs) | Some extra_test -> (match correct with Compare_c.Correct -> extra_test generated expected | _ -> (* if there is an extra test, we don't care about the things that fail on the first test *) (Compare_c.Correct,[])) 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") +> String.concat "") 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 () 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); Common.load_score expected_score_file () end else empty_score() in let new_bestscore = Common.regression_testing_vs score expected_score in Common.save_score score actual_score_file; 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 let testall = testall_bis None let test_spacing = testall_bis (Some Compare_c.exact_compare) (* ------------------------------------------------------------------------ *) 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 (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 (mvs,xs,_,_,_,_,(grep_tokens,query,_,_),_) = Parse_cocci.process file (Some !Config.std_iso) false in xs +> List.iter2 Pretty_print_cocci.unparse mvs; 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)) let print_link t a b = if not (a = b) then (try Hashtbl.find t (a,b) with Not_found -> (Hashtbl.add t (a,b) (); Printf.printf " \"%s\" -> \"%s\";\n" b a)) let print_dotted_link dst = function "" -> () | src -> Printf.printf " \"%s\" -> \"%s\" [style = dotted];\n" src dst let rec depto t from = function Ast_cocci.Dep x | Ast_cocci.EverDep x | Ast_cocci.NeverDep x -> print_link t from x | Ast_cocci.AndDep(x,y) | Ast_cocci.OrDep(x,y) -> depto t from x; depto t from y | _ -> () let test_rule_dependencies file = let t = Hashtbl.create 101 in if not (file =~ ".*\\.cocci") then pr2 "warning: seems not a .cocci file"; Iso_pattern.verbose_iso := false; let (_,xs,fvs,_,_,_,_,_) = Parse_cocci.process file (Some !Config.std_iso) false in Printf.printf "digraph {\n"; let prevrule = ref "" in List.iter2 (fun def fvs -> match def with Ast_cocci.ScriptRule (nm,_,dep,script_vars,_,_) -> print_dotted_link nm !prevrule; prevrule := nm; depto t nm dep; List.iter (function (_,(parent,_),_,_) -> print_link t nm parent) script_vars | Ast_cocci.InitialScriptRule (_,_,_,_,_) | Ast_cocci.FinalScriptRule (_,_,_,_,_) -> () | Ast_cocci.CocciRule (nm,(dep,_,_),_,_,_) -> print_dotted_link nm !prevrule; prevrule := nm; depto t nm dep; List.iter (function (parent,_) -> print_link t nm parent) (List.concat fvs)) xs fvs; Printf.printf "}\n"; Printf.printf "// pipe to: ccomps -Cx | dot | gvpack -array_1 | neato -n2 -T pdf\n" (*****************************************************************************) (* 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.4/tools/0000755000175000017500000000000012614153277013754 5ustar eugeneugencoccinelle-1.0.4/tools/lic.ml0000644000175000017500000000555612614153277015070 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) let lines = ["This file is part of Coccinelle, lincensed under the terms of the GPL v2."; "See copyright.txt in the Coccinelle source code for more information."; "The Coccinelle source code can be obtained at http://coccinelle.lip6.fr"; ] 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"; 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.4/tools/spgen/0000755000175000017500000000000012614153277015070 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/documentation/0000755000175000017500000000000012614153277017741 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/documentation/future.tex0000644000175000017500000000551012614153277021776 0ustar eugeneugen\begin{itemize} \item \textbf{Global configuration file}: Some of the preface attributes remain more or less constant across generated scripts, such as author and url. Furthermore, there are some hardcoded values in the program that should be configurable, such as the default values for rulenames, position names, and error messages.\newline It could be useful to have some kind of configuration file that collects these values and reuses them each time a script is generated. \item \textbf{Generic rule splitting}: The disjunction rule generation implementation currently doesn't lend itself very well to possible expansion. For instance, if there was another case where we would like to expand a rule into several rules, how could we do this in a generalised way? How should this work with several split rules?\newline Example: any construct where the patch rule changes something other than itself, e.g. function declarations; if the declared function has a prototype, the prototype is changed as well in \texttt{patch} mode, but this has to be done explicitly with two rules in \texttt{context} mode.\newline Discussion: consider splitting generation of extra rules out into its own module, one for each type of split rule. Essentially using multiple passes over the AST0 to get the rules, one pass per rule type. This is however slightly complicated by the fact that context rule generation should be modified if there is a disjunction.\newline Note: could have following design (prolly not though): \begin{itemize} \item Given ast0 rule: \item Generate positions using rebuilder (rebuilder works like combiner except its functions are 'a -> 'a and all functions must be like "take an ast0 component and return an ast0 component of the same type". This is different from the combiner in that the combiner says "take an ast0 component and return a 'a", where ALL ast0 components are converted into a 'a, whereas for the rebuilder, the statement is turned into a statement, the expression is turned into an expression etc.). Only problem is that it modifies state: we need to know the name of the added metaposition ... \item turn to pretty-print strings (at this stage, stars and context mode + whencodes are handled as well) \item things to watch out for: no\_gen mode (in whencodes), disjunction handling, inc\_star, whencode handling, context\_mode star generation, \end{itemize} \item \textbf{Stars and braces}: If a braced statement is starred, it would be nicer if the braces were not on the same lines as the stars. \item \textbf{Character limit}: Ensuring character limit in the generated rule. This is currently implemented for the preface, but not for rule headers and script rules. \item Perhaps rethink position generation at some point. If the script already contains minuses, we would rather put the positions there compared to the heuristic version. \end{itemize} coccinelle-1.0.4/tools/spgen/documentation/knownissues.tex0000644000175000017500000001001112614153277023044 0ustar eugeneugen\begin{itemize} \item \textbf{Missing information in rule headers}: Rule headers will not be generated correctly if the original rules contain \texttt{extends} or \texttt{expression}. Those qualifiers will be missing in the generated rule since they are not included in the output of the parser.\newline Fix: Change the parser to include this information. \item \textbf{Typedefs in rule headers}: If there are meta typedefs in the original rule headers, they will be included in every generated rule that uses the type. This causes an error when using the generated script since meta typedefs can only be declared once.\newline Fix: Remove the error check in the parser since this should not cause an error. \item Disjunction generation has a number of issues: \begin{itemize} \item \textbf{Selecting wrong position in statement dots cases}: There must be the same number of positions in each disjunction case, otherwise \texttt{org} and \texttt{report} will only match when all positions can be found. In statement dots disjunctions, this is currently solved by putting the position at the first possible statement. The issue here is that, if the case contains many statements, only the first surrounding statement will be highlighted instead of the important part.\newline Fix: Implement support for finding a single best statement in a statement dots (list of statements). \item \textbf{Nested disjunctions}: The position counter is frozen within a disjunction. But if there is a nested disjunction inside it, the same position will be used in both disjunction levels, causing a nonsensical script.\newline Fix: Keep track of the current nest and name the position accordingly. \end{itemize} \item \textbf{No format string metavariable check}: The user can specify metavariables to be used in the messages for \texttt{org} and \texttt{report} mode. The program currently does not check if the declared metavariables actually exist in the original rule.\newline Fix: Implement check of metavariables. \item \textbf{Dependencies between patch rules}: It is possible to make patch rules that depend on other patch rules modifying the code. E.g. if one patch rule transforms f(0) and one transforms f(e), then f(0) will only match the first, since it is transformed to something else when it reaches the f(e) rule. But in \texttt{context} mode, both rules will print the f(0) occurrence.\newline Fix: ??? Somehow detect that two rules will match the same case and insert constraints such that any match in subsequent rules does not match the first one. \item \textbf{Dependencies in context rules}: In a \texttt{context} script, if there are dependencies between rules, they might be mixed up. This happens if there are rules dependent on the generated rules since they will then be printed before the rules on which they are dependent!\newline Fix: ??? \item \textbf{Type and switch case disjunctions}: Currently, the program fails if attempting to generate a \texttt{Coccinelle} script with type or switch case disjunctions. The failure happens in the position generator. The reason it is not implemented is that it requires quite a lot of code for a case that rarely appears.\newline Fix: Implement full position generation for types and switch cases. \item \textbf{File transformation not context-dependent}: When printing the transformed script, a somewhat primitive string replacement strategy is used to rename rules and inject dependencies (e.g. change \texttt{@rulename@} to \texttt{@rulename depends on patch@}). The transformation is not context-dependent which means that the script will get mangled if there is e.g. a \texttt{@@} \textit{inside comments} on a new line, since this will be mistaken for a SmPL-syntax \texttt{@@}.\newline Fix: Use simple parsing in the file transformation. Another solution is to not transform the original file at all, but to completely reconstruct it from the AST (this requires a pretty printer for AST that retains comments and plus slices!). In practice, however, this is only a problem in very specific cases that are unlikely to occur. \end{itemize} coccinelle-1.0.4/tools/spgen/documentation/implementation.tex0000644000175000017500000000476412614153277023523 0ustar eugeneugenMuch of the documentation of the implementation is contained in the interface files of the source code.\\\\ TODO: make a graph illustrating the workflow.\\\\ Some notes: \begin{itemize} \item See \texttt{spgen/source/README.md} for a broad overview of the workflow and dependencies, read \texttt{spgen/source/spgen.ml} for the driver of the program. %\item Terminology: patch rule, context rule, */+/- rule, context\_mode ... \item Several of the modules make extensive use of the AST0 visitor\footnote{\texttt{coccinelle/parsing\_cocci/visitor\_ast0.ml}}. It is used because it abstracts away a lot of the boilerplace code needed for accessing the components of the abstract syntax tree. \item An easy way to debug in \texttt{spgen/source/rule\_body.ml}: add \begin{verbatim} >> Snapshot.add "debug message" >> \end{verbatim} in some function sequence. Then "debug message" will appear in the exact same place it was called in the generated script. \item Absolutely not optimised for performance (in particular, memory). \begin{itemize} \item Snapshot need not be purely functional; rule map can be hashtable in mutable record field instead of map (needs to be sorted in get\_result however). However, a map might be beneficial later on if we want to keep various copies for e.g. rule splitting. \item Rule map is converted to string list before printing; no need to do so, could just print directly from rule map. However, this makes for a better separation interface-wise. \item Most importantly, the generally small size of Coccinelle scripts means that performance is not actually a problem in practice. \end{itemize} \item spgen needs its own flag in the Coccinelle parser: \texttt{Flag\_parsing\_cocci.generating\_mode}. This ensures that dependencies are not optimised away in the parser, as we need that information for printing the rules properly. It cannot be substituted for the \texttt{ignore\_patch\_or\_match} option, because that option also affects other parts of the parser. \item Regression tests: run spgen with flag \texttt{-{}-test .cocci}. \end{enumerate} \textbf{To uninstall}: From the \texttt{spgen} directory, do: \begin{enumerate} \item Run \texttt{make uninstall}$^{\ref{sudo}}$. \end{enumerate} \bigskip \subsection{Running the program} The most common usages are as follows, for a semantic patch file \texttt{foo.cocci} and an spgen config file \texttt{foo.config}: \begin{itemize} \item \texttt{spgen foo.cocci}: Generate the file with the information found d in \texttt{foo.config} if it exists. If not, the program is run in interactive mode. \item \texttt{spgen -{}-config foo.config foo.cocci}: Generate the file with \texttt{foo.config} as the configuration file. The shorthand \texttt{-c} can be used instead of \texttt{-{}-config}. \item \texttt{spgen foo.cocci -{}-interactive}: Run the program in interactive mode. The shorthand \texttt{-i} can be used instead of \texttt{-{}-interactive}. \end{itemize} Additional options: \begin{itemize} \item \texttt{-{}-default}: Generates the file, entirely using default values, such as generic error messages, instead of user input. Can, e.g., be used to quickly check the generated context rule(s). \item \texttt{-o }: Saves the generated file to \texttt{} instead of printing it to standard output. \item \texttt{-{}-no-output}: Generates the file, but doesn't output the result. \item \texttt{-help, -{}-help}: Displays the list of options. \end{itemize} \bigskip \subsection{User input} When generating a script, \texttt{spgen} might need some extra information from the user. There are two kinds of information: \begin{itemize} \item \textbf{Preface}: information to go at the beginning of the script. Contains metainformation about the script such as description, author, etc. See the full list in Section \ref{config}. \item \textbf{Rule information}: rule-specific info, such as error messages that are output in \texttt{org} and \texttt{report} mode. \end{itemize} There are two ways of passing this information, interactive mode and configuration mode. \bigskip \subsubsection{Interactive mode\label{interact}} In interactive mode, the program prompts the user for the information through the commandline. The user can then choose to save the information into an \texttt{spgen} config file, which can be further modified and reused in configuration mode. \bigskip \subsubsection{Configuration mode\label{config}} In configuration mode, the program looks for an \texttt{spgen} config file to provide the needed information to generate the file. For \texttt{}.cocci, the config file should be called \texttt{}.config.\\\\ The user-specified attributes in the \textbf{preface} are, in no specific order ((r) means required): \begin{center} \renewcommand{\arraystretch}{1.2} \begin{tabular}{p{3cm}p{2.1cm}p{3.6cm}p{5.5cm}} \textbf{Attribute name} & \textbf{Shorthand} & \textbf{Value} & \textbf{Description}\\ \texttt{description} (r) & \texttt{d} & Single-value text & Describes what the Coccinelle script does.\\ \texttt{confidence} (r) & \texttt{c} & Low, Moderate, High & Confidence level for the script.\\ \texttt{authors} & \texttt{a} & Multi-value text & Authors of the script, including affiliation and license.\\ \texttt{url} & \texttt{u} & Single-value text & URL for the script.\\ \texttt{limitations} & \texttt{l} & Multi-value text & Limitations for the script.\\ \texttt{keywords} & \texttt{k} & Single-value text & Keywords for the script.\\ \texttt{options} & \texttt{o} & Single-value text &\texttt{spatch} options with which to run the script.\\ \texttt{comments} & \texttt{m} & Single-value text & Additional comments.\\ \end{tabular} \end{center}\vspace{0.5cm} The \textbf{rule information} contains error messages for \texttt{org} and \texttt{report}, and possibly rule names for rules that are unnamed in the original \texttt{Coccinelle script}.\\\\ \clearpage \noindent The syntax for the \texttt{spgen} config files is rather simple, and the easiest way to learn it is to run \texttt{spgen} in interactive mode and study the resulting config. But for completeness ...: \begin{itemize} \item The syntax for attributes is \begin{verbatim} = \end{verbatim} where \texttt{} can be either the attribute name or its shorthand. The end of \texttt{} is marked by a newline. It is therefore not possible to insert newlines in any of the values. \item For multi-valued attributes, values are delimited by pipes, \texttt{|}, ie. \begin{verbatim} = ||...| \end{verbatim} \item Error messages for rules follow the syntax \begin{verbatim} = org: report: \end{verbatim} for \texttt{org} and \texttt{report} error messages, respectively. Here, \texttt{} is either the actual rule name, or, if it is a nameless rule, \texttt{:}.\newline Meanwhile, \texttt{} follow the syntax of \texttt{python} format strings, e.g. \begin{verbatim} "This is a message that references two metavariables %s and %s." % (x,y) \end{verbatim} where \texttt{x} and \texttt{y} are metavariables in the rule. If using metavariables from another rule, write \texttt{.}. If using no metavariables, just write the error message surrounded by quotes. \item Comments can be written in \texttt{C}-style, ie. \texttt{//} and \texttt{/**/}. \end{itemize} \bigskip \subsection{Examples} Example files can be found in the \texttt{examples} directory. For each example, there should be four files. The file extensions denote the following: \begin{itemize} \item \texttt{.c}: \texttt{C} source file that returns matches/patches for the corresponding cocci file. Can be tested with \texttt{spatch --sp-file .cocci .c}. \item \texttt{.cocci}: simple, unhardened Coccinelle script. \item \texttt{.config}: \texttt{spgen} configuration file for specifying preface and rule information. \item \texttt{\_.cocci}: expected output when running \texttt{spgen} on the unhardened Coccinelle script with the config file. Should be a valid, hardened Coccinelle script. Can be tested with e.g. \texttt{spatch --sp-file \_.cocci .c -D report --no-show-diff}. \end{itemize} %PSEUDOGRAMMAR: %\begin{center} %\renewcommand{\arraystretch}{1.2} %\begin{tabular}{p{3cm}p{11cm}} %config : & (declaration) NL (config) \newline EOF \\ %declaration: & (attribute) = (value) \newline % (attribute) = (multivalue) \newline % (rulename) = (messages) \\ %attribute : & description \newline % comments ... \\ %value : & string (no newline) \\ %multivalue : & value | multivalue \newline % value \\ %rulename : & string (rulename) \newline % int : string (line, new rule) \\ %messages : & org : (message) NL report : (message) \newline % org : (message) \newline % report : (message) \\ %message : & "string" \newline "string" \% metavariables %\end{tabular} %\end{center} coccinelle-1.0.4/tools/spgen/documentation/Makefile0000644000175000017500000000073212614153277021403 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # a fairly minimal-effort rule for compiling the documentation. # requires latexmk and a few packages (standard stuff). docs: latexmk -pdf -pdflatex="pdflatex" -use-make documentation.tex clean: rm -f *.aux *.fdb_latexmk *.log *.out *.toc *.pdf *~ coccinelle-1.0.4/tools/spgen/documentation/documentation.tex0000644000175000017500000000254312614153277023340 0ustar eugeneugen\documentclass[a4paper,11pt]{article} \usepackage[english]{babel} \usepackage[utf8]{inputenc} \usepackage{textcomp} \usepackage[T1]{fontenc} % slightly reduce ridiculous margins \addtolength{\oddsidemargin}{-.5in} \addtolength{\evensidemargin}{-.5in} \addtolength{\textwidth}{1in} %for images %\usepackage[pdftex]{graphicx} % header \usepackage{fancyhdr} \pagestyle{fancy} \fancyhead[L]{\texttt{spgen} documentation} \fancyhead[R]{INRIA/LIP6 \today} % urls \usepackage{hyperref} \hypersetup{pdfborder = {0 0 0}} %remove link borders \title{\textbf{Documentation for \texttt{spgen}}} \date{\today} \author{Chi Pham} \begin{document} \maketitle \tableofcontents \newpage \section{About} We first provide information about the tool, its motivation, and its uses. \input{about.tex} \clearpage \section{Usage} This section contains information about how the tool is installed and used. \input{usage.tex} \clearpage \section{Implementation} This section contains information about the implementation details of the tool. \input{implementation.tex} \clearpage \section{Known issues} This section lists the known issues that might either cause the tool to fail or to generate an erroneous script. \input{knownissues.tex} \clearpage \section{Future work} This section lists the work to be done on the tool aside from fixing the known issues. \input{future.tex} \end{document} coccinelle-1.0.4/tools/spgen/documentation/about.tex0000644000175000017500000000417412614153277021603 0ustar eugeneugen\subsection{What is \texttt{spgen}?} \texttt{spgen} is a \texttt{Coccinelle}\footnote{\hyperref[http://coccinelle.lip6.fr/]{http://coccinelle.lip6.fr/}} metaprogramming tool that can generate hardened semantic patches for use in e.g. the Linux kernel.\\ Or, in less fancy words, \texttt{spgen} can take your simple \texttt{Coccinelle} script containing one or more rules with \texttt{*}, \texttt{+}, or \texttt{-}, and then output the same script with more options.\\\\ In particular, \texttt{spgen} generates the \texttt{patch}, \texttt{context}, \texttt{org}, and \texttt{report} virtual rules. These options are prevalent in the \texttt{Coccinelle} scripts included in the Linux kernel and are used in the following cases: \begin{itemize} \item \texttt{patch}: Used for +/- rules that transform the matched \texttt{C} code and output the changes in Unix \texttt{diff} format. \item \texttt{context}: Used for * rules that find the matched \texttt{C} code and output it in \texttt{diff}-like format. \item \texttt{org}: Used for script rules that output matches in \texttt{emacs} org mode format\footnote{\hyperref[http://orgmode.org/]{http://orgmode.org/}} with an error message and line numbers. \item \texttt{report}: Used for script rules that output matches with an error message and line numbers. \end{itemize} \bigskip \subsection{Features} \texttt{spgen} includes (but is not limited to) support for \begin{itemize} \item Generating a \texttt{context} (aka *) version of a \texttt{patch} (aka +/-) rule. \item Generating \texttt{org} and \texttt{report} (aka script) versions of both \texttt{patch} and \texttt{context} rules. \item Adding \texttt{patch}, \texttt{context}, \texttt{org}, and \texttt{report} dependencies to rule headers. \item Allowing the user to specify preface information for the generated rule, such as keywords, options, etc. as well as error messages for rules and names for nameless rules. \item Automatic rulename and error message generation when none specified by the user. \item Rule splitting to ensure correct \texttt{context} mode output for rules containing pattern matching disjunctions. \item And more ... \end{itemize} coccinelle-1.0.4/tools/spgen/scripts/0000755000175000017500000000000012614156171016553 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/scripts/spgen.sh.in0000755000175000017500000000052512614153277020641 0ustar eugeneugen#! /bin/sh -e # This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr TARGET=spgen exec_prefix=@prefix@ LIBDIR=@libdir@/coccinelle/spgen"" exec ""${LIBDIR}/${TARGET}"" "$@" coccinelle-1.0.4/tools/spgen/source/0000755000175000017500000000000012614153277016370 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/source/user_input.mli0000644000175000017500000000514412614153277021274 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Types and functionality for user input * Turns the raw input from the config/interactive into printable strings and * information ready to use by the generators. *) (* ------------------------------------------------------------------------- *) (* CONFIDENCE *) (* The confidence level of the script. Low, Moderate, or High. *) module Confidence : sig type t = Low | Moderate | High exception Not_confidence of string val to_string : t -> string (* fails with Not_confidence if the string is not l, m, h, low, moderate, or * high. Case insensitive. *) val from_string : string -> t end (* ------------------------------------------------------------------------- *) (* USER RULE *) (* user-specified data (new name + org and report messages) for one rule. *) module Rule : sig type t (* rule_name is the new rulename (or the original one if a new one is not * needed). org and report are (error message, list of metavariables). *) val make : rule_name:string -> org:(string * string list) -> report:(string * string list) -> t val get_name : t -> string val get_org : t -> string * Meta_variable.t list val get_report : t -> string * Meta_variable.t list end (* ------------------------------------------------------------------------- *) (* USER INPUT *) (* The user input type. encapsulates the stuff that is specified by the user*) type t (* constructor; description and confidence level are required *) val make : description:string -> confidence:Confidence.t -> t (* setters *) val set_keys : string -> t -> t val set_conf : Confidence.t -> t -> t val set_comments : string -> t -> t val set_options : string -> t -> t val set_url : string -> t -> t val set_limits : string list -> t -> t val add_limit : string -> t -> t val set_authors : string list -> t -> t val add_author : string -> t -> t val add_rule : rule_name:string -> Rule.t -> t -> t (* check if there's already a rule with that name *) val check_name : string -> t -> unit (* get string formatted version of preface *) val get_preface : t -> string (* returns rule with associated metadata, default generated if not found *) val get_rule : rule_name:string -> t -> Rule.t (* turns a user input into the config that generates it *) val unparse : t -> string (* format string checking *) val check_format_string : string * string list -> unit val count_format_vars : string -> int coccinelle-1.0.4/tools/spgen/source/user_input.ml0000644000175000017500000002216412614153277021124 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module MV = Meta_variable module RuleMap = Map.Make (String) (* ------------------------------------------------------------------------- *) (* Encapsulates all local input for the rule to be generated: * - Description of the script. * - Limitations of the script. * - Keywords for the script. * - Confidence level of the script (Low, Moderate, High). * - Additional comments for the script. * - Coccinelle options with which to call the script. * - Authors of the script (copyright). * Not yet globally configurable; see spgen_config.ml. * - Error messages for org and report mode for each rule. *) (* ------------------------------------------------------------------------- *) (* HELPERS FOR USER INPUT *) let opt s = if s = "" then None else Some s let rev_opt p = function Some s -> p ^ s ^ "\n" | None -> "" (* Count number of format variables, effectively number of unescaped %'s. *) let count_format_vars s = (* ignore escaped percent signs, which in python is %%. *) let s = Str.global_replace (Str.regexp_string "%%") "" s in let rec count_pct acc i s = if i < 0 then acc else if s.[i] = '%' then count_pct (acc+1) (i-1) s else count_pct acc (i-1) s in count_pct 0 ((String.length s)-1) s (* fails if the number of metavariables != the number of % in format str *) let check_format_string (msg, mvs) = let pcts = count_format_vars msg in let mvcount = List.length mvs in if pcts <> mvcount then failwith ("Config error: ill-formed format string.\n" ^ "Number of format variables in the message \"" ^ msg ^ "\": " ^ (string_of_int pcts) ^ "\n" ^ "Number of declared format variables: " ^ (string_of_int mvcount)) (* reconstructs a format string from the message and metavars (as strings) *) let make_format_string msg = let msg = "\"" ^ msg ^ "\"" in function | [] -> msg | x -> let x = List.map MV.tostring_mv x in msg ^ " % " ^ "(" ^ (String.concat "," x) ^ ")" (* turn user-specified metavariable strings into metavariables. * important that they are created with no rulename if within the same rule, * since this is used to generate the right inheritance later on. * They are initialised with type = "" since we don't need it. *) let make_metavars = let mv a = let split_name = Str.bounded_split (Str.regexp "\\.") a 2 in match split_name with | [meta_name] -> MV.make ~typ:"" meta_name | [inherit_rule; meta_name] -> MV.make ~typ:"" ~inherit_rule meta_name | _ -> failwith "bounded split" in List.map mv (* ------------------------------------------------------------------------- *) (* CONFIDENCE TYPE *) (* confidence in the accuracy of the script *) module Confidence = struct type t = Low | Moderate | High exception Not_confidence of string let to_string = function Low -> "Low" | Moderate -> "Moderate" | High -> "High" let from_string s = match String.lowercase s with | "low" | "l" -> Low | "moderate" | "m" -> Moderate | "high" | "h" -> High | s -> raise (Not_confidence s) end (* ------------------------------------------------------------------------- *) (* USER RULE TYPE *) (* user-specified data to put in spgenerated script. * type is (rulename, (org message, org metavars), (rep message, rep metavars)) * rulename can be original rulename or a new user-specified one. *) module Rule = struct type t = string * (string * MV.t list) * (string * MV.t list) (* constructor. If rulename is nameless ie. "rule starting on line ...", * generate a new one. *) let make ~rule_name ~org ~report = let ((om,ov),(rm,rv)) = (org, report) in let _ = assert (rule_name <> "" && not(om = "" && rm = "")) in let rule_name = if String.contains rule_name ' ' then Globals.generate_rule rule_name else rule_name in let ov, rv = make_metavars ov, make_metavars rv in (rule_name, (om,ov), (rm,rv)) let get_name (n,_,_) = n let get_org (_,o,_) = o let get_report (_,_,r) = r end (* ------------------------------------------------------------------------- *) (* USER INPUT TYPE *) (* user_input type that covers all the data specified by the user * rules are a map, mapping original rulename to * (new rulename, (org message, org metavars), (rep message, rep metavars) *) type t = { description : string; limitations : string list; keywords : string option; confidence : Confidence.t; comments : string option; options : string option; authors : string list; url : string option; rules : Rule.t RuleMap.t; } (* CONSTRUCTOR, description and confidence levels are required. *) let make ~description ~confidence = if description = "" then failwith "Error: Description is required." else { description; limitations = []; keywords = None; confidence; comments = None; options = None; authors = []; url = None; rules = RuleMap.empty } (* SETTERS *) let add_limit limit t = { t with limitations = limit :: t.limitations } let set_limits limits t = { t with limitations = limits } let set_keys keys t = { t with keywords = opt keys } let set_conf conf t = { t with confidence = conf } let set_comments cmnt t = { t with comments = opt cmnt } let set_options optn t = { t with options = opt optn } let set_url url t = { t with url = opt url } let add_author auth t = { t with authors = auth :: t.authors } let set_authors auths t = { t with authors = auths } (* check that rulename is valid + is not already added. Returns unit. *) let check_name nm t = let already key value = let new_name = Rule.get_name value in (key = new_name && key = nm) || (* nm is same as already added rule *) (new_name = nm) in (* nm is same as other rule with new nm *) if RuleMap.exists already t.rules then failwith ("Error: already another rule named \"" ^ nm ^"\"!") else Globals.check_rule ~strict:true nm (* add rule to rulemap in t. * for nameless rules: check legality of user-declared name. *) let add_rule ~rule_name rule t = let newnm = Rule.get_name rule in let _ = if rule_name <> newnm then check_name newnm t in { t with rules = RuleMap.add rule_name rule t.rules } (* GETTERS *) (* format the preface information and turn it into one big string *) let get_preface { description=d; limitations=l; keywords=k; confidence=c; comments=m; options=o; authors=a; url=u; _ } = let author_format = let year = string_of_int (Common.this_year()) in Globals.pre_split ~prefix:("// Copyright: (C) "^year^" ") in let desc = Globals.pre_split ~prefix:"/// " d in let limits = String.concat "\n" (List.map (Globals.pre_split ~prefix:"//# ") l) in let keys = Globals.pre_split_opt ~prefix:"// Keywords: " k in let confidence = "// Confidence: " ^ (Confidence.to_string c) in let comments = Globals.pre_split_opt ~prefix:"// Comments: " m in let options = Globals.pre_split_opt ~prefix:"// Options: " o in let authors = String.concat "\n" (List.map author_format a) in let url = Globals.pre_split_opt ~prefix:"// URL: " u in let preface = [desc; limits; "///"; confidence; authors; url; comments; options; keys] in String.concat "\n" (List.filter ((<>) "") preface) (* get the user-input rulename and org and report messages for rule_name. * if the original rule could not be found in the userinput, use default msg *) let get_rule ~rule_name {rules = r; _} = try RuleMap.find rule_name r with Not_found -> let rulenm = Globals.generate_rule rule_name in let default = Globals.get_default_message() in (rulenm, (default, []), (default, [])) (* ------------------------------------------------------------------------- *) (* UNPARSE USER INPUT INTO CONFIG *) (* turns a rule into the config script that generated it *) let unparse_rule rnm (newnm,(orgmsg,orgmvs),(repmsg,repmvs)) = let orgmsg = make_format_string orgmsg orgmvs in let repmsg = make_format_string repmsg repmvs in let rnm = if rnm <> newnm then let l = Globals.extract_line rnm in (string_of_int l) ^ ":" ^ newnm else rnm in rnm ^ " =\n" ^ " org:" ^ orgmsg ^ "\n report:" ^ repmsg ^ "\n" (* turn a user input collection into its corresponding config script *) let unparse { description; limitations; keywords; confidence; comments; options; rules; authors; url } = let a = "// Generated config\n" in let b = "description = " ^ description ^ "\n" in let c = if limitations = [] then "" else "limitations = " ^ (String.concat "|" limitations) ^ "\n" in let d = rev_opt "keywords = " keywords in let e = "confidence = " ^ (Confidence.to_string confidence) ^ "\n" in let f = rev_opt "comments = " comments in let g = rev_opt "options = " options in let h = if authors = [] then "" else "authors = " ^ (String.concat "|" authors) ^ "\n" in let i = rev_opt "url = " url in let j = RuleMap.fold (fun rnm msg acc -> (unparse_rule rnm msg) :: acc) rules [] in let preface = String.concat "" [a;b;c;d;e;f;g;h;i] in let rules = String.concat "" j in preface ^ rules coccinelle-1.0.4/tools/spgen/source/detect_patch.ml0000644000175000017500000001503412614153277021354 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module IntMap = Common.IntMap (* ------------------------------------------------------------------------- *) (* Detects whether a rule is a */+/- rule or not. * * Generates a disjunction map for a rule, which maps each disjunction within * the rule to a list of bools indicating whether each disjunction case has * */+/-. * (this is useful for determining whether a rule uses 'pattern matching'.) *) (* ------------------------------------------------------------------------- *) (* HELPERS *) (* merges two disjunction maps. * runs through all keys in both maps, unlikely to be a problem since there * won't be many keys (each key representing one disjunction) *) let merge = let fn key aopt bopt = match aopt, bopt with | Some a, Some b -> Some (List.map2 (||) a b) | Some a, None | None, Some a -> Some a | None, None -> None in IntMap.merge fn (* mcodes contain the actual information about */+/-. *) let mcode = function | (x, a, info, Ast0.CONTEXT _, pos, _) -> (false, IntMap.empty) | (x, a, info, Ast0.MINUS _, pos, _) -> (true, IntMap.empty) | (x, a, info, Ast0.PLUS _, pos, _) -> (true, IntMap.empty) | (x, a, info, Ast0.MIXED _, pos, _) -> failwith "detect_patch: mixed not supported" (* Disjunction handler. * takes left and right parenthesis mcodes, list of pipe separator mcodes, * the list of different cases and one function to handle each case. * Parentheses and pipes are always context mode. * Returns * (whether there is a patch in any of the disjunction cases, * a mapping of the beginning line number of the disj to a list of * bools indicating whether each of the disjunctions are a patch or no) *) let handle_disj lp rp pipelist clist cfn = let index = Ast0.get_mcode_line lp in let disj_patches (is_patch, acc_list, acc_map) case = let (case_is_p, case_map) = cfn case in let p = is_patch || case_is_p in let dp = case_is_p :: acc_list in let dps = merge case_map acc_map in (p, dp, dps) in (* contains_patch is a bool denoting whether the whole disj contains a patch * disj_patch is a list of bools, each bool representing a disj case * acc are the accumulated disjunctions within the disjunction *) let (contains_patch, disj_patch, acc) = List.fold_left disj_patches (false, [], IntMap.empty) clist in (contains_patch, IntMap.add index (List.rev disj_patch) acc) (* ------------------------------------------------------------------------- *) (* THE COMBINER *) let patch_combiner = let bind (x, m1) (y, m2) = (x || y, IntMap.fold IntMap.add m1 m2) in let option_default = (false, IntMap.empty) in (* apply the passed function, do nothing else *) let donothing r k e = k e in let meta_mcode = mcode in let string_mcode = mcode in let const_mcode = mcode in let simpleAssign_mcode = mcode in let opAssign_mcode = mcode in let fix_mcode = mcode in let unary_mcode = mcode in let arithOp_mcode = mcode in let logicalOp_mcode = mcode in let cv_mcode = mcode in let sign_mcode = mcode in let struct_mcode = mcode in let storage_mcode = mcode in let inc_mcode = mcode in let dotsexprfn = donothing in let dotsinitfn = donothing in let dotsparamfn = donothing in let dotsdeclfn = donothing in let dotscasefn = donothing in let assignOpfn = donothing in let binaryOpfn = donothing in let initfn = donothing in let paramfn = donothing in let forinfofn = donothing in let string_fragmentfn = donothing in let topfn = donothing in let dotsstmtfn = donothing in let identfn c fn v = match Ast0.unwrap v with | Ast0.DisjId(lp, idlist, pipelist, rp) -> handle_disj lp rp pipelist idlist c.VT0.combiner_rec_ident | _ -> fn v in let exprfn c fn v = match Ast0.unwrap v with | Ast0.DisjExpr(lp, exprlist, pipelist, rp) -> handle_disj lp rp pipelist exprlist c.VT0.combiner_rec_expression | _ -> fn v in let tyfn c fn v = match Ast0.unwrap v with | Ast0.DisjType(lp, tylist, pipelist, rp) -> handle_disj lp rp pipelist tylist c.VT0.combiner_rec_typeC | _ -> fn v in let declfn c fn v = match Ast0.unwrap v with | Ast0.DisjDecl(lp, decllist, pipelist, rp) -> handle_disj lp rp pipelist decllist c.VT0.combiner_rec_declaration | _ -> fn v in let casefn c fn v = match Ast0.unwrap v with | Ast0.DisjCase(lp, caselist, pipelist, rp) -> handle_disj lp rp pipelist caselist c.VT0.combiner_rec_case_line | _ -> fn v in let stmtfn c fn v = match Ast0.unwrap v with | Ast0.Disj(lp, sdlist, pipelist, rp) -> handle_disj lp rp pipelist sdlist c.VT0.combiner_rec_statement_dots | _ -> fn v in V0.flat_combiner bind option_default meta_mcode string_mcode const_mcode simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn binaryOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn topfn (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) (* (true if contains */+/-, disjunction map) *) type t = bool * bool list Common.IntMap.t let make = function | Ast0.InitialScriptRule _ | Ast0.FinalScriptRule _ | Ast0.ScriptRule _ -> (false, IntMap.empty) | Ast0.CocciRule ((minus,_,_),(plus,_),_) -> let handle_toplvl (is_patch, disj) tpl = let (r1, r2) = patch_combiner.VT0.combiner_rec_top_level tpl in (is_patch || r1, merge disj r2) in let rule = List.fold_left handle_toplvl (false, IntMap.empty) in let (p1,p2) = rule plus in let (m1,m2) = rule minus in (p1 || m1, merge p2 m2) let make_statement_dots s = patch_combiner.VT0.combiner_rec_statement_dots s let is_patch (t,_) = t let get_disj_patch index (_,t) = try IntMap.find index t with Not_found -> let i = string_of_int index in failwith ("detect_patch: Could not find disjunction starting on line " ^ i) let filter_patch_rules = let rec get fn = function | x::xs -> let ((is_patch, disj_map) as dp) = make x in if is_patch then get (fun a -> fn ((x, dp)::a)) xs else get fn xs | [] -> fn [] in get (fun x -> x) coccinelle-1.0.4/tools/spgen/source/disj_generator.ml0000644000175000017500000001622012614153277021722 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module Snap = Snapshot module PG = Position_generator (* ------------------------------------------------------------------------- *) (* Returns snapshot that has both updated result (added rule with no stars) * and updated disj_result (rule with stars). *) (* ------------------------------------------------------------------------- *) (* TYPE HANDLER FUNCTIONS *) type statement_dots_fn = Ast0.statement Ast0.dots -> Snap.t -> Snap.t type string_fn = string Ast0.mcode -> Snap.t -> Snap.t type statement_fn = Ast0.statement -> Snap.t -> Snap.t type expression_fn = Ast0.expression -> Snap.t -> Snap.t type ident_fn = Ast0.ident -> Snap.t -> Snap.t type declaration_fn = Ast0.declaration -> Snap.t -> Snap.t (* ------------------------------------------------------------------------- *) (* DISJUNCTION HANDLER *) let ( >> ) f g x = g (f x) (* given the components of a disjunction + functions to handle them + snapshot: * returns new snapshot that has the disjunction added in the context rule. * this may include splitting the rule and/or adding stars where appropriate. *) let handle_disj ~lp (* left parenthesis, string mcode *) ~rp (* right parenthesis, string mcode *) ~pipes (* separator pipes, string mcode list *) ~cases (* disjunction cases, 'a list *) ~casefn (* function to handle one disj case, 'a -> snapshot -> snapshot *) ~singlefn (* casefn for only one patch, same type as casefn *) ~strfn (* string mcode handler, string mcode -> snapshot -> snapshot *) ~at_top (* true: disj is the only thing so don't add another rule, bool *) snapshot = let index = Ast0.get_mcode_line lp in let boollist = Snap.get_disj index snapshot in let combined = List.combine cases boollist in (* determine if all or none are patches *) let all_same = function [] -> true | x :: xs -> List.for_all (( = ) x) xs in (* true if multiple patch cases; ie. we want disjunction parentheses *) let mult_stmt = List.length (List.filter (fun x -> x) boollist) <> 1 in let casefn = if mult_stmt then casefn else singlefn in (* keep the same positions if several disjunctions *) let freeze_pos = if mult_stmt then Snap.do_freeze_pos else (fun x -> x) in (* handle each disjunction case one at a time * setmodefn is the function that sets the generation mode of the snapshot. * tblist is a list of (disj case, whether it is a patch) *) let handle_cases set_modefn tblist pipes = let rec handle_cases' tblist pipes fn = match tblist, pipes with | [(t,b)], [] -> fn >> set_modefn b >> casefn t | (t,b) :: ts, p :: ps -> handle_cases' ts ps (fn >> set_modefn b >> casefn t >> strfn p) | _ -> assert false (* should be exactly one more stmt than pipes *) in handle_cases' tblist pipes (fun x -> x) in let disj = (* CASE 1: all or none are patches or toplevel, no extra rule needed, * always generate positions (unless we're in no_gen mode). *) if at_top || all_same boollist then begin let handle_no_gen = handle_cases (fun _ y -> y) in strfn lp >> handle_no_gen combined pipes >> strfn rp end (* CASE 2: only some are patches, generate extra rule (disj result) *) else begin (* if b is true, DO generate positions/stars and add to disj result *) let set_add_disj b = Snap.set_no_gen (not b) >> Snap.set_disj_mode b in let handle_do_gen = handle_cases set_add_disj in Snap.init_disj_result >> set_add_disj mult_stmt >> strfn lp >> handle_do_gen combined pipes >> set_add_disj mult_stmt >> strfn rp >> set_add_disj true end in freeze_pos disj snapshot (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) (* These functions all return a snapshot that has the extra disjunction rule * generated (if necessary) *) (* The at_top flag means that the code is not surrounded by starrable * components, ie. it should not be split into two rules. (it needs to be more * accurate; see rule_body.ml) *) (* Returns snapshot that has added generated statement disjunction rule *) let generate_statement ~stmtdotsfn ~strfn ~stmtfn ~stmt ~at_top = (* inserts one position if in generation mode. * We only want one position per disjunction case (since they all have the * same metaposition), so just add position to first possible case. *) let sdotsfn sd snp = let std_no_pos = List.fold_left (fun a b -> a >> stmtfn b) (fun x -> x) in let rec std' l snp = match l with | [] -> assert false (* no disj patches with only unpositionable cases *) | x::xs -> (match PG.statement_pos x snp with | Some (x, snp) -> (Snap.set_no_gen true >> std_no_pos (x::xs) >> Snap.set_no_gen false) snp | None -> std' xs (stmtfn x snp)) in let add_pos_function = if Snap.no_gen snp then std_no_pos else std' in add_pos_function (Ast0.unwrap sd) snp in match Ast0.unwrap stmt with | Ast0.Disj(lp, sdlist, pipes, rp) -> handle_disj ~lp ~rp ~pipes ~cases:sdlist ~casefn:sdotsfn ~singlefn:stmtdotsfn ~strfn ~at_top | _ -> failwith "only disj allowed in here" (* Returns snapshot that has added generated expression disjunction rule *) let generate_expression ~strfn ~exprfn ~expr ~at_top s = (* inserts one position if in generation mode *) let expposfn e snp = if Snap.no_gen snp then exprfn e snp else match PG.expression_pos e snp with | Some (ee, snp) -> exprfn ee snp | None -> failwith "no unpos cases" in match Ast0.unwrap expr with | Ast0.DisjExpr(lp, elist, pipes, rp) -> handle_disj ~lp ~rp ~pipes ~cases:elist ~casefn:expposfn ~singlefn:expposfn ~strfn ~at_top s | _ -> failwith "only disj allowed in here" (* Returns snapshot that has added generated ident disjunction rule *) let generate_ident ~strfn ~identfn ~ident ~at_top s = (* inserts one position if in generation mode *) let idposfn i snp = if Snap.no_gen snp then identfn i snp else let (i, snp) = PG.ident_pos i snp in identfn i snp in match Ast0.unwrap ident with | Ast0.DisjId(lp, ilist, pipes, rp) -> handle_disj ~lp ~rp ~pipes ~cases:ilist ~casefn:idposfn ~singlefn:idposfn ~strfn ~at_top s | _ -> failwith "only disj allowed in here" (* Returns snapshot that has added generated declaration disjunction rule *) let generate_declaration ~strfn ~declfn ~decl ~at_top s = (* inserts one position if in generation mode *) let decposfn d snp = if Snap.no_gen snp then declfn d snp else match PG.declaration_pos d snp with | Some (dd, snp) -> declfn dd snp | None -> failwith "no unpos cases" in match Ast0.unwrap decl with | Ast0.DisjDecl(lp, dlist, pipes, rp) -> handle_disj ~lp ~rp ~pipes ~cases:dlist ~casefn:decposfn ~singlefn:decposfn ~strfn ~at_top s | _ -> failwith "only disj allowed in here" coccinelle-1.0.4/tools/spgen/source/snapshot.mli0000644000175000017500000000514112614153277020733 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Encapsulates state variables to keep track of internal state during * context rule generation. * * Contains the generated rule, current line number, mode, positions. *) (* ------------------------------------------------------------------------- *) (* TYPE *) type t (* Constructor *) val make: disj_map:Detect_patch.t -> t (* ------------------------------------------------------------------------- *) (* MODE AND LINE FUNCTIONS *) (* Change the mode of the current line *) val set_mode_star: arity:Ast0_cocci.arity -> t -> t val set_mode_context: arity:Ast0_cocci.arity -> t -> t (* Increase line number, set the mode of the new line to context. *) val inc_line: t -> t (* Increase line number, but only if current mode is star. *) val inc_star: t -> t (* Increase line number if rule line number exceeds current rule line. *) val skip: rule_line:int -> t -> t (* ------------------------------------------------------------------------- *) (* ADDING VALUE FUNCTIONS *) (* Add string value to the current line in the generated rule *) val add: string -> t -> t (* Add value, change the arity. *) val add_with_arity: string -> Ast0_cocci.arity -> t -> t (* ------------------------------------------------------------------------- *) (* DISJUNCTION FUNCTIONS *) (* start the disjunction rule *) val init_disj_result : t -> t (* get the disjunction map *) val get_disj : int -> t -> bool list (* set disjunction mode, in which everything added to the normal generated * rule is added to the disjunction rule as well. *) val set_disj_mode : bool -> t -> t (* ------------------------------------------------------------------------- *) (* POSITION FUNCTIONS *) (* freeze the position while executing the passed function *) val do_freeze_pos: (t -> t) -> t -> t (* Returns the numbered name of the new pos and the modified t *) val add_position: t -> (string * t) (* ------------------------------------------------------------------------- *) (* NO GEN FUNCTIONS *) (* flag for not generating positions *) val set_no_gen : bool -> t -> t val no_gen: t -> bool (* enter whencode nest while executing the passed function *) val do_whencode: (t -> t) -> t -> t (* ------------------------------------------------------------------------- *) (* GETTERS *) val get_positions: t -> string list val get_result: t -> string list (* main rule *) * string list option (* generated disj rule *) coccinelle-1.0.4/tools/spgen/source/ast_tostring.mli0000644000175000017500000000227712614153277021623 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Turns Ast_cocci base types into strings. *) (* ------------------------------------------------------------------------- *) (* TOSTRING FUNCTIONS *) val meta_tostring : Ast_cocci.meta_name -> string val constant_tostring : Ast_cocci.constant -> string val struct_union_tostring : Ast_cocci.structUnion -> string val sign_tostring : Ast_cocci.sign -> string val const_vol_tostring : Ast_cocci.const_vol -> string val storage_tostring : Ast_cocci.storage -> string val inc_elem_tostring : Ast_cocci.inc_elem -> string val inc_file_tostring : Ast_cocci.inc_file -> string val fix_tostring : Ast_cocci.fixOp -> string val arith_tostring : Ast_cocci.arithOp -> string val logic_tostring : Ast_cocci.logicalOp -> string val unary_tostring : Ast_cocci.unaryOp -> string val assign_tostring : Ast_cocci.assignOp -> string val binary_tostring : Ast_cocci.binaryOp -> string val type_tostring : Ast_cocci.baseType -> string val whenmodifier_tostring : Ast_cocci.when_modifier -> string coccinelle-1.0.4/tools/spgen/source/spgen.ml0000644000175000017500000001263612614153277020046 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ------------------------------------------------------------------------- *) (* Driver module for the whole program. * * The high-level process is something like: * 1. Parse the cocci file using the main parser * 2. Parse the user-provided input for the spgenerated file * 3. Generate context rules (ie. rules with *'s and positions) * 4. Generate script rules (ie. rules for org and report modes) * 5. Print the preface (ie. metadata and virtuals) * 6. Print the original file with transformations in dependencies, names, etc. * 7. Print the generated context and script rules *) (* ------------------------------------------------------------------------- *) type options = { file : string; config : string; output : string; interactive : bool; default : bool; hide : bool; } (* if no options are set, it defaults to interactive mode *) let make_options ?(config = "") ?(output = "") ?(interactive = false) ?(default = false) ?(hide = false) file = { file; config; output; interactive; default; hide } (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) let run { file; config; output; interactive; default; hide; } = (* ------------- CHECK ------------- *) if not(Sys.file_exists file) then failwith ("The file \""^ file ^"\" doesn't exist!"); if config <> "" && not(Sys.file_exists config) then failwith ("The config file \"" ^ config ^ "\" doesn't exist!"); if file = output then failwith ("Input file cannot be the same as output file!"); (* ------------- SETTINGS ------------- *) (* default config name. Ie. .config *) let (dir, base, _) = Common.dbe_of_filename file in let name = Common.filename_of_dbe (dir, base, "config") in (* if no config specified, but the default config exists, use it *) let config = if config = "" && Sys.file_exists name then name else config in (* if no config specified and no default config, run in interactive mode *) let interactive = (config = "") || interactive in (* ------------- PARSE ------------- *) Flag_parsing_cocci.generating_mode := true; let (_, rules, virtuals, _) = Parse_cocci.parse file in Flag_parsing_cocci.generating_mode := false; (* cleanup! for tests, etc. *) (* if the rule is a star rule, the sgrep_mode2 flag is set after parsing *) let context_mode = !Flag.sgrep_mode2 in (* get the */+/- rules and check that their names don't create conflicts *) let rules_disj_maps = Detect_patch.filter_patch_rules rules in let rule_names = List.map (fun (x,_) -> Ast0_cocci.get_rule_name x) rules_disj_maps in let _ = List.iter (Globals.check_rule ~strict:false) rule_names in (* ------------- GLOBALS ------------- *) (* these are settings that are usually the same regardless of rule *) let (_(*author*), _(*license*), rule_name, pos_name, error_msg, char_limit) = Spgen_config.parse_global ~config_name:"" in let _ = Globals.init ~rule_name ~pos_name ~error_msg ~char_limit in let virtuals = Globals.key_virtuals ~context_mode virtuals in (* ------------- LOCALS ------------- *) let user_input = if default then Spgen_config.parse_default else if interactive then Spgen_interactive.interact ~rule_names ~config_name:name else Spgen_config.parse_local ~rule_names ~config_name:config in let preface = User_input.get_preface user_input in (* ------------- GENERATE ------------- *) (* drules is the ordered list of patch rules, tupled with their disj maps. *) let generate drules = let rec generate' rules fn = match rules with | (rule, disj_map) :: rs -> (* extract the corresponding user input to current rule *) let old_name = Ast0_cocci.get_rule_name rule in let user_rule = User_input.get_rule ~rule_name:old_name user_input in let new_name = User_input.Rule.get_name user_rule in (* generate context and script rules *) let nrule = (rule, new_name) in let (ctxt, meta_pos) = Context_rule.generate ~context_mode ~new_name ~disj_map ~rule in let script = Script_rule.generate ~meta_pos ~user_rule in let add (rs, cs, ss) = fn (nrule::rs, ctxt::cs, script::ss) in generate' rs add | [] -> fn ([],[],[]) in generate' drules (fun x -> x) in let (namedrules, contexts, scripts) = generate rules_disj_maps in (* ------------- PRINT ------------- *) if not(hide) then begin let out = if output = "" then stdout else (open_out output) in let split() = output_string out ("// --------------------------------------" ^ "--------------------------------------\n\n") in try File_transform.print ~context_mode ~file_name:file ~preface ~virtuals ~ordered_rules:namedrules out; split(); List.iter (Context_rule.print out) contexts; split(); List.iter (Script_rule.print_org out) scripts; split(); List.iter (Script_rule.print_report out) scripts; flush out; close_out out with Failure msg -> flush out; close_out out; if output <> "" && Sys.file_exists output then Sys.remove output; failwith msg end coccinelle-1.0.4/tools/spgen/source/snapshot.ml0000644000175000017500000002316112614153277020564 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module StringSet = Set.Make (String) module IntMap = Common.IntMap (* ------------------------------------------------------------------------- *) (* Types used to represent internal state during context rule generation. * We cannot pass the states from function to function in the visitor due to * the function signatures already having been decided for us. * Basically glorified global variables (but with limited access and scope, so * not quite!). * * The generated rule is represented by a (mode * string) IntMap. Mapping line * number to mode ( * or nothing) and the string contents. * * During execution, there are quite many cases dictated by the three internal * flags: * - disj_mode (add to disj result) * - no_gen_mode (do not generate positions) ALSO TRIGGERED BY WHENCODES! * - freeze_pos (don't increment position counter). * * An overview of the logic: * State | Add to disj result| Generate position| Incr pos counter * --------------------------------------------------------------------------- * normal | NO | YES | YES * normal whencodes | NO | NO | x * disj context | NO | NO | x * disj patch | YES | YES | NO * disj patch whencode| YES | NO | x * after special disj | YES | YES | YES * *) (* ------------------------------------------------------------------------- *) (* ARITY *) (* Arity denotes whether a match is optional (OPT) or required (NONE). * Mostly the same as Ast0_cocci, but does not allow unique matches. *) type arity = OPT | NONE let tostring_arity = function | OPT -> "?" | NONE -> "" (* converts Ast0.arity to local arity *) let to_a = function | Ast0.OPT -> OPT | Ast0.NONE -> NONE (* ------------------------------------------------------------------------- *) (* MODE *) (* Mode denotes whether a line should be preprended with * or nothing. *) type mode = Star of arity | Context of arity let tostring_mode = function | Star a -> (tostring_arity a) ^ "* " | Context a -> (tostring_arity a) ^ "" let is_star = function | Star _ -> true | Context _ -> false let set_arity m a = match m, a with | Context _, Some a -> Context a | Star _, Some a -> Star a | m, None -> m (* ------------------------------------------------------------------------- *) (* STATE *) (* Wrapper for state variables. *) type t = { result : (mode * string) IntMap.t; (* maps line number to content *) current_mode : mode; (* whether current line is in context or star mode *) current_line : int; (* current line number (for hashtable indexing) *) rule_line : int; (* current line number in the original rule *) whencode_nest : int; (* number of levels of whencode nests *) pos_counter : int; (* number of added metapositions *) positions : StringSet.t; (* names of added metapositions *) disj_map : Detect_patch.t; (* maps line number to disj patch detect *) disj_result : (mode * string) IntMap.t option; (* generated disj rule *) disj_mode : bool; (* flag for adding content to disj rule *) no_gen_mode : bool; (* flag for not generating positions *) freeze_pos : bool * bool; (* flag for not incrementing the pos counter *) (* the second part means a pos was added during *) } (* Constructor. * Note: disj_map stays invariant throughout the processing of the rule ... *) let make ~disj_map = { result = IntMap.empty; current_mode = Context NONE; current_line = 0; rule_line = 0; whencode_nest = 0; pos_counter = 0; positions = StringSet.empty; disj_result = None; disj_map; disj_mode = false; no_gen_mode = false; freeze_pos = false, false; } (* ------------------------------------------------------------------------- *) (* STATE: MODE AND LINE FUNCTIONS *) let set_mode m snp = { snp with current_mode = m } let set_mode_star ~arity = set_mode (Star (to_a arity)) let set_mode_context ~arity = set_mode (Context (to_a arity)) let set_rule_line l snp = { snp with rule_line = l } let inc_current_line snp = { snp with current_line = snp.current_line + 1 } (* New lines default to Context, they have to be explicitly set to Star. *) let inc_line snp = inc_current_line (set_mode_context Ast0.NONE snp) let inc_star snp = if is_star snp.current_mode then inc_line snp else snp (* if input number exceeds the current rule line number, increase the internal * line number. *) let skip ~rule_line snp = let snp = if rule_line > snp.rule_line then inc_line snp else snp in set_rule_line rule_line snp (* ------------------------------------------------------------------------- *) (* STATE: ADDING CONTENT TO MAP FUNCTIONS *) (* Functions for modifying the generated rule (represented as map that maps * line number to mode and contents (string)). * * NOTE: can be changed to hashtbl if needed. Just also need to * - make the record field mutable. * - in get_result, need to sort by line number when extracting the lines. *) (* add the value in v to the entry that has i as key *) let add_map (v : string) (i : int) (m : mode) (r : (mode * string) IntMap.t) = if IntMap.mem i r then let (_, cur) = IntMap.find i r in IntMap.add i (m, cur ^ v) r else IntMap.add i (m, v) r (* add the value in v to the current line entry, possibly changing arity. *) let add_result (v : string) (a : arity option) (snp : t) = let (r, i, m) = (snp.result, snp.current_line, set_arity snp.current_mode a) in if snp.disj_mode then begin match snp.disj_result with | Some d -> { snp with result = add_map v i m r; disj_result = Some (add_map v i m d) } | None -> { snp with result = add_map v i m r } end else { snp with result = add_map v i m r } (* add to current line *) let add_with_arity value arity = add_result value (Some (to_a arity)) let add value = add_result value None (* ------------------------------------------------------------------------- *) (* STATE: POSITION FUNCTIONS *) (* generate a position and add it to the internal list. * return the name of the new position and the modified snapshot. *) let add_position snp = let pos_name = Globals.get_pos_name() in let newpos = pos_name ^ (string_of_int snp.pos_counter) in let newsnp = if fst snp.freeze_pos then { snp with positions = StringSet.add newpos snp.positions; freeze_pos = (true, true) (* set dirty bit, because adding position *) } else { snp with pos_counter = snp.pos_counter + 1; positions = StringSet.add newpos snp.positions; } in (newpos, newsnp) (* set the freeze position flag to b. * if we're ending a freeze period AND one position was added during this time * (aka the dirty flag), then we need to increment the counter. * TODO: nested freezes in e.g. nested disjunctions are VERY error-prone. *) let set_freeze_pos b snp = let (freez,dirty) = snp.freeze_pos in if freez && dirty && not(b) then { snp with freeze_pos = (b,false); pos_counter = snp.pos_counter + 1; } else { snp with freeze_pos = (b,false) } (* do fn (t -> t) while position incrementing is frozen. * this is e.g. used in disjunctions where we want all cases to have the * same position. *) let do_freeze_pos fn snp = let (current,_) = snp.freeze_pos in set_freeze_pos current (fn (set_freeze_pos true snp)) (* ------------------------------------------------------------------------- *) (* STATE: DISJUNCTION FUNCTIONS *) (* get the bool list for the disjunction starting at line l. *) let get_disj l snp = Detect_patch.get_disj_patch l snp.disj_map (* start generation of disjunction rule, copy the existing generated rule *) let init_disj_result snp = match snp.disj_result with | Some s -> snp | None -> { snp with disj_result = Some snp.result } let set_disj_mode b snp = { snp with disj_mode = b } (* ------------------------------------------------------------------------- *) (* STATE: WHENCODES FUNCTIONS *) (* We never want to add stars or positions to whencodes, so we keep track of * whether we are currently inside a whencode (and they may be nested). *) let inc_whencode snp = { snp with whencode_nest = snp.whencode_nest + 1 } let dec_whencode snp = { snp with whencode_nest = snp.whencode_nest - 1 } let in_whencode snp = snp.whencode_nest <> 0 let do_whencode fn snp = dec_whencode (fn (inc_whencode snp)) (* ------------------------------------------------------------------------- *) (* STATE: NO GEN *) (* if no_gen flag is set, unparse the AST0 as normal, don't insert positions * or forced newlines. *) let set_no_gen b snp = { snp with no_gen_mode = b } (* do not add positions or newlines if ... *) let no_gen snp = in_whencode snp || snp.no_gen_mode (* ------------------------------------------------------------------------- *) (* STATE: GETTERS *) let get_positions snp = StringSet.elements snp.positions (* Returns the map as a string list, sorted by key and the same for * the disjunction result if any. *) let get_result snp = let transform x no_mode = List.map (fun (_,(c,s)) -> if no_mode then s else (tostring_mode c) ^ s) (IntMap.bindings x) in match snp.disj_result with | Some d -> (transform snp.result true, Some (transform d false)) | None -> (transform snp.result false, None) coccinelle-1.0.4/tools/spgen/source/disj_generator.mli0000644000175000017500000001037212614153277022075 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Handles disjunctions. * Disjunctions need special rule generation hence the separate module: * - The positions have to be the same over each disjunction case. Therefore * there can at most be generated one position per disjunction case. Also, * it has to be the exact same position for all cases. * * - Disjunctions can be used for pattern matching in Coccinelle rules, where * only some cases are matched/patched. However, this may create false * positives when generating a context rule from a patch rule. Therefore two * rules have to be generated (aka the ugly part). * This is the case when there is: * - something interesting outside the disjunction * - something uninteresting inside the disjunction * - something interesting inside the disjunction * * - Disregard the above rule in cases where there is no risk of false * positives - e.g. if the disjunction is the only thing in the rule. * Determined by at_top flag. * * ---------------------------------------------------------------------------- * Example of rule splitting: * * @disj@ expression n; identifier x; @@ * * - x = call(x); * ( * some_function(0); * | * - some_function(n); * + some_function(x); * ) * * The following would NOT work: * * @disj@ expression n; identifier x; position p1,p2; @@ * * * x@p1 = call(x); * ( * some_function(0); * | * * some_function@p2(n); * ) * * because that would match even when some_function is called on 0 (due to the * first star) which we don't want. Instead we want two rules: * * @disj1@ expression n; identifier x; position p1,p2; @@ * * x@p1 = call(x); * ( * some_function(0); * | * some_function@p2(n); * ) * * @disj2@ expression n; identifier x; position disj1.p1, disj1.p2 @@ * * * x@p1 = call(x); * * some_function@p2(n); * * which would match if and only if n is not 0 (in this particular example). *) (* ------------------------------------------------------------------------- *) (* DISJ GENERATION FUNCTIONS *) (* These types are just aliases for functions that take some AST0 component and * a snapshot, handle the component with regards to the input snapshot and * return the resulting snapshot. *) type statement_dots_fn = Ast0_cocci.statement Ast0_cocci.dots -> Snapshot.t -> Snapshot.t type string_fn = string Ast0_cocci.mcode -> Snapshot.t -> Snapshot.t type statement_fn = Ast0_cocci.statement -> Snapshot.t -> Snapshot.t type expression_fn = Ast0_cocci.expression -> Snapshot.t -> Snapshot.t type ident_fn = Ast0_cocci.ident -> Snapshot.t -> Snapshot.t type declaration_fn = Ast0_cocci.declaration -> Snapshot.t -> Snapshot.t (* These functions take a disjunction component (stmt, expr, ident, decl) and a * snapshot + some other things, and perform the disjunction rule generation. * Fails if the disjunction component is NOT a disjunction. * * All functions take: * - strfn: a function to handle string_mcodes. * - some Ast0 component, ie. the thing that contains the disjunction. * - some function to handle the Ast0 component. * - at_top: a flag that indicates whether it is safe to just generate one * rule, even though the disjunction uses pattern matching. * * Return: * - an updated snapshot with the inserted disjunction, possibly an extra * disjunction rule if needed. *) val generate_statement : stmtdotsfn:statement_dots_fn -> strfn:string_fn -> stmtfn:statement_fn -> stmt:Ast0_cocci.statement -> at_top:bool -> Snapshot.t -> Snapshot.t val generate_expression : strfn:string_fn -> exprfn:expression_fn -> expr:Ast0_cocci.expression -> at_top:bool -> Snapshot.t -> Snapshot.t val generate_ident : strfn:string_fn -> identfn:ident_fn -> ident:Ast0_cocci.ident -> at_top:bool -> Snapshot.t -> Snapshot.t val generate_declaration : strfn:string_fn -> declfn:declaration_fn -> decl:Ast0_cocci.declaration -> at_top:bool -> Snapshot.t -> Snapshot.t coccinelle-1.0.4/tools/spgen/source/spgen_interactive.mli0000644000175000017500000000161312614153277022605 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Get user input from interactive (commandline) mode. * Returns the user input, formatted for use, and gives the user the * opportunity to save the input in a config file. *) (* ------------------------------------------------------------------------- *) (* INTERACTION FUNCTIONS *) (* Launches interactive mode. * * Arguments: * - rule_names are the names of all */+/- rules * - config_name is the suggested name for persisting the user input. * * Returns: * - preface (description, comments, etc.) formatted for use in a string * - a list of user inputs, one per rule *) val interact : rule_names:string list -> config_name:string -> User_input.t coccinelle-1.0.4/tools/spgen/source/spgen_test.mli0000644000175000017500000000042712614153277021251 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) val regression_test : test_dir:string -> unit coccinelle-1.0.4/tools/spgen/source/position_generator.mli0000644000175000017500000000270012614153277023004 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Given some Ast0 component x, generates a position at an appropriate place * and returns * - Some (x,snp), where x has an inserted metaposition and snp is the updated snapshot. * - None, if no position could be generated (this is the case in e.g. dots * (...) because they don't really have a well-defined position). * * "appropriate place" means usually after an id if possible. * The added position is always in an Ast0.PLUS context (using the fact * that a metaposition in the original script is NEVER in plus context). * * Note that it might return Some even if no position was inserted * if the component is optional (ie. on a line preceded with ? in SmPL) *) (* ------------------------------------------------------------------------- *) (* POSITION GENERATION FUNCTIONS *) val ident_pos : Ast0_cocci.ident -> Snapshot.t -> Ast0_cocci.ident * Snapshot.t val expression_pos : Ast0_cocci.expression -> Snapshot.t -> (Ast0_cocci.expression * Snapshot.t) option val declaration_pos : Ast0_cocci.declaration -> Snapshot.t -> (Ast0_cocci.declaration * Snapshot.t) option val statement_pos : Ast0_cocci.statement -> Snapshot.t -> (Ast0_cocci.statement * Snapshot.t) option coccinelle-1.0.4/tools/spgen/source/meta_variable.mli0000644000175000017500000000333312614153277021670 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Extract all metavariables used in a rule. We can't really use the metavars * returned by the parser since a lot of them are missing. * This also means that metavariables declared in the header but unused in the * rule are not included. *) (* ------------------------------------------------------------------------- *) (* META_VARIABLE FUNCTIONS *) type t (* make a metavariable. * - inherit_rule: if the metavariable is declared in a different rule than it * appears in, set this to that rule's name. Default is "" (not inherited). * - constraints: e.g "!=0" (default to ""). * - typ: type of the metavariable. *) val make : ?inherit_rule:string -> ?constraints:string -> typ:string -> string (* metavariable name *) -> t (* getters *) val get_rule : t -> string val get_name : t -> string val tostring_mv : t -> string (* forces inheritance if the metavar is not already inherited *) val inherit_rule : new_rule:string -> t -> t (* prints the metavariable in the format used in rule headers to out_channel *) val print : out_channel -> t -> unit (* prints the metavariables in the format used in rule headers to out_channel. * if do_group, group by type. *) val print_list : out_channel -> do_group:bool -> t list -> unit (* Given the minus abstract syntax tree (Ast0) for a rule, extracts all * metavariables used in the rule. * Rulename used to determine whether the metavariables are inherited or not. *) val extract : minus_rule:Ast0_cocci.rule -> rule_name:string -> t list coccinelle-1.0.4/tools/spgen/source/meta_variable.ml0000644000175000017500000005220112614153277021515 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module TC = Type_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module S = Ast_tostring (* ------------------------------------------------------------------------- *) (* Takes a minus AST0 and extracts all metavariables used in the rule. * * In general, the metavariable layout is * (type, (inherit_rule, metaname), constraints) * e.g. parameter list[rule1.n] P is ("parameter list[rule1.n]", ("","P"), "") * and position free.p1!=loop.ok is ("position", ("free", "p1"), "!=loop.ok") * * NOTE: inherit_rule is only for inherited rules, ie. akin to "rulename.mv". * If the metavariable is in local scope, inherit_rule will be "". * * Named arguments in here: * - rn is the rulename (string) * - mc is an Ast0.mcode ('a mcode) * - mn is an Ast.meta_name (type alias for (rule_name, metavar_name) tuple) * - typ/before is the type (string), put in the type spot * - constr/after is the constraint (string), put in the constraints spot * - listlen is a list_len (Ast.list_len) *) (* ------------------------------------------------------------------------- *) (* TYPES AND HELPERS *) type meta_variable = string * (string * string) * string let make_mv typ (rule, name) constr = (typ, (rule,name), constr) (* If the externally specified rulename is the same as the internal rulename * (ie. the one attached to the metavariable) OR the external rulename is * nameless ("rule starting on line ..."), then there is no inheritance * required; ie. return true. *) let no_inherit extern intern = extern = intern || String.contains extern ' ' let name_str ~rn (r, mn) = if no_inherit r rn then mn else r ^ "." ^ mn let name_tup ~rn (r, mn) = if no_inherit r rn then ("", mn) else (r, mn) let str_tup str = ("", str) let tostring_mv (t, rnm, c) = let full_name = name_str ~rn:"" rnm in String.concat "" [t; full_name; c] (* the type used and returned by the visitor. * we're using a set to eliminate duplicates, since a metavariable might * appear several times in a rule, but we only want it declared once. *) module MVSet = Set.Make( struct type t = meta_variable (* we use the normal string comparison, except if the string starts with * "type", "typedef" or "identifier" in which case it comes before others. * This is to ensure that types and identifiers get printed first since * other metavariables might be dependent on them. *) let compare (t1,(_,n1),_) (t2,(_,n2),_) = let starts_with s c = Str.string_match (Str.regexp ("^"^s)) c 0 in let is_type = starts_with "type" in let is_identifier = starts_with "identifier" in match (is_type t1, is_type t2) with | true, false -> -1 | false, true -> 1 | true, true -> String.compare n1 n2 | false, false -> (match (is_identifier t1, is_identifier t2) with | true, false -> -1 | false, true -> 1 | _ -> String.compare n1 n2 ) end ) (* ------------------------------------------------------------------------- *) (* STRING HELPERS *) (* These functions take subcomponents of the AST0 and turn them into * pretty strings for printing. * ALL FUNCTIONS HERE RETURN STRINGS *) (* get string formatted version of type (used as front of meta expressions) *) let type_c ~form = (* TODO: figure out when default and prefix are used ... *) let (default, prefix) = match form with | Ast.ANY -> ("expression ", "") | Ast.ID -> ("idexpression ", "idexpression ") | Ast.LocalID -> ("local idexpression ", "local idexpression ") | Ast.GlobalID -> ("global idexpression ", "global idexpression ") | Ast.CONST -> ("constant ", "constant ") in let type2c a = match TC.type2c a with | "unknown *" -> default ^ " *" | a -> prefix ^ a in function | Some [a] -> type2c a | Some a -> prefix ^ ("{" ^ (String.concat "," (List.map type2c a)) ^ "} ") | None -> default (* TODO: in SeedId, we sometimes (?) want to keep the rulename; but not if it * has been declared before? *) let seed ~rn = let se = function | Ast.SeedString s -> "\"" ^ s ^ "\"" | Ast.SeedId (r,nm) -> nm in function | Ast.NoVal -> "" | Ast.StringSeed s -> " = \"" ^ s ^ "\"" | Ast.ListSeed s -> " = " ^ (String.concat " ## " (List.map se s)) let regex_constraint = function | Ast.IdRegExp (s,r) -> " =~ \"" ^ s ^ "\"" | Ast.IdNotRegExp (s,r) -> " !~ \"" ^ s ^"\"" let list_constraints ~tostring_fn ~op = function | [] -> "" | [x] -> op ^ (tostring_fn x) | x -> op ^ "{" ^ (String.concat "," (List.map tostring_fn x)) ^ "}" let id_constraint ~rn = let list_constraints' slist mnlist op = let combined = (List.map (fun x -> "\"" ^ x ^ "\"") slist) @ (List.map (name_str ~rn) mnlist) in list_constraints ~tostring_fn:(fun x -> x) ~op combined in function | Ast.IdNoConstraint -> "" | Ast.IdPosIdSet(slist,mnlist) -> list_constraints' slist mnlist " = " | Ast.IdNegIdSet(slist,mnlist) -> list_constraints' slist mnlist " != " | Ast.IdRegExpConstraint(re) -> regex_constraint re let id_constraint ~rn = let list_constraints' slist mnlist op = let combined = (List.map (fun x -> "\"" ^ x ^ "\"") slist) @ (List.map (name_str ~rn) mnlist) in list_constraints ~tostring_fn:(fun x -> x) ~op combined in function | Ast.IdNoConstraint -> "" | Ast.IdPosIdSet(slist,mnlist) -> list_constraints' slist mnlist " = " | Ast.IdNegIdSet(slist,mnlist) -> list_constraints' slist mnlist " != " | Ast.IdRegExpConstraint(re) -> regex_constraint re let constraints ~rn = function Ast0.NoConstraint -> "" | Ast0.NotIdCstrt recstr -> regex_constraint recstr | Ast0.NotExpCstrt exps -> (* exps is a list of expressions, but it is limited to numbers and ids * (e.g. expression e != {0,1,n,4l}). See parser entry for NotExpCstrt. *) let stringify e = (match Ast0.unwrap e with | Ast0.Constant c -> S.constant_tostring (Ast0.unwrap_mcode c) | Ast0.Ident {Ast0.node = Ast0.Id m; _} -> Ast0.unwrap_mcode m | _ -> failwith ("Error: Non-int/id exp constraints not supported. " ^ "Should have failed in the parser.") ) in let res = List.map stringify exps in list_constraints ~tostring_fn:(fun x -> x) ~op:" != " res | Ast0.SubExpCstrt mns -> list_constraints ~tostring_fn:(name_str ~rn) ~op:" <= " mns let assign_constraints = function | Ast0.AssignOpNoConstraint -> "" | Ast0.AssignOpInSet l -> list_constraints ~tostring_fn:Ast0.string_of_assignOp ~op:" = " l let binary_constraints = function | Ast0.BinaryOpNoConstraint -> "" | Ast0.BinaryOpInSet l -> list_constraints ~tostring_fn:Ast0.string_of_binaryOp ~op:" = " l let list_len ~rn = function | Ast0.AnyListLen -> " " | Ast0.MetaListLen (mn,_,_,_,_,_) -> "[" ^ (name_str ~rn mn) ^ "] " | Ast0.CstListLen i -> "[" ^ (string_of_int i) ^ "] " (* ------------------------------------------------------------------------- *) (* MSET HELPERS *) (* These functions take subcomponents of the AST0 and turn them into MVSets of * prettily formatted strings, ready to be bound in the combiner. * ALL FUNCTIONS HERE RETURN META_VARIABLE MVSET.T *) (* Scours an optional list of type_c's for meta types and meta identifiers * used in the types. If the type_c's have dependencies to other metavariables, * we need to declare those metavariables as well of course. *) let types ~rn = function | Some typecs -> (* TODO: are the keep_bindings used for anything ? *) let bin = function | TC.Unitary -> "" | TC.Nonunitary -> "" | TC.Saved -> "" in let get_meta_id acc = function | TC.MV(mn, b, _) -> let metavar = make_mv "identifier" (name_tup ~rn mn) (bin b) in MVSet.add metavar acc | _ -> acc in let rec get_meta_type acc = function | TC.MetaType(mn, b, _) -> let metavar = make_mv "type " (name_tup ~rn mn) (bin b) in MVSet.add metavar acc | TC.TypeName s -> let metavar = ("typedef ", str_tup s, "") in MVSet.add metavar acc | TC.Decimal(nm1, nm2) -> MVSet.union (get_meta_id acc nm1) (get_meta_id acc nm2) | TC.EnumName n | TC.StructUnionName(_, n) -> get_meta_id acc n | TC.ConstVol (_, t) | TC.SignedT (_, Some t) | TC.Pointer t | TC.FunctionPointer t | TC.Array t -> get_meta_type acc t | _ -> acc in List.fold_left get_meta_type MVSet.empty typecs | None -> MVSet.empty (* Function to call on mcodes. We are only interested in the mcodes because of * the positions/metavars that might be attached to them. * Note that attached metavariables might have metavariables attached to * themselves as well! *) let mcode ~rn ~mc:(_,_,_,_,pos,_) = let rec add_one_pos set = (* adds the mn metavar + any metapositions attached to it to the set. *) let handle_metavar ~typ ~mn ~positions ~set = let mv = make_mv typ (name_tup ~rn mn) "" in let added_mv_set = MVSet.add mv set in MVSet.union added_mv_set (add_all_pos positions) in (* extracting the node is equivalent to calling Ast0.unwrap *) function | Ast0.ExprTag {Ast0.node = Ast0.MetaExpr((mn,_,_,_,p,_),_,_,_,_); _} -> handle_metavar ~typ:"expression " ~mn ~positions:!p ~set | Ast0.StmtTag {Ast0.node = Ast0.MetaStmt((mn,_,_,_,p,_),_); _} -> handle_metavar ~typ:"statement " ~mn ~positions:!p ~set | Ast0.DeclTag {Ast0.node = Ast0.MetaDecl((mn,_,_,_,p,_),_); _} -> handle_metavar ~typ:"declaration " ~mn ~positions:!p ~set | Ast0.IdentTag {Ast0.node = Ast0.MetaId((mn,_,_,_,p,_),_,_,_); _} -> handle_metavar ~typ:"identifier " ~mn ~positions:!p ~set | Ast0.TypeCTag {Ast0.node = Ast0.MetaType((mn,_,_,_,p,_),_); _} -> handle_metavar ~typ:"type " ~mn ~positions:!p ~set | Ast0.MetaPosTag(Ast0.MetaPos((mn,_,_,_,_,_), mns, colt)) -> let constr = list_constraints ~tostring_fn:(name_str ~rn) ~op:" != " mns in let collect = (match colt with Ast.PER -> "" | Ast.ALL -> " any") in let pos = make_mv "position " (name_tup ~rn mn) (constr ^ collect) in MVSet.add pos set | _ -> failwith "should only have metavariables in here." and add_all_pos lst = List.fold_left add_one_pos MVSet.empty lst in add_all_pos !pos (* turns mcode into MVSet of formatted strings. * (mc : 'a mcode) is the mcode, * (totup_fn : 'a -> string * string) formats the mcode value. *) let mc_format ~rn ~mc:((mn,_,_,_,_,_) as mc) ~totup_fn ~before ~after = let pos = mcode ~rn ~mc in let mv = make_mv before (totup_fn mn) after in MVSet.add mv pos let as_format a b afn bfn = failwith "\"as\" metavariables not supported" (* turns meta_name mcode with list information into MVSet of formatted strings. * (mc : Ast.meta_name mcode) becomes . *) let list_format ~rn ~before ~mc:((mn,_,_,_,_,_) as mc) ~listlen = let pos = mcode ~rn ~mc in let mvname = name_tup ~rn mn in let mv = make_mv (before ^ (list_len ~rn listlen)) mvname "" in MVSet.add mv pos (* for iterators and declarers *) let ids ~rn ~typ ~id = match Ast0.unwrap id with | Ast0.Id mc -> mc_format ~rn ~mc ~totup_fn:str_tup ~before:(typ ^ " name ") ~after:"" | Ast0.MetaId (mc, idconstr, s, _) -> (* ever seed here? *) let idconstr = id_constraint ~rn idconstr in let totup_fn = name_tup ~rn in mc_format ~rn ~mc ~totup_fn ~before:(typ ^ " ") ~after:idconstr | _ -> failwith (typ ^ " with non-(Id/MetaId). dunno what this means") (* ------------------------------------------------------------------------- *) (* THE COMBINER *) (* MVSet Visitor_ast0_types.combiner_rec_functions * Using the flat combiner from Visitor_ast0 *) let metavar_combiner rn = let option_default = MVSet.empty in let bind x y = MVSet.union x y in (* the mcodes might contain positions which should be declared as metavars *) let mcode mc = mcode ~rn ~mc in let meta_mcode a = failwith ("NOT ALLOWED") in (* should be handled before *) let string_mcode = mcode in let const_mcode = mcode in let simpleAssign_mcode = mcode in let opAssign_mcode = mcode in let fix_mcode = mcode in let unary_mcode = mcode in let arithOp_mcode = mcode in let logicalOp_mcode = mcode in let cv_mcode = mcode in let sign_mcode = mcode in let struct_mcode = mcode in let storage_mcode = mcode in let inc_mcode = mcode in (* apply the passed function, do nothing else *) let donothing c fn v = fn v in let dotsexprfn = donothing in let dotsinitfn = donothing in let dotsparamfn = donothing in let dotsstmtfn = donothing in let dotsdeclfn = donothing in let dotscasefn = donothing in let forinfofn = donothing in let casefn = donothing in let topfn = donothing in (* --- These are shortened formatting functions that return MVSets --- *) (* Formats as where mn is extracted from meta_name mcode mc *) let meta_mc_format ~mc ~typ ~constr = mc_format ~rn ~mc ~totup_fn:(name_tup ~rn) ~before:typ ~after:constr in (* Formats as where str is extracted from string mcode mc *) let str_mc_format ~mc ~typ = mc_format ~rn ~mc ~totup_fn:str_tup ~before:typ ~after:"" in (* Formats as , mn extracted from meta_name mcode mc *) let lst_format ~mc ~typ ~listlen = list_format ~rn ~before:typ ~mc ~listlen in (* --- Implementations of functions that handle possible metavariables --- *) let identfn c fn v = match Ast0.unwrap v with | Ast0.MetaId(mc, idconstr, s, _) -> let constr = id_constraint ~rn idconstr in let seed = seed ~rn s in if seed = "" then (* if it has a seed then it is fresh ... ? *) meta_mc_format ~mc ~typ:"identifier " ~constr else meta_mc_format ~mc ~typ:"fresh identifier " ~constr:(constr ^ seed) | Ast0.MetaFunc(mc, idconstr, _) -> let constr = id_constraint ~rn idconstr in meta_mc_format ~mc ~typ:"function " ~constr | Ast0.MetaLocalFunc(mc, idconstr, _) -> let constr = id_constraint ~rn idconstr in meta_mc_format ~mc ~typ:"local function " ~constr | _ -> fn v in let stmtfn c fn v = match Ast0.unwrap v with | Ast0.MetaStmt (mc, pure) -> meta_mc_format ~mc ~typ:"statement " ~constr:"" | Ast0.MetaStmtList (mc, pure) -> meta_mc_format ~mc ~typ:"statementlist[]" ~constr:"" | Ast0.AsStmt (s1, s2)-> let stmt = c.VT0.combiner_rec_statement in as_format s1 s2 stmt stmt | Ast0.Iterator (id, _, expdots, _, stmt,_) -> let expids = c.VT0.combiner_rec_expression_dots expdots in let stmtid = MVSet.union expids (c.VT0.combiner_rec_statement stmt) in let iteids = ids ~rn ~typ:"iterator" ~id in MVSet.union iteids stmtid | _ -> fn v in let exprfn c fn v = let exprfn = c.VT0.combiner_rec_expression in match Ast0.unwrap v with | Ast0.MetaErr (mc, constr, _) -> let constr = constraints ~rn constr in meta_mc_format ~mc ~typ:"error " ~constr | Ast0.MetaExpr (mc, constr, typeclist, form, _) -> (* types function finds metavariable types and identifiers that were * used in this expression and therefore need to be declared. *) let types = types ~rn typeclist in (* type_c function returns the types in pretty string format *) let typ = type_c ~form typeclist in let constr = constraints ~rn constr in MVSet.union (meta_mc_format ~mc ~typ ~constr) (types) | Ast0.MetaExprList (mc, listlen, _) -> lst_format ~mc ~typ:"expression list" ~listlen | Ast0.AsExpr (e1, e2) -> as_format e1 e2 exprfn exprfn | Ast0.AsSExpr (e1, s2) -> as_format e1 s2 exprfn stmtfn | _ -> fn v in let assignOpfn c fn v = match Ast0.unwrap v with | Ast0.MetaAssign (mc, constr, pure) -> let constr = assign_constraints constr in meta_mc_format ~mc ~typ:"assignment operator " ~constr | _ -> fn v in let binaryOpfn c fn v = match Ast0.unwrap v with | Ast0.MetaBinary (mc, constr, pure) -> let constr = binary_constraints constr in meta_mc_format ~mc ~typ:"binary operator " ~constr | _ -> fn v in let tyfn c fn v = match Ast0.unwrap v with | Ast0.MetaType (mc, pure) -> meta_mc_format ~mc ~typ:"type " ~constr:"" | Ast0.AsType (tc1, tc2) -> let ty = c.VT0.combiner_rec_typeC in as_format tc1 tc2 ty ty (* this clause generates unparsable scripts for who knows what reason ... * TODO: need to find out if it should be included or not. For now, ignore. *) | Ast0.TypeName mc -> let _ = str_mc_format ~mc ~typ:"typedef " in fn v | _ -> fn v in let initfn c fn v = match Ast0.unwrap v with | Ast0.MetaInit(mc, pure) -> meta_mc_format ~mc ~typ:"initializer " ~constr:"" | Ast0.MetaInitList(mc, listlen, pure) -> lst_format ~mc ~typ:"initializer list " ~listlen | Ast0.AsInit(i1,i2) -> let ini = c.VT0.combiner_rec_initialiser in as_format i1 i2 ini ini | _ -> fn v in let paramfn c fn v = match Ast0.unwrap v with | Ast0.MetaParam(mc, pure) -> meta_mc_format ~mc ~typ:"parameter " ~constr:"" | Ast0.MetaParamList(mc, listlen, pure) -> lst_format ~mc ~typ:"parameter list" ~listlen | Ast0.AsParam (ptd,ex) -> let par = c.VT0.combiner_rec_parameter in let expr = c.VT0.combiner_rec_expression in as_format ptd ex par expr | _ -> fn v in let declfn c fn v = match Ast0.unwrap v with | Ast0.MetaDecl(mc, pure) -> meta_mc_format ~mc ~typ:"declaration " ~constr:"" | Ast0.MetaField(mc, pure) -> meta_mc_format ~mc ~typ:"field " ~constr:"" | Ast0.MetaFieldList (mc, listlen, pure) -> lst_format ~mc ~typ:"field list" ~listlen | Ast0.AsDecl(dc1, dc2) -> let dec = c.VT0.combiner_rec_declaration in as_format dc1 dc2 dec dec | Ast0.MacroDecl(_, id, _, expdots, _, _) -> let expids = c.VT0.combiner_rec_expression_dots expdots in MVSet.union (ids ~rn ~typ:"declarer" ~id) expids | Ast0.MacroDeclInit(_, id, _, expdots, _, _, ini, _) -> let expids = c.VT0.combiner_rec_expression_dots expdots in let inid = MVSet.union expids (c.VT0.combiner_rec_initialiser ini) in let declids = ids ~rn ~typ:"declarer" ~id in MVSet.union declids inid | _ -> fn v in let string_fragmentfn c fn v = match Ast0.unwrap v with | Ast0.MetaFormatList(_, mc, listlen) -> lst_format ~mc ~typ:"format list" ~listlen | Ast0.FormatFragment(_, format) -> (match Ast0.unwrap format with | Ast0.MetaFormat(mc, idconstr) -> let constr = id_constraint rn idconstr in meta_mc_format ~mc ~typ:"format " ~constr | _ -> fn v ) | _ -> fn v in V0.flat_combiner bind option_default meta_mcode string_mcode const_mcode simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn binaryOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn topfn (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) type t = meta_variable let make ?(inherit_rule = "") ?(constraints = "") ~typ meta_name = make_mv typ (inherit_rule, meta_name) constraints let get_rule (_,(r,_),_) = r let get_name (_,(_,nm),_) = nm (* forces rule inheritance (except if rule is already inherited). *) let inherit_rule ~new_rule ((a,(b,c),d) as mv) = if b = "" then (a,(new_rule,c),d) else mv let print out mv = output_string out (tostring_mv mv) (* prints the strings in the set on separate lines, ended with semicolons. * if do_group, group all metavars of same type on the same line. *) let print_list out ~do_group mvs = let group_by_type mvs = let rec group acc = function | [] -> acc | ((t,_,_)::ls as b) -> let (same, rest) = List.partition (fun (x,_,_) -> t = x) b in group ((t, same) :: acc) rest in let collapse_group (typ, lst) = let mvs = List.map (fun (_,b,c) -> tostring_mv ("",b,c)) lst in typ ^ (String.concat ", " mvs) in List.rev_map collapse_group (group [] mvs) in if do_group then begin let grouped = group_by_type mvs in List.iter (fun b -> output_string out (b ^ ";\n")) grouped end else List.iter (fun b -> output_string out ((tostring_mv b) ^ ";\n")) mvs (* takes abstract syntax trees for a rule and extract all metavariables. * That is, metavariables declared in the header, but unused in the body, are * discarded. Returns list of meta_variable.t's. *) let extract ~minus_rule ~rule_name = let mvcomb = metavar_combiner rule_name in let minus = List.map mvcomb.VT0.combiner_rec_top_level minus_rule in let comb = List.fold_left MVSet.union MVSet.empty minus in MVSet.elements comb coccinelle-1.0.4/tools/spgen/source/context_rule.ml0000644000175000017500000000526012614153277021440 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module MV = Meta_variable (* ------------------------------------------------------------------------- *) (* Generates a context mode rule with metapositions and stars! * May generate an extra disjunction rule if the original rule calls for it. *) (* ------------------------------------------------------------------------- *) (* CONTEXT RULE GENERATION FUNCTIONS *) type t = (Rule_header.t * Rule_body.t) list let generate ~context_mode ~disj_map ~new_name ~rule = match rule with | Ast0.InitialScriptRule (nm,_,_,_,_) | Ast0.FinalScriptRule (nm,_,_,_,_) | Ast0.ScriptRule (nm,_,_,_,_,_) -> failwith ("Internal error: Can't generate a context rule for a script rule! " ^ "The rule is: " ^ nm) | Ast0.CocciRule ((minus_rule,_,(isos,drop_isos,deps,old_nm,exists)),_,_) -> let context_nm = Globals.get_context_name ~context_mode new_name in let disj_nm = Globals.get_disj_name new_name in let meta_vars = MV.extract ~minus_rule ~rule_name:old_nm in let deps = Globals.add_context_dependency ~context_mode deps in let rh_fn = Rule_header.generate ~isos ~drop_isos ~deps ~meta_vars in let (pos, (context_body, disj)) = Rule_body.generate ~context_mode ~disj_map ~minus_rule in let _ = if pos = [] then failwith ("MEGA ERROR: Congratulations! You managed to write a Coccinelle " ^ "rule that spgen was unable to add a position to! The rule is \"" ^ old_nm ^ "\".") in (* the added position metavariables in local scope (for headers) *) let pos_mv = List.map (MV.make ~typ:"position ") pos in (* the added position metavariables in inherited scope (for scripts) *) let pos_inh = List.map (MV.inherit_rule ~new_rule:context_nm) pos_mv in match disj with | None -> let context_header = rh_fn ~exists ~rule_name:context_nm ~meta_pos:pos_mv in ([(context_header, context_body)], pos_inh) | Some disj_body -> (* context rule has no stars, therefore "exists" in header *) let context_header = rh_fn ~rule_name:context_nm ~exists:Ast.Exists ~meta_pos:pos_mv in let disj_header = rh_fn ~rule_name:disj_nm ~exists ~meta_pos:pos_inh in ([(context_header, context_body); (disj_header, disj_body)], pos_inh) let print out l = List.iter (fun (rh,rb) -> Rule_header.print out rh; Rule_body.print out rb) l coccinelle-1.0.4/tools/spgen/source/spgen_test.ml0000644000175000017500000001605712614153277021106 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ------------------------------------------------------------------------- *) (* Regression tests. * Process for spgen: * - file.cocci (original cocci file) * - file.config (config file for running spgen) * - file.expected (expected spgenerated file) * * Run * Compare file.actual.cocci with file.expected * Run . *) (* ------------------------------------------------------------------------- *) (* some common functions *) let spf = Common.spf (* Printf.sprintf *) let perr_nl = prerr_endline (* Common.pr2 *) let perr = prerr_string (* Common.pr_no_nl *) let dbe2nm = Common.filename_of_dbe (* (path,file,ext) -> path/file.ext *) let nm2dbe = Common.dbe_of_filename (* path/file.ext -> (path,file,ext) *) (* hardcoded values; timeout for testing + extension names *) let timeout_per_file = 60 let exp_ext = "expected" let act_ext = "actual.cocci" let score_ext = "score" (* marshalling format used by Common *) (* ------------------------------------------------------------------------- *) (* more or less the same as in coccinelle/parsing_c/compare_c.ml. * diff flags are * -u: unified format (ie. output diffs with - and +) * -b: ignore changes in amount of whitespace * -B: ignore changes in blank lines *) let get_diff filename1 filename2 = let com = spf "diff -u -b -B %s %s" filename1 filename2 in let xs = Common.cmd_to_list com in (* get rid of the --- and +++ lines *) if xs = [] then xs else Common.drop 2 xs (* Run spgen on .cocci with .config, * compare to .expected, * add result to . *) let compare_one score expected = let (dir, base, ext) = nm2dbe expected in let hashkey = base ^ "." ^ ext in let actual = dbe2nm (dir, base, act_ext) in let cocci = dbe2nm (dir, base, "cocci") in let config = dbe2nm (dir, base, "config") in if ext <> exp_ext then failwith ("expected extension "^exp_ext^", not "^ext); if not(Sys.file_exists cocci) then failwith ("no cocci for " ^ expected); if not(Sys.file_exists config) then failwith ("no config for " ^ expected); try Common.timeout_function timeout_per_file ( fun () -> perr_nl cocci; (* spgenerate the file *) let options = Spgen.make_options ~output:actual cocci in let _ = Spgen.run options in (* check that the spgenerated file is parsable. Note that the parsing * flag generating_mode must be false (this should be done in spgen.ml). *) Flag.set_defined_virtual_rules "context"; let _ = Parse_cocci.process actual None false in match get_diff actual expected with | [] -> let _ = if Sys.file_exists actual then Sys.remove actual in Hashtbl.add score hashkey Common.Ok | difflist -> let difflist = List.map (spf " %s\n") difflist in let difflist = String.concat "" difflist in let diff = spf "INCORRECT: %s\n diff (actual vs expected) = \n%s" actual difflist in Hashtbl.add score hashkey (Common.Pb diff) ) with exn -> let s = spf "PROBLEM\n exn = %s\n" (Printexc.to_string exn) in Hashtbl.add score hashkey (Common.Pb s) (* Prints regression test statistics and information + updates score files. * (perhaps split, but then also have to refactor Common.regression_testing_vs) * * The directory in which the regression test files are stored * The new test information * Similar to coccinelle/testing.ml, but with less stuff. *) let print_update_regression test_dir score = if Hashtbl.length score <= 0 then failwith "There are no tests results ..."; let expected_score_file = dbe2nm (test_dir, "SCORE_expected", score_ext) in let best_of_both_file = dbe2nm (test_dir, "SCORE_best_of_both", score_ext) in let actual_score_file = dbe2nm (test_dir, "SCORE_actual", score_ext) in perr_nl "--------------------------------"; perr_nl "statistics"; perr_nl "--------------------------------"; let print_result (filename, result) = perr (spf "%-40s: " filename); perr ( match result with | Common.Ok -> "CORRECT\n" | Common.Pb s -> s ) in (* hash_to_list also sorts the entries by filename *) List.iter print_result (Common.hash_to_list score); perr_nl "--------------------------------"; perr_nl "regression testing information"; perr_nl "--------------------------------"; perr_nl ("regression file: "^ expected_score_file); let expected_score = if Sys.file_exists expected_score_file then Common.load_score expected_score_file() else let s = Common.empty_score() in let _ = Common.save_score s expected_score_file in s in (* find and print changes in test results since last time *) let new_bestscore = Common.regression_testing_vs score expected_score in Common.save_score score actual_score_file; 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 perr_nl "Current score is equal to expected score; everything is fine" end else if good < expected_good then begin perr_nl "Current score is lower than expected :("; perr_nl (spf "(was expecting %d but got %d)\n" expected_good good); perr_nl "If you think it's normal, then maybe you need to update the"; perr_nl (spf "score file %s, copying info from %s." expected_score_file actual_score_file) end else (* if good > expected_good then *) begin perr_nl "Current score is greater than expected :)"; perr_nl (spf "(was expecting %d but got %d)" expected_good good); perr_nl "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 (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) let regression_test ~test_dir = (* sort expected result files by name *) let test_files = dbe2nm (test_dir, "*", exp_ext) in let e = Common.glob test_files in let e = List.filter (fun f -> Common.filesize f > 0) e in let expected_files = List.sort compare e in if e = [] then failwith ( (spf "No test files with expected extension <.%s> found." exp_ext) ^ " Are you sure this is the right directory?" ); (* populate score table *) let actual_score = Common.empty_score() in List.iter (compare_one actual_score) expected_files; print_update_regression test_dir actual_score coccinelle-1.0.4/tools/spgen/source/README.md0000644000175000017500000000661112614153277017653 0ustar eugeneugenSPGEN SOURCE CODE ================ Dependencies ------------ **Parser dependencies (coccinelle/parsing_cocci/)**: ast\_cocci.ml ast0\_cocci.ml visitor\_ast0.ml visitor\_ast0\_types.ml type\_cocci.ml **Internal dependency order (partial; ie. not total, some can be interchanged)**: globals.ml ast\_tostring.ml detect_patch.ml meta\_variable.ml snapshot.ml user\_input.ml position\_generator.ml disj\_generator.ml rule\_body.ml rule\_header.ml context\_rule.ml script\_rule.ml file\_transform.ml spgen\_interactive.ml spgen\_config.ml spgen.ml main.ml Workflow -------- **main.ml contains the entry point. It calls the driver for the program which is in spgen.ml**: 1. Parse the SmPL script by calling the Coccinelle parser. Output is the generated abstract syntax trees (AST0), a list of rulenames in the script, and a list of virtual modes in the script. 2. Check validity of virtual modes and rulenames (globals.ml). 3. Filter out rules to be generated, ie. any rule containing \*/+/- rules, and generate disjunction maps for each of them (detect\_patch.ml). 4. Get user-specified metadata either through the commandline or config file (spgen\_interactive.ml, spgen\_config.ml, user\_input.ml). 5. Generate context rules from the \*/+/- rules (context\_rule.ml). Context rules are the rules supported by *context* mode, ie. rules with \*'s and inserted metapositions. 6. Generate script rules for each context rule (script\_rule.ml). Script rules are supported by the virtual modes *org* and *report*, ie. printing modes. 7. Output the new generated script. First by modifying the original script to conform to new rulenames, virtuals, and dependencies as well as add preface ie. description, comments, etc. (file\_transform.ml). Then output the generated context and script rules. **context\_rule.ml contains the main context rule generation**: 1. Extract all metavariables from an AST0 (meta\_variable.ml). 2. Generate the body of the new rule (rule\_body.ml). - traverse AST0 and "reparse" original patch/context rule to new context rule using the AST0 visitor module (parsing\_cocci/visitor\_ast0.ml). - use snapshot type to keep state during the traversal (snapshot.ml). - generate metapositions at structurally suitable places in the rule, used for *org* and *report* printing modes (position\_generator.ml). If the original rule was a plus rule (ie. no \*/-, only +), the positions dictate where the new \*'s are placed. Otherwise, the original \*/- dictate where the new \*'s are placed. - special disjunction cases that arise in converting a *patch* rule to a *context* rule are handled as well (disj\_generator.ml). 3. Generate the header of the new rule with inserted dependencies and metapositions (rule\_header.ml). Constraints ----------- There are a number of constraints that the input Coccinelle script has to satisfy: - New rulenames cannot be "rule<number>", where <number> is any number, since this naming scheme is used by spgen to generate names for unnamed rules. - New rulenames as specified in config/interactive cannot contain spaces or start with numbers (as this is not allowed in Coccinelle; in fact spgen is slightly less strict than Coccinelle in terms of rulenames). - New rulenames cannot be any of the keywords used in spgen, ie. "description", "confidence", "author", etc. - Cannot contain virtual modes "patch", "context", "org", or "report". - etc. coccinelle-1.0.4/tools/spgen/source/spgen_lexer.mll0000644000175000017500000000717012614153277021416 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Lexer/parser for spgen config file *) { (* ------------------------------------------------------------------------- *) (* TYPES *) (* the config syntax has pretty low complexity and is very lenient, so we just * interpret the tokens directly and skip the lexical analysis. *) type attribute = | Org of string * string list | Report of string * string list type part = | Description of string | Limitations of string list | Keywords of string | Confidence of string | Comments of string | Options of string | Authors of string list (* author, affiliation, license in one *) | Url of string | Rule of (string * string option) * attribute list (* the table is for line numbers to produce more meaningful error messages *) let table = ref (Array.make 0 (0,0)) exception Eof let get_start_line lexbuf = match !table.(Lexing.lexeme_start lexbuf) with (l,_) -> l let get_column lexbuf = match !table.(Lexing.lexeme_start lexbuf) with (_,c) -> c let get_position_str lexbuf = "around line " ^ (string_of_int (get_start_line lexbuf)) ^ ", column " ^ (string_of_int (get_column lexbuf)) let error prob lexbuf = let pos = get_position_str lexbuf in failwith ("Config error: " ^ prob ^ pos) let illegal = error "Illegal syntax " let split_list delim = Str.split (Str.regexp (" *"^delim^" *")) } (* ------------------------------------------------------------------------- *) (* LEXING RULES *) let sp = [' ' '\t'] let ws = ['\n' '\r' '\012' '\013' ' ' '\t']* let notws = [^ '\n' '\r' '\012' '\013' ' ' '\t']* let notnl = [^ '\n' '\r' '\012' '\013']* let equal = (sp* "=" sp*) let colon = (sp* ":" sp*) let percent = (sp* "%" sp*) let letter = ['A'-'Z' 'a'-'z' '_'] let number = ['0'-'9']* let cname = letter (letter | number)* rule token = parse | ("description"|"d") equal (notnl as d) { Description d } | ("keywords" |"k") equal (notnl as v) { Keywords v } | ("confidence" |"c") equal (notws as c) { Confidence c } | ("comments" |"m") equal (notnl as m) { Comments m } | ("options" |"o") equal (notnl as o) { Options o } | ("url" |"u") equal (notnl as u) { Url u } | ("limitations"|"l") equal (notnl as l) { Limitations (split_list "|" l) } | ("author"|"authors"|"a") equal (notnl as a) { Authors (split_list "|" a) } (* for naming unnamed rules. e.g. 8:name = ... for the rule on line 8. *) | (number as oldrule) colon (cname as newrule) equal { Rule ((oldrule, Some newrule), cocci_rule lexbuf) } (* standard rules with org and report messages *) | (cname as rulenm) equal { Rule ((rulenm, None), cocci_rule lexbuf) } (* comments and whitespace are skipped *) | ws | "//" [^ '\n']* { token lexbuf } | "/*" { comment lexbuf } | eof { raise Eof} | _ { illegal lexbuf } and comment = parse | "*/" {token lexbuf} | eof { error "unclosed comment, needs \"*/\"! " lexbuf} | _ {comment lexbuf } and cocci_rule = parse | ws* "org" colon { let (a,b) = format_string lexbuf in Org (a,b) :: (cocci_rule lexbuf) } | ws* "report" colon { let (a,b) = format_string lexbuf in Report (a,b) :: (cocci_rule lexbuf) } | _ { [] } (* possibly formatted org and report messages *) and format_string = parse | "\"" (notnl as msg) "\"" percent "(" (notnl as lst) ")" { (msg, split_list "," lst) } | "\"" (notnl as msg) "\"" percent (notnl as lst) { (msg,[lst]) } | "\"" (notnl as msg) "\"" { (msg, []) } | _ { illegal lexbuf } coccinelle-1.0.4/tools/spgen/source/globals.mli0000644000175000017500000000626312614153277020525 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Global variables, common string functions, and helpers. *) (* ------------------------------------------------------------------------- *) (* GLOBAL VARIABLES *) (* global variables are readonly outside initialisation *) val init : rule_name:string -> (* default rule name for nameless rules *) pos_name:string -> (* default position name for generated positions *) error_msg:string -> (* default error message for org and report mode *) char_limit:int -> (* page width limit for generated script *) unit (* default position name *) val get_pos_name : unit -> string (* default error message *) val get_default_message : unit -> string (* use input rulename to make a name for its context counterpart. *) val get_context_name : context_mode:bool -> string -> string (* use input rulename to make a name for its disjunction counterpart. *) val get_disj_name : string -> string (* use input rulename to make a name for its org counterpart. *) val get_org_name : string -> string (* use input rulename to make a name for its report counterpart. *) val get_report_name : string -> string (* ------------------------------------------------------------------------- *) (* DEPENDENCY HELPERS (HARDCODED) *) (* takes existing virtual rulenames, checks them, and returns the standard * ones: (patch), context, org, and report. *) val key_virtuals : context_mode:bool -> string list -> string list (* takes rule dependencies and adds default patch dependency: * " && patch && !context && !org && !report" *) val add_patch_dependency : Ast_cocci.dependency -> Ast_cocci.dependency (* takes rule dependencies and adds default context dependency: * if context_mode: " && !patch && (context || org || report)" *) val add_context_dependency : context_mode:bool -> Ast_cocci.dependency -> Ast_cocci.dependency (* ------------------------------------------------------------------------- *) (* SANITY CHECKS AND RULE HELPERS *) (* specific for nameless rule that are automatically given the name * "rule starting on line ". extracts the number or fails if none. *) val extract_line : string -> int (* check rulename for validity. fails if invalid. * if strict, also fail on rulenames containing spaces. *) val check_rule : strict:bool -> string -> unit (* takes a rulename; if it is invalid, generates and returns a new rulename. * if valid, returns the input name. *) val generate_rule : string -> string (* ------------------------------------------------------------------------- *) (* STRING FUNCTIONS *) val starts_with_digit : string -> bool (* splits string into string list of length at most char_limit, delimitering * by space, and prefixing each string with prefix. *) val pre_split : ?prefix:string -> string -> string (* same as above, except for string options. If None, return "". *) val pre_split_opt : ?prefix:string -> string option -> string coccinelle-1.0.4/tools/spgen/source/file_transform.ml0000644000175000017500000002520112614153277021734 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci (* ------------------------------------------------------------------------- *) (* Transforms the original Coccinelle script and prints it. * Prints preface and added virtual rules. * * Naming conventions: outch = out_channel, inch = in_channel. * * TODO: There are a number of edge cases that are not handled well in this * module due to using pure string-matching without context. * Example: @'s inside comments within rule declarations. * For most _reasonable_ SmPL scripts, this shouldn't be a problem though. *) (* ------------------------------------------------------------------------- *) (* GENERAL PURPOSE FUNCTIONS *) let line_number = ref 0 let get_line inch = line_number := !line_number + 1; input_line inch let nothing _ = () let print = output_string let print_newline outch = output_string outch "\n" let print_nl outch x = print outch x; print_newline outch let print_virtuals outch virtuals = print_newline outch; List.iter (fun x -> print_nl outch ("virtual " ^ x)) virtuals; print_newline outch exception Eof_error of string let fail_eof name = let errmsg = "Error: Reached end of file before rule "^name^" was found." in raise (Eof_error errmsg) (* ------------------------------------------------------------------------- *) (* REGEXES AND STRING MATCH FUNCTIONS *) (* returns true if str matches the regular expression in regexp *) let regex_match regex str = Str.string_match (Str.regexp regex) str 0 (* regex for any number of same-line whitespace *) let sp_re = "[ \t]*" (* regex for at least one space or tab *) let spp_re = "[ \t]+" (* regex for any number of /**/ comments *) let cmnt_re = "\\(" ^ sp_re ^ "/\\*.*\\*/" ^ sp_re ^ "\\)*" (* regex for any number of /**/ comments with arbitrary whitespace *) let spcmnt_re = sp_re ^ cmnt_re ^ sp_re (* we have to handle many cases since it is technically possible to have * comments and large amounts of whitespace in rule header declarations. * If someone actually writes a script like this, they should be punished. *) let escape = Str.global_replace (Str.regexp "\\$") "\\\\$" let match_full rule_name = regex_match ("^@"^spcmnt_re^(escape rule_name)^"\\(@\\|"^spp_re^".*@\\)") let match_part rule_name = regex_match ("^@"^spcmnt_re^(escape rule_name)^"\\("^spp_re^".*\\)?$") let match_end = regex_match ".*@" let match_nameless_rule = regex_match "\\(^\\(@@\\)\\|^@.*@$\\)" let match_rule_start = regex_match ("^@") let match_rule_start_arob = regex_match ("^@"^spcmnt_re^"$") let match_rule_end = regex_match (spcmnt_re^"@@") let match_non_empty = regex_match (spcmnt_re^"[^ \t]") (* ------------------------------------------------------------------------- *) (* IN_CHANNEL TRAVERSAL *) let rec find_match ~do_this ~until inch = let line = get_line inch in if until line then (line, inch) else begin do_this line; find_match ~do_this ~until inch end let rec find_line ~do_this ~until_line inch = find_match ~do_this ~until:(fun _ -> until_line = !line_number) inch (* upon a call to regex string matching, print what follows after the match *) let print_rest outch line = let i = Str.match_end() in let length = String.length line in let rest = String.sub line i (length - i) in if i <> length then print_nl outch rest (* prints the contents of the opened channel until finishes *) let rec print_to_end outch inch = (try print_nl outch (get_line inch) with End_of_file -> (print_newline outch; raise End_of_file)); print_to_end outch inch (* goes through the file, printing it as it goes, until finding the rule * declaration of name, without printing the rule declaration. * returns the line where the rule dec ends, and the in_channel at that stage. *) let skip_rule_dec name outch inch = let rec traverse outch inch = let line = get_line inch in if match_full name line then (* "@rulename@" *) (line, inch) else if match_part name line then (* "@rulename" *) find_match ~do_this:nothing ~until:match_end inch else if match_rule_start_arob line then (* "@", next line maybe rulename *) let (line,inch) = find_match ~do_this:nothing ~until:match_non_empty inch in if regex_match (sp_re^name) line then find_match ~do_this:nothing ~until:match_end inch else begin print_nl outch ("@"^line); traverse outch inch end else begin (* line does not contain rule dec *) print_nl outch line; traverse outch inch end in traverse outch inch (* ------------------------------------------------------------------------- *) (* PATCH SPECIFIC *) (* outputs the rule declaration with standard patch dependencies. * rule_name is the new name which overrules the one in the Ast0 rule. *) let print_patch_decl outch rule_name = function | Ast0.InitialScriptRule (nm,_,_,_,_) | Ast0.FinalScriptRule (nm,_,_,_,_) | Ast0.ScriptRule (nm,_,_,_,_,_) -> failwith ("Error: The rule " ^ nm ^ " is a script rule ...!") | Ast0.CocciRule ((_,_,(isos,drop_isos,deps,_,exists)),_,_) -> let deps = Globals.add_patch_dependency deps in let patch_header = Rule_header.generate ~isos ~drop_isos ~deps ~rule_name ~exists ~meta_vars:[] ~meta_pos:[] in Rule_header.print_declaration outch patch_header (* prints the file until the declaration of the rule, which is then substituted * with whatever handler does. *) let print_named_rule ~rule ~handler ~outch ~inch = let name = Ast0.get_rule_name rule in let (line,inch) = skip_rule_dec name outch inch in handler line inch (* prints the file until the rule declaration (rule_name must follow the format * "rule starting on line "), which is substituted with whatever handler * does. *) let print_nameless_rule ~rule ~handler ~outch ~inch = let rule_name = Ast0.get_rule_name rule in let rule_line = Globals.extract_line rule_name in let _ = assert (rule_line > !line_number) in let (line, inch) = find_line ~do_this:(print_nl outch) ~until_line:rule_line inch in if match_nameless_rule line then handler line inch else if String.contains line '@' then let (line, inch) = find_match ~do_this:nothing ~until:match_end inch in handler line inch else failwith ("Error: Did not find a " ^rule_name^ ", instead found: " ^line) (* Finds the declaration of the input rule ("@rulename ...@") and substitutes * it with a patch dependent version ("@rulename depends on patch ...@"). *) let print_rule_patch outch inch (rule, new_name) = (* prints out patch header. If there was anything after the rule declaration, * print that too. returns the in_channel at the point after the printing. *) let handler line inch = print_patch_decl outch new_name rule; print_rest outch line; inch in let old_name = Ast0.get_rule_name rule in try if old_name = new_name then print_named_rule ~rule ~handler ~outch ~inch else print_nameless_rule ~rule ~handler ~outch ~inch with | End_of_file -> fail_eof old_name | e -> raise e (* propagate exception upwards *) let print_patch outch inch rules = let inch = List.fold_left (print_rule_patch outch) inch rules in print_to_end outch inch (* ------------------------------------------------------------------------- *) (* CONTEXT SPECIFIC *) (* in context mode, we do not want to keep the original rules, since our * generated versions contain the same information + added metapositions. *) (* find the start of the next rule. *) let next outch inch = try let r = find_match ~do_this:nothing ~until:match_rule_start inch in Some r with End_of_file -> None (* there were no more rules *) (* find the rule with that name and skip it entirely. *) let skip_named_rule ~rule ~last_line ~outch ~inch = let name = Ast0.get_rule_name rule in let (_,inch) = if match_part name last_line then (last_line, inch) else begin if String.contains last_line '@' then failwith ("Transform error: Can't currently handle this case. Don't " ^ "put newlines in your rule declarations!!!"); print_nl outch last_line; skip_rule_dec name outch inch end in let (_,inch) = find_match ~do_this:nothing ~until:match_rule_end inch in next outch inch (* find the rule that starts on that line and skip it entirely *) let skip_nameless_rule ~rule ~outch ~inch = let name = Ast0.get_rule_name rule in let rule_line = Globals.extract_line name in let _ = assert (rule_line >= !line_number) in let inch = if rule_line = !line_number then inch else snd (find_line ~do_this:(print_nl outch) ~until_line:rule_line inch) in (* at this point, line is the line that contains the rule header. so we need * the rule header end @@ and then the start of the next rule. *) let (_,inch) = find_match ~do_this:nothing ~until:match_rule_end inch in next outch inch (* print a context rule (that is, don't print it, but find it and skip it!) * last_res is (the last line contents, the in_channel) from the previous call. * * returns Some (last line contents, in_channel) if there was another rule * after the input rule, otherwise None. *) let print_rule_context outch last_res (rule, new_name) = let old_name = Ast0.get_rule_name rule in try match last_res with | None -> raise End_of_file | Some (last_line, inch) -> if old_name = new_name then skip_named_rule ~rule ~last_line ~outch ~inch else skip_nameless_rule ~rule ~outch ~inch with | End_of_file -> fail_eof old_name | e -> raise e (* propagate exception upwards *) let print_context outch inch rules = let res = List.fold_left (print_rule_context outch) (Some ("",inch)) rules in match res with | Some (_,i) -> print_to_end outch i | None -> raise End_of_file (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) (* reads the file and prints it with transformations. * assumes rules are sorted in order of when they occur in the script. *) let print ~context_mode ~file_name ~preface ~virtuals ~ordered_rules outch = let _ = line_number := 0 in let _ = print_nl outch preface in let _ = print_virtuals outch virtuals in let inch = open_in file_name in try if context_mode then print_context outch inch ordered_rules else print_patch outch inch ordered_rules with | End_of_file -> flush outch; close_in inch (* ended safely *) | Eof_error msg -> flush outch; close_in inch; failwith msg | e -> close_in_noerr inch; raise e coccinelle-1.0.4/tools/spgen/source/globals.ml0000644000175000017500000001365412614153277020356 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci (* ------------------------------------------------------------------------- *) (* Global variables and hardcoded standard stuff goes here. * Also some general purpose functions for strings and sanity checks. *) (* ------------------------------------------------------------------------- *) (* GLOBAL VARIABLES AND GETTERS *) (* read-only after initialisation *) (* Default names for generated positions *) let pos_name = ref "j" let get_pos_name() = !pos_name (* Default rule names for unnamed rules. Accessed through generate_rule. *) let rule_name = ref "rule" let rule_counter = ref 0 (* Default error message for org and report mode *) let error_message = ref "found a match here ..." let get_default_message() = !error_message let get_context_name ~context_mode str = if context_mode then str else str ^ "_context" let get_disj_name str = str ^ "_disj" let get_org_name str = str ^ "_org" let get_report_name str = str ^ "_report" (* Page width limit for generated script (not always upheld ...) *) let char_limit = ref 80 let init ~rule_name:r ~pos_name:p ~error_msg:e ~char_limit:cl = rule_counter := 0; pos_name := p; rule_name := r; error_message := e; char_limit := cl (* ------------------------------------------------------------------------- *) (* HARDCODED (PHOOEY!) *) (* list of things you can't call your rules, because it will mess with spgen *) let keywords = ["patch"; "context"; "org"; "report"; "description"; "limitations"; "keywords"; "comments"; "options"; "confidence"; "authors"; "url"; "d";"k";"c";"m";"o";"l";"a";"u"] (* default virtual rule names *) let get_virtuals ~context_mode = if context_mode then ["context"; "org"; "report"] else ["patch"; "context"; "org"; "report"] (* check if virtual rule names are valid and return the standard ones *) let key_virtuals ~context_mode v = let keyvirtuals = get_virtuals ~context_mode in let check x = if List.mem x keyvirtuals then failwith "Error: patch, context, org, and report are reserved virtual rules." in List.iter check v; keyvirtuals (* adds the hardcoded 'default' patch rule dependency. *) let add_patch_dependency deps = let patch_dep = Ast.AndDep( Ast.Dep "patch", Ast.AndDep( Ast.AntiDep "context", Ast.AndDep(Ast.AntiDep "org", Ast.AntiDep "report"))) in if deps = Ast.NoDep then patch_dep else Ast.AndDep(deps, patch_dep) (* adds the hardcoded 'default' context rule dependency. *) let add_context_dependency ~context_mode deps = let context_dep = (* context || org || report *) Ast.OrDep(Ast.Dep "context", Ast.OrDep(Ast.Dep "org", Ast.Dep "report")) in let context_dep = if context_mode then context_dep else Ast.AndDep(Ast.AntiDep "patch", context_dep) in if deps = Ast.NoDep then context_dep else Ast.AndDep(deps, context_dep) (* ------------------------------------------------------------------------- *) (* SANITY CHECKS AND RULE HELPERS *) let starts_with_digit x = Str.string_match (Str.regexp "^[0-9]") x 0 (* check if a rulename is valid *) let check_rule ~strict x = if x = "" then failwith "Error: Rulename cannot be empty!"; if strict && String.contains x ' ' then failwith ("Error: Rulenames cannot contain spaces: \"" ^x^ "\"."); if starts_with_digit x then failwith ("Error: Rules that start with digits are not allowed: \"" ^x^ "\"."); let gen_rule = !rule_name in let regexp = Str.regexp ((Str.quote gen_rule) ^ "[0-9]+$") in if Str.string_match regexp x 0 then failwith ("Error: The default generated rule name is \""^ gen_rule ^"\".\n"^ "The name \"" ^ x ^ "\" is invalid, since it may overlap with a " ^ "generated rule name."); if List.mem x keywords then failwith ("Error: A rule can't be called \""^ x ^"\"! That's a keyword in spgen ...") (* for rules with no name; get the line they are starting on *) let extract_line str = if Str.string_match (Str.regexp "^\\(rule starting on line \\)") str 0 then let i = Str.match_end() in let num = String.sub str i ((String.length str) - i) in int_of_string num else failwith ("Was not a nameless rule: " ^ str) (* Only generates rulename if input name is invalid as rulename *) let generate_rule nm = try check_rule ~strict:true nm; nm with Failure _ -> let new_name = !rule_name ^ (string_of_int !rule_counter) in rule_counter := !rule_counter + 1; new_name (* ------------------------------------------------------------------------- *) (* NIFTY STRING FUNCTIONS *) (* split a string into a list of strings with at most limit characters each, * delimitering by space. *) let split limit s = (* returns list of (start index, len) of each sequence of words (string) that * contains at most limit chars. In reverse order. *) let get_rev_indices str lim = let len = String.length s in let rec get_rev acc start = if (len - start <= lim) then (start, len) :: acc else let space_index = try String.rindex_from str (start + lim) ' ' with Not_found -> start + lim in get_rev ((start, space_index) :: acc) (space_index + 1) in get_rev [] 0 in let rev_indices = get_rev_indices s (limit-1) in let get_line (start, endd) = String.sub s start (endd - start) in List.rev_map get_line rev_indices (* split string into strings of at most char_limit length * append prefix to each new string *) let pre_split ?(prefix = "") s = let limit = (!char_limit - String.length prefix) in let splitted = split limit s in String.concat "\n" (List.map (fun x -> prefix ^ x) splitted) (* same as pre_split, but with a string option *) let pre_split_opt ?(prefix = "") = function | Some s -> pre_split ~prefix s | None -> "" coccinelle-1.0.4/tools/spgen/source/spgen_interactive.ml0000644000175000017500000001662112614153277022441 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module UI = User_input (* ------------------------------------------------------------------------- *) (* Interactive commandline mode for getting (local) user input. *) (* ------------------------------------------------------------------------- *) (* GENERAL PURPOSE FUNCTIONS *) (* name of the file to save to. Is set at the entry point. *) let name = ref "" (* persistence *) let write_file ~file s = let chan = try open_out file with Sys_error msg -> let msg = "Error: Invalid filename: " ^ file ^ ". Message: " ^ msg in failwith msg in try (output_string chan s; close_out chan) with Sys_error msg -> let msg = "Error: failed writing to " ^ file ^ ". Message: " ^ msg in failwith msg (* termination *) let exit() = print_string "\n~*~ GOODBYE! ~*~\n"; exit 0 (* allow the user to save the current progress in a config file *) let save t = (* unparse the current configurations and save them to a file *) let save' t name = let unp = UI.unparse t in let _ = write_file ~file:name unp in print_string ("\nSaved progress to " ^ name ^ "!\n" ^ "-------------\n") in let name = !name in let _ = print_string ("\nSave progress to " ^name^"?\n") in let _ = print_string ("Options:\n" ^ " Type y(es) or press to save.\n"^ " Type n(o) to not save.\n"^ " Write another filename to save to.\n") in match String.lowercase (read_line()) with | "" | "y" | "yes" -> save' t name | "n" | "no" -> () | file -> save' t file let get_input_save t = let input = read_line() in if input = "q()" then (save t; exit()) else input let get_input() = let input = read_line() in if input = "q()" then exit() else input let print_error msg = print_string "\n>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n\n"; print_string msg; print_string "\n\n<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n" (* ------------------------------------------------------------------------- *) (* INTERACTIVE USER INPUT GETTERS *) let rec get_description() = print_string "\nWrite a description for the Coccinelle script (required):\n"; match get_input() with | "" -> get_description() | x -> x let rec get_confidence() = print_string ("\nSpecify a confidence level for the script (required):\n" ^ "Options: l(ow), m(oderate), h(igh).\n"); try UI.Confidence.from_string (get_input()) with UI.Confidence.Not_confidence _ -> (print_error "Error: Ill-formed confidence level!"; get_confidence()) let get_limitations t = let rec get first t = print_string ("\nSpecify a" ^ (if first then "" else "nother") ^ " limitation for the script or press to continue:\n"); match get_input_save t with | "" -> t | x -> get false (UI.add_limit x t) in get true t let get_keywords t = print_string ("\nSpecify keywords for the script or press to " ^ "continue:\n"); let keys = get_input_save t in UI.set_keys keys t let get_options t = print_string ("\nSpecify options for the script or press to " ^ "continue:\n"); let options = get_input_save t in UI.set_options options t let get_url t = print_string ("\nSpecify an URL for the script or press to " ^ "continue:\n"); let url = get_input_save t in UI.set_url url t let get_authors t = let rec get first t = print_string ("\nSpecify an" ^ (if first then "" else "other") ^ " author for the script or press to continue:\n" ^ "Standard format is: , . .\n"); match get_input_save t with | "" -> t | x -> get false (UI.add_author x t) in get true t let get_comments t = print_string ("\nWrite any further comments for the script or press " ^ " to continue:\n"); let comments = get_input_save t in UI.set_comments comments t (* get org or report msg. strict denotes whether it is required. *) let rec get_message pmsg strict t = print_string pmsg; let msg = get_input_save t in if msg = "" && strict then (* message required but none given; try again *) get_message pmsg strict t else begin (* if there are no format variables, just use the message alone*) let pcts = UI.count_format_vars msg in if pcts = 0 then (msg,[]) else begin (* there were format variables; allow user to declare them *) let _ = print_string ( "\nDeclare the " ^(string_of_int pcts) ^" variable(s) " ^ "used in the message, in order, separated by comma.\n" ^ "Inherited metavariables are declared by ..\n" ) in let mv = get_input_save t in let mv = Str.split (Str.regexp " *, *") mv in (* if user declared format variables successfully, return *) if List.length mv = pcts then (msg, mv) else (* the number of format variables did not match the actual message *) let _ = print_error ( "Error: Ill-formed message; " ^ "number of format variables does not match number of declared " ^ "metavariables. Try again." ) in get_message pmsg strict t end end (* gets rulename if there is currently none (rule starting on ...). * if there is one, just return the same. *) let get_name r t = let rec get_name' r = print_string ("\nSpecify a name for the " ^ r ^ ":\n"); let newnm = get_input_save t in try UI.check_name newnm t; newnm with Failure m -> print_error m; get_name' r in if String.contains r ' ' then get_name' r else r (* returns rule mapped to user-specified org and report messages + new name. *) let rec get_rule (rulename : string) (t : UI.t) = let _ = print_string ("\nHandling rule \"" ^ rulename ^ "\" ...") in let nm = get_name rulename t in let _ = print_string ("\n~ Getting messages for org and report mode ~\n\n" ^ "No quotes necessary around the message.\n" ^ "It is possible to include formatted variables like %s (Python style), " ^ "you will get a chance to declare them afterwards.\n" ^ "Example message: Unneeded variable \\\"%s\\\". Return \\\"%s\\\".\n" ^ "Example format variables: x, other_rule.y. \n") in let org = get_message ("\nRule \"" ^ nm ^ "\". Write a message"^ " for org mode:\n") true t in let (repmsg,repmvs) = get_message ("\nRule \"" ^ nm ^ "\". Write a message" ^ " for report or press to reuse the org message.\n") false t in let report = if repmsg = "" then org else (repmsg,repmvs) in UI.Rule.make ~rule_name:nm ~org ~report (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) let interact ~rule_names ~config_name = name := config_name; print_string ("\n~*~ WELCOME TO SPGEN INTERACTIVE MODE ~*~\n\n" ^ "At any time, write q() to quit the program.\n"); let description = get_description() in let confidence = get_confidence() in let t = UI.make ~description ~confidence in let t = get_limitations t in let t = get_keywords t in let t = get_options t in let t = get_authors t in let t = get_url t in let t = get_comments t in let rec add t r = try UI.add_rule ~rule_name:r (get_rule r t) t with Failure msg -> print_error msg; add t r in let t = List.fold_left add t rule_names in let _ = save t in t coccinelle-1.0.4/tools/spgen/source/spgen.mli0000644000175000017500000000147412614153277020215 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Driver module for spgen. * * Options: * - config: the name of the file to draw user input from * - output: the name of the file to save the generated file (default: stdout) * - interactive: if true, draw user input interactively * - default: if true, generate without user input (using default values) * - hide: if true, do not output the generated file *) type options val make_options : ?config:string -> ?output:string -> ?interactive:bool -> ?default:bool -> ?hide:bool -> string -> (* filename of cocci file to generate *) options val run : options -> unit coccinelle-1.0.4/tools/spgen/source/main.ml0000644000175000017500000000460012614153277017646 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* ------------------------------------------------------------------------- *) (* OPTIONS *) (* the cocci script to be generated *) let file = ref "" (* the config file to draw user input from *) let config = ref "" (* whether to draw user input interactively *) let interactive = ref false (* whether to generate without user input (using default values) *) let default = ref false (* where to output the resulting generated file *) let output = ref "" (* hide resulting generated file *) let hide = ref false (* path to directory with spgen tests *) let test_dir = ref "" let set_config x = config := x; interactive := false let anonymous s = if !file = "" then file := s let usage = let msg = "Usage: %s [options] \n" ^^ (* format string concatenation *) "Example: spgen --config file.config file.cocci.\n\n" ^^ "Options are:" in Printf.sprintf msg (Filename.basename Sys.argv.(0)) let speclist = [ ("--config", Arg.String set_config, " Configuration file for the generated file."); ("-c", Arg.String set_config, " Shorthand for --config."); ("--interactive", Arg.Set interactive, " Run the program in interactive mode."); ("-i", Arg.Set interactive, " Shorthand for --interactive."); ("-o", Arg.Set_string output, " Output result to this file instead of standard output."); ("--default", Arg.Set default, " Generate the file using generic default values instead of user input."); ("--no-output", Arg.Set hide, " Don't print the result."); ("--test", Arg.Set_string test_dir, " Run the regression tests."); ] (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) let main _ = Arg.parse (Arg.align speclist) anonymous usage; if !test_dir <> "" then Spgen_test.regression_test ~test_dir:(!test_dir) else begin if !file = "" then (Arg.usage (Arg.align speclist) usage; exit 1); let options = Spgen.make_options ~config:!config ~interactive:!interactive ~default:!default ~output:!output ~hide:!hide !file in Spgen.run options end let _ = main () coccinelle-1.0.4/tools/spgen/source/rule_header.mli0000644000175000017500000000163412614153277021356 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Generates rule headers like * * @rulename depends on ...@ * metavariable mv; * position p; * @@ * *) (* ------------------------------------------------------------------------- *) (* RULE HEADER FUNCTIONS *) type t (* Generates rule header. *) val generate : rule_name:string -> isos:string list -> drop_isos:string list -> deps: Ast_cocci.dependency -> exists:Ast_cocci.exists -> meta_vars: Meta_variable.t list -> meta_pos: Meta_variable.t list -> t (* print the full header, metavariables and all *) val print : out_channel -> t -> unit (* print only the first line @rulename depends on ...@ *) val print_declaration : out_channel -> t -> unit coccinelle-1.0.4/tools/spgen/source/rule_body.mli0000644000175000017500000000512512614153277021062 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Generates context rule body with inserted positions and stars. * * If context_mode (ie. the original rule is already * a context rule), just * add positions, but let the stars be. * If patch mode, add positions structurally (see position_generator.ml) and * add stars where the minus transformation are OR where the positions were * generated. * * ---------------------------------------------------------------------------- * Example: * Say we have two rule bodies like this (rule headers included for context): * * @minus@ expression e; @@ * * if (e * - != NULL * ) { * function1(e); * ... * e++; * function2(); * - function3(e); * + function4(e); * * @plus@ expression e; @@ * * if (e * + != NULL * ) { * function1(e); * ... * e++; * function2(); * + function3(e); * * They are both patch rules, but one doesn't contain minuses. * In the first case, stars are added where the minuses were. Positions are * added according to the same heuristics as the other example. * * @minus_context@ expression e; position p1,p2,p2; @@ * * if (e@p1 * * != NULL * ) { * function1@p2(e); * ... * e@p3++; * function2(); * * function3(e); * } * * In the second case, we don't know where the interesting parts are, so we add * positions on a best-guess basis (ie. the first in a sequence). The stars are * added on the same lines as the positions. * * @plus_context@ expression e; position p1,p2,p3; @@ * * * if (e@p1) * { * * function1@p2(e); * ... * * e@p3++; * function2(); * } * *) (* ------------------------------------------------------------------------- *) (* RULE BODY FUNCTIONS *) type t (* Arguments: * - context_mode indicates whether the rule already has stars in it. * - disjunction map, indicates */+/- slices in disjunctions. * - AST0 for the minus rule (we don't need the plus rule to generate *'s). * * Returns: * - List of added metapositions (as strings) * - The generated context rule, optional generated disjunction rule *) val generate : context_mode:bool -> disj_map:Detect_patch.t -> minus_rule:Ast0_cocci.rule -> string list * (t * t option) (* prints a context rule *) val print : out_channel -> t -> unit coccinelle-1.0.4/tools/spgen/source/script_rule.mli0000644000175000017500000000261312614153277021430 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* * Creates two script rules like: * * @script:python depends on org@ * p1 << rulename.p1; * p2 << rulename.p2; * x << rulename.x; * @@ * * msg="Warning: This is a message! Found %s." % (x) * coccilib.org.print_safe_todo(p1[0], msg) * coccilib.org.print_link(p2[0], "") * * * @script:python depends on report@ * p1 << rulename.p1; * p2 << rulename.p2; * @@ * * msg="Error: This is a report message on line %s" % (p2[0].line) * coccilib.report.print_report(p1[0], msg) *) (* ------------------------------------------------------------------------- *) (* SCRIPT GENERATION FUNCTIONS *) type t (* generates org and report script for one rule. * metapos is the list of added metapositions that show where the match is. * user_rule contains the rule name, the rule messages and the metavars. * * INVARIANT: there MUST be at least one position in the metapos list!!! *) val generate : meta_pos:Meta_variable.t list -> user_rule:User_input.Rule.t -> t (* prints org rule *) val print_org : out_channel -> t -> unit (* prints report rule *) val print_report : out_channel -> t -> unit coccinelle-1.0.4/tools/spgen/source/file_transform.mli0000644000175000017500000000423412614153277022110 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Transforms the original Coccinelle script and prints it (transformation is * done while printing). * * Prints preface, added virtual rules. * * Patch mode: * - add rule names to previously unnamed rules. * - add standard dependencies to existing patch rules. * * Context mode: * - skip all original context rules, since we now have the same rules but in * a generated (and therefore superior!) version. * * The transformation is done alongside the printing so if anything fails, * some of it might already have been printed. * * ---------------------------------------------------------------------------- * Example: * Input file (ie. the one in file_name) is: * * @im_a_rule@ * @@ * * function(); * * @depends on im_a_rule@ * @@ * * another_function( ... ); * + call_me(); * ... * * Then if we call it with e.g. * preface = { confidence = Moderate; description = "this is a script" }, * virtuals = ["patch";"context";"org";"report"], * rules = [(, None); (, Some "NAME")], * context_mode = false (because it has a +), * it would print the following to the out_channel: * * /// this is a script * /// * // Confidence: Moderate * * virtual patch * virtual context * virtual org * virtual report * * @im_a_rule@ * @@ * * function(); * * @NAME depends on im_a_rule && patch && !context && !org && !report@ * @@ * * another_function( ... ); * + call_me(); * ... *) (* ------------------------------------------------------------------------- *) (* TRANSFORMATION FUNCTIONS *) (* rules must be in the same order that they occurred in the original file *) val print : context_mode:bool -> file_name:string -> preface:string -> virtuals:string list -> ordered_rules:(Ast0_cocci.parsed_rule * string (* new name *)) list -> out_channel -> unit coccinelle-1.0.4/tools/spgen/source/rule_body.ml0000644000175000017500000003233612614153277020715 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci module Ast0 = Ast0_cocci module V0 = Visitor_ast0 module VT0 = Visitor_ast0_types module S = Ast_tostring module Snap = Snapshot module PG = Position_generator module DG = Disj_generator (* ------------------------------------------------------------------------- *) (* Generates the rule body of a context rule. * * Main logic for starring lines: * CONTEXT ( * ): put the stars where they were in the original rule. Do not * change rule layout, only add positions. * * PATCH (+/-): If a statement dots contain any minus transformations, put the * star where the minus is. If not, put a star where a position was generated. * All lines are always non-starred, unless there turns out to be * an added metaposition (from the position generator) on that same line, in * which case the whole line becomes star mode. A position is added if it is * in Ast0.PLUS context, since natural positions are NEVER in PLUS context. * * Uses a (Snapshot.t -> Snapshot.t) combiner. Snapshot is a state type that * contains the generated rule and state information. So each rule component * gets turned into a function that modifies the state. The result is a * composite function that takes an initial (presumably empty) snapshot and * turns it into a snapshot that contains a full generated rule. *) (* ------------------------------------------------------------------------- *) (* HELPERS *) (* Function composition *) let ( >> ) f g x = g (f x) (* Continuously apply fn ('b -> 'a -> 'a) with lst ('b list) and start ('a). *) let reduce fn lst start = List.fold_left (fun a b -> fn b a) start lst (* print helpers for context rules (which are really just string lists) *) let print_newl out = output_string out "\n" let printfn out x = List.iter (fun x -> output_string out x; print_newl out) x; print_newl out (* ------------------------------------------------------------------------- *) (* FUNCTIONS TO HANDLE SPECIAL CASES *) let starrify_line a = Snap.set_mode_star ~arity:a (* metapositions are represented as lists of Ast0.anythings. * PATCH MODE: if a position is in plus mode ("added"), ie. made by the * position generator, it indicates an important line which should be starred. * Mutual recursion because meta anythings can have metas themselves ... *) let rec add_positions ~context_mode lst = reduce (add_pos ~context_mode) lst and add_pos ~context_mode = function (* these are the added/generated positions (hence the PLUS mode) *) | Ast0.MetaPosTag(Ast0.MetaPos(((_,nm),arity,_,Ast0.PLUS _,_,_),_,_)) -> let default = Snap.add_with_arity ("@"^nm) arity in if context_mode then default else starrify_line arity >> default | Ast0.MetaPosTag(Ast0.MetaPos(((_,nm),arity,_,_,p,_),_,_)) (* extracting the node is equivalent to calling Ast0.unwrap *) | Ast0.ExprTag {Ast0.node = Ast0.MetaExpr(((_,nm),arity,_,_,p,_),_,_,_,_); _} | Ast0.StmtTag {Ast0.node = Ast0.MetaStmt(((_,nm),arity,_,_,p,_),_); _} | Ast0.DeclTag {Ast0.node = Ast0.MetaDecl(((_,nm),arity,_,_,p,_),_); _} | Ast0.IdentTag {Ast0.node = Ast0.MetaId(((_,nm),arity,_,_,p,_),_,_,_); _} | Ast0.TypeCTag {Ast0.node = Ast0.MetaType(((_,nm),arity,_,_,p,_),_); _} -> Snap.add_with_arity ("@"^nm) arity >> add_positions ~context_mode !p | _ -> failwith "add_pos only supported for metavariables." (* renders the mcode as a string in the map and updates the line number. * context_mode means that the stars are put where the minuses are. *) let mcode ~context_mode ~tostring_fn (x, a, info, mc, pos, _) = let default ~add_star = Snap.skip ~rule_line:(info.Ast0.pos_info.Ast0.line_start) >> (if add_star then starrify_line a else (fun a -> a)) >> Snap.add info.Ast0.whitespace >> Snap.add_with_arity (tostring_fn x) a >> add_positions ~context_mode !pos in match mc with | Ast0.MINUS _ -> default ~add_star:context_mode | Ast0.CONTEXT _ -> default ~add_star:false | _ -> failwith "plus and mixed not allowed, should be the minus ast0..." (* Handle Ast0_cocci.whenmodes. Primary purpose is to handle WhenModifiers * and WhenNotTrue/False which are not parameterised in the visitor. *) let whencodes ~strfn ~exprfn ~notfn ~alwaysfn l = let add_whens = function | Ast0.WhenNot(whenmc, notequalmc, a) -> strfn whenmc >> strfn notequalmc >> notfn a | Ast0.WhenAlways(whenmc, equalmc, a) -> strfn whenmc >> strfn equalmc >> alwaysfn a | Ast0.WhenModifier(whenmc, a) -> strfn whenmc >> Snap.add (" " ^ (S.whenmodifier_tostring a)) | Ast0.WhenNotTrue(whenmc, notequalmc, expr) -> strfn whenmc >> strfn notequalmc >> Snap.add " true" >> exprfn expr | Ast0.WhenNotFalse(whenmc, equalmc, expr) -> strfn whenmc >> strfn equalmc >> Snap.add " false" >> exprfn expr in Snap.do_whencode (reduce add_whens l) (* This is where the magic happens! * Inserts stars/positions into the statements of a statement_dots. * Only give positions and stars to statements if they are the first in a dots * or come immediately after a nest, dots, disjunction, or metastatement. *) let star_dotsstmtfn ~context_mode combiner stmtdots = (* detects if any of the statements in here contain minuses in which case we * put the stars where the minuses are. * NOTE: uses only minus rule, so does not detect plus slices. This is * exactly what we want to happen as plus slices are not in generated rule! *) let detect_patch = Detect_patch.make_statement_dots stmtdots in let has_minuses = Detect_patch.is_patch detect_patch in let c = combiner ~context_mode:(context_mode || has_minuses) in let stmtfn = c.VT0.combiner_rec_statement in (* inserts position into statement where structurally appropriate *) let star_stmtfn stmt snp = let _ = assert (not (Snap.no_gen snp)) in match PG.statement_pos stmt snp with | Some (stmt, snp) -> stmtfn stmt snp | None -> stmtfn stmt snp in (* returns true if the statement can potentially cover large amounts of * code/requires special handling and therefore should not be starred. *) let do_not_star x = match Ast0.unwrap x with | Ast0.Nest _ | Ast0.Dots _ | Ast0.Disj _ | Ast0.MetaStmt _ -> true | _ -> false in (* increase line number if not in context_mode (if context_mode, we don't * want to modify layout, only add positions). *) let inc_line = if context_mode then (fun x -> x) else Snap.inc_line in (* puts stars and positions in statements that come after one of the cases * in do_not_star. Insert newline after a do_not_star case. *) let rec insert_stars star_current fn = let starfn = if star_current then star_stmtfn else stmtfn in function | [] -> fn | [x] -> if do_not_star x then fn >> stmtfn x else fn >> starfn x | x::xs -> if do_not_star x then insert_stars true (fn >> stmtfn x >> inc_line) xs else insert_stars false (fn >> starfn x) xs in insert_stars true (fun x -> x) (Ast0.unwrap stmtdots) (* ------------------------------------------------------------------------- *) (* THE COMBINER *) (* The type of the combiner is (Snapshot.t -> Snapshot.t) which enables us to * pass states from token to token. We need the states to keep track of our * current context and for proper line formatting. * The state also contains the generated rule. * (not actually recursive, just needs to pass itself on to star_dotsstmtfn to * allow context_mode toggling without making them mutually recursive) *) let rec gen_combiner ~context_mode = let bind x y = x >> y in (* do x then apply y to the result *) let option_default = (fun x -> x) in (* apply the passed function, do nothing else *) let donothing r k e = k e in let mcode a = mcode ~context_mode ~tostring_fn:a in let meta_mcode = mcode S.meta_tostring in let string_mcode = mcode (fun x -> x) in let const_mcode = mcode S.constant_tostring in let simpleAssign_mcode = mcode (fun x -> x) in let opAssign_mcode = mcode S.arith_tostring in let fix_mcode = mcode S.fix_tostring in let unary_mcode = mcode S.unary_tostring in let arithOp_mcode = mcode S.arith_tostring in let logicalOp_mcode = mcode S.logic_tostring in let cv_mcode = mcode S.const_vol_tostring in let sign_mcode = mcode S.sign_tostring in let struct_mcode = mcode S.struct_union_tostring in let storage_mcode = mcode S.storage_tostring in let inc_mcode = mcode S.inc_file_tostring in let dotsexprfn = donothing in let dotsinitfn = donothing in let dotsparamfn = donothing in let dotsdeclfn = donothing in let dotscasefn = donothing in let assignOpfn = donothing in let binaryOpfn = donothing in let tyfn = donothing in let initfn = donothing in let paramfn = donothing in let forinfofn = donothing in let casefn = donothing in let string_fragmentfn = donothing in (* Universal special cases, regardless of no_gen mode: * Disjunctions with SmPL style pattern-matching may need to be split into * two rules. *) let identfn _ c_identfn ident = match Ast0.unwrap ident with | Ast0.DisjId _ -> DG.generate_ident ~strfn:string_mcode ~identfn:c_identfn ~ident ~at_top:false | _ -> c_identfn ident in let exprfn _ c_exprfn expr = match Ast0.unwrap expr with | Ast0.DisjExpr _ -> DG.generate_expression ~strfn:string_mcode ~exprfn:c_exprfn ~expr ~at_top:false | _ -> c_exprfn expr in let declfn _ c_declfn decl = match Ast0.unwrap decl with | Ast0.DisjDecl _ -> DG.generate_declaration ~strfn:string_mcode ~declfn:c_declfn ~decl ~at_top:false | _ -> c_declfn decl in let stmtfn combiner c_stmtfn stmt = let c_dotsstmtfn = combiner.VT0.combiner_rec_statement_dots in let c_exprfn = combiner.VT0.combiner_rec_expression in let whncodes = whencodes ~strfn:string_mcode ~exprfn:c_exprfn ~notfn:c_dotsstmtfn ~alwaysfn:c_stmtfn in let inc_star = if context_mode then (fun x -> x) else Snap.inc_star in match Ast0.unwrap stmt with (* nest and dots are explicitly written out rather than * letting the visitor handle them. Otherwise whencodes would be ignored. * (whencodes are difficult to parameterise in the visitor due to typing). * * nest, dots, and metastatements can represent code slices * of arbitrary length and should therefore not be starred, so if their * current line is starred, put them on a new line (inc_star). *) | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> inc_star >> string_mcode starter >> whncodes whn >> c_dotsstmtfn stmt_dots >> string_mcode ender | Ast0.Dots(dots,whn) -> inc_star >> string_mcode dots >> whncodes whn | Ast0.MetaStmt _ -> inc_star >> c_stmtfn stmt | Ast0.Disj _ -> DG.generate_statement ~stmtdotsfn:c_dotsstmtfn ~strfn:string_mcode ~stmtfn:c_stmtfn ~stmt ~at_top:false | _ -> c_stmtfn stmt in (* positions and stars are added here!!! *) let dotsstmtfn _ c_dotsstmtfn dotsstmt = (fun snp -> if Snap.no_gen snp (* add no positions; this is relevant in whencodes *) then c_dotsstmtfn dotsstmt snp else star_dotsstmtfn ~context_mode gen_combiner dotsstmt snp) in (* detect if disj is the only thing, in which case we don't want to split * the disjunction rule. * TODO: better detection of when to set at_top! for example, should not * split if the only other stmts are unstarrable. * (this includes the case where no statement outside the disjunction has a * minus, since the pos generator will ignore them due to minus inside disj!) *) let topfn c c_topfn top = match Ast0.unwrap top with | Ast0.CODE stmtdots -> (match Ast0.unwrap stmtdots with | [{Ast0.node = Ast0.Disj _; _} as x] -> DG.generate_statement ~stmtdotsfn:c.VT0.combiner_rec_statement_dots ~stmtfn:c.VT0.combiner_rec_statement ~strfn:string_mcode ~stmt:x ~at_top:true | _ -> c_topfn top ) | _ -> c_topfn top in V0.flat_combiner bind option_default meta_mcode string_mcode const_mcode simpleAssign_mcode opAssign_mcode fix_mcode unary_mcode arithOp_mcode logicalOp_mcode cv_mcode sign_mcode struct_mcode storage_mcode inc_mcode dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn identfn exprfn assignOpfn binaryOpfn tyfn initfn paramfn declfn stmtfn forinfofn casefn string_fragmentfn topfn (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) type t = string list (* Creates a context mode rule for the input rule. * Returns list of added metapositions and the new rule. *) let generate ~context_mode ~disj_map ~minus_rule = let snp = Snap.make ~disj_map in let combiner = gen_combiner ~context_mode in let final = reduce combiner.VT0.combiner_rec_top_level minus_rule snp in (Snap.get_positions final, Snap.get_result final) let print = printfn coccinelle-1.0.4/tools/spgen/source/Makefile0000644000175000017500000000632412614153277020035 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # path to coccinelle source COCCIDIR=../../.. SCRIPTDIR=../scripts # do not raise error if config does not exist; handle in $(CONFIG) rule below include $(COCCIDIR)/Makefile.libs -include $(COCCIDIR)/Makefile.config # where to install the program INSTALLDIR=$(DESTDIR)$(LIBDIR)/spgen ############################################################################## # Variables ############################################################################## TARGET=spgen CONFIG= $(COCCIDIR)/Makefile.config SYSLIBS= str.cma unix.cma bigarray.cma nums.cma LIBS= $(PCREDIR)/pcre.cma \ $(DYNLINKDIR)/dynlink.cma \ $(COCCIDIR)/commons/commons.cma \ $(COCCIDIR)/globals/globals.cma \ $(COCCIDIR)/parsing_cocci/cocci_parser.cma INCLUDEDIRS= $(COCCIDIR)/commons $(COCCIDIR)/commons/ocamlextra \ $(COCCIDIR)/globals $(COCCIDIR)/parsing_cocci $(PCREDIR) INCLUDES=$(INCLUDEDIRS:%=-I %) # lexer source LEXER_SRC= spgen_lexer.mll # compiled lexers GENERATED= $(LEXER_SRC:.mll=.ml) # all source OCaml files that have interfaces (.mli) SRC= globals.ml ast_tostring.ml detect_patch.ml meta_variable.ml \ snapshot.ml user_input.ml position_generator.ml disj_generator.ml \ rule_body.ml rule_header.ml context_rule.ml script_rule.ml \ file_transform.ml spgen_interactive.ml spgen_config.ml spgen.ml spgen_test.ml # all source OCaml interface files (ocamlfind??) SRC_INTERFACE= $(SRC:.ml=.mli) # all source OCaml files (except for the generated lexer) FULL_SRC= $(SRC_INTERFACE) $(SRC) main.ml OCAMLCFLAGS ?= -g OCAMLC_CMD=$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) CFLAGS = -cflags '$(INCLUDES)' LFLAGS = -lflags '$(SYSLIBS) $(LIBS)' ############################################################################## # Top rules ############################################################################## all: $(TARGET) # currently no support for opt all.opt: $(TARGET) $(TARGET): $(CONFIG) $(LIBS) $(GENERATED) $(FULL_SRC) $(OCAMLC_CMD) -custom -o $(TARGET) $(SYSLIBS) $(LIBS) $(FLAGS_pcre) $(GENERATED) $(FULL_SRC) .PHONY: clean distclean clean: rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot rm -f *~ .*~ gmon.out #*# rm -f .depend rm -f $(GENERATED) distclean: rm -f $(TARGET) $(CONFIG) $(LIBS): @echo "\n\n\tYou need to compile Coccinelle first.\n\n" @false $(SCRIPTDIR)/spgen.sh: @$(ECHO) -e "\n\n\tYou need to run ./configure from the Coccinelle directory first.\n\n" @false install: $(TARGET) $(SCRIPTDIR)/spgen.sh uninstall-legacy rm -f $(DESTDIR)$(BINDIR)/$(TARGET) $(MKDIR_P) $(INSTALLDIR) $(INSTALL_PROGRAM) $(TARGET) $(INSTALLDIR)/$(TARGET) $(INSTALL_PROGRAM) $(SCRIPTDIR)/spgen.sh $(DESTDIR)$(BINDIR)/$(TARGET) uninstall-legacy: # legacy cleanup, from when the tool was called sgen rm -f $(DESTDIR)$(BINDIR)/sgen $(SCRIPTDIR)/sgen.sh rm -rf $(DESTDIR)$(LIBDIR)/sgen uninstall: uninstall-legacy rm -f $(DESTDIR)$(BINDIR)/$(TARGET) rm -f $(INSTALLDIR)/$(TARGET) rmdir $(INSTALLDIR) $(LEXER_SRC:.mll=.ml) : $(LEXER_SRC) $(OCAMLLEX) $(LEXER_SRC) .PHONY: depend .depend depend: $(GENERATED) $(OCAMLDEP) *.mli *.ml > .depend coccinelle-1.0.4/tools/spgen/source/spgen_config.ml0000644000175000017500000001034512614153277021366 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module UI = User_input module Lex = Spgen_lexer (* ------------------------------------------------------------------------- *) (* Read config files for user-specified options *) (* ------------------------------------------------------------------------- *) (* LEXER FUNCTIONS *) (* function to be applied continuously on the input coccinelle script *) let lex_config lexbuf = let rec aux ((d,l,k,c,m,o,a,u,r) as res) = try let result = Lex.token lexbuf in match result with | Lex.Description d -> aux (d,l,k,c,m,o,a,u,r) | Lex.Limitations l -> aux (d,l,k,c,m,o,a,u,r) | Lex.Keywords k -> aux (d,l,k,c,m,o,a,u,r) | Lex.Confidence c -> aux (d,l,k,c,m,o,a,u,r) | Lex.Comments m -> aux (d,l,k,c,m,o,a,u,r) | Lex.Options o -> aux (d,l,k,c,m,o,a,u,r) | Lex.Authors a -> aux (d,l,k,c,m,o,a,u,r) | Lex.Url u -> aux (d,l,k,c,m,o,a,u,r) | Lex.Rule (rn,attr) -> aux (d,l,k,c,m,o,a,u, (rn, attr) :: r) with Lex.Eof -> res in aux ("",[],"","","","",[],"",[]) (* open the input coccinelle script and lex/parse it. * the table maps the absolute character position to its line and column number *) let parse filename = let _ = Lex.table := Common.full_charpos_to_pos filename in Common.with_open_infile filename (fun channel -> let lexbuf = Lexing.from_channel channel in lex_config lexbuf) (* ------------------------------------------------------------------------- *) (* PARSER FUNCTIONS *) (* parse org/report messages and associated metavars. * if several org/report messages defined, take the last one *) let parse_msgs attributes = let read ((om,ov),(rm,rv)) = function | Lex.Org (om,ov) -> ((om,ov), (rm,rv)) | Lex.Report (rm,rv) -> ((om,ov), (rm,rv)) in List.fold_left read (("",[]), ("",[])) attributes (* add the rule to the User_input.t. *) let add_rule rule_check t ((oldrnm,newnm),a) = let oldrnm = rule_check oldrnm in let (org,report) = match parse_msgs a with | ("",_),("",_) -> failwith ("Config error: must specify at least org or report message.") | ("",_),mgv | mgv,("",_) -> (try UI.check_format_string mgv; (mgv,mgv) with Failure msg -> failwith ("Config error: " ^ msg)) | org, rep -> try UI.check_format_string org; UI.check_format_string rep; (org, rep) with Failure msg -> failwith ("Config error: " ^ msg) in let rule_name = match newnm with | Some nm -> nm | None -> oldrnm in let rule = UI.Rule.make ~rule_name ~org ~report in UI.add_rule ~rule_name:oldrnm rule t (*rule list is a list of (rulename, attribute list) *) let add_rules rule_exists rule_list t = List.fold_left (fun a b -> add_rule rule_exists a b) t rule_list (* expanded constructor for User_input.t *) let make desc limit keys conf comments options authors url = let t = try UI.make ~description:desc ~confidence:(UI.Confidence.from_string conf) with UI.Confidence.Not_confidence s -> failwith ("Config error: Confidence must be low, moderate, or high, not "^s) in let t = UI.set_limits limit t in let t = UI.set_keys keys t in let t = UI.set_comments comments t in let t = UI.set_options options t in let t = UI.set_authors authors t in UI.set_url url t (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) let parse_local ~rule_names ~config_name = let rule_check x = let x = if Globals.starts_with_digit x then "rule starting on line "^ x else x in if (List.mem x rule_names) then x else failwith ("Config error: no */+/- rule called \"" ^ x ^ "\".") in let (d,l,k,c,m,o,a,u,r) = parse config_name in let t = make d l k c m o a u in let t = add_rules rule_check r t in t let parse_default = UI.make ~description:"No description." ~confidence:(UI.Confidence.from_string "moderate") (* TODO: implement *) let parse_global ~config_name = (None, None, "rule_", "j", "found a match around here ...", 80) coccinelle-1.0.4/tools/spgen/source/script_rule.ml0000644000175000017500000001176312614153277021265 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module MV = Meta_variable module UI = User_input (* ------------------------------------------------------------------------- *) (* Generate script rules for org and report. *) (* ------------------------------------------------------------------------- *) (* TYPES AND HELPERS *) type t = string list (*org*) * string list (*rep*) let comma_sep = String.concat "," (* invariant: always at least one position *) let split_pos = function mv::mvs -> (mv,mvs) | _ -> assert false (* print helpers for script rules (which are really just string lists) *) let print_newl out = output_string out "\n" let printfn out x = List.iter (fun x -> output_string out x; print_newl out) x; print_newl out (* ------------------------------------------------------------------------- *) (* CONSTANTS *) let print_todo_fn = "coccilib.org.print_todo" let print_safe_todo_fn = "coccilib.org.print_safe_todo" let print_link_fn = "coccilib.org.print_link" let print_report_fn = "coccilib.report.print_report" (* ------------------------------------------------------------------------- *) (* SCRIPT GENERATION FUNCTIONS *) (* Format the variables used in the format string. * Returns ("around lines" string for metapos's, comma-separated mv names) *) let line_vars ~meta_pos ~meta_vars = let line = List.map (fun x -> x ^ "[0].line") in match meta_pos with | [] -> ("", comma_sep meta_vars) | [x] -> ("around line %s.", comma_sep (meta_vars @ (line [x]))) | x -> let agg = comma_sep (List.map (fun _ -> "%s") x) in ("around lines " ^ agg ^ ".", comma_sep (meta_vars @ (line x))) (* turn metavariables into script header variables *) let format_header_vars = let binding mv = let (rn,nm) = (MV.get_rule mv, MV.get_name mv) in nm ^ " << " ^ rn ^ "." ^ nm ^ ";" in List.map binding (* only include metavars/positions in the format string if more than one *) let format_err_msg err_msg mpnames mvnames = if (List.length mvnames + List.length mpnames) > 0 then let (linepos, formatvars) = line_vars ~meta_pos:mpnames ~meta_vars:mvnames in "msg = \"" ^ err_msg ^ " " ^ linepos ^ "\" % (" ^ formatvars ^ ")" else "msg = \"" ^ err_msg ^ ".\"" (* assembles an org script rule. *) let gen_org_rule nm (firstpos, restpos) metavars err_msg = (* if there are metavars, they might contain brackets which conflict with * the todo format. In that case, use safe mode (replaces brackets). *) let printfn = if metavars <> [] then print_safe_todo_fn else print_todo_fn in let new_rulenm = Globals.get_org_name nm in let headervars = format_header_vars (metavars @ (firstpos :: restpos)) in (* the error message is used as is, positions are inserted in print calls *) let metavars = List.map MV.get_name metavars in let err_msg = format_err_msg err_msg [] metavars in let zero p = (MV.get_name p) ^ "[0]" in [ (*header*) "@script:python " ^ new_rulenm ^ " depends on org@"; String.concat "\n" headervars; "@@\n"; (*body*) err_msg; (printfn ^ "(" ^ (zero firstpos) ^ ", msg)") ] @ (List.map (fun x -> print_link_fn ^ "(" ^ (zero x) ^ ", \"\")") restpos) (* assembles a report script rule. *) let gen_report_rule nm (firstpos, restpos) metavars err_msg = let new_rulenm = Globals.get_report_name nm in let headervars = format_header_vars (metavars @ (firstpos :: restpos)) in let firstpos = (MV.get_name (firstpos)) ^ "[0]" in let restpos = List.map MV.get_name restpos in let metavars = List.map MV.get_name metavars in let err_msg = format_err_msg err_msg restpos metavars in [ (*header*) "@script:python " ^ new_rulenm ^ " depends on report@"; String.concat "\n" headervars; "@@\n"; (*body*) err_msg; (print_report_fn ^ "(" ^ firstpos ^ ", msg)") ] (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) (* generate org and report rule for the added metapositions and with the user * specified information (error messages). *) let generate ~meta_pos ~user_rule = (* extract user-specified data from rule *) let nm = UI.Rule.get_name user_rule in let (org_msg, omv) = UI.Rule.get_org user_rule in let (report_msg, rmv) = UI.Rule.get_report user_rule in (* find the first position, fails if the meta_pos list is empty *) let (firstpos, restpos) = split_pos meta_pos in let new_rule = MV.get_rule firstpos in (* make sure user-specified metavars are inherited from the context rule *) let omv = List.map (MV.inherit_rule ~new_rule) omv in let rmv = List.map (MV.inherit_rule ~new_rule) rmv in (* generate org and report script rules *) let org = gen_org_rule nm (firstpos, restpos) omv org_msg in let report = gen_report_rule nm (firstpos, restpos) rmv report_msg in (org, report) let print_org out (org, _) = printfn out org let print_report out (_, rep) = printfn out rep coccinelle-1.0.4/tools/spgen/source/context_rule.mli0000644000175000017500000000426512614153277021615 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Generate context rule * * If context_mode (ie. the original rule is already * a context rule), just * add positions, but let the stars be. * * If patch mode, add positions. * - If rule has -, then put the *'s at the -'s place. * - If rule only has +, put the *'s where the added positions are. * * ---------------------------------------------------------------------------- * Example of generated context rule (see more in rule_body.mli): * Input rule is a "+" rule represented as an AST0. * * @some_rule@ * identifier i; * @@ * * int i = 2; * + call_me(i); * ... * * Then the output will be a "*" rule similar to the one below. * It is not returned as AST0 because the contents of the rule may require a * splitting into several rules. * * @some_rule_context depends on !patch && (context || org || report)@ * identifier i; * position p; * @@ * * * int i@p = 2; * ... *) (* ------------------------------------------------------------------------- *) type t (* generates a context rule from a */+/- rule. * Invariants: * - rule contains */+/-. * - new_name, if any, must be valid. no whitespace funny business * (however, it can be at this point). * * Arguments: * - context_mode: if true, input rule has *, else input rule has +/-. * - disj_map: disjunction map, indicates */+/- slices in disjunctions. * - new_name: new name if input rule is nameless, else same as name in rule. * - rule: the input rule, must be a */+/- rule. * * Returns: * - the generated context rule * - list of added metapositions (at least one, and inherited from the * generated rule for convenience). *) val generate : context_mode:bool -> disj_map:Detect_patch.t -> new_name:string -> rule:Ast0_cocci.parsed_rule -> t * Meta_variable.t list (* prints the generated context rule to the specified out_channel. *) val print : out_channel -> t -> unit coccinelle-1.0.4/tools/spgen/source/ast_tostring.ml0000644000175000017500000000532712614153277021451 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci (* ------------------------------------------------------------------------- *) (* TOSTRING FUNCTIONS FOR AST_COCCI BASE TYPES *) (* takes a list of 'a and concatenates it using fn ('a -> string), * delimitering with between (string) *) let between_tostring between tostring_fn = let rec between_tostring' acc between fn = function | [] -> acc | [x] -> acc ^ (fn x) | x::xs -> between_tostring' (acc ^ (fn x) ^ between) between fn xs in between_tostring' "" between tostring_fn let meta_tostring (r, x) = x let constant_tostring = function | Ast.String(s) -> "\"" ^ s ^ "\"" | Ast.Char(s) -> "'" ^ s ^ "'" | Ast.Int(s) -> s | Ast.Float(s) -> s | Ast.DecimalConst(s,_,_) -> s let struct_union_tostring = function | Ast.Struct -> "struct" | Ast.Union -> "union" let sign_tostring = function | Ast.Signed -> "signed" | Ast.Unsigned -> "unsigned" let const_vol_tostring = function | Ast.Const -> "const" | Ast.Volatile -> "volatile" let storage_tostring = function | Ast.Static -> "static" | Ast.Auto -> "auto" | Ast.Register -> "register" | Ast.Extern -> "extern" let inc_elem_tostring = function | Ast.IncPath s -> s | Ast.IncDots -> "..." let inc_file_tostring = function | Ast.Local(elems) -> "\"" ^ (between_tostring "/" inc_elem_tostring elems) ^ "\"" | Ast.NonLocal(elems) -> "<" ^ (between_tostring "/" inc_elem_tostring elems) ^ ">" let fix_tostring = function | Ast.Dec -> "--" | Ast.Inc -> "++" let arith_tostring = Ast.string_of_arithOp let logic_tostring = Ast.string_of_logicalOp let unary_tostring = function | Ast.GetRef -> "&" | Ast.GetRefLabel -> "&&" | Ast.DeRef -> "*" | Ast.UnPlus -> "+" | Ast.UnMinus -> "-" | Ast.Tilde -> "~" | Ast.Not -> "!" let binary_tostring = Ast.string_of_binaryOp let assign_tostring = Ast.string_of_assignOp let type_tostring = function | Ast.VoidType -> "void" | Ast.CharType -> "char" | Ast.ShortType -> "short" | Ast.ShortIntType -> "short int" | Ast.IntType -> "int" | Ast.DoubleType -> "double" | Ast.LongDoubleType -> "long double" | Ast.FloatType -> "float" | Ast.LongType -> "long" | Ast.LongIntType -> "long int" | Ast.LongLongType -> "long long" | Ast.LongLongIntType -> "long long int" | Ast.SizeType -> "size_t" | Ast.SSizeType -> "ssize_t" | Ast.PtrDiffType -> "ptrdiff_t" let whenmodifier_tostring = function | Ast.WhenAny -> "any" | Ast.WhenStrict -> "strict" | Ast.WhenForall -> "forall" | Ast.WhenExists -> "exists" coccinelle-1.0.4/tools/spgen/source/rule_header.ml0000644000175000017500000000607312614153277021207 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast = Ast_cocci module MV = Meta_variable (* ------------------------------------------------------------------------- *) (* Generates rule headers with dependencies, isos, etc. in correct order. *) (* ------------------------------------------------------------------------- *) (* TYPES AND HELPERS *) type t = { first_line : string; (* @rule_name ...@ *) meta_vars : MV.t list; meta_pos : MV.t list; last_line : string; (* @@ *) } let comma_sep = String.concat ", " (* Stringify dependencies. Adds parentheses where necessary for precedence. *) let tostring_dep = function | Ast.NoDep -> "" | deps -> let rec dep in_and n k = match n with | Ast.Dep s -> k s | Ast.AntiDep s -> k ("!" ^ s) | Ast.EverDep s -> k ("ever " ^ s) | Ast.NeverDep s -> k ("never " ^ s) | Ast.AndDep(s1, s2) -> dep true s1 (fun l -> dep true s2 (fun r -> k (l ^ " && " ^ r))) | Ast.OrDep(s1, s2) -> dep false s1 (fun l -> dep false s2 (fun r -> let s = l ^ " || " ^ r in if in_and then k ("(" ^ s ^ ")") else k s)) | Ast.NoDep -> k "no_dep" | Ast.FailDep -> k "fail_dep" in " depends on " ^ (dep false deps (fun x -> x)) (* gather data into a string rule header... may or may not be slightly buggy. * TODO: add newlines at 80-character limit *) let rule_declaration ~rule_name ~isos ~drop_isos ~deps ~exists = let _ = assert (not (String.contains rule_name ' ')) in let extends = "" in (* where is this information ?? *) let expression = "" in (* where is this information ?? *) let deps = tostring_dep deps in let isos = match isos with | [] -> "" | x -> " using " ^ (comma_sep (List.map (fun x -> "\""^x^"\"") x)) in let drop_isos = match drop_isos with | [] -> "" | x -> " disable " ^ (comma_sep x) in let exists = match exists with | Ast.Exists -> " exists" | Ast.Forall -> " forall" | Ast.Undetermined -> "" in String.concat "" ["@"; rule_name; extends; deps; isos; drop_isos; exists; expression; "@"] (* ------------------------------------------------------------------------- *) (* ENTRY POINT *) (* generate rule header *) let generate ~rule_name ~isos ~drop_isos ~deps ~exists ~meta_vars ~meta_pos = let first_line = rule_declaration ~rule_name ~isos ~drop_isos ~deps ~exists in let last_line = "@@\n\n" in { first_line = first_line ^ "\n"; meta_vars; meta_pos; last_line; } (* print a rule header *) let print out {first_line = f; meta_vars = mv; meta_pos = mp; last_line = l;} = output_string out f; MV.print_list out ~do_group:true mv; MV.print_list out ~do_group:true mp; output_string out l (* prints only the first line of the rule header, ie. the declaration *) let print_declaration out {first_line = f; _} = output_string out f coccinelle-1.0.4/tools/spgen/source/detect_patch.mli0000644000175000017500000000435512614153277021531 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Detects if a rule contains */+/- or not. Such a rule is here referred to as * a patch rule (includes also * rules). * Does not distinguish between whether it has *, +, or -, just returns true * if it contains either. * * Also generates disjunction map, a map that maps the line number of the * beginning of the disjunction to an ordered list of bools, each indicating * whether their corresponding disjunction case contains */+/-. * * ---------------------------------------------------------------------------- * Example of disjunction map: * * @@ expression e; @@ * * ( * f(0) * | * f(1) * | * - f(e) * + g(e) * ) * * This rule contains both +/- so it would return true on a call to detect. * * It also has one disjunction on so the * disjunction map would have one entry with * key = * value = [false;false;true;]. * *) (* ------------------------------------------------------------------------- *) (* DETECTION FUNCTIONS *) type t (* constructs t from AST0 rule, uses both minus and plus tree. *) val make : Ast0_cocci.parsed_rule -> t (* constructs t from statement dots. * NOTE: minus and plus slices are stored in separate AST0s, so the statement * dots here will only cover either the */- portion of the tree OR the * + portion of the tree. Ie. a call to is_patch will only return true if the * statement dots contain EITHER */- or +, depending on which AST0 it is from. *) val make_statement_dots : Ast0_cocci.statement Ast0_cocci.dots -> t (* returns true if the rule contains stars, pluses, or minuses. *) val is_patch : t -> bool (* get the patch map for the disjunction starting on given line number. * fails if no disjunction found on that line. *) val get_disj_patch : int -> t -> bool list (* returns only the rules that contained */+/- along with their disjunction * maps. Preserves order. *) val filter_patch_rules : Ast0_cocci.parsed_rule list -> (Ast0_cocci.parsed_rule * t) list coccinelle-1.0.4/tools/spgen/source/spgen_config.mli0000644000175000017500000000356312614153277021543 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* Get user input from config file. * * - The configs are centered around the syntax: * = * using newlines as delimiters. * - For attributes with multiple values, the values are delimitered by pipes | * - Rules follow the syntax: * = * org: "here is a message. found %s!" % e * report: "this is an org message." * where the messages follow the Python format string syntax. If only one of * org or report is specified, the same message is used for both. * - can be the literal rule name, or, if none: * : * - Each attribute has a one-letter shorthand, usually the first letter. * - Comments follow C syntax, ie. // for one-line and /**/ for multi-line. * * See the lexer file for specifics. *) (* ------------------------------------------------------------------------- *) (* PARSER FUNCTIONS *) (* read local config with information specific for the coccinelle script * currently being generated. *) val parse_local : rule_names:string list -> config_name:string -> User_input.t (* no user input, default is: * description = No description. * confidence = Moderate *) val parse_default : User_input.t (* read global config for general information in any rule generation. * TODO: implement. *) val parse_global : config_name:string -> string option * (* Author name *) string option * (* License *) string * (* Default generated rule name *) string * (* Default generated position name *) string * (* Default error message for org and report *) int (* Character limit (width) for generated script *) coccinelle-1.0.4/tools/spgen/source/position_generator.ml0000644000175000017500000004712512614153277022645 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) module Ast0 = Ast0_cocci module Ast = Ast_cocci module Snap = Snapshot (* ------------------------------------------------------------------------- *) (* Given an Ast0 component, returns the same component with a generated * metaposition added. * * This is all pretty messy and requires, for each component, individual * assessment of where to put the position. * The general heuristic is to add it either: * - recursively to a smaller subcomponent (e.g. first expression in e1 + e2) * - at an id (e.g. a function name) or * - at an mcode (e.g. an operator). *) (* ------------------------------------------------------------------------- *) (* POSITION HELPERS *) (* always make a new pos even if the mcode already has an associated position, * an existing pos might have undesirable constraints or inheritance. *) let make_pos (_, arity, info, mcodekind, _, adj) snp : Ast0.anything * Snap.t = let (name, snp) = Snap.add_position snp in let meta_mcode = (("",name),arity,info,Ast0.PLUS Ast.ONE,ref [],adj) in let list_constraints = [] in let meta_collect = Ast.PER in let new_pos = Ast0.MetaPos(meta_mcode, list_constraints, meta_collect) in (Ast0.MetaPosTag(new_pos), snp) (* ------------------------------------------------------------------------- *) (* ALWAYS POSITION GENERATORS: always possible to generate pos *) (* adds generated metaposition to mcode unless it is optional. * yes, this contradicts the above statement. But it will never result in an * error because it is not possible to write an SmPL script with only optional * components. *) let mcode_pos ((x, a, info, mc, pos, q) as mco) snp : 'a Ast0.mcode * Snap.t = if a = Ast0.OPT then (mco, snp) else let (newpos, snp) = make_pos mco snp in ((x, a, info, mc, ref (newpos :: !pos), q), snp) (* helper for adding mcode position, reconstructs component *) let mcode ~mc (* 'a Ast0.mcode *) ~constructor (* mc:'a Ast0.mcode -> 'b *) snp (* Snap.t *) : 'b Ast0.wrap * Snap.t = let (mc, snp) = mcode_pos mc snp in (Ast0.wrap (constructor ~mc), snp) let assignOp_pos a snp : Ast0.base_assignOp Ast0.wrap * Snap.t = match Ast0.unwrap a with | Ast0.SimpleAssign mc -> let constructor ~mc = Ast0.SimpleAssign mc in mcode ~mc ~constructor snp | Ast0.OpAssign mc -> let constructor ~mc = Ast0.OpAssign mc in mcode ~mc ~constructor snp | Ast0.MetaAssign (mc, v, w) -> let constructor ~mc = Ast0.MetaAssign(mc,v,w) in mcode ~mc ~constructor snp let binaryOp_pos a snp : Ast0.base_binaryOp Ast0.wrap * Snap.t = match Ast0.unwrap a with | Ast0.Arith mc -> let constructor ~mc = Ast0.Arith mc in mcode ~mc ~constructor snp | Ast0.Logical mc -> let constructor ~mc = Ast0.Logical mc in mcode ~mc ~constructor snp | Ast0.MetaBinary (mc,v,w) -> let constructor ~mc = Ast0.MetaBinary(mc,v,w) in mcode ~mc ~constructor snp let rec ident_pos i snp : Ast0.base_ident Ast0.wrap * Snap.t = match Ast0.unwrap i with | Ast0.Id mc -> let constructor ~mc = Ast0.Id mc in mcode ~mc ~constructor snp | Ast0.MetaId(mc, i, s, p) -> let constructor ~mc = Ast0.MetaId(mc,i,s,p) in mcode ~mc ~constructor snp | Ast0.MetaFunc(mc, i, p) -> let constructor ~mc = Ast0.MetaFunc(mc,i,p) in mcode ~mc ~constructor snp | Ast0.MetaLocalFunc(mc, i, p) -> let constructor ~mc = Ast0.MetaLocalFunc(mc,i,p) in mcode ~mc ~constructor snp | Ast0.DisjId _ -> (i, snp) | Ast0.OptIdent (id) -> let (id, snp) = ident_pos id snp in (Ast0.wrap (Ast0.OptIdent (id)), snp) | Ast0.AsIdent(id1, id2) -> failwith "pos_gen: should only be in metavars" (* ------------------------------------------------------------------------- *) (* HELPERS FOR SOMETIMES POSITION GENERATORS *) let all_same = function [] -> true | x :: xs -> List.for_all (( = ) x) xs (* wraps Ast0 component and wraps it in Some *) let wrap (a : 'a) (snp : Snap.t) : ('a Ast0.wrap * Snap.t) option = Some (Ast0.wrap a, snp) (* adds position to the mcode, reconstructs component, and wraps it in Some *) let mcode_wrap ~mc (* 'a Ast0.mcode *) ~constructor (* mc:'a Ast0.mcode -> b *) snp (* Snap.t *) : ('b Ast0.wrap * Snap.t) option = Some (mcode ~mc ~constructor snp) (* adds position to the id, reconstructs component, and wraps it in Some *) let id_wrap ~id (* Ast0.base_ident Ast0.wrap *) ~constructor (* id:Ast0.base_ident Ast0.wrap -> 'a *) snp (* Snap.t *) : ('a Ast0.wrap * Snap.t) option = let (id, snp) = ident_pos id snp in wrap (constructor ~id) snp (* generic helper function. * Arguments: * - item, an Ast0 component: 'a * - item_posfn, position generator: 'a -> Snap.t -> ('b * Snap.t) option * - constructor: item:'b -> 'c * - alt, alt function: unit -> ('c Ast0.wrap * Snap.t) option * - snp, snapshot: Snap.t * * Tries to generate position with item_posfn and reconstruct outer structure. * If no position could be generated, call alt() as a backup. *) let item_wrap ~item ~item_posfn ~constructor ?(alt = fun _ -> None) snp : ('c Ast0.wrap * Snap.t) option = match item_posfn item snp with | Some (item, snp) -> wrap (constructor ~item) snp | None -> alt() (* ------------------------------------------------------------------------- *) (* SOMETIMES POSITION GENERATORS - not always possible to generate pos *) (* DISJUNCTION RELATED: type_pos and case_line_pos *) (* These functions are deliberately left unfinished for now. * Implementing requires changes to disj_generator, but the cases are fairly * rare, so for now just throw an exception if encountered. * (to implement, disjunctions should return None here, and be added as special * cases in rule_body.ml and disj_generator.ml. See DisjExpr for example.) *) let type_pos t snp : (Ast0.base_typeC Ast0.wrap * Snap.t) option = match Ast0.unwrap t with | Ast0.DisjType(lp,tlist,pipelist,rp) -> let boollist = Snap.get_disj (Ast0.get_mcode_line lp) snp in if all_same boollist then None else failwith ( "pos_gen: Mixed match/patch type disjunctions not supported " ^ "in position generator." ) | _ -> None (* NB: if implementing disj generation, make sure that the statement dots in * the clist are generated in no_gen mode... *) let case_line_pos c snp : (Ast0.base_case_line Ast0.wrap * Snap.t) option = match Ast0.unwrap c with | Ast0.DisjCase(lp, clist, pipelist, rp) -> let boollist = Snap.get_disj (Ast0.get_mcode_line lp) snp in if all_same boollist then None else failwith ( "pos_gen: Mixed match/patch case disjunctions in switch cases " ^ "not supported in position generator." ) | _ -> None let case_line_dots_pos c snp : (Ast0.base_case_line Ast0.wrap * Snap.t) option list = List.map (fun x -> case_line_pos x snp) (Ast0.unwrap c) let rec expression_pos exp snp : (Ast0.base_expression Ast0.wrap * Snap.t) option = (* try adding a position to the internal expression. If that failed, try * the alt function (usually, we use mcodes or ids as fallbacks) *) let exp_wrap ~exp ~constructor ?(alt = fun _ -> None) snp = let constructor ~item = constructor ~exp:item in item_wrap ~item:exp ~item_posfn:expression_pos ~constructor ~alt snp in (* try adding a position to internal expressions, first try exp1, then exp2. * if both have failed then call alt function. *) let exp_wrap2 ~exp1 ~exp2 ~constructor ?(alt = fun _ -> None) snp = let c1 ~exp = constructor ~exp1:exp ~exp2 in let c2 ~exp = constructor ~exp1 ~exp2:exp in let try_exp2() = exp_wrap ~exp:exp2 ~constructor:c2 ~alt snp in exp_wrap ~exp:exp1 ~constructor:c1 ~alt:try_exp2 snp in match Ast0.unwrap exp with | Ast0.NestExpr _ | Ast0.Edots _ | Ast0.AsExpr _ | Ast0.AsSExpr _ | Ast0.EComma _ | Ast0.MetaExprList _ | Ast0.DisjExpr _ | Ast0.ConjExpr _ -> None | Ast0.Ident(id) -> let constructor ~id = Ast0.Ident id in id_wrap ~id ~constructor snp | Ast0.Constant(mc) -> let constructor ~mc = Ast0.Constant mc in mcode_wrap ~mc ~constructor snp | Ast0.StringConstant(q1, sd, q2) -> let constructor ~mc = Ast0.StringConstant (q1, sd, mc) in mcode_wrap ~mc:q2 ~constructor snp | Ast0.FunCall(exp, lp, expdots, rp) -> let c ~exp ~mc = Ast0.FunCall(exp, mc, expdots, rp) in let alt() = mcode_wrap ~mc:lp ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:lp) ~alt snp | Ast0.Assignment(exp1, asop, exp2, st) -> let c ~exp1 ~exp2 ~mc = Ast0.Assignment(exp1, mc, exp2, st) in let alt() = let (mc, snp) = assignOp_pos asop snp in wrap (c ~exp1 ~exp2 ~mc) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:asop) ~alt snp | Ast0.Sequence(exp1, com, exp2) -> let c ~exp1 ~exp2 ~mc = Ast0.Sequence(exp1, mc, exp2) in let alt() = mcode_wrap ~mc:com ~constructor:(c ~exp1 ~exp2) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:com) ~alt snp | Ast0.CondExpr(exp1, why, expopt, colon, exp2) -> let c ~exp1 ~exp2 ~mc = Ast0.CondExpr(exp1, mc, expopt, colon, exp2) in let alt() = mcode_wrap ~mc:why ~constructor:(c ~exp1 ~exp2) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:why) ~alt snp | Ast0.Postfix(exp, fixmc) -> let c ~exp ~mc = Ast0.Postfix (exp, mc) in let alt() = mcode_wrap ~mc:fixmc ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:fixmc) ~alt snp | Ast0.Infix(exp, fixmc) -> let c ~exp ~mc = Ast0.Infix (exp, mc) in let alt() = mcode_wrap ~mc:fixmc ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:fixmc) ~alt snp | Ast0.Unary(exp, unmc) -> let c ~exp ~mc = Ast0.Unary (exp, mc) in let alt() = mcode_wrap ~mc:unmc ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:unmc) ~alt snp | Ast0.Binary(exp1, bin, exp2) -> let c ~exp1 ~exp2 ~mc = Ast0.Binary(exp1, mc, exp2) in let alt() = let (mc, snp) = binaryOp_pos bin snp in wrap (c ~exp1 ~exp2 ~mc) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:bin) ~alt snp | Ast0.Nested(exp1, bin, exp2) -> let c ~exp1 ~exp2 ~mc = Ast0.Nested(exp1, mc, exp2) in let alt() = let (mc, snp) = binaryOp_pos bin snp in wrap (c ~exp1 ~exp2 ~mc) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:bin) ~alt snp | Ast0.Paren(lp, exp, rp) -> let c ~exp ~mc = Ast0.Paren (mc, exp, rp) in let alt() = mcode_wrap ~mc:lp ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:lp) ~alt snp | Ast0.ArrayAccess(exp1, lb, exp2, rb) -> let c ~exp1 ~exp2 ~mc = Ast0.ArrayAccess(exp1, mc, exp2, rb) in let alt() = mcode_wrap ~mc:lb ~constructor:(c ~exp1 ~exp2) snp in exp_wrap2 ~exp1 ~exp2 ~constructor:(c ~mc:lb) ~alt snp | Ast0.RecordAccess(exp, stop, id) -> let c ~exp ~id = Ast0.RecordAccess(exp, stop, id) in let alt() = id_wrap ~id ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~id) ~alt snp | Ast0.RecordPtAccess(exp, arrow, id) -> let c ~exp ~id = Ast0.RecordPtAccess(exp, arrow, id) in let alt() = id_wrap ~id ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~id) ~alt snp | Ast0.Cast(lp, typec, rp, exp) -> let _ = type_pos typec snp in (* sanity check for disj *) let c ~exp ~mc = Ast0.Cast(lp, typec, mc, exp) in let alt() = mcode_wrap ~mc:rp ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:rp) ~alt snp | Ast0.SizeOfExpr(sizeofmc, exp) -> let constructor ~mc = Ast0.SizeOfExpr(mc, exp) in mcode_wrap ~mc:sizeofmc ~constructor snp | Ast0.SizeOfType(sizeofmc, lp, typec, rp) -> let _ = type_pos typec snp in (* sanity check for disj *) let constructor ~mc = Ast0.SizeOfType(mc, lp, typec, rp) in mcode_wrap ~mc:sizeofmc ~constructor snp | Ast0.TypeExp(typec) -> let _ = type_pos typec snp in (* sanity check for disj *) None | Ast0.Constructor(lp, typec, rp, init) -> let _ = type_pos typec snp in (* sanity check for disj *) let constructor ~mc = Ast0.Constructor (mc, typec, rp, init) in mcode_wrap ~mc:lp ~constructor snp | Ast0.MetaErr (mc, co, pu) -> (* is this ever within the rule body? *) let constructor ~mc = Ast0.MetaErr (mc, co, pu) in mcode_wrap ~mc ~constructor snp | Ast0.MetaExpr(mc, co, ty, fo, pu) -> let constructor ~mc = Ast0.MetaExpr (mc, co, ty, fo, pu) in mcode_wrap ~mc ~constructor snp | Ast0.OptExp exp -> let constructor ~exp = Ast0.OptExp exp in exp_wrap ~exp ~constructor snp (* redefine exp_wrap outside scope of expression_pos due to internal exp_wrap * being typed to only work for expression constructors and not 'a constructors *) let exp_wrap ~exp ~constructor ?(alt = fun _ -> None) snp : ('a Ast0.wrap * Snap.t) option = let constructor ~item = constructor ~exp:item in item_wrap ~item:exp ~item_posfn:expression_pos ~constructor ~alt snp let rec declaration_pos decl snp : (Ast0.base_declaration Ast0.wrap * Snap.t) option = match Ast0.unwrap decl with | Ast0.DisjDecl _ | Ast0.Ddots _ | Ast0.MetaDecl _ | Ast0.MetaField _ | Ast0.MetaFieldList _ | Ast0.AsDecl _ -> None | Ast0.Init(st, ty, id, eq, ini, sem) -> let _ = type_pos ty snp in (* sanity check *) let constructor ~id = Ast0.Init(st, ty, id, eq, ini, sem) in id_wrap ~id ~constructor snp | Ast0.UnInit(st, ty, id, sem) -> let _ = type_pos ty snp in (* sanity check *) let constructor ~id = Ast0.UnInit(st, ty, id, sem) in id_wrap ~id ~constructor snp | Ast0.TyDecl _ -> failwith "pos_gen: tydecl" | Ast0.Typedef (tm, tc, tc2, sem) -> let constructor ~mc = Ast0.Typedef (mc, tc, tc2, sem) in mcode_wrap ~mc:tm ~constructor snp | Ast0.MacroDecl (st,id,lp,ed,rp,sem) -> let constructor ~id = Ast0.MacroDecl (st, id, lp, ed, rp, sem) in id_wrap ~id ~constructor snp | Ast0.MacroDeclInit (st,id,lp,ed,rp,eq,init,sem) -> let constructor ~id = Ast0.MacroDeclInit (st,id,lp,ed,rp,eq,init,sem) in id_wrap ~id ~constructor snp | Ast0.OptDecl(dec) -> let constructor ~item = Ast0.OptDecl item in item_wrap ~item:dec ~item_posfn:declaration_pos ~constructor snp | Ast0.FunProto(fninfo,id,lp1,params,va,rp1,sem) -> let constructor ~id = Ast0.FunProto(fninfo,id,lp1,params,va,rp1,sem) in id_wrap ~id ~constructor snp let forinfo_pos f snp : (Ast0.base_forinfo Ast0.wrap * Snap.t) option = match Ast0.unwrap f with | Ast0.ForExp (Some exp, sem) -> let c ~exp ~mc = Ast0.ForExp(Some exp, mc) in let alt() = mcode_wrap ~mc:sem ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:sem) ~alt snp | Ast0.ForExp (None, sem) -> let constructor ~mc = Ast0.ForExp (None, mc) in mcode_wrap ~mc:sem ~constructor snp | Ast0.ForDecl (bef, decl) -> let constructor ~item = Ast0.ForDecl(bef, item) in item_wrap ~item:decl ~item_posfn:declaration_pos ~constructor snp let rec statement_pos s snp : (Ast0.base_statement Ast0.wrap * Snap.t) option = match Ast0.unwrap s with (* these cannot have positions (disjunctions are handled separately) *) | Ast0.Nest _ | Ast0.Dots _ | Ast0.Disj _ | Ast0.Conj _ | Ast0.MetaStmtList _ -> None | Ast0.AsStmt _ -> None | Ast0.MetaStmt _ -> None (* uncertainty of whether these should be handled! *) | Ast0.Exec _ -> None | Ast0.TopExp _ -> None | Ast0.TopId _ -> None | Ast0.Ty _ -> None | Ast0.TopInit _ -> None | Ast0.Include (incmc,filemc) -> let constructor ~mc = Ast0.Include(incmc, mc) in mcode_wrap ~mc:filemc ~constructor snp | Ast0.Undef (defmc, id) -> let constructor ~id = Ast0.Undef(defmc, id) in id_wrap ~id ~constructor snp | Ast0.Define (defmc, id, defparam, stmtdots) -> let constructor ~id = Ast0.Define(defmc, id, defparam, stmtdots) in id_wrap ~id ~constructor snp | Ast0.Pragma (pragmc, id, praginfo) -> let constructor ~id = Ast0.Pragma(pragmc, id, praginfo) in id_wrap ~id ~constructor snp | Ast0.OptStm stm -> let c ~item = Ast0.OptStm item in item_wrap ~item:stm ~item_posfn:statement_pos ~constructor:c snp | Ast0.ExprStatement(None, sem) -> None | Ast0.ExprStatement(Some exp, sem) -> let c ~exp ~mc = Ast0.ExprStatement(Some exp, mc) in let alt() = mcode_wrap ~mc:sem ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:sem) ~alt snp | Ast0.Exp exp -> let constructor ~exp = Ast0.Exp exp in exp_wrap ~exp ~constructor snp | Ast0.Decl (bef, decl) -> let c ~item = Ast0.Decl (bef, item) in item_wrap ~item:decl ~item_posfn:declaration_pos ~constructor:c snp | Ast0.Seq (lb, stmtdots, rb) -> let constructor ~mc = Ast0.Seq(mc, stmtdots, rb) in mcode_wrap ~mc:lb ~constructor snp | Ast0.IfThen (ifm, l, exp, r, st, a) -> let c ~exp ~mc = Ast0.IfThen(mc, l, exp, r, st, a) in let alt() = mcode_wrap ~mc:ifm ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:ifm) ~alt snp | Ast0.IfThenElse (ifm, l, exp, r, s1, e, s2, a) -> let c ~exp ~mc = Ast0.IfThenElse(mc, l, exp, r, s1, e, s2, a) in let alt() = mcode_wrap ~mc:ifm ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:ifm) ~alt snp | Ast0.While (whmc, l, exp, r, s, a) -> let c ~exp ~mc = Ast0.While(mc, l, exp, r, s, a) in let alt() = mcode_wrap ~mc:whmc ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:whmc) ~alt snp | Ast0.Do (d, s, whmc, l, exp, r, sem) -> let c ~exp ~mc = Ast0.Do(mc, s, whmc, l, exp, r, sem) in let alt() = mcode_wrap ~mc:d ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:d) ~alt snp | Ast0.For (fo,lp, fi,expo1,sem,expo2,rp,stmt,a) -> let c ~item ~mc = Ast0.For (mc,lp,item,expo1,sem,expo2,rp,stmt,a) in let alt() = mcode_wrap ~mc:fo ~constructor:(c ~item:fi) snp in item_wrap ~item:fi ~item_posfn:forinfo_pos ~constructor:(c ~mc:fo) ~alt snp | Ast0.Iterator (id,lp,expdots,rp,stmt,a) -> let constructor ~id = Ast0.Iterator(id, lp, expdots, rp, stmt, a) in id_wrap ~id ~constructor snp | Ast0.Switch (sw, lp, exp, rp, lb, sd, cd, rb) -> let _ = case_line_dots_pos cd snp in (* sanity check for disj *) let c ~exp ~mc = Ast0.Switch(mc, lp, exp, rp, lb, sd, cd, rb) in let alt() = mcode_wrap ~mc:sw ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:sw) ~alt snp | Ast0.Label (id,col) -> let constructor ~id = Ast0.Label(id, col) in id_wrap ~id ~constructor snp | Ast0.Goto (goto,id,sem) -> let constructor ~id = Ast0.Goto(goto, id, sem) in id_wrap ~id ~constructor snp | Ast0.Break (bmc,sem) -> let constructor ~mc = Ast0.Break(mc, sem) in mcode_wrap ~mc:bmc ~constructor snp | Ast0.Continue (cmc,sem) -> let constructor ~mc = Ast0.Continue(mc, sem) in mcode_wrap ~mc:cmc ~constructor snp | Ast0.ReturnExpr (retmc, exp, sem) -> let c ~exp ~mc = Ast0.ReturnExpr(mc, exp, sem) in let alt() = mcode_wrap ~mc:retmc ~constructor:(c ~exp) snp in exp_wrap ~exp ~constructor:(c ~mc:retmc) ~alt snp | Ast0.Return (retmc,sem) -> let constructor ~mc = Ast0.Return(mc, sem) in mcode_wrap ~mc:retmc ~constructor snp | Ast0.FunDecl (b, f, id, lp, ps, op, rp, lb, sd, rb, a) -> let constructor ~id = Ast0.FunDecl(b,f,id,lp,ps,op,rp,lb,sd,rb,a) in id_wrap ~id ~constructor snp coccinelle-1.0.4/tools/spgen/README.md0000644000175000017500000000761212614153277016355 0ustar eugeneugenSPGEN ==== Description ----------- This is a tool to harden Coccinelle scripts by generating context and printing modes. Example: Given a semantic patch (examples/addvoid.cocci) @@ identifier f; @@ f( + void ) { ... } and metadata about the script through the commandline in interactive mode or a config file (examples/addvoid.config) // Generated config from interactive mode. description = Adds void to function headers with no arguments. limitations = If a matched function has a prototype declaration, the script will not match the prototype. confidence = High options = --recursive-includes url = http://coccinelle.lip6.fr 1:addvoid = org:"WARNING: Zero-argument function \"%s\" should have void declaration." % (f) the program outputs a hardened semantic patch with virtual rules patch, context, org, and report (examples/addvoid_.cocci) /// Adds void to function headers with no arguments. //# If a matched function has a prototype declaration, the script will not //# match the prototype. /// // Confidence: High // URL: http://coccinelle.lip6.fr // Options: --recursive-includes virtual patch virtual context virtual org virtual report @addvoid depends on patch && !context && !org && !report@ identifier f; @@ f( + void ) { ... } // ---------------------------------------------------------------------------- @addvoid_context depends on !patch && (context || org || report)@ identifier f; position j0; @@ * f@j0( ) { ... } // ---------------------------------------------------------------------------- @script:python addvoid_org depends on org@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.org.print_safe_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python addvoid_report depends on report@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.report.print_report(j0[0], msg) This script can then be run on C files in the same manner as the original, by specifying the virtual rule when running spatch, e.g. for context mode spatch --sp-file addvoid_.cocci addvoid.c -D context Installation ------------ You need to have Coccinelle and all of Coccinelle's dependencies installed. Installation relies on the project being in the tools/spgen folder of the Coccinelle source code (if not, change the COCCIDIR path in the makefile). 1. Run the command make all to compile the code. 2. Run make install to install the program. 3. Test the program e.g. with spgen examples/addvoid.cocci or spgen .cocci The output should be a Coccinelle script with equivalent functionality to the original one, but with added virtual modes patch, context, org, and report. Uninstallation -------------- To uninstall, just run make uninstall Usage ----- After installation, run e.g. spgen file.cocci --config file.config to generate the file named file.cocci with file.config (spgen config). Or spgen file.cocci --interactive to run the program in interactive mode where the program will generate a config file for you. If running spgen file.cocci with no flags, the program will use file.config per default if it exists, or else start in interactive mode. For all options, see spgen -help Contents -------- The home directory contains this file, a Makefile, and the directories mentioned below. The documentation directory contains the documentation tex files. The examples directory contains examples of Coccinelle scripts and corresponding spgen config files as well as C files to test on. The scripts directory contains the script used for installation. The source directory contains the OCaml source code for spgen. The tests directory contains test files. coccinelle-1.0.4/tools/spgen/examples/0000755000175000017500000000000012614153277016706 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/examples/context.c0000644000175000017500000000021612614153277020535 0ustar eugeneugenint g(int u, int v) { int k = u / v; return k; } int f(int xx, int yy) { int i = xx * yy; i = g(xx, yy) + i; return i; } coccinelle-1.0.4/tools/spgen/examples/inherited.c0000644000175000017500000000012612614153277021024 0ustar eugeneugenvoid main(int i) { g(1); f(2); h(2); h2(2); h(3) foo(1); } coccinelle-1.0.4/tools/spgen/examples/inherited_.cocci0000644000175000017500000000515112614153277022024 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr /// This is a Coccinelle script to test inheritance between rules. //# Only works for functions with exact names f, g, h, hh. //# Not really useful. /// // Confidence: High // Copyright: (C) 2015 Author1, affiliation. License1 // Copyright: (C) 2015 Author2, affiliation. License2 // Copyright: (C) 2015 Author3. // URL: http://coccinelle.lip6.fr/ // Comments: Additional comments. // Options: --a-flag, --another-flag, --a-third-flag. // Keywords: inheritance, test. virtual patch virtual context virtual org virtual report @r@ expression x; @@ ( f(x); | g(1); ) @rule_h depends on patch && !context && !org && !report@ expression r.x; @@ - h(x); + hh(x); @rule_h2 depends on patch && !context && !org && !report@ expression r.x; @@ - h2(x); + hh22(x); @rule_0 depends on patch && !context && !org && !report@ @@ - foo(1); + bar(1); // ---------------------------------------------------------------------------- @rule_h_context depends on !patch && (context || org || report)@ expression r.x; position j0; @@ * h@j0(x); @rule_h2_context depends on !patch && (context || org || report)@ expression r.x; position j0; @@ * h2@j0(x); @rule_0_context depends on !patch && (context || org || report)@ position j0; @@ * foo@j0(1); // ---------------------------------------------------------------------------- @script:python rule_h_org depends on org@ x << r.x; j0 << rule_h_context.j0; @@ msg = "Replace call to h with call to hh on expression %s. " % (x) coccilib.org.print_safe_todo(j0[0], msg) @script:python rule_h2_org depends on org@ j0 << rule_h2_context.j0; @@ msg = "This is a message for rule_h2 in org mode.." coccilib.org.print_todo(j0[0], msg) @script:python rule_0_org depends on org@ j0 << rule_0_context.j0; @@ msg = "found a match around here ...." coccilib.org.print_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python rule_h_report depends on report@ x << r.x; j0 << rule_h_context.j0; @@ msg = "Replace call to h with call to hh on expression %s. " % (x) coccilib.report.print_report(j0[0], msg) @script:python rule_h2_report depends on report@ j0 << rule_h2_context.j0; @@ msg = "This is a message for rule_h2 in report mode.." coccilib.report.print_report(j0[0], msg) @script:python rule_0_report depends on report@ j0 << rule_0_context.j0; @@ msg = "found a match around here ...." coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/examples/addvoid.cocci0000644000175000017500000000041412614153277021321 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @@ identifier f; @@ f( + void ) { ... } coccinelle-1.0.4/tools/spgen/examples/disj_.cocci0000644000175000017500000000371512614153277021006 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr /// Description for the disj script. //# This is a limitation. //# This is another limitation. /// // Confidence: Moderate // Comments: This is to test disjunction generation. virtual patch virtual context virtual org virtual report @disj depends on patch && !context && !org && !report@ expression E1, E2, E3; identifier x; @@ if (E2 < - E3 + E1 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | - this(E1); + that(E2); | - some_function(E1) + another_function(E2) ; - x = 30; ) ... } // ---------------------------------------------------------------------------- @disj_context depends on !patch && (context || org || report) exists@ identifier x; expression E1, E2, E3; position j0, j1; @@ if (E2@j0 < E3 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | this@j1(E1); | some_function@j1(E1) ; x = 30; ) ... } @disj_disj depends on !patch && (context || org || report)@ identifier x; expression E1, E2, E3; position disj_context.j0, disj_context.j1; @@ if (E2@j0 < * E3 ) { ... ( * this@j1(E1); | * some_function@j1(E1) ; * x = 30; ) ... } // ---------------------------------------------------------------------------- @script:python disj_org depends on org@ j0 << disj_context.j0; j1 << disj_context.j1; @@ msg = "Org message. Found a match in disj rule.." coccilib.org.print_todo(j0[0], msg) coccilib.org.print_link(j1[0], "") // ---------------------------------------------------------------------------- @script:python disj_report depends on report@ E1 << disj_context.E1; E2 << disj_context.E2; j0 << disj_context.j0; j1 << disj_context.j1; @@ msg = "Report message. Remove call to this(%s) and replace with call to that(%s) around line %s." % (E1,E2,j1[0].line) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/examples/disj.c0000644000175000017500000000073012614153277020003 0ustar eugeneugenint main(int *arg) { int m = function(arg); // should not match, lacks assignment to 30 if (*arg < 0) { some_function(10); m = *arg; } // should match! if (*arg < 1) { some_function(20); m = 30; } // should not match, contains some_function call to 0 if (*arg < 10) { m = 30; some_function(0); } // should match! if (*arg < 100) { this(5); } return m; } coccinelle-1.0.4/tools/spgen/examples/addvoid.c0000644000175000017500000000026712614153277020471 0ustar eugeneugen/* A function with no arguments. */ int main() { return 1; } /* A function prototype */ void function(); /* The body of the declared function */ void function() { return; } coccinelle-1.0.4/tools/spgen/examples/inherited.config0000644000175000017500000000124412614153277022051 0ustar eugeneugen/* This is a comment! */ d = This is a Coccinelle script to test inheritance between rules. c = h k = inheritance, test. o = --a-flag, --another-flag, --a-third-flag. l = Only works for functions with exact names f, g, h, hh.|Not really useful. a = Author1, affiliation. License1|Author2, affiliation. License2|Author3. u = http://coccinelle.lip6.fr/ m = Additional comments. 15:rule_h = org:"Replace call to h with call to hh on expression %s." % r.x // no report message; use same as org 23:rule_h2 = org:"This is a message for rule_h2 in org mode." report:"This is a message for rule_h2 in report mode." // nothing for rule on line 25; let the program generate it coccinelle-1.0.4/tools/spgen/examples/README.md0000644000175000017500000000155112614153277020167 0ustar eugeneugenExamples ============== Each example has four corresponding files: - name.c: C source file that returns matches/patches for the corresponding cocci file. Can be tested with spatch --sp-file name.cocci name.c - name.cocci: simple, unhardened Coccinelle script. - name.config: spgen configuration file for specifying preface and rule information. - name_.cocci: expected output when running spgen on the unhardened Coccinelle script with the config file. Should be a valid, hardened Coccinelle script. Can be tested on the C file with e.g. spatch --sp-file name_.cocci name.c -D report --no-show-diff Examples: - addvoid: minimal patch example - context: context example (all others are patches) - disj: example of using spgen on a rule with pattern-matching disjunctions - inherited: example of metavariable inheritance and usage for printing modes coccinelle-1.0.4/tools/spgen/examples/disj.config0000644000175000017500000000063212614153277021027 0ustar eugeneugen// description and confidence are required, everything else is optional description = Description for the disj script. confidence = Moderate limitations = This is a limitation.|This is another limitation. comments = This is to test disjunction generation. disj = org: "Org message. Found a match in disj rule." report: "Report message. Remove call to this(%s) and replace with call to that(%s)" % (E1,E2) coccinelle-1.0.4/tools/spgen/examples/addvoid.config0000644000175000017500000000055512614153277021514 0ustar eugeneugen// Generated config description = Adds void to function headers with no arguments. limitations = If a matched function has a prototype declaration, the script will not match the prototype. confidence = High options = --recursive-includes url = http://coccinelle.lip6.fr 5:addvoid = org:"WARNING: Zero-argument function \"%s\" should have void declaration." % (f) coccinelle-1.0.4/tools/spgen/examples/context.cocci0000644000175000017500000000052412614153277021375 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @@ local function f; identifier x, y, m; @@ f( * int x, int y ) { int m = x * y; ... return m; } coccinelle-1.0.4/tools/spgen/examples/context.config0000644000175000017500000000065012614153277021562 0ustar eugeneugen// Generated config description = A generated context rule! This is a Coccinelle script that tests the use of the local function metavariable type in SmPL. This comment is longer than 80 characters, so it will be split. confidence = Low 5:localf = org:"Found a function with arguments %s and %s that multiplies its arguments" % (x,y) report:"ERROR: Found a function with arguments %s and %s that are multiplied" % (x,y) coccinelle-1.0.4/tools/spgen/examples/inherited.cocci0000644000175000017500000000057512614153277021672 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @r@ expression x; @@ ( f(x); | g(1); ) @@ expression r.x; @@ - h(x); + hh(x); @@ expression r.x; @@ - h2(x); + hh22(x); @@ @@ - foo(1); + bar(1); coccinelle-1.0.4/tools/spgen/examples/addvoid_.cocci0000644000175000017500000000263712614153277021471 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr /// Adds void to function headers with no arguments. //# If a matched function has a prototype declaration, the script will not //# match the prototype. /// // Confidence: High // URL: http://coccinelle.lip6.fr // Options: --recursive-includes virtual patch virtual context virtual org virtual report @addvoid depends on patch && !context && !org && !report@ identifier f; @@ f( + void ) { ... } // ---------------------------------------------------------------------------- @addvoid_context depends on !patch && (context || org || report)@ identifier f; position j0; @@ * f@j0( ) { ... } // ---------------------------------------------------------------------------- @script:python addvoid_org depends on org@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.org.print_safe_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python addvoid_report depends on report@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/examples/disj.cocci0000644000175000017500000000070112614153277020637 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr @disj@ expression E1, E2, E3; identifier x; @@ if (E2 < - E3 + E1 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | - this(E1); + that(E2); | - some_function(E1) + another_function(E2) ; - x = 30; ) ... } coccinelle-1.0.4/tools/spgen/examples/context_.cocci0000644000175000017500000000302112614153277021527 0ustar eugeneugen// This file is part of Coccinelle, lincensed under the terms of the GPL v2. // See copyright.txt in the Coccinelle source code for more information. // The Coccinelle source code can be obtained at http://coccinelle.lip6.fr /// A generated context rule! This is a Coccinelle script that tests the use of /// the local function metavariable type in SmPL. This comment is longer than /// 80 characters, so it will be split. /// // Confidence: Low virtual context virtual org virtual report // ---------------------------------------------------------------------------- @localf depends on context || org || report@ identifier m, x, y; local function f; position j0, j1, j2; @@ f@j0( * int x, int y ) { int m@j1 = x * y; ... return m@j2; } // ---------------------------------------------------------------------------- @script:python localf_org depends on org@ x << localf.x; y << localf.y; j0 << localf.j0; j1 << localf.j1; j2 << localf.j2; @@ msg = "Found a function with arguments %s and %s that multiplies its arguments " % (x,y) coccilib.org.print_safe_todo(j0[0], msg) coccilib.org.print_link(j1[0], "") coccilib.org.print_link(j2[0], "") // ---------------------------------------------------------------------------- @script:python localf_report depends on report@ x << localf.x; y << localf.y; j0 << localf.j0; j1 << localf.j1; j2 << localf.j2; @@ msg = "ERROR: Found a function with arguments %s and %s that are multiplied around lines %s,%s." % (x,y,j1[0].line,j2[0].line) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/0000755000175000017500000000000012614153277016232 5ustar eugeneugencoccinelle-1.0.4/tools/spgen/tests/tiny.config0000644000175000017500000000073412614153277020410 0ustar eugeneugendescription = This is a description for the Coccinelle script tiny.cocci. confidence = Low keywords = tiny, negative, assignment. limitations = limitation 1.|limitation 2. authors = Karl Koder, DIKU. Some license.|Hanne Hacker, DIKU. Some license. url = http://coccinelle.lip6.fr/ options = --option-1, --option-2, --option-3. comments = Further comments. some_rule = org: "WARNING: Check for negative value in assignment" report: "Check for negative value in assignment" coccinelle-1.0.4/tools/spgen/tests/metaops.expected0000644000175000017500000000334412614153277021431 0ustar eugeneugen/// Meta operators /// // Confidence: Moderate virtual patch virtual context virtual org virtual report @plusminus depends on patch && !context && !org && !report@ expression e1, e2; binary operator op1 = { -, *, /, %, |, &, ^, <<, >>, &&, ||, ==, !=, >, >=, <, <= } ; @@ - e1 op1 e2 + e1 + e2 @assign depends on patch && !context && !org && !report@ expression e1, e2; assignment operator aop1 = { +=, -=, *=, /=, %=, |=, &=, ^=, <<=, >>= }; assignment operator aop2 = = ; @@ ( - e1 aop1 e2 + e1 = e2 | - e1 aop2 e2 + e1 += e2 ) // ---------------------------------------------------------------------------- @plusminus_context depends on !patch && (context || org || report)@ expression e1, e2; binary operator op1 = {-,*,/,%,|,&,^,<<,>>,&&,||,==,!=,>,>=,<,<=}; position j0; @@ * e1@j0 op1 e2 @assign_context depends on !patch && (context || org || report)@ assignment operator aop1 = {+=,-=,*=,/=,%=,|=,&=,^=,<<=,>>=}, aop2 = =; expression e1, e2; position j0; @@ ( * e1@j0 aop1 e2 | * e1@j0 aop2 e2 ) // ---------------------------------------------------------------------------- @script:python plusminus_org depends on org@ j0 << plusminus_context.j0; @@ msg = "Binary operator." coccilib.org.print_todo(j0[0], msg) @script:python assign_org depends on org@ j0 << assign_context.j0; @@ msg = "Assignment operator." coccilib.org.print_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python plusminus_report depends on report@ j0 << plusminus_context.j0; @@ msg = "Binary operator." coccilib.report.print_report(j0[0], msg) @script:python assign_report depends on report@ j0 << assign_context.j0; @@ msg = "Assignment operator." coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/addvoid.cocci0000644000175000017500000000005212614153277020643 0ustar eugeneugen@@ identifier f; @@ f( + void ) { ... } coccinelle-1.0.4/tools/spgen/tests/local.cocci0000644000175000017500000000016212614153277020325 0ustar eugeneugen@@ local function f; identifier x, y, m; @@ f( * int x, int y ) { int m = x * y; ... return m; } coccinelle-1.0.4/tools/spgen/tests/metaops.cocci0000644000175000017500000000050412614153277020703 0ustar eugeneugen@@ expression e1, e2; binary operator op1 = { -, *, /, %, |, &, ^, <<, >>, &&, ||, ==, !=, >, >=, <, <= } ; @@ - e1 op1 e2 + e1 + e2 @@ expression e1, e2; assignment operator aop1 = { +=, -=, *=, /=, %=, |=, &=, ^=, <<=, >>= }; assignment operator aop2 = = ; @@ ( - e1 aop1 e2 + e1 = e2 | - e1 aop2 e2 + e1 += e2 ) coccinelle-1.0.4/tools/spgen/tests/interleaved.config0000644000175000017500000000057312614153277021730 0ustar eugeneugendescription = Removes field and name struct fields from module_ calls. keywords = MACRO, .name, .field. confidence = Low fix1 = org:"Found .field = MACRO for identifier %s" % (match1.d) report:"Found .field = MACRO for identifier %s" % (match1.d) fix2 = org:"Found .name = MACRO for identifier %s" % (match2.d) report:"Found .name = MACRO for identifier %s" % (match2.d) coccinelle-1.0.4/tools/spgen/tests/local.expected0000644000175000017500000000245712614153277021057 0ustar eugeneugen/// A generated context rule! This is a Coccinelle script that tests the use of /// the local function metavariable type in SmPL. This comment is longer than /// 80 characters, so it will be split. /// // Confidence: Low virtual context virtual org virtual report // ---------------------------------------------------------------------------- @localf depends on context || org || report@ identifier m, x, y; local function f; position j0, j1, j2; @@ f@j0( * int x, int y ) { int m@j1 = x * y; ... return m@j2; } // ---------------------------------------------------------------------------- @script:python localf_org depends on org@ x << localf.x; y << localf.y; j0 << localf.j0; j1 << localf.j1; j2 << localf.j2; @@ msg = "Found a function with arguments %s and %s that multiplies its arguments " % (x,y) coccilib.org.print_safe_todo(j0[0], msg) coccilib.org.print_link(j1[0], "") coccilib.org.print_link(j2[0], "") // ---------------------------------------------------------------------------- @script:python localf_report depends on report@ x << localf.x; y << localf.y; j0 << localf.j0; j1 << localf.j1; j2 << localf.j2; @@ msg = "ERROR: Found a function with arguments %s and %s that are multiplied around lines %s,%s." % (x,y,j1[0].line,j2[0].line) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/metaops.config0000644000175000017500000000031712614153277021072 0ustar eugeneugen// Generated config description = Meta operators confidence = Moderate 1:plusminus = org:"Binary operator" report:"Binary operator" 9:assign = org:"Assignment operator" report:"Assignment operator" coccinelle-1.0.4/tools/spgen/tests/include.cocci0000644000175000017500000000126212614153277020660 0ustar eugeneugen@header@ @@ #include @eth_zero_addr@ expression e; @@ -memset(e,0,ETH_ALEN); +eth_zero_addr(e); @eth_broadcast_addr@ identifier e; @@ -memset(e,\(0xff\|0xFF\|255\),ETH_ALEN); +eth_broadcast_addr(e); @linux_header depends on !header && (eth_zero_addr || eth_broadcast_addr) @ @@ #include + #include + @special_header depends on !header && !linux_header && (eth_zero_addr || eth_broadcast_addr) @ @@ #include <.../...> + + #include + @custom_header depends on !header && !linux_header && !special_header && (eth_zero_addr || eth_broadcast_addr) @ @@ #include "..." + + #include coccinelle-1.0.4/tools/spgen/tests/inherited.expected0000644000175000017500000000460712614153277021737 0ustar eugeneugen/// This is a Coccinelle script to test inheritance between rules. //# Only works for functions with exact names f, g, h, hh. //# Not really useful. /// // Confidence: High // Copyright: (C) 2015 Author1, affiliation. License1 // Copyright: (C) 2015 Author2, affiliation. License2 // Copyright: (C) 2015 Author3. // URL: http://coccinelle.lip6.fr/ // Comments: Additional comments. // Options: --a-flag, --another-flag, --a-third-flag. // Keywords: inheritance, test. virtual patch virtual context virtual org virtual report @r@ expression x; @@ ( f(x); | g(1); ) @rule_h depends on patch && !context && !org && !report@ expression r.x; @@ - h(x); + hh(x); @rule_h2 depends on patch && !context && !org && !report@ expression r.x; @@ - h2(x); + hh22(x); @rule_0 depends on patch && !context && !org && !report@ @@ - foo(1); + bar(1); // ---------------------------------------------------------------------------- @rule_h_context depends on !patch && (context || org || report)@ expression r.x; position j0; @@ * h@j0(x); @rule_h2_context depends on !patch && (context || org || report)@ expression r.x; position j0; @@ * h2@j0(x); @rule_0_context depends on !patch && (context || org || report)@ position j0; @@ * foo@j0(1); // ---------------------------------------------------------------------------- @script:python rule_h_org depends on org@ x << r.x; j0 << rule_h_context.j0; @@ msg = "Replace call to h with call to hh on expression %s. " % (x) coccilib.org.print_safe_todo(j0[0], msg) @script:python rule_h2_org depends on org@ j0 << rule_h2_context.j0; @@ msg = "This is a message for rule_h2 in org mode.." coccilib.org.print_todo(j0[0], msg) @script:python rule_0_org depends on org@ j0 << rule_0_context.j0; @@ msg = "found a match around here ...." coccilib.org.print_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python rule_h_report depends on report@ x << r.x; j0 << rule_h_context.j0; @@ msg = "Replace call to h with call to hh on expression %s. " % (x) coccilib.report.print_report(j0[0], msg) @script:python rule_h2_report depends on report@ j0 << rule_h2_context.j0; @@ msg = "This is a message for rule_h2 in report mode.." coccilib.report.print_report(j0[0], msg) @script:python rule_0_report depends on report@ j0 << rule_0_context.j0; @@ msg = "found a match around here ...." coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/disj.expected0000644000175000017500000000335312614153277020712 0ustar eugeneugen/// Description for the disj script. //# This is a limitation. //# This is another limitation. /// // Confidence: Moderate // Comments: This is to test disjunction generation. virtual patch virtual context virtual org virtual report @disj depends on patch && !context && !org && !report@ expression E1, E2, E3; identifier x; @@ if (E2 < - E3 + E1 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | - this(E1); + that(E2); | - some_function(E1) + another_function(E2) ; - x = 30; ) ... } // ---------------------------------------------------------------------------- @disj_context depends on !patch && (context || org || report) exists@ identifier x; expression E1, E2, E3; position j0, j1; @@ if (E2@j0 < E3 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | this@j1(E1); | some_function@j1(E1) ; x = 30; ) ... } @disj_disj depends on !patch && (context || org || report)@ identifier x; expression E1, E2, E3; position disj_context.j0, disj_context.j1; @@ if (E2@j0 < * E3 ) { ... ( * this@j1(E1); | * some_function@j1(E1) ; * x = 30; ) ... } // ---------------------------------------------------------------------------- @script:python disj_org depends on org@ j0 << disj_context.j0; j1 << disj_context.j1; @@ msg = "Org message. Found a match in disj rule.." coccilib.org.print_todo(j0[0], msg) coccilib.org.print_link(j1[0], "") // ---------------------------------------------------------------------------- @script:python disj_report depends on report@ E1 << disj_context.E1; E2 << disj_context.E2; j0 << disj_context.j0; j1 << disj_context.j1; @@ msg = "Report message. Remove call to this(%s) and replace with call to that(%s) around line %s." % (E1,E2,j1[0].line) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/interleaved.cocci0000644000175000017500000000074712614153277021546 0ustar eugeneugen/* This file has interleaving of patch and non-patch rules. */ @match1@ declarer name module1; declarer name module2; identifier d; @@ ( module1(d); | module2(d, ...); ) @fix1 depends on match1@ identifier match1.d; @@ static struct struct_name d = { - .field = MACRO, }; @match2@ identifier d; @@ ( module3(&d) | module4(&d, ...) | module5(&d, ...) ) @fix2 depends on match2@ identifier match2.d; @@ static struct struct_name d = { - .name = MACRO, }; coccinelle-1.0.4/tools/spgen/tests/inherited.config0000644000175000017500000000124412614153277021375 0ustar eugeneugen/* This is a comment! */ d = This is a Coccinelle script to test inheritance between rules. c = h k = inheritance, test. o = --a-flag, --another-flag, --a-third-flag. l = Only works for functions with exact names f, g, h, hh.|Not really useful. a = Author1, affiliation. License1|Author2, affiliation. License2|Author3. u = http://coccinelle.lip6.fr/ m = Additional comments. 11:rule_h = org:"Replace call to h with call to hh on expression %s." % r.x // no report message; use same as org 19:rule_h2 = org:"This is a message for rule_h2 in org mode." report:"This is a message for rule_h2 in report mode." // nothing for rule on line 25; let the program generate it coccinelle-1.0.4/tools/spgen/tests/disj.config0000644000175000017500000000063212614153277020353 0ustar eugeneugen// description and confidence are required, everything else is optional description = Description for the disj script. confidence = Moderate limitations = This is a limitation.|This is another limitation. comments = This is to test disjunction generation. disj = org: "Org message. Found a match in disj rule." report: "Report message. Remove call to this(%s) and replace with call to that(%s)" % (E1,E2) coccinelle-1.0.4/tools/spgen/tests/addvoid.config0000644000175000017500000000065512614153277021041 0ustar eugeneugen// Generated config description = Adds void to function headers with no arguments. limitations = If a matched function has a prototype declaration, the script will not match the prototype.|Another limitation can be specified with a pipe as a delimiter. confidence = High options = --recursive-includes url = http://coccinelle.lip6.fr 1:addvoid = org:"WARNING: Zero-argument function \"%s\" should have void declaration." % (f) coccinelle-1.0.4/tools/spgen/tests/local.config0000644000175000017500000000065012614153277020514 0ustar eugeneugen// Generated config description = A generated context rule! This is a Coccinelle script that tests the use of the local function metavariable type in SmPL. This comment is longer than 80 characters, so it will be split. confidence = Low 1:localf = org:"Found a function with arguments %s and %s that multiplies its arguments" % (x,y) report:"ERROR: Found a function with arguments %s and %s that are multiplied" % (x,y) coccinelle-1.0.4/tools/spgen/tests/tiny.expected0000644000175000017500000000241412614153277020741 0ustar eugeneugen/// This is a description for the Coccinelle script tiny.cocci. //# limitation 1. //# limitation 2. /// // Confidence: Low // Copyright: (C) 2015 Karl Koder, DIKU. Some license. // Copyright: (C) 2015 Hanne Hacker, DIKU. Some license. // URL: http://coccinelle.lip6.fr/ // Comments: Further comments. // Options: --option-1, --option-2, --option-3. // Keywords: tiny, negative, assignment. virtual patch virtual context virtual org virtual report @some_rule depends on patch && !context && !org && !report@ int e; identifier i; @@ int i = e; + if (i < 0) i = 0; ... // ---------------------------------------------------------------------------- @some_rule_context depends on !patch && (context || org || report)@ identifier i; int e; position j0; @@ * int i@j0 = e; ... // ---------------------------------------------------------------------------- @script:python some_rule_org depends on org@ j0 << some_rule_context.j0; @@ msg = "WARNING: Check for negative value in assignment." coccilib.org.print_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python some_rule_report depends on report@ j0 << some_rule_context.j0; @@ msg = "Check for negative value in assignment." coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/inherited.cocci0000644000175000017500000000023312614153277021205 0ustar eugeneugen@r@ expression x; @@ ( f(x); | g(1); ) @@ expression r.x; @@ - h(x); + hh(x); @@ expression r.x; @@ - h2(x); + hh22(x); @@ @@ - foo(1); + bar(1); coccinelle-1.0.4/tools/spgen/tests/disj.cocci0000644000175000017500000000033712614153277020170 0ustar eugeneugen@disj@ expression E1, E2, E3; identifier x; @@ if (E2 < - E3 + E1 ) { ... ( some_function(0); x = 30; | some_function(1); x = 30; | - this(E1); + that(E2); | - some_function(E1) + another_function(E2) ; - x = 30; ) ... } coccinelle-1.0.4/tools/spgen/tests/interleaved.expected0000644000175000017500000000401412614153277022256 0ustar eugeneugen/// Removes field and name struct fields from module_ calls. /// // Confidence: Low // Keywords: MACRO, .name, .field. virtual patch virtual context virtual org virtual report /* This file has interleaving of patch and non-patch rules. */ @match1@ declarer name module1; declarer name module2; identifier d; @@ ( module1(d); | module2(d, ...); ) @fix1 depends on match1 && patch && !context && !org && !report@ identifier match1.d; @@ static struct struct_name d = { - .field = MACRO, }; @match2@ identifier d; @@ ( module3(&d) | module4(&d, ...) | module5(&d, ...) ) @fix2 depends on match2 && patch && !context && !org && !report@ identifier match2.d; @@ static struct struct_name d = { - .name = MACRO, }; // ---------------------------------------------------------------------------- @fix1_context depends on match1 && !patch && (context || org || report)@ identifier match1.d; position j0; @@ static struct struct_name d@j0 = { * .field = MACRO, }; @fix2_context depends on match2 && !patch && (context || org || report)@ identifier match2.d; position j0; @@ static struct struct_name d@j0 = { * .name = MACRO, }; // ---------------------------------------------------------------------------- @script:python fix1_org depends on org@ d << match1.d; j0 << fix1_context.j0; @@ msg = "Found .field = MACRO for identifier %s " % (d) coccilib.org.print_safe_todo(j0[0], msg) @script:python fix2_org depends on org@ d << match2.d; j0 << fix2_context.j0; @@ msg = "Found .name = MACRO for identifier %s " % (d) coccilib.org.print_safe_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python fix1_report depends on report@ d << match1.d; j0 << fix1_context.j0; @@ msg = "Found .field = MACRO for identifier %s " % (d) coccilib.report.print_report(j0[0], msg) @script:python fix2_report depends on report@ d << match2.d; j0 << fix2_context.j0; @@ msg = "Found .name = MACRO for identifier %s " % (d) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/tiny.cocci0000644000175000017500000000011412614153277020213 0ustar eugeneugen@some_rule@ int e; identifier i; @@ int i = e; + if (i < 0) i = 0; ... coccinelle-1.0.4/tools/spgen/tests/include.expected0000644000175000017500000000735712614153277021414 0ustar eugeneugen/// include script /// // Confidence: Low virtual patch virtual context virtual org virtual report @header@ @@ #include @eth_zero_addr depends on patch && !context && !org && !report@ expression e; @@ -memset(e,0,ETH_ALEN); +eth_zero_addr(e); @eth_broadcast_addr depends on patch && !context && !org && !report@ identifier e; @@ -memset(e,\(0xff\|0xFF\|255\),ETH_ALEN); +eth_broadcast_addr(e); @linux_header depends on !header && (eth_zero_addr || eth_broadcast_addr) && patch && !context && !org && !report@ @@ #include + #include + @special_header depends on !header && !linux_header && (eth_zero_addr || eth_broadcast_addr) && patch && !context && !org && !report@ @@ #include <.../...> + + #include + @custom_header depends on !header && !linux_header && !special_header && (eth_zero_addr || eth_broadcast_addr) && patch && !context && !org && !report@ @@ #include "..." + + #include // ---------------------------------------------------------------------------- @eth_zero_addr_context depends on !patch && (context || org || report)@ expression e; position j0; @@ * memset@j0(e,0,ETH_ALEN); @eth_broadcast_addr_context depends on !patch && (context || org || report)@ identifier e; position j0, j1; @@ * memset@j0(e,\(0xff@j1\|0xFF@j1\|255@j1\),ETH_ALEN); @linux_header_context depends on !header && (eth_zero_addr || eth_broadcast_addr) && !patch && (context || org || report)@ position j0; @@ * #include @j0 @special_header_context depends on !header && !linux_header && (eth_zero_addr || eth_broadcast_addr) && !patch && (context || org || report)@ position j0; @@ * #include <.../...>@j0 @custom_header_context depends on !header && !linux_header && !special_header && (eth_zero_addr || eth_broadcast_addr) && !patch && (context || org || report)@ position j0; @@ * #include "..."@j0 // ---------------------------------------------------------------------------- @script:python eth_zero_addr_org depends on org@ j0 << eth_zero_addr_context.j0; @@ msg = "this is a rule." coccilib.org.print_todo(j0[0], msg) @script:python eth_broadcast_addr_org depends on org@ j0 << eth_broadcast_addr_context.j0; j1 << eth_broadcast_addr_context.j1; @@ msg = "this is antoher rule." coccilib.org.print_todo(j0[0], msg) coccilib.org.print_link(j1[0], "") @script:python linux_header_org depends on org@ j0 << linux_header_context.j0; @@ msg = "this is a third rule." coccilib.org.print_todo(j0[0], msg) @script:python special_header_org depends on org@ j0 << special_header_context.j0; @@ msg = "this is a special rule." coccilib.org.print_todo(j0[0], msg) @script:python custom_header_org depends on org@ j0 << custom_header_context.j0; @@ msg = "this is a custom rule." coccilib.org.print_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python eth_zero_addr_report depends on report@ j0 << eth_zero_addr_context.j0; @@ msg = "this is a rule." coccilib.report.print_report(j0[0], msg) @script:python eth_broadcast_addr_report depends on report@ j0 << eth_broadcast_addr_context.j0; j1 << eth_broadcast_addr_context.j1; @@ msg = "this is antoher rule around line %s." % (j1[0].line) coccilib.report.print_report(j0[0], msg) @script:python linux_header_report depends on report@ j0 << linux_header_context.j0; @@ msg = "this is a third rule." coccilib.report.print_report(j0[0], msg) @script:python special_header_report depends on report@ j0 << special_header_context.j0; @@ msg = "this is a special rule." coccilib.report.print_report(j0[0], msg) @script:python custom_header_report depends on report@ j0 << custom_header_context.j0; @@ msg = "this is a custom rule." coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/addvoid.expected0000644000175000017500000000240112614153277021364 0ustar eugeneugen/// Adds void to function headers with no arguments. //# If a matched function has a prototype declaration, the script will not //# match the prototype. //# Another limitation can be specified with a pipe as a delimiter. /// // Confidence: High // URL: http://coccinelle.lip6.fr // Options: --recursive-includes virtual patch virtual context virtual org virtual report @addvoid depends on patch && !context && !org && !report@ identifier f; @@ f( + void ) { ... } // ---------------------------------------------------------------------------- @addvoid_context depends on !patch && (context || org || report)@ identifier f; position j0; @@ * f@j0( ) { ... } // ---------------------------------------------------------------------------- @script:python addvoid_org depends on org@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.org.print_safe_todo(j0[0], msg) // ---------------------------------------------------------------------------- @script:python addvoid_report depends on report@ f << addvoid_context.f; j0 << addvoid_context.j0; @@ msg = "WARNING: Zero-argument function \"%s\" should have void declaration. " % (f) coccilib.report.print_report(j0[0], msg) coccinelle-1.0.4/tools/spgen/tests/include.config0000644000175000017500000000070212614153277021043 0ustar eugeneugen// Generated config description = include script confidence = Low special_header = org:"this is a special rule" report:"this is a special rule" linux_header = org:"this is a third rule" report:"this is a third rule" eth_zero_addr = org:"this is a rule" report:"this is a rule" eth_broadcast_addr = org:"this is antoher rule" report:"this is antoher rule" custom_header = org:"this is a custom rule" report:"this is a custom rule" coccinelle-1.0.4/tools/spgen/Makefile0000644000175000017500000000153112614153277016530 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr COCCIDIR=../.. -include $(COCCIDIR)/Makefile.config all: @$(ECHO) -e "\n\n\tCompiling spgen ...\n\n" cd source; $(MAKE) all || exit 1; cd .. @$(ECHO) -e "\n\n\tspgen can now be installed via 'make install'.\n\n" # also compile documentation; this is not done by default world: docs all clean: cd source; $(MAKE) clean; cd .. cd documentation; $(MAKE) clean; cd .. install: cd source; $(MAKE) install || exit 1; cd .. @$(ECHO) -e "\n\n\tspgen installed: DONE!!!\n\n" uninstall: cd source; $(MAKE) uninstall || exit 1; cd .. @$(ECHO) -e "\n\n\tspgen uninstalled: DONE!!!\n\n" docs: cd documentation; $(MAKE) docs; cd .. coccinelle-1.0.4/tools/alloc_free.ml0000644000175000017500000001165612614153277016412 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/all.opt.itarget0000644000175000017500000000021612614153277016705 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.4/tools/README.splitpatch0000644000175000017500000001311412614153277017006 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.4/tools/gitgrep.ml0000644000175000017500000001637412614153277015762 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 maxlen is per file, regardless of whether the pattern is found in that file. *) (* Patterns can't use ^ and $ *) type dir = Minus | Plus | Context | ChangeLog type orientation = Pos | Neg 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 match_one start dir cl pattern line = if ((start = '-' && dir = Minus) || (start = '+' && dir = Plus) || (cl && dir = ChangeLog) || (not (start = '-') && not (start = '+') && dir = Context)) then matches pattern line else false let res = ref [] let changed = ref 0 let badgits = ref [] let add x = function (y::_) as a -> if x = y then a else x::a | _ -> [x] let too_many_changed = function Some n -> !changed > n | None -> false let scan allpatterns i maxlen = let allpospatterns = List.filter (function (_,Pos,_) -> true | _ -> false) allpatterns in let allnegpatterns = List.filter (function (_,Neg,_) -> true | _ -> false) allpatterns in let git = ref "" in let pospatterns = ref allpospatterns in let negpatterns = ref allnegpatterns in let clear_patterns _ = pospatterns := []; negpatterns := [] in let ender isalldone = (if too_many_changed maxlen then badgits := add !git !badgits else if isalldone then if !pospatterns = [] && !negpatterns = allnegpatterns then res := Git(!git)::!res); if isalldone then (pospatterns := allpospatterns; negpatterns := allnegpatterns) in let rec loop cl = let line = input_line i in match Str.split space line with ["commit";newgit] -> ender true; changed := 0; git := newgit; loop true | "diff"::_ -> ender false; changed := 0; loop false | _ -> if String.length line = 0 then loop cl else begin let start = String.get line 0 in (if start = '-' || start = '+' then changed := !changed + 1); let fails = List.exists (function (dir,ok,pattern) -> match_one start dir cl pattern line) !negpatterns in if fails then begin clear_patterns(); loop cl end else begin let remaining_patterns = List.filter (function (dir,ok,pattern) -> not (* argument is true if match succeeds *) (match_one start dir cl pattern line)) !pospatterns in pospatterns := remaining_patterns; loop cl end end in try loop false with End_of_file -> ender true (* for Minus and Plus directions only *) let scan_grouped allpatterns i maxlen = let block = ref 0 in let git = ref "" in let patterns = ref allpatterns in let ender isdone = if too_many_changed maxlen then badgits := add !git !badgits else if isdone then begin (if !patterns = [] then res := Block(!block,!git)::!res); patterns := [] end in (* mp = true in minus-plus region *) let rec loop mp = let line = input_line i in match Str.split space line with ["commit";newgit] -> ender true; patterns := allpatterns; changed := 0; block := 0; git := newgit; loop false | "diff"::_ -> ender false; changed := 0; loop false | _ -> if String.length line > 0 then let first_char = String.get line 0 in (if first_char = '-' || first_char = '+' then changed := !changed + 1); let new_mp = match first_char with '-' | '+' -> if not mp then begin ender true; block := !block + 1; true end else true | _ -> false in let remaining_patterns = List.filter (function (dir,ok,pattern) -> not (* argument is true if the pattern matches *) (match (first_char,dir) with ('-',Minus) | ('+',Plus) -> matches pattern line | _ -> false)) !patterns in patterns := remaining_patterns; loop new_mp else loop mp in try loop false with End_of_file -> ender true 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 version = ref None let isword s = Str.string_match (Str.regexp "^[[a-zA-Z][][a-zA-Z0-9_*+-]*$") s 0 let make_pattern s = if isword s then (Printf.eprintf "word\n"; Str.regexp (Printf.sprintf "\\b%s\\b" s)) else (Printf.eprintf "not word\n"; Str.regexp s) let rec split_args = function [] -> [] | "-grouped"::rest -> grouped := true; split_args rest | "-maxlen"::len::rest -> maxlen := Some (int_of_string len); split_args rest | "-version"::v::rest -> version := Some v; split_args rest | key::pattern::rest -> let pattern = make_pattern pattern in let rest = split_args rest in (match key with "-" -> (Minus,Pos,pattern) :: rest | "+" -> (Plus,Pos,pattern) :: rest | "@" -> (Context,Pos,pattern) :: rest | "C" -> (ChangeLog,Pos,pattern) :: rest | "no-" -> (Minus,Neg,pattern) :: rest | "no+" -> (Plus,Neg,pattern) :: rest | "no@" -> (Context,Neg,pattern) :: rest | "noC" -> (ChangeLog,Neg,pattern) :: rest | _ -> failwith "bad argument list") | _ -> failwith "bad argument list" let process patterns version maxlen = res := []; let i = match version with Some version -> open_git version | None -> stdin in (if !grouped then scan_grouped patterns i maxlen else scan patterns i maxlen); ((match version with Some _ -> close_in i | None -> ()); List.rev !res) let _ = if Array.length Sys.argv < 3 then failwith "arguments: -/+/@/C pattern -/+/@/C pattern ... version"; let args = List.tl(Array.to_list Sys.argv) in let requirements = split_args args in let version = !version in (if !grouped then if List.exists (function (_,Neg,_) -> true | (dir,_,_) -> not (dir = Minus || dir = Plus)) requirements then failwith "only minus and plus requirements, and no negated requirements, allowed in the grouped case"); let res = List.map (function Git x -> x | Block (_,x) -> x) (process requirements version !maxlen) 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 = List.filter (function x -> not(List.mem x !badgits)) res in List.iter (function name -> Printf.printf "%s\n" name) res coccinelle-1.0.4/tools/distributed/0000755000175000017500000000000012614153277016276 5ustar eugeneugencoccinelle-1.0.4/tools/distributed/README0000644000175000017500000000106012614153277017153 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.4/tools/distributed/cleanup.ml0000644000175000017500000000433712614153277020266 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 = [] (* no clue what this is supposed to do, but can discard output 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.4/tools/distributed/spatch_linux.c0000644000175000017500000000374512614153277021154 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.4/tools/distributed/spatch_linux_script0000755000175000017500000000042012614153277022305 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.4/tools/distributed/Makefile0000644000175000017500000000045312614153277017740 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.4/tools/licensify.ml0000644000175000017500000001036312614153277016276 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (** * For a while, the version-conrolled source code of Coccinelle * did not contain any legal header. * At that time, this script was used to add the headers during the * release process. * * In commit eec9ca2207c273 the header has been added to the * version-controlled iles (using the licensify-new.ml script) * so this licensify.ml script has become useless. *) let lines = ["Copyright 2012-2015, 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.4/tools/licensify-new.ml0000644000175000017500000000603712614153277017070 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (** * This script adds a legal header to various kinds of files. * To apply it to a directory, change to this directory and do: * ocaml str.cma path/to/licensify-new.ml *) let lines = ["This file is part of Coccinelle, lincensed under the terms of the GPL v2."; "See copyright.txt in the Coccinelle source code for more information."; "The Coccinelle source code can be obtained at http://coccinelle.lip6.fr"; ] 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"; 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.4/tools/splitpatch.ml0000644000175000017500000005700412614153277016467 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 affected_files sha = Printf.sprintf "cd %s; git show --oneline --name-only %s" !git_tree sha 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 let nonmessage = read_up_to_dashes i in if message = [] then (subject,None,cover,[]) else (subject,Some cover,message,nonmessage) | _ -> failwith ("Subject must be exactly one line "^ (string_of_int (List.length subject))) (* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *) (* Info processing *) let get_info info_file = let tbl = Hashtbl.create 101 in (if Sys.file_exists info_file then let lines = cmd_to_list (Printf.sprintf "grep ^## %s" info_file) in List.iter (function line -> if Str.string_match (Str.regexp "## *") line 0 then let line = let match_end = Str.match_end () in String.sub line match_end (String.length line - match_end) in try let line = match !prefix_before with None -> line | Some pb -> let pb = pb^"/" in String.concat "" (Str.split (Str.regexp pb) line) in let end_of_file = Str.search_forward (Str.regexp " *: *") line 0 in let match_end = Str.match_end () in let file = String.sub line 0 end_of_file in let info = String.sub line match_end (String.length line - match_end) in let cell = try Hashtbl.find tbl file with Not_found -> let cell = ref [] in Hashtbl.add tbl file cell; cell in cell := info :: !cell with Not_found -> Printf.fprintf stderr "no file found in %s\n" line) lines); tbl (* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *) (* 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() | _ -> 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 = (*Printf.printf "getting counts for:\n"; List.iter (function (bonus,x) -> Printf.printf " %d: %s\n" bonus (String.concat " " x)) l; Printf.printf "\n"; *) 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 (*List.iter (function (wt,(bonus,x)) -> Printf.printf " %f: %d: %s\n" wt bonus (String.concat " " x)) weighted; *) let rec loop n = function [] -> [] | (_,k)::rest -> (k,n) :: (loop (n+1) rest) in loop 1 weighted let superset l1 l2 = List.for_all (function x -> List.mem x l1) l2 let get_most_common_subject files default = let all = List.map (function file -> cmd_to_list (subject_command file)) files in let entries = List.map (function entries -> List.rev (List.fold_left (fun prev line -> match Str.split (Str.regexp " +") line with [] -> failwith ("bad git log line: " ^ line) | commit::rest -> let rec loop = function [] -> [] | x::xs -> if last_char x = ':' then x :: loop xs else [] in let tags = loop rest in (* ignore lines with no : *) match tags with [] -> prev | _ -> let aff_files = List.tl (cmd_to_list (affected_files commit)) in let bonus = (* 0 is better *) if superset files aff_files then 0 else 1 in (bonus,tags)::prev) [] entries)) all in (* Does there exist a file for which we have no information? *) if List.exists (function x -> x = []) all then default^":" else 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 (bonus,entry) as allentry -> (bonus, (List.fold_left (+) 0 (List.map (List.assoc allentry) entries), entry))) common_entries) in (* Printf.printf "Files:\n"; List.iter (function f -> Printf.printf " %s\n" f) files; Printf.printf "Subjects:\n"; List.iter (function (ct,(bonus,f)) -> Printf.printf " %d: %d: %s\n" ct bonus (String.concat " " f)) common_entry_counts; Printf.printf "\n"; *) 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 cover 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 && not cover then Printf.fprintf o "Subject: [PATCH] %s\n\n" subject else if number >= 100 then Printf.fprintf o "Subject: [PATCH %03d/%d] %s\n\n" ctr number subject else if number >= 10 then Printf.fprintf o "Subject: [PATCH %02d/%d] %s\n\n" ctr number subject else Printf.fprintf o "Subject: [PATCH %d/%d] %s\n\n" ctr number subject let print_info o info_tbl files = let do_one prefix file = try let lines = List.rev (!(Hashtbl.find info_tbl file)) in Printf.fprintf o "%s" prefix; List.iter (function line -> Printf.fprintf o "%s\n" line) lines; Printf.fprintf o "\n" with Not_found -> () in match files with [file] -> do_one "" file | l -> List.iter (function file -> do_one (Printf.sprintf "%s:\n" file) file) l let cluster_by_dir diffs = let info = List.sort compare (List.map (function (file,diff) -> (Filename.dirname file, file, diff)) diffs) in let rec loop = function [] -> [] | (dir,file,diffs)::rest -> match loop rest with ((dira,filea,diffsa)::r)::rest -> if dir = dira then ((dir,file,diffs)::(dira,filea,diffsa)::r)::rest else [(dir,file,diffs)]::((dira,filea,diffsa)::r)::rest | [] -> [[(dir,file,diffs)]] | []::_ -> failwith "not possible" in List.map (List.map (function (dir,file,diffs) -> (file,diffs))) (loop info) let make_message_files subject cover message nonmessage date maintainer_table patch front add_ext nomerge dirmerge info_tbl = let ctr = ref 0 in let elements = Hashtbl.fold (function (services,maintainers) -> function diffs -> function rest -> if services=[default_string] || 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 if dirmerge then let diffs = List.concat (List.map (function (common,diffs) -> !diffs) !diffs) in let diffs = cluster_by_dir diffs in List.map (function diffs -> ctr := !ctr + 1; let (files,diffs) = List.split (List.rev diffs) in let subject = get_most_common_subject files "???" in (subject,(!ctr,false,maintainers,files,diffs))) 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 elements = List.sort (fun (_,(ctr1,_,_,_,_)) (_,(ctr2,_,_,_,_)) -> compare ctr1 ctr2) 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 (not (cover=None)) (Printf.sprintf "%s %s" common subject); print_info o info_tbl files; print_all o message; Printf.fprintf o "\n---\n"; print_all o nonmessage; (if not (nonmessage = []) then Printf.fprintf o "\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) 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 file 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 true subject; print_all o cover; Printf.fprintf o "\n---\n\n"; let l = cmd_to_list (Printf.sprintf "diffstat -p1 < %s" file) in let adjust_after = match !prefix_after with None -> l | Some pa -> let pa = (String.concat "/" (Str.split (Str.regexp "/") pa))^"/" in List.map (function l -> String.concat "" (Str.split (Str.regexp pa) l)) l in List.iter (function line -> Printf.fprintf o "%s\n" line) adjust_after; 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 nonmessage maintainer_table patch nomerge dirmerge info_tbl = 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 nonmessage date maintainer_table patch front add_ext nomerge dirmerge info_tbl in make_cover_file (List.length generated) patch subject cover front date maintainer_table; generate_command front cover generated (* ------------------------------------------------------------------------ *) let nomerge = ref false let dirmerge = 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); let (dirmergep,other_args) = List.partition (function a -> a = "-dirmerge") other_args in (* lazy solution: one directory up from the file level *) (if not(dirmergep = []) then dirmerge := 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 let info_file = (safe_chop_extension file)^".info" in (* set up environment *) read_configs message_file; (* get message information *) let (subject,cover,message,nonmessage) = get_template_information message_file in (* get file-specific information, if any *) let info_tbl = get_info info_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 nonmessage maintainer_table file !nomerge !dirmerge info_tbl coccinelle-1.0.4/tools/dir_stats.ml0000644000175000017500000001147312614153277016310 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/obsolete/0000755000175000017500000000000012614153277015570 5ustar eugeneugencoccinelle-1.0.4/tools/obsolete/generate_dependencies.ml0000644000175000017500000000542012614153277022423 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.4/tools/spp.ml0000644000175000017500000000450512614153277015114 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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" (String.concat " " 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 " ^ (String.concat " " 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" (String.concat " " nargs) outfile) in pr2 cmd2; Sys.command cmd2 end let _ = main () coccinelle-1.0.4/tools/gitsort.ml0000644000175000017500000000772412614153277016013 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/dumper.ml0000644000175000017500000000551612614153277015611 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/bridge.ml0000644000175000017500000001660712614153277015554 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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.4/tools/process_isoprofile.ml0000644000175000017500000001235712614153277020227 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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 || parse_ovd > total_ovd || 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 || mysat_ovd > total_ovd || 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.4/tools/cstripenv.ml0000644000175000017500000000561312614153277016330 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/all.itarget0000644000175000017500000000017612614153277016111 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.4/tools/extract_c_and_res.ml0000644000175000017500000000342012614153277017754 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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: " ^ Filename.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.4/tools/Makefile0000644000175000017500000000431712614153277015421 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr 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 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) $+ 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 *.cm[ioxa] *.o *.a *.cmxa *.annot distclean: clean rm -f $(PROGS) isoprof rm -f .depend .PHONY: 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.4/tools/cocci-send-email.perl0000644000175000017500000011276012614153277017743 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.4/tools/dumper.mli0000644000175000017500000000062212614153277015753 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) (* 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.4/tools/pycocci0000755000175000017500000005742712614153277015352 0ustar eugeneugen#!/usr/bin/env python # # Copyright (c) 2014 Luis R. Rodriguez # Copyright (c) 2013 Johannes Berg # # This file is released under the GPLv2. # # Python wrapper for Coccinelle for multithreaded support, # designed to be used for working on a git tree, and with sensible # defaults, specifically for kernel developers. from multiprocessing import Process, cpu_count, Queue import argparse, subprocess, os, sys, re import tempfile, shutil import uuid class ReqError(Exception): pass class ExecutionError(ReqError): def __init__(self, errcode): self.error_code = errcode class Req: "To be used for verifying binay package dependencies on Python code" def __init__(self, chatty=True): self.all_reqs_ok = True self.debug = False self.chatty = chatty def logwrite(self, msg): if self.chatty: sys.stdout.write(msg) sys.stdout.flush() def enable_debug(self): self.debug = True def reqs_match(self): if self.all_reqs_ok: return True self.logwrite("You have unfulfilled binary requirements\n") return False def req_missing(self, program): self.all_reqs_ok = False self.logwrite("You need to have installed: %s\n" % program) def req_old_program(self, program, version_req): self.all_reqs_ok = False self.logwrite("You need to have installed: %s >= %s\n" % (program, version_req)) def which(self, program): cmd = ['which', program] process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True) stdout = process.communicate()[0] process.wait() if process.returncode != 0: raise ExecutionError(process.returncode) return stdout def req_exists(self, program): cmd = ['which', program] process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True) stdout = process.communicate()[0] process.wait() if process.returncode == 0: return True return False def req_get_prog_version(self, program, version_query, version_pos): ''' Suppose you have a binary that outputs: $ spatch --version spatch version 1.0.0-rc21 with Python support and with PCRE support Every program veries what it wants you to query it for a version string, prog_version() is designed so that you pass what the program expects for its version query, and the position you expect the version string to be on using python list. ''' cmd = [program, version_query] process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True) stdout = process.communicate()[0] process.wait() if process.returncode != 0: raise ExecutionError(process.returncode) if self.debug: sys.stdout.write("Running '%s' got us this break down:\n%s\n" % ( ' '.join(cmd), "\n".join(map(str, [[i, x] for i, x in enumerate(stdout.split())])), )) sys.stdout.write("You are using for version: %s\n" % stdout.split()[version_pos]) sys.stdout.write("Specifically your idx, element: %s\n" % ([[i, x] for i, x in enumerate(stdout.split())][version_pos])) return stdout.split()[version_pos] MAX_RC = 25 def __compute_rel_weight(self, rel_specs): weight = 0 extra = 0 sublevel = 0 relmod = 0 if self.debug: sys.stdout.write("VERSION = %s\n" % rel_specs['VERSION']) sys.stdout.write("PATCHLEVEL = %s\n" % rel_specs['PATCHLEVEL']) sys.stdout.write("SUBLEVEL = %s\n" % rel_specs['SUBLEVEL']) sys.stdout.write("EXTRAVERSION = %s\n" % rel_specs['EXTRAVERSION']) sys.stdout.write("RELMOD_UPDATE = %s\n" % rel_specs['RELMOD_UPDATE']) if rel_specs['EXTRAVERSION'] != '': if ("." in rel_specs['EXTRAVERSION'] or "rc" in rel_specs['EXTRAVERSION']): rc = rel_specs['EXTRAVERSION'].lstrip("-rc") if (rc == ""): rc = 0 else: rc = int(rc) - (Req.MAX_RC + 1) extra = int(rc) else: extra = int(rel_specs['EXTRAVERSION']) + 10 if rel_specs['SUBLEVEL'] != '': sublevel = int(rel_specs['SUBLEVEL'].lstrip(".")) * 20 else: sublevel = 5 if rel_specs['RELMOD_UPDATE'] != '': mod = rel_specs['RELMOD_UPDATE'] if (mod == ""): mod = 0 else: mod = int(mod) relmod = int(mod) weight = (int(rel_specs['VERSION']) << 32) + \ (int(rel_specs['PATCHLEVEL']) << 16) + \ (sublevel << 8 ) + \ (extra * 60) + (relmod * 2) return weight def req_get_rel_spec(self, rel): if "rc" in rel: m = re.match(r"v*(?P\d+)\.+" "(?P\d+)[.]*" "(?P\d*)" "(?P[-rc]+\w*)\-*" "(?P\d*)[-]*", rel) else: m = re.match(r"v*(?P\d+)\.+" "(?P\d+)[.]*" "(?P\d*)[.]*" "(?P\w*)\-*" "(?P\d*)[-]*", rel) if not m: return m rel_specs = m.groupdict() return rel_specs def compute_rel_weight(self, rel): rel_specs = self.req_get_rel_spec(rel) if not rel_specs: return 0 return self.__compute_rel_weight(rel_specs) def linux_version_cmp(self, version_req, version): ''' If the program follows the linux version style scheme you can use this to compare versions. ''' weight_has = self.compute_rel_weight(version) weight_req = self.compute_rel_weight(version_req) if self.debug: sys.stdout.write("You have program weight: %s\n" % weight_has) sys.stdout.write("Required program weight: %s\n" % weight_req) if weight_has < weight_req: return -1 return 0 def require_version(self, program, version_query, version_req, version_pos, version_cmp): ''' If you have a program version requirement you can specify it here, as for the other flags refer to prog_version. ''' if not self.require(program): return False version = self.req_get_prog_version(program, version_query, version_pos) if self.debug: sys.stdout.write("Checking release specs and weight: for: %s\n" % program) sys.stdout.write("You have version: %s\n" % version) sys.stdout.write("Required version: %s\n" % version_req) if version_cmp(version_req, version) != 0: self.req_old_program(program, version_req) return False return True def require(self, program): if self.req_exists(program): return True self.req_missing(program) return False def require_hint(self, program, package_hint): if self.require(program): return True sys.stdout.write("Try installing the package: %s\n" % package_hint) return False def coccinelle(self, version): if self.require_version('spatch', '--version', version, 2, self.linux_version_cmp): return True self.logwrite("Try installing the package: coccinelle\n") self.logwrite("If that is too old go grab the code from source:\n\n") self.logwrite("git clone https://github.com/coccinelle/coccinelle.git\n\n") self.logwrite("To build you will need: ocaml ncurses-devel\n\n") self.logwrite("If on SUSE / OpenSUSE you will also need: ocaml-ocamldoc\n\n") return False def make(self, version): return self.require_version('make', '--version', version, 2, self.linux_version_cmp) def gcc(self, version): return self.require_version('gcc', '--version', version, 3, self.linux_version_cmp) class GitError(Exception): pass class ExecutionGitError(GitError): def __init__(self, errcode): self.error_code = errcode def _check(process): if process.returncode != 0: raise ExecutionError(process.returncode) def git_init(tree=None): process = subprocess.Popen(['git', 'init'], stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() _check(process) def git_rev_parse(tree=None, extra_args=None): cmd = ['git', 'rev-parse' ] + extra_args process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() if process.returncode != 0: return None return stdout.split('\n', 1)[0] def gitname(path=None): work_dir = path if not os.path.isdir(path): work_dir = os.path.dirname(path) process = subprocess.Popen(['git', 'rev-parse', '--show-toplevel', path], stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=work_dir) stdout = process.communicate()[0] process.wait() if process.returncode != 0: return None return stdout.split('\n', 1)[0] def git_add(path, tree=None): process = subprocess.Popen(['git', 'add', '--ignore-removal', path], stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() _check(process) def git_checkout(tree=None, extra_args=None): cmd = ['git', 'checkout' ] + extra_args process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() _check(process) def git_commit_all(message, tree=None): git_add('.', tree=tree) process = subprocess.Popen(['git', 'commit', '--allow-empty', '-a', '-m', message], stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() _check(process) def git_diff(tree=None, extra_args=None): cmd = ['git', 'diff', '--color=always'] + extra_args process = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True, cwd=tree) stdout = process.communicate()[0] process.wait() _check(process) return stdout # simple tempdir wrapper object for 'with' statement # # Usage: # with tempdir.tempdir() as tmpdir: # os.chdir(tmpdir) # do something # class tempdir(object): def __init__(self, suffix='', prefix='', dir=None, nodelete=False): self.suffix = '' self.prefix = '' self.dir = dir self.nodelete = nodelete def __enter__(self): self._name = tempfile.mkdtemp(suffix=self.suffix, prefix=self.prefix, dir=self.dir) return self._name def __exit__(self, type, value, traceback): if self.nodelete: print('not deleting directory %s!' % self._name) else: shutil.rmtree(self._name) def apply_patches(args, patch_src, target_dir, logwrite=lambda x:None): """ Given a path of a directories of patches apply the patches """ patches = [] for root, dirs, files in os.walk(patch_src): for f in files: if f.endswith('.patch'): patches.append(os.path.join(root, f)) patches.sort() prefix_len = len(patch_src) + 1 for pfile in patches: print_name = pfile[prefix_len:] logwrite("Applying patch %s\n" % pfile) process = subprocess.Popen(['patch', '-p1'], stdout=subprocess.PIPE, stderr=subprocess.STDOUT, stdin=subprocess.PIPE, close_fds=True, universal_newlines=True, cwd=target_dir) output = process.communicate(input=open(pfile, 'r').read())[0] output = output.split('\n') if output[-1] == '': output = output[:-1] if process.returncode != 0: if not args.verbose: logwrite("Failed to apply changes from %s" % print_name) for line in output: logwrite('> %s' % line) raise Exception('Patch failed') # remove orig/rej files that patch sometimes creates for root, dirs, files in os.walk(target_dir): for f in files: if f[-5:] == '.orig' or f[-4:] == '.rej': os.unlink(os.path.join(root, f)) git_commit_all(tree=target_dir, message="apply patch %s" % (print_name)) class CoccinelleError(Exception): pass class ExecutionErrorThread(CoccinelleError): def __init__(self, errcode, fn, cocci_file, threads, t, logwrite, print_name): self.error_code = errcode logwrite("Failed to apply changes from %s\n" % print_name) logwrite("Specific log output from change that failed using %s\n" % print_name) tf = open(fn, 'r') for line in tf.read(): logwrite(line) tf.close() logwrite("Full log using %s\n" % print_name) for num in range(threads): fn = os.path.join(t, '.tmp_spatch_worker.' + str(num)) if (not os.path.isfile(fn)): continue tf = open(fn, 'r') for line in tf.read(): logwrite(line) tf.close() os.unlink(fn) class ExecutionErrorCocci(CoccinelleError): def __init__(self, errcode, output, cocci_file, logwrite, print_name): self.error_code = errcode logwrite("Failed to apply changes from %s\n" % print_name) logwrite(output) def spatch(cocci_file, outdir, logwrite, num_jobs, print_name, extra_args=[]): req = Req(chatty=True) req.coccinelle('1.0.2') if not req.reqs_match(): sys.exit(1) num_cpus = cpu_count() if num_jobs: threads = int(num_jobs) else: threads = num_cpus cmd = ['spatch', '--sp-file', cocci_file, '--in-place', '--recursive-includes', '--relax-include-path', '--timeout', '120', '--dir', outdir ] if (threads > 1): cmd.extend(['--jobs', str(threads)]) cmd.extend(extra_args) logwrite("%s\n" % " ".join(cmd)) sprocess = subprocess.Popen(cmd, stdout=subprocess.PIPE, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True) output = sprocess.communicate()[0] sprocess.wait() if sprocess.returncode != 0: raise ExecutionErrorCocci(sprocess.returncode, output, cocci_file, logwrite, print_name) return output def spatch_old(cocci_file, outdir, max_threads, thread_id, temp_dir, ret_q, extra_args=[]): cmd = ['spatch', '--sp-file', cocci_file, '--in-place', '--recursive-includes', '--relax-include-path', '--timeout', '120', '--dir', outdir ] if (max_threads > 1): cmd.extend(['-max', str(max_threads), '-index', str(thread_id)]) cmd.extend(extra_args) fn = os.path.join(temp_dir, '.tmp_spatch_worker.' + str(thread_id)) outfile = open(fn, 'w') logwrite("%s\n" % " ".join(cmd)) sprocess = subprocess.Popen(cmd, stdout=outfile, stderr=subprocess.STDOUT, close_fds=True, universal_newlines=True) sprocess.wait() outfile.close() ret_q.put((sprocess.returncode, fn)) def threaded_spatch(cocci_file, outdir, logwrite, num_jobs, print_name, extra_args=[]): num_cpus = cpu_count() if num_jobs: threads = int(num_jobs) else: threads = num_cpus jobs = list() output = "" ret_q = Queue() with tempdir() as t: for num in range(threads): p = Process(target=spatch_old, args=(cocci_file, outdir, threads, num, t, ret_q, extra_args)) jobs.append(p) for p in jobs: p.start() for num in range(threads): ret, fn = ret_q.get() if ret != 0: raise ExecutionErrorThread(ret, fn, cocci_file, threads, t, logwrite, print_name) for job in jobs: p.join() for num in range(threads): fn = os.path.join(t, '.tmp_spatch_worker.' + str(num)) tf = open(fn, 'r') output = output + tf.read() tf.close() os.unlink(fn) return output def logwrite(msg): sys.stdout.write(msg) sys.stdout.flush() def _main(): parser = argparse.ArgumentParser(description='Wrapper around Coccinelle spatch ' + 'which infers which options to enable.') parser.add_argument('cocci_file', metavar='', type=str, help='This is the Coccinelle file you want to use') parser.add_argument('target_dir', metavar='', type=str, help='Target directory or file to modify') parser.add_argument('-p', '--profile-cocci', const=True, default=False, action="store_const", help='Enable profile, this will pass --profile to Coccinelle.') parser.add_argument('-s', '--show-proof', const=True, default=False, action="store_const", help='Show proof that the provided SmPL patch can replace a respective patch series') parser.add_argument('-j', '--jobs', metavar='', type=str, default=None, help='Only use the cocci file passed for Coccinelle, don\'t do anything else, ' + 'also creates a git repo on the target directory for easy inspection ' + 'of changes done by Coccinelle.') parser.add_argument('-v', '--verbose', const=True, default=False, action="store_const", help='Enable output from Coccinelle') args = parser.parse_args() if not os.path.isfile(args.cocci_file): return -2 if not os.path.isfile(args.target_dir) and not os.path.isdir(args.target_dir): logwrite("Path (%s) is not a file or directory\n" % (args.target_dir)) return -2 current_branch = None smpl_branch_name = "pycocci-smpl-" + str(uuid.uuid4())[:8] patch_branch_name = "pycocci-patch-" + str(uuid.uuid4())[:8] extra_spatch_args = [] if args.profile_cocci: extra_spatch_args.append('--profile') jobs = 0 if args.jobs > 0: jobs = args.jobs has_spatch_1_0_1 = Req(chatty=False) has_spatch_1_0_1.coccinelle('1.0.1') has_spatch_1_0_2 = Req(chatty=False) has_spatch_1_0_2.coccinelle('1.0.2') git_reqs = Req(chatty=False) git_reqs.require('git') glimpse_index = os.path.abspath(os.path.join(args.target_dir, '.glimpse_index')) git_dir = None if git_reqs.reqs_match(): git_dir = gitname(args.target_dir) if args.show_proof: # As an example if you use --show-proof patches/collateral-evolutions/network/09-threaded-irq.cocci # the patches under 09-threaded-irq will be used for the proof. patch_src = args.cocci_file.split('/')[-1].split('.cocci')[0] dirname = os.path.dirname(args.cocci_file) patch_src = os.path.abspath(os.path.join(dirname, patch_src)) if not os.path.isdir(patch_src): logwrite("Path given (%s) must be a directory with patches\n" % (patch_src)) return -2 git_reqs = Req(chatty=True) git_reqs.require('git') if not git_dir: if os.path.isfile(args.target_dir): logwrite("Path given (%s) is a file, try passing the directory " "(%s) if you are certain you want us to create a git repo to provide a" "a proof there\n" % (args.target_dir, os.path.dirname(args.target_dir))) return -2 logwrite("Path (%s) not part of a git tree, creating one for you...\n" % (args.target_dir)) git_init(tree=args.target_dir) git_commit_all(tree=args.target_dir, message="Initial commit") cmd = [ '--abbrev-ref', 'HEAD' ] current_branch = git_rev_parse(tree=args.target_dir, extra_args = cmd) logwrite("\n") logwrite("Current branch: %s\n" % (current_branch)) logwrite("Patch branch: %s\n" % (patch_branch_name)) logwrite("SmPL branch: %s\n" % (smpl_branch_name)) logwrite("\n") git_checkout(tree=args.target_dir, extra_args = ['-b', smpl_branch_name]) git_checkout(tree=args.target_dir, extra_args = ['-b', patch_branch_name]) apply_patches(args, patch_src, args.target_dir, logwrite) git_checkout(tree=args.target_dir, extra_args = [smpl_branch_name]) if os.path.isfile(glimpse_index): extra_spatch_args.append('--use-glimpse') elif has_spatch_1_0_2.reqs_match(): if git_dir: extra_spatch_args.append('--use-gitgrep') else: extra_spatch_args.append('--use-coccigrep') else: extra_spatch_args.append('--use-coccigrep') if has_spatch_1_0_2.reqs_match(): output = spatch(args.cocci_file, args.target_dir, logwrite, jobs, os.path.basename(args.cocci_file), extra_args=extra_spatch_args) else: output = threaded_spatch(args.cocci_file, args.target_dir, logwrite, jobs, os.path.basename(args.cocci_file), extra_args=extra_spatch_args) if args.verbose: logwrite(output) if args.show_proof: git_commit_all(tree=args.target_dir, message="Initial commit") git_checkout(tree=args.target_dir, extra_args = [current_branch]) cmd = [ '--stat', patch_branch_name + ".." + smpl_branch_name ] diff_stat = git_diff(tree=args.target_dir, extra_args = cmd) if len(diff_stat) == 0: logwrite('\nSmPL patch fully replaces patch series!') else: logwrite('\nDifferences found:\n\n') logwrite('Change directory to %s and run:\n\n\tgit diff %s..%s\n\n' % (args.target_dir, patch_branch_name, smpl_branch_name)) logwrite('diffstat of the changes:\n') logwrite(diff_stat) return 0 if __name__ == '__main__': ret = _main() if ret: sys.exit(ret) coccinelle-1.0.4/release.nix0000644000175000017500000004525612614153277014770 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}/lib/coccinelle export COCCIDIR=$TMPDIR export SPATCH=${coccinelle}/bin/spatch.opt export ISO=${coccinelle}/lib/coccinelle/standard.iso export DEFS=${coccinelle}/lib/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.4/cocci.ml0000644000175000017500000021663712614153277014245 0ustar eugeneugen(* * This file is part of Coccinelle, lincensed under the terms of the GPL v2. * See copyright.txt in the Coccinelle source code for more information. * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr *) 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 (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 (* --------------------------------------------------------------------- *) (* 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) -> let ast1 = if !Flag_cocci.popl then Popl.popl ast else Asttoctl2.asttoctl ast (ua,fua,fuas) pos in List.combine ast1 (Asttomember.asttomember ast ua)) ast (Common.combine4 ua fua 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 = let show_diff = !Flag_cocci.show_diff && (!Flag_cocci.force_diff || (not(Common.fst(Compare_c.compare_to_original cfile outfile) = Compare_c.Correct))) in (* diff only in spacing, etc *) if show_diff then begin (* 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 (match res with [] -> () | _ -> 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 || !Flag.show_trying || !Flag.show_transinfo || !Flag_cocci.show_binding_in_out then begin let name = match ast with Ast_cocci.CocciRule (nm, (deps, drops, exists), x, _, _) -> nm | Ast_cocci.ScriptRule (nm, _, _, _, _, _) -> nm | _ -> string_of_int rulenb in Common.pr_xxxxxxxxxxxxxxxxx (); pr (name ^ " = "); Common.pr_xxxxxxxxxxxxxxxxx () end let show_or_not_scr_rule_name name = if !Flag_cocci.show_ctl_text || !Flag.show_trying || !Flag.show_transinfo || !Flag_cocci.show_binding_in_out then begin Common.pr_xxxxxxxxxxxxxxxxx (); pr ("script " ^ name ^ " = "); Common.pr_xxxxxxxxxxxxxxxxx () end let show_or_not_ctl_text2 ctl mvs 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 mvs 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 d = Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_text2 a b c d) (* 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 | _ -> "" (* Warning The following function has the absolutely essential property of setting Flag.current_element, whether or not one wants to print tracing information! This is probably not smart... *) 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: ",Some (funcs,namefuncs)) | 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 ",Some(s,name)); | _ -> Flag.current_element := "something_else"; (" ",None); ) in if !Flag.show_trying then match trying with Some(str,name) -> let info = Ast_c.info_of_name name in let file = Filename.basename(Ast_c.file_of_info info) in let line = Ast_c.line_of_info info in pr2 (Printf.sprintf "%s%s%s: %s:%d" prelude tag str file line) | None -> pr2 (Printf.sprintf "%s%s something else" prelude tag) 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 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: " ^ (string_of_int 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,_,_,_) | (_,Flag.GitGrep,_,_,_) -> true | (_,_,_,Some (q1,q2,_),[cfile]) -> Cocci_grep.interpret (q1,q2) 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 = Printf.sprintf "egrep -q '(%s)' %s" (String.concat "|" tokens) (String.concat " " cfiles) in (match Sys.command com with | 0 (* success *) -> true | _ (* failure *) -> (if !Flag.show_misc then pr2 ("grep failed: " ^ com)); false (* no match, so not worth trying *)) in (match (res,tokens) with (false,Some tokens) -> pr2_once ("Expected tokens " ^ (String.concat " " tokens)); pr2 ("Skipping:" ^ (String.concat " " cfiles)) | _ -> ()); res let worth_trying a b = Common.profile_code "worth_trying" (fun () -> try worth_trying2 a b with Flag.UnreadableFile file -> begin pr2 ("Skipping unreadable file: " ^ file); false end) 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 || 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 mcode mcode donothing donothing donothing donothing donothing donothing expression donothing donothing donothing 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 = ("include_table", ref 0, Hashtbl.create(101)) let find_table = ("find_table", ref 0, Hashtbl.create(101)) let cache_find (_,_,cache) k = let (ct,res) = Hashtbl.find cache k in ct := !ct + 1; res let cache_add (nm,ct,cache) k v = ct := !ct + 1; (if !ct > Flag_cocci.cache_threshold then begin Hashtbl.iter (fun k (vct,v) -> if !vct < Flag_cocci.elem_threshold then begin Hashtbl.remove cache k; ct := !ct - 1 end else vct := 0) cache end); Hashtbl.add cache k (ref 1, v) 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 try cache_find find_table cmd with Not_found -> let res = match Common.cmd_to_list cmd with [x] -> Some x | _ -> None in cache_add find_table cmd res; res 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 = String.concat "/" relpath in cache_add include_table (searchlist,relpath) res; Some res | (hd::tail) as relpath1 -> let relpath1 = String.concat "/" relpath1 in (match search_include_path exists searchlist relpath1 with None -> search_path unique_file_exists searchlist tail | Some f -> cache_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(cache_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 = Filename.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 = String.concat "/" 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 all_includes && not (Sys.file_exists attempt2) 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) || (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 * Ast_cocci.mvinit) 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 * string list) option (*coccigrep/gitgrep 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 mv = { 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,mv,code) -> let r = make_init lang code (build_rule_info name deps) mv in InitialScriptRuleCocciInfo r | Ast_cocci.FinalScriptRule (name,lang,deps,mv,code) -> 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; }) ) (* --------------------------------------------------------------------- *) (* Needs to be tail recursive, which List.flatten is not *) let flatten l = List.rev (List.fold_left (function prev -> function cur -> List.fold_left (function prev -> function x -> x :: prev) prev cur) [] l) let build_info_program (cprogram,typedefs,macros) env = let (cs, parseinfos) = Common.unzip cprogram in let alltoks = parseinfos +> List.map (fun (s,toks) -> toks) +> 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 = TAC.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 } ) (* remove ../ in the middle of an include path *) let fixpath s = let s = Str.split_delim (Str.regexp "/") s in let rec loop = function x::".."::rest -> loop rest | x::rest -> x :: loop rest | [] -> [] in String.concat "/" (loop s) let header_cache_table = Hashtbl.create 101 (* global *) let header_cache choose_includes f key1 key2 = if List.mem choose_includes [Flag_cocci.I_ALL_INCLUDES;Flag_cocci.I_REALLY_ALL_INCLUDES] && !Flag_cocci.include_headers_for_types then let k = (key1,key2) in try Hashtbl.find header_cache_table k with Not_found -> let res = f key1 key2 in Hashtbl.add header_cache_table k res; res else f key1 key2 let rec prepare_h seen env (hpath : string) choose_includes parse_strings : file_info list = let h_cs = if not (Common.lfile_exists hpath) then begin pr2_once ("TYPE: header " ^ hpath ^ " not found"); None end else try Some (header_cache choose_includes cprogram_of_file_cached parse_strings hpath) with Flag.UnreadableFile file -> begin pr2_once ("TYPE: header " ^ hpath ^ " not readable"); None end in match h_cs with None -> [] | Some h_cs -> (*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)) (List.map fixpath (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 info_h_cs = [] then !env else last_env_toplevel_c_info info_h_cs; others@ [{ fname = Filename.basename hpath; full_fname = hpath; asts = info_h_cs; was_modified_once = ref false; fpath = hpath; fkind = Header; }] let prepare_c files choose_includes parse_strings : file_info list = let files_and_cprograms = List.rev (List.fold_left (function prev -> function file -> try (file,cprogram_of_file_cached parse_strings file) :: prev with Flag.UnreadableFile file -> pr2_once ("C file " ^ file ^ " not readable"); prev) [] files) in let includes = includes_to_parse files_and_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 Flag_parsing_c.parsing_header_for_types := !Flag_cocci.include_headers_for_types; let includes = includes +> List.map (function hpath -> prepare_h seen env hpath choose_includes parse_strings) +> List.concat in Flag_parsing_c.parsing_header_for_types := false; let cfiles = files_and_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 = Filename.basename file; full_fname = file; asts = cs; was_modified_once = ref false; fpath = file; fkind = Source }) in if !Flag_cocci.include_headers_for_types then cfiles else includes @ cfiles (*****************************************************************************) (* Manage environments as they are being built up *) (*****************************************************************************) module MyHashedType : Hashtbl.HashedType with type t = Ast_c.metavars_binding = struct type t = Ast_c.metavars_binding let my_n = 5000 let my_m = 10000 let equal = (=) let hash = Hashtbl.hash_param my_n my_m end module MyHashtbl = Hashtbl.Make(MyHashedType) let max_tbl = ref 1001 let env_tbl = MyHashtbl.create !max_tbl let init_env _ = MyHashtbl.clear env_tbl; env_tbl let init_env_list _ = [] let update_env env v i = (* let v = (List.map Hashtbl.hash (List.map snd v), v) in*) MyHashtbl.replace env v i; env let update_env_list env v i = (v,i)::env (* know that there are no conflicts *) let safe_update_env env v i = (*let v = (List.map Hashtbl.hash (List.map snd v), v) in*) MyHashtbl.add env v i; env let end_env env = let res = List.sort compare (MyHashtbl.fold (fun k v rest -> (k,v) :: rest) env []) in MyHashtbl.clear env; res let end_env_list env = let env = List.sort compare env in let rec loop = function x::((y::_) as xs) -> if x = y then loop xs else x :: loop xs | l -> l in loop 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 merge_env_list new_e old_e = new_e@old_e let contains_binding e = function (_,(r,m),_,Ast_cocci.NoMVInit) -> (try let _ = List.find (function ((re, rm), _) -> r = re && m = rm) e in true with Not_found -> false) | _ -> true exception Exited let python_application mv ve script_vars r = let mv = List.map (function ((Some x,None),y,z,init) -> (x,y,z,init) | _ -> 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.rulename; 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_var_env = List.filter (function (x,Ast_c.MetaNoVal) -> false | _ -> true) (List.combine script_vars script_vals) in let new_e = script_var_env @ 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) exception Missing_position let consistent_positions binding reqopts = try let positions = List.fold_left (fun prev p -> match fst p with Lib_engine.Match re -> let vars = re.Ast_cocci.positive_inherited_positions in let pvars = List.fold_left (fun prev v -> try let b = List.assoc v binding in match b with Ast_c.MetaPosValList l -> l :: prev | _ -> failwith "position variable should have a position binding" with Not_found -> raise Missing_position) [] vars in Common.union_set pvars prev | _ -> prev) [] reqopts in match positions with [] -> true | [_] -> true | l::ls -> let desired_functions = List.fold_left (fun prev (_,elem,_,_) -> if not (List.mem elem prev) then elem::prev else prev) [] l in let inter = List.fold_left (fun prev l -> Common.inter_set prev (List.fold_left (fun prev (_,elem,_,_) -> if not (List.mem elem prev) then elem::prev else prev) [] l)) desired_functions ls in match inter with [] -> false | _ -> true with Missing_position -> false let printtime str = Printf.printf "%s: %f\n" str (Unix.gettimeofday ()) 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.metavars 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) -> (* choices come from a disjunction, but if the pattern is <... ...> there may be nothing at all, hence the first case *) let consistent = match snd r.ctl with [] -> true | reqopts -> List.exists (consistent_positions relevant_bindings) reqopts in if not consistent then (cache, update_env newes (e +> List.filter (fun (s,v) -> List.mem s r.rule_info.used_after)) rules_that_have_matched) else 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,new_bindings_ua) = 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 *) let new_bindings = 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 new_bindings_ua = 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))) in (new_bindings,new_bindings_ua) 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 new_bindings = [] then begin (*use the old bindings, specialized to the used_after_list*) if !Flag_ctl.partial_match then Printf.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 *) begin 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_ua +> List.map (List.filter (function (s,v) -> 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 end in ((relevant_bindings,(new_bindings,new_bindings_ua))::cache, 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 match negated_pos_vars with [] -> List.combine envs (List.map (function (non_pos,_) -> List.sort compare non_pos) splitted_relevant) | _ -> (* when there are negated position variables, extend the position variables with the values found at other identical variable bindings *) let non_poss = let non_poss = List.sort compare (List.map fst splitted_relevant) in let rec loop = function [] -> [] | [x] -> [x] | x::((y::_) as xs) -> if x = y then loop xs else x :: loop xs in loop non_poss in let extended_relevant = Hashtbl.create 101 in List.iter (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 Hashtbl.add extended_relevant non_pos (List.sort compare (non_pos @ (combine_pos negated_pos_vars (List.map snd others))))) non_poss; List.combine envs (List.map (function (non_pos,_) -> Hashtbl.find extended_relevant non_pos) 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_generated_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 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 MyHashtbl.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,!Flag.defined_virtual_env)) :: !Iteration.initialization_stack; initial_final_bigloop Initial (fun (x,mvs,_,y) -> fun deps -> Ast_cocci.InitialScriptRule(rname,x,deps,mvs,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 " ^ (String.concat " " 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,virt_env)) -> Flag.defined_virtual_rules := virt_rules; Flag.defined_virtual_env := virt_env; 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,mvs,_,y) -> fun deps -> Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename, x,deps,mvs,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) let has_finalize (cocci_infos,_) = List.exists (function | FinalScriptRuleCocciInfo _ -> true | ScriptRuleCocciInfo _ | InitialScriptRuleCocciInfo _ | CocciRuleCocciInfo _ -> false) cocci_infos (*****************************************************************************) (* 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 " ^ string_of_int (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 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.4/version0000644000175000017500000000000612614155436014217 0ustar eugeneugen1.0.4 coccinelle-1.0.4/Makefile.libs0000644000175000017500000000553012614153277015207 0ustar eugeneugen# This file is part of Coccinelle, lincensed under the terms of the GPL v2. # See copyright.txt in the Coccinelle source code for more information. # The Coccinelle source code can be obtained at http://coccinelle.lip6.fr # # 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 %) # 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 = # 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 = # parmap library PARMAPDIR = bundles/parmap/parmap-1.0-rc5-patched/_build LOCAL_parmap = $(PARMAPDIR)/parmap.cma LOCALOPT_parmap = $(PARMAPDIR)/parmap.cmxa GLOBAL_parmap = $(PARMAPDIR)/parmap.cma GLOBALOPT_parmap = $(PARMAPDIR)/parmap.cmxa FLAGS_parmap = -cclib -lparmap_stubs OPTFLAGS_parmap = -cclib -lparmap_stubs