diff --git a/Tmain/list-roles.d/stdout-expected.txt b/Tmain/list-roles.d/stdout-expected.txt index 111465ee06..b0ff59d580 100644 --- a/Tmain/list-roles.d/stdout-expected.txt +++ b/Tmain/list-roles.d/stdout-expected.txt @@ -114,6 +114,7 @@ Vera d/macro undef on undefined Vera h/header local on local header Vera h/header system on system header Verilog m/module decl on declaring instances +XS M/moduleFile included on included with INCLUDE keyword Zsh f/function autoloaded on function name passed to autoload built-in command Zsh h/heredoc endmarker on end marker Zsh s/script autoloaded on autoloaded @@ -234,6 +235,7 @@ Vera d/macro undef on undefined Vera h/header local on local header Vera h/header system on system header Verilog m/module decl on declaring instances +XS M/moduleFile included on included with INCLUDE keyword Zsh f/function autoloaded on function name passed to autoload built-in command Zsh h/heredoc endmarker on end marker Zsh s/script autoloaded on autoloaded diff --git a/Units/parser-xs.r/no-noprefix.d/args.ctags b/Units/parser-xs.r/no-noprefix.d/args.ctags new file mode 100644 index 0000000000..932119c2d4 --- /dev/null +++ b/Units/parser-xs.r/no-noprefix.d/args.ctags @@ -0,0 +1,2 @@ +--sort=no +--extras-XS=-{noprefix} diff --git a/Units/parser-xs.r/no-noprefix.d/expected.tags b/Units/parser-xs.r/no-noprefix.d/expected.tags new file mode 100644 index 0000000000..2ebcd7ad10 --- /dev/null +++ b/Units/parser-xs.r/no-noprefix.d/expected.tags @@ -0,0 +1,3 @@ +X input.xs /^MODULE = X PACKAGE = X PREFIX = xyz_$/;" m +X input.xs /^MODULE = X PACKAGE = X PREFIX = xyz_$/;" p module:X +xyz_f input.xs /^xyz_f(dbtype)$/;" f package:X.X typeref:typename:void diff --git a/Units/parser-xs.r/no-noprefix.d/input.xs b/Units/parser-xs.r/no-noprefix.d/input.xs new file mode 100644 index 0000000000..cf7f505555 --- /dev/null +++ b/Units/parser-xs.r/no-noprefix.d/input.xs @@ -0,0 +1,5 @@ +MODULE = X PACKAGE = X PREFIX = xyz_ + +void +xyz_f(dbtype) + char * dbtype diff --git a/Units/parser-xs.r/pod.d/args.ctags b/Units/parser-xs.r/pod.d/args.ctags new file mode 100644 index 0000000000..c54486a01f --- /dev/null +++ b/Units/parser-xs.r/pod.d/args.ctags @@ -0,0 +1,3 @@ +--sort=no +--extras=+g +--fields=+Sl diff --git a/Units/parser-xs.r/pod.d/expected.tags b/Units/parser-xs.r/pod.d/expected.tags new file mode 100644 index 0000000000..6463fac9f0 --- /dev/null +++ b/Units/parser-xs.r/pod.d/expected.tags @@ -0,0 +1,6 @@ +XS::Typemap input.xs /^MODULE = XS::Typemap PACKAGE = XS::Typemap$/;" m language:XS +XS::Typemap input.xs /^MODULE = XS::Typemap PACKAGE = XS::Typemap$/;" p language:XS module:XS::Typemap +T_SV input.xs /^T_SV( sv )$/;" f language:XS package:XS::Typemap.XS::Typemap typeref:typename:SV * signature:(SV * sv) +T_SVREF input.xs /^T_SVREF( svref )$/;" f language:XS package:XS::Typemap.XS::Typemap typeref:typename:SVREF signature:(SVREF svref) +intArrayPtr input.xs /^intArray * intArrayPtr( int nelem ) {$/;" f language:C typeref:typename:intArray * signature:(int nelem) +TYPEMAPS input.xs /^=head1 TYPEMAPS$/;" c language:Pod diff --git a/Units/parser-xs.r/pod.d/input.xs b/Units/parser-xs.r/pod.d/input.xs new file mode 100644 index 0000000000..684f369093 --- /dev/null +++ b/Units/parser-xs.r/pod.d/input.xs @@ -0,0 +1,59 @@ +/* Taken from perl-5.10.1/ext/XS-Typemap/Typemap.xs */ + +/* T_ARRAY - allocate some memory */ +intArray * intArrayPtr( int nelem ) { + intArray * array; + Newx(array, nelem, intArray); + return array; +} + + +MODULE = XS::Typemap PACKAGE = XS::Typemap + +PROTOTYPES: DISABLE + +=head1 TYPEMAPS + +Each C type is represented by an entry in the typemap file that +is responsible for converting perl variables (SV, AV, HV and CV) to +and from that type. + +=over 4 + +=item T_SV + +This simply passes the C representation of the Perl variable (an SV*) +in and out of the XS layer. This can be used if the C code wants +to deal directly with the Perl variable. + +=cut + +SV * +T_SV( sv ) + SV * sv + CODE: + /* create a new sv for return that is a copy of the input + do not simply copy the pointer since the SV will be marked + mortal by the INPUT typemap when it is pushed back onto the stack */ + RETVAL = sv_mortalcopy( sv ); + /* increment the refcount since the default INPUT typemap mortalizes + by default and we don't want to decrement the ref count twice + by mistake */ + SvREFCNT_inc(RETVAL); + OUTPUT: + RETVAL + +=item T_SVREF + +Used to pass in and return a reference to an SV. + +=cut + +SVREF +T_SVREF( svref ) + SVREF svref + CODE: + RETVAL = svref; + OUTPUT: + RETVAL + diff --git a/Units/parser-xs.r/simple-xs.d/args.ctags b/Units/parser-xs.r/simple-xs.d/args.ctags new file mode 100644 index 0000000000..6a89aa1b8b --- /dev/null +++ b/Units/parser-xs.r/simple-xs.d/args.ctags @@ -0,0 +1,4 @@ +--sort=no +--extras=+g +--extras=+r +--fields=+rSE diff --git a/Units/parser-xs.r/simple-xs.d/expected.tags b/Units/parser-xs.r/simple-xs.d/expected.tags new file mode 100644 index 0000000000..44b35c1a31 --- /dev/null +++ b/Units/parser-xs.r/simple-xs.d/expected.tags @@ -0,0 +1,60 @@ +SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_$/;" m roles:def +SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_$/;" p module:SDBM_File roles:def +sdbm_TIEHASH input.xs /^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;" f package:SDBM_File.SDBM_File typeref:typename:SDBM_File signature:(char * dbtype,char * filename,int flags,int mode,char * pagname) roles:def +TIEHASH input.xs /^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;" f package:SDBM_File.SDBM_File typeref:typename:SDBM_File signature:(char * dbtype,char * filename,int flags,int mode,char * pagname) roles:def extras:noprefix +sdbm_DESTROY input.xs /^sdbm_DESTROY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:void signature:(SDBM_File db) roles:def +DESTROY input.xs /^sdbm_DESTROY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:void signature:(SDBM_File db) roles:def extras:noprefix +sdbm_FETCH input.xs /^sdbm_FETCH(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_value signature:(SDBM_File db,datum_key key) roles:def +FETCH input.xs /^sdbm_FETCH(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_value signature:(SDBM_File db,datum_key key) roles:def extras:noprefix +sdbm_STORE input.xs /^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key,datum_value value,int flags) roles:def +STORE input.xs /^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key,datum_value value,int flags) roles:def extras:noprefix +sdbm_DELETE input.xs /^sdbm_DELETE(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def +DELETE input.xs /^sdbm_DELETE(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def extras:noprefix +sdbm_EXISTS input.xs /^sdbm_EXISTS(db,key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def +EXISTS input.xs /^sdbm_EXISTS(db,key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def extras:noprefix +sdbm_FIRSTKEY input.xs /^sdbm_FIRSTKEY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key signature:(SDBM_File db) roles:def +FIRSTKEY input.xs /^sdbm_FIRSTKEY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key signature:(SDBM_File db) roles:def extras:noprefix +sdbm_NEXTKEY input.xs /^sdbm_NEXTKEY(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key signature:(SDBM_File db) roles:def +NEXTKEY input.xs /^sdbm_NEXTKEY(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key signature:(SDBM_File db) roles:def extras:noprefix +sdbm_error input.xs /^sdbm_error(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db) roles:def +error input.xs /^sdbm_error(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:int signature:(SDBM_File db) roles:def extras:noprefix +sdbm_clearerr input.xs /^ sdbm_clearerr = 1$/;" a function:SDBM_File.SDBM_File.sdbm_error roles:def +filter_fetch_key input.xs /^filter_fetch_key(db, code)$/;" f package:SDBM_File.SDBM_File typeref:typename:SV * signature:(SDBM_File db,SV * code,SV * RETVAL) roles:def +SDBM_File::filter_fetch_key input.xs /^ SDBM_File::filter_fetch_key = fetch_key$/;" a function:SDBM_File.SDBM_File.filter_fetch_key roles:def +SDBM_File::filter_store_key input.xs /^ SDBM_File::filter_store_key = store_key$/;" a function:SDBM_File.SDBM_File.filter_fetch_key roles:def +SDBM_File::filter_fetch_value input.xs /^ SDBM_File::filter_fetch_value = fetch_value$/;" a function:SDBM_File.SDBM_File.filter_fetch_key roles:def +SDBM_File::filter_store_value input.xs /^ SDBM_File::filter_store_value = store_value$/;" a function:SDBM_File.SDBM_File.filter_fetch_key roles:def +SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_$/;" m roles:def +SDBM_X input.xs /^MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_$/;" p module:SDBM_File roles:def +constants.xs input.xs /^INCLUDE: constants.xs$/;" M roles:included extras:reference +sdbm_X_DELETE0 input.xs /^sdbm_X_DELETE0(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def +DELETE0 input.xs /^sdbm_X_DELETE0(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def extras:noprefix +sdbm_X_DELETE1 input.xs /^sdbm_X_DELETE1(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def +DELETE1 input.xs /^sdbm_X_DELETE1(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int signature:(SDBM_File db,datum_key key) roles:def extras:noprefix +sin0 input.xs /^sin0()$/;" f package:SDBM_File.SDBM_X typeref:typename:double signature:() roles:def +sin1 input.xs /^sin1();$/;" f package:SDBM_File.SDBM_X typeref:typename:double signature:() roles:def +PERL_NO_GET_CONTEXT input.xs /^#define PERL_NO_GET_CONTEXT$/;" d file: roles:def extras:fileScope,guest +EXTERN.h input.xs /^#include "EXTERN.h"/;" h roles:local extras:reference,guest +perl.h input.xs /^#include "perl.h"/;" h roles:local extras:reference,guest +XSUB.h input.xs /^#include "XSUB.h"/;" h roles:local extras:reference,guest +sdbm.h input.xs /^#include "sdbm.h"/;" h roles:local extras:reference,guest +fetch_key input.xs /^#define fetch_key /;" d file: roles:def extras:fileScope,guest +store_key input.xs /^#define store_key /;" d file: roles:def extras:fileScope,guest +fetch_value input.xs /^#define fetch_value /;" d file: roles:def extras:fileScope,guest +store_value input.xs /^#define store_value /;" d file: roles:def extras:fileScope,guest +__anoned1397e40108 input.xs /^typedef struct {$/;" s file: roles:def extras:fileScope,guest,anonymous +dbp input.xs /^ DBM * dbp ;$/;" m struct:__anoned1397e40108 typeref:typename:DBM * file: roles:def extras:fileScope,guest +filter input.xs /^ SV * filter[4];$/;" m struct:__anoned1397e40108 typeref:typename:SV * [4] file: roles:def extras:fileScope,guest +filtering input.xs /^ int filtering ;$/;" m struct:__anoned1397e40108 typeref:typename:int file: roles:def extras:fileScope,guest +SDBM_File_type input.xs /^ } SDBM_File_type;$/;" t typeref:struct:__anoned1397e40108 file: roles:def extras:fileScope,guest +SDBM_File input.xs /^typedef SDBM_File_type * SDBM_File ;$/;" t typeref:typename:SDBM_File_type * file: roles:def extras:fileScope,guest +datum_key input.xs /^typedef datum datum_key ;$/;" t typeref:typename:datum file: roles:def extras:fileScope,guest +datum_value input.xs /^typedef datum datum_value ;$/;" t typeref:typename:datum file: roles:def extras:fileScope,guest +sdbm_FETCH input.xs /^#define sdbm_FETCH(/;" d file: signature:(db,key) roles:def extras:fileScope,guest +sdbm_STORE input.xs /^#define sdbm_STORE(/;" d file: signature:(db,key,value,flags) roles:def extras:fileScope,guest +sdbm_DELETE input.xs /^#define sdbm_DELETE(/;" d file: signature:(db,key) roles:def extras:fileScope,guest +sdbm_EXISTS input.xs /^#define sdbm_EXISTS(/;" d file: signature:(db,key) roles:def extras:fileScope,guest +sdbm_FIRSTKEY input.xs /^#define sdbm_FIRSTKEY(/;" d file: signature:(db) roles:def extras:fileScope,guest +sdbm_NEXTKEY input.xs /^#define sdbm_NEXTKEY(/;" d file: signature:(db,key) roles:def extras:fileScope,guest +X input.xs /^#define X "X"/;" d file: roles:def extras:fileScope,guest +Y input.xs /^#define Y "Y"/;" d file: roles:def extras:fileScope,guest diff --git a/Units/parser-xs.r/simple-xs.d/features b/Units/parser-xs.r/simple-xs.d/features new file mode 100644 index 0000000000..92d5e6de8e --- /dev/null +++ b/Units/parser-xs.r/simple-xs.d/features @@ -0,0 +1 @@ +pcre2 diff --git a/Units/parser-xs.r/simple-xs.d/input.xs b/Units/parser-xs.r/simple-xs.d/input.xs new file mode 100644 index 0000000000..2505f4d2fa --- /dev/null +++ b/Units/parser-xs.r/simple-xs.d/input.xs @@ -0,0 +1,167 @@ +/* Derrive from perl5/ext/SDBM_File/SDBM_File.xs */ +#define PERL_NO_GET_CONTEXT +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "sdbm.h" + +#define fetch_key 0 +#define store_key 1 +#define fetch_value 2 +#define store_value 3 + +typedef struct { + DBM * dbp ; + SV * filter[4]; + int filtering ; + } SDBM_File_type; + +typedef SDBM_File_type * SDBM_File ; +typedef datum datum_key ; +typedef datum datum_value ; + +#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key) +#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags) +#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key) +#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key) +#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp) +#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp) + + +MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ + +PROTOTYPES: DISABLE + +SDBM_File +sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL) + char * dbtype + char * filename + int flags + int mode + char * pagname + CODE: + { + DBM * dbp ; + + RETVAL = NULL ; + if (pagname == NULL) { + dbp = sdbm_open(filename, flags, mode); + } + else { + dbp = sdbm_prep(filename, pagname, flags, mode); + } + if (dbp) { + RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); + RETVAL->dbp = dbp ; + } + + } + OUTPUT: + RETVAL + +void +sdbm_DESTROY(db) + SDBM_File db + CODE: + if (db) { + int i = store_value; + sdbm_close(db->dbp); + do { + if (db->filter[i]) + SvREFCNT_dec_NN(db->filter[i]); + } while (i-- > 0); + safefree(db) ; + } + +datum_value +sdbm_FETCH(db, key) + SDBM_File db + datum_key key + +int +sdbm_STORE(db, key, value, flags = DBM_REPLACE) + SDBM_File db + datum_key key + datum_value value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to sdbm file"); + croak("sdbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + sdbm_clearerr(db->dbp); + } + +int +sdbm_DELETE(db, key) + SDBM_File db + datum_key key + +int +sdbm_EXISTS(db,key) + SDBM_File db + datum_key key + +datum_key +sdbm_FIRSTKEY(db) + SDBM_File db + +datum_key +sdbm_NEXTKEY(db, key) + SDBM_File db + +int +sdbm_error(db) + SDBM_File db + ALIAS: + sdbm_clearerr = 1 + CODE: + RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp); + OUTPUT: + RETVAL + +SV * +filter_fetch_key(db, code) + SDBM_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + ALIAS: + SDBM_File::filter_fetch_key = fetch_key + SDBM_File::filter_store_key = store_key + SDBM_File::filter_fetch_value = fetch_value + SDBM_File::filter_store_value = store_value + CODE: + DBM_setFilter(db->filter[ix], code); + +BOOT: + { + HV *stash = gv_stashpvs("SDBM_File", 1); + newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT)); + newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT)); + newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX)); + } + +MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_ + +INCLUDE: constants.xs + +int +sdbm_X_DELETE0(db, key) + SDBM_File db + datum_key key + +#define X "X" + +int +sdbm_X_DELETE1(db, key) + SDBM_File db + datum_key key + +#define Y "Y" + +double +sin0() + +double +sin1(); diff --git a/docs/news.rst b/docs/news.rst index 37940b7dd5..7b96b68165 100644 --- a/docs/news.rst +++ b/docs/news.rst @@ -482,6 +482,7 @@ The following parsers have been added: * TypeScript * Varlink *peg/packcc* * WindRes +* XS *optlib pcre2* * XSLT v1.0 *libxml* * Yacc * Yaml *libyaml* diff --git a/main/parsers_p.h b/main/parsers_p.h index 7ec20898db..ad0ac69419 100644 --- a/main/parsers_p.h +++ b/main/parsers_p.h @@ -48,7 +48,8 @@ #ifdef HAVE_PCRE2 #define OPTLIB2C_PCRE2_PARSER_LIST \ - RDocParser + RDocParser, \ + XSParser #else #define OPTLIB2C_PCRE2_PARSER_LIST #endif diff --git a/optlib/xs.c b/optlib/xs.c new file mode 100644 index 0000000000..b31b497c29 --- /dev/null +++ b/optlib/xs.c @@ -0,0 +1,300 @@ +/* + * Generated by ./misc/optlib2c from optlib/xs.ctags, Don't edit this manually. + */ +#include "general.h" +#include "parse.h" +#include "routines.h" +#include "field.h" +#include "xtag.h" + + +static void initializeXSParser (const langType language) +{ + addLanguageOptscriptToHook (language, SCRIPT_HOOK_PRELUDE, + "{{ /scope false def\n" + " /xsstart false def\n" + " /prefix false def\n" + " /prefix-length 0 def\n" + " /noprefix? /XS.noprefix _extraenabled def\n" + " /tag-noprefix false def\n" + " % [ (x) (y) (z) ] ARRAY2SIGNATURE (x,y,z)\n" + " /array2signature {\n" + " mark\n" + " ?( 3 -1 roll { ?, } forall dup ?, eq {\n" + " pop\n" + " } if\n" + " ?) _buildstring\n" + " } def\n" + "}}"); + + addLanguageRegexTable (language, "init"); + addLanguageRegexTable (language, "main"); + addLanguageRegexTable (language, "func"); + addLanguageRegexTable (language, "keywords"); + addLanguageRegexTable (language, "fheader"); + addLanguageRegexTable (language, "fcode"); + addLanguageRegexTable (language, "freturn"); + addLanguageRegexTable (language, "alias"); + addLanguageRegexTable (language, "pod"); + + addLanguageTagMultiTableRegex (language, "init", + "^((?:.*?)[\n]?)[ \t]*(MODULE[ \t]*=)", + "", "", "p{tjump=main}{_guest=C,1start,1end}{_advanceTo=2start}" + "{{\n" + " /xsstart 2 /start _matchloc def\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^[ \t]*MODULE[ \t]*=[ \t]*([^ \t\n]+)([ \t]*PACKAGE[ \t]*=[ \t]*([^ \t\n]+))?([ \t]*PREFIX[ \t]*=[ \t]*([^ \t\n]+))?[^\n]*\n", + "\\1", "m", "p" + "{{\n" + " \\3 false ne {\n" + " % Make a tag for the package and set it to the scope.\n" + " \\3 /package 3 /start _matchloc _tag _commit dup . scope:\n" + " } {\n" + " % Make a tag for the module and set it to the scope.\n" + " .\n" + " } ifelse\n" + " /scope exch def\n" + "\n" + " % Record the prefix.\n" + " \\5 false ne {\n" + " /prefix \\5 def\n" + " /prefix-length \\5 length def\n" + " } if\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^[ \t]+[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^INCLUDE:[ \t]*([^|\n]+?)[ \t]*\\|?\n", + "\\1", "M", "p{_role=included}", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^([A-Za-z_][^\n]*?)[ \t]*\n", + "", "", "p{tenter=func}" + "{{\n" + " % return type\n" + " \\1 dup _normalize_spaces! _chop_space\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^=[^\n]+\n", + "", "", "p{tenter=pod}{_guest=Pod,0start,}{_advanceTo=0end}", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "main", + "^()", + "", "", "p{tquit}" + "{{\n" + " xsstart false ne {\n" + " (CPreProcessor) xsstart 1 /start _matchloc _makepromise { pop } if\n" + " } if\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "func", + "^(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "func", + "^#[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "func", + "^([A-Za-z_][a-zA-Z0-9_]*)[ \t]*\\([^;\n]*;?\n", + "\\1", "f", "p{tjump=fheader}{scope=push}" + "{{\n" + " % function name\n" + " count 0 gt {\n" + " noprefix? prefix false ne and {\n" + " \\1 prefix _strstr {\n" + " 0 eq {\n" + " prefix-length \\1 length prefix-length sub 0 string _copyinterval\n" + " % type name-sans-prefix\n" + " /function 1 /start _matchloc _tag _commit\n" + " % for attaching signature later\n" + " dup /tag-noprefix exch def\n" + " dup /XS.noprefix _markextra\n" + " dup scope scope:\n" + " % type tag\n" + " 1 index\n" + " % type tag type\n" + " typeref:\n" + " } if\n" + " } {\n" + " pop\n" + " } ifelse\n" + " } if\n" + " % Fill the scope: field.\n" + " . scope scope:\n" + " % if a return type is on the stack, set it to typeref: field.\n" + " % Should we consdier \"struct\", \"union\", and \"enum\" here?\n" + " . exch typeref:\n" + " } if\n" + " % For gathering signatures\n" + " [\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "func", + "^[^\n]*\n", + "", "", "p{tleave}", NULL); + addLanguageTagMultiTableRegex (language, "func", + "^.", + "", "", "p{tleave}", NULL); + addLanguageTagMultiTableRegex (language, "keywords", + "^(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "fheader", + "^[ \t]+ALIAS:\n", + "", "", "p{tenter=alias}", NULL); + addLanguageTagMultiTableRegex (language, "fheader", + "^#[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "fheader", + "^[ \t]+(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n", + "", "", "p{tjump=fcode}", NULL); + addLanguageTagMultiTableRegex (language, "fheader", + "^[ \t]+([^=;\n]*)(=[^;\n]+)?;?\n", + "", "", "p" + "{{\n" + " \\1 dup _normalize_spaces! _chop_space\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "fheader", + "^[^\n]*\n?", + "", "", "p{tleave}{_advanceTo=0start}{scope=pop}" + "{{\n" + " ] _scopetop {\n" + " exch array2signature\n" + " % tag signature\n" + " dup 3 1 roll\n" + " % signature tag signature\n" + " signature:\n" + " tag-noprefix false eq {\n" + " % signature\n" + " pop\n" + " } {\n" + " tag-noprefix exch signature:\n" + " /tag-noprefix false def\n" + " } ifelse\n" + " } {\n" + " pop\n" + " } ifelse\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "fcode", + "^#[^\n]*\n", + "", "", "p", NULL); + addLanguageTagMultiTableRegex (language, "fcode", + "^[^\n]*\n?", + "", "", "p{tleave}{_advanceTo=0start}{scope=pop}" + "{{\n" + " ] _scopetop {\n" + " exch array2signature\n" + " % tag signature\n" + " dup 3 1 roll\n" + " % signature tag signature\n" + " signature:\n" + " tag-noprefix false eq {\n" + " % signature\n" + " pop\n" + " } {\n" + " tag-noprefix exch signature:\n" + " /tag-noprefix false def\n" + " } ifelse\n" + " } {\n" + " pop\n" + " } ifelse\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "freturn", + "^[^\n]*\n?", + "", "", "p{tleave}{_advanceTo=0start}{scope=pop}" + "{{\n" + " ] _scopetop {\n" + " exch array2signature\n" + " % tag signature\n" + " dup 3 1 roll\n" + " % signature tag signature\n" + " signature:\n" + " tag-noprefix false eq {\n" + " % signature\n" + " pop\n" + " } {\n" + " tag-noprefix exch signature:\n" + " /tag-noprefix false def\n" + " } ifelse\n" + " } {\n" + " pop\n" + " } ifelse\n" + "}}", NULL); + addLanguageTagMultiTableRegex (language, "alias", + "^[ \t]+([^= \t]+)[ \t]*=[^\n]*\n", + "\\1", "a", "p{scope=ref}", NULL); + addLanguageTagMultiTableRegex (language, "alias", + "^", + "", "", "p{tleave}", NULL); + addLanguageTagMultiTableRegex (language, "pod", + "^=cut[^\n]*\n", + "", "", "p{_guest=,,0start}{tleave}", NULL); + addLanguageTagMultiTableRegex (language, "pod", + "^[^\n]*\n", + "", "", "p", NULL); +} + +extern parserDefinition* XSParser (void) +{ + static const char *const extensions [] = { + "xs", + NULL + }; + + static const char *const aliases [] = { + NULL + }; + + static const char *const patterns [] = { + NULL + }; + + static roleDefinition XSModuleFileRoleTable [] = { + { true, "included", "included with INCLUDE keyword" }, + }; + static kindDefinition XSKindTable [] = { + { + true, 'm', "module", "modules", + }, + { + true, 'p', "package", "packages", + }, + { + true, 'f', "function", "functions", + }, + { + true, 'a', "alias", "aliases", + }, + { + true, 'M', "moduleFile", "module files", + ATTACH_ROLES(XSModuleFileRoleTable), + }, + }; + static xtagDefinition XSXtagTable [] = { + { + .enabled = true, + .name = "noprefix", + .description = "include functions name with prefix removed", + }, + }; + + parserDefinition* const def = parserNew ("XS"); + + def->versionCurrent= 0; + def->versionAge = 0; + def->enabled = true; + def->extensions = extensions; + def->patterns = patterns; + def->aliases = aliases; + def->method = METHOD_NOT_CRAFTED|METHOD_REGEX; + def->useCork = CORK_QUEUE; + def->kindTable = XSKindTable; + def->kindCount = ARRAY_SIZE(XSKindTable); + def->xtagTable = XSXtagTable; + def->xtagCount = ARRAY_SIZE(XSXtagTable); + def->initialize = initializeXSParser; + + return def; +} diff --git a/optlib/xs.ctags b/optlib/xs.ctags new file mode 100644 index 0000000000..183a005012 --- /dev/null +++ b/optlib/xs.ctags @@ -0,0 +1,221 @@ +# +# xs.ctags --- interface description file format used to create an extension interface between Perl and C code +# +# Copyright (c) 2023, Red Hat, Inc. +# Copyright (c) 2023, Masatake YAMATO +# +# Author: Masatake YAMATO +# +# 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +# USA. +# +# References: +# +# - https://perldoc.perl.org/perlxs +# + +# TODO: +# +# - merged form of the description of types and the list of argument names like: +# +# double +# sin(double x) +# +# - ... in parameter list like: +# +# double +# sin(...) +# +# - TYPEMAP +# +--langdef=XS +--map-XS=+.xs + +# +# Kind definitions +# + +--kinddef-XS=m,module,modules +--kinddef-XS=p,package,packages +--kinddef-XS=f,function,functions +--kinddef-XS=a,alias,aliases +--kinddef-XS=M,moduleFile,module files +--_roledef-XS.{moduleFile}=included,included with INCLUDE keyword + +# +# Extra definitions +# +--_extradef-XS=noprefix,include functions name with prefix removed +--extras-XS=+{noprefix} + +# +# Tables declaration +# + +--_tabledef-XS=init +--_tabledef-XS=main +--_tabledef-XS=func +--_tabledef-XS=keywords +--_tabledef-XS=fheader +--_tabledef-XS=fcode +--_tabledef-XS=freturn +--_tabledef-XS=alias +--_tabledef-XS=pod + +# +# Prelude +# + +--_prelude-XS={{ + /scope false def + /xsstart false def + /prefix false def + /prefix-length 0 def + /noprefix? /XS.noprefix _extraenabled def + /tag-noprefix false def + % [ (x) (y) (z) ] ARRAY2SIGNATURE (x,y,z) + /array2signature { + mark + ?( 3 -1 roll { ?, } forall dup ?, eq { + pop + } if + ?) _buildstring + } def +}} + +# +# Tables definitions +# + +# keywords table +--_mtable-regex-XS=keywords/(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n//p + +# table for returning fron function +--_mtable-regex-XS=freturn/[^\n]*\n?//p{tleave}{_advanceTo=0start}{scope=pop}{{ + ] _scopetop { + exch array2signature + % tag signature + dup 3 1 roll + % signature tag signature + signature: + tag-noprefix false eq { + % signature + pop + } { + tag-noprefix exch signature: + /tag-noprefix false def + } ifelse + } { + pop + } ifelse +}} + +# table for pod area +--_mtable-regex-XS=pod/=cut[^\n]*\n//p{_guest=,,0start}{tleave} +--_mtable-regex-XS=pod/[^\n]*\n//p + +# init table +--_mtable-regex-XS=init/((?:.*?)[\n]?)[ \t]*(MODULE[ \t]*=)//p{tjump=main}{_guest=C,1start,1end}{_advanceTo=2start}{{ + /xsstart 2 /start _matchloc def +}} + +# main table +--_mtable-regex-XS=main/[ \t]*MODULE[ \t]*=[ \t]*([^ \t\n]+)([ \t]*PACKAGE[ \t]*=[ \t]*([^ \t\n]+))?([ \t]*PREFIX[ \t]*=[ \t]*([^ \t\n]+))?[^\n]*\n/\1/m/p{{ + \3 false ne { + % Make a tag for the package and set it to the scope. + \3 /package 3 /start _matchloc _tag _commit dup . scope: + } { + % Make a tag for the module and set it to the scope. + . + } ifelse + /scope exch def + + % Record the prefix. + \5 false ne { + /prefix \5 def + /prefix-length \5 length def + } if +}} + +--_mtable-regex-XS=main/[ \t]+[^\n]*\n//p +--_mtable-extend-XS=main+keywords +--_mtable-regex-XS=main/INCLUDE:[ \t]*([^|\n]+?)[ \t]*\|?\n/\1/M/p{_role=included} +--_mtable-regex-XS=main/([A-Za-z_][^\n]*?)[ \t]*\n//p{tenter=func}{{ + % return type + \1 dup _normalize_spaces! _chop_space +}} + +--_mtable-regex-XS=main/=[^\n]+\n//p{tenter=pod}{_guest=Pod,0start,}{_advanceTo=0end} + +--_mtable-regex-XS=main/[^\n]*\n//p +--_mtable-regex-XS=main/()//p{tquit}{{ + xsstart false ne { + (CPreProcessor) xsstart 1 /start _matchloc _makepromise { pop } if + } if +}} + +# func table +--_mtable-extend-XS=func+keywords +--_mtable-regex-XS=func/#[^\n]*\n//p +--_mtable-regex-XS=func/([A-Za-z_][a-zA-Z0-9_]*)[ \t]*\([^;\n]*;?\n/\1/f/p{tjump=fheader}{scope=push}{{ + % function name + count 0 gt { + noprefix? prefix false ne and { + \1 prefix _strstr { + 0 eq { + prefix-length \1 length prefix-length sub 0 string _copyinterval + % type name-sans-prefix + /function 1 /start _matchloc _tag _commit + % for attaching signature later + dup /tag-noprefix exch def + dup /XS.noprefix _markextra + dup scope scope: + % type tag + 1 index + % type tag type + typeref: + } if + } { + pop + } ifelse + } if + % Fill the scope: field. + . scope scope: + % if a return type is on the stack, set it to typeref: field. + % Should we consdier "struct", "union", and "enum" here? + . exch typeref: + } if + % For gathering signatures + [ +}} +--_mtable-regex-XS=func/[^\n]*\n//p{tleave} +--_mtable-regex-XS=func/.//p{tleave} + +# function header +--_mtable-regex-XS=fheader/[ \t]+ALIAS:\n//p{tenter=alias} +--_mtable-regex-XS=fheader/#[^\n]*\n//p +--_mtable-regex-XS=fheader/[ \t]+(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n//p{tjump=fcode} +--_mtable-regex-XS=fheader/[ \t]+([^=;\n]*)(=[^;\n]+)?;?\n//p{{ + \1 dup _normalize_spaces! _chop_space +}} +--_mtable-extend-XS=fheader+freturn + +# function code +--_mtable-regex-XS=fcode/#[^\n]*\n//p +--_mtable-extend-XS=fcode+freturn + +# alias +--_mtable-regex-XS=alias/[ \t]+([^= \t]+)[ \t]*=[^\n]*\n/\1/a/p{scope=ref} +--_mtable-regex-XS=alias///p{tleave} diff --git a/source.mak b/source.mak index f131acedbe..46a2e77686 100644 --- a/source.mak +++ b/source.mak @@ -219,6 +219,7 @@ OPTSCRIPT_OBJS = $(OPTSCRIPT_SRCS:.c=.$(OBJEXT)) OPTLIB2C_PCRE2_INPUT = \ optlib/rdoc.ctags \ + optlib/xs.ctags \ \ $(NULL) OPTLIB2C_PCRE2_SRCS = $(OPTLIB2C_PCRE2_INPUT:.ctags=.c)