Skip to content

Commit ce2c144

Browse files
masatakemasatake
committed
XS: new parrser
Signed-off-by: Masatake YAMATO <[email protected]>
1 parent c62933e commit ce2c144

File tree

8 files changed

+355
-1
lines changed

8 files changed

+355
-1
lines changed

‎Units/parser-xs.r/simple-xs.d/args.ctags

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
--sort=no
2+
--extras=+g

‎Units/parser-xs.r/simple-xs.d/expected.tags

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_$/;" m
2+
SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_$/;" p module:SDBM_File
3+
sdbm_TIEHASH input.xs /^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;" f package:SDBM_File.SDBM_File typeref:typename:SDBM_File
4+
TIEHASH input.xs /^sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)$/;" f package:SDBM_File.SDBM_File typeref:typename:SDBM_File
5+
sdbm_DESTROY input.xs /^sdbm_DESTROY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:void
6+
DESTROY input.xs /^sdbm_DESTROY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:void
7+
sdbm_FETCH input.xs /^sdbm_FETCH(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_value
8+
FETCH input.xs /^sdbm_FETCH(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_value
9+
sdbm_STORE input.xs /^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
10+
STORE input.xs /^sdbm_STORE(db, key, value, flags = DBM_REPLACE)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
11+
sdbm_DELETE input.xs /^sdbm_DELETE(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
12+
DELETE input.xs /^sdbm_DELETE(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
13+
sdbm_EXISTS input.xs /^sdbm_EXISTS(db,key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
14+
EXISTS input.xs /^sdbm_EXISTS(db,key)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
15+
sdbm_FIRSTKEY input.xs /^sdbm_FIRSTKEY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key
16+
FIRSTKEY input.xs /^sdbm_FIRSTKEY(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key
17+
sdbm_NEXTKEY input.xs /^sdbm_NEXTKEY(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key
18+
NEXTKEY input.xs /^sdbm_NEXTKEY(db, key)$/;" f package:SDBM_File.SDBM_File typeref:typename:datum_key
19+
sdbm_error input.xs /^sdbm_error(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
20+
error input.xs /^sdbm_error(db)$/;" f package:SDBM_File.SDBM_File typeref:typename:int
21+
filter_fetch_key input.xs /^filter_fetch_key(db, code)$/;" f package:SDBM_File.SDBM_File typeref:typename:SV *
22+
SDBM_File input.xs /^MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_$/;" m
23+
SDBM_X input.xs /^MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_$/;" p module:SDBM_File
24+
sdbm_X_DELETE0 input.xs /^sdbm_X_DELETE0(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int
25+
DELETE0 input.xs /^sdbm_X_DELETE0(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int
26+
sdbm_X_DELETE1 input.xs /^sdbm_X_DELETE1(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int
27+
DELETE1 input.xs /^sdbm_X_DELETE1(db, key)$/;" f package:SDBM_File.SDBM_X typeref:typename:int
28+
PERL_NO_GET_CONTEXT input.xs /^#define PERL_NO_GET_CONTEXT$/;" d file:
29+
fetch_key input.xs /^#define fetch_key /;" d file:
30+
store_key input.xs /^#define store_key /;" d file:
31+
fetch_value input.xs /^#define fetch_value /;" d file:
32+
store_value input.xs /^#define store_value /;" d file:
33+
__anoned1397e40108 input.xs /^typedef struct {$/;" s file:
34+
dbp input.xs /^ DBM * dbp ;$/;" m struct:__anoned1397e40108 typeref:typename:DBM * file:
35+
filter input.xs /^ SV * filter[4];$/;" m struct:__anoned1397e40108 typeref:typename:SV * [4] file:
36+
filtering input.xs /^ int filtering ;$/;" m struct:__anoned1397e40108 typeref:typename:int file:
37+
SDBM_File_type input.xs /^ } SDBM_File_type;$/;" t typeref:struct:__anoned1397e40108 file:
38+
SDBM_File input.xs /^typedef SDBM_File_type * SDBM_File ;$/;" t typeref:typename:SDBM_File_type * file:
39+
datum_key input.xs /^typedef datum datum_key ;$/;" t typeref:typename:datum file:
40+
datum_value input.xs /^typedef datum datum_value ;$/;" t typeref:typename:datum file:
41+
sdbm_FETCH input.xs /^#define sdbm_FETCH(/;" d file:
42+
sdbm_STORE input.xs /^#define sdbm_STORE(/;" d file:
43+
sdbm_DELETE input.xs /^#define sdbm_DELETE(/;" d file:
44+
sdbm_EXISTS input.xs /^#define sdbm_EXISTS(/;" d file:
45+
sdbm_FIRSTKEY input.xs /^#define sdbm_FIRSTKEY(/;" d file:
46+
sdbm_NEXTKEY input.xs /^#define sdbm_NEXTKEY(/;" d file:
47+
X input.xs /^#define X "X"/;" d file:
48+
Y input.xs /^#define Y "Y"/;" d file:

‎Units/parser-xs.r/simple-xs.d/features

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
pcre2

‎Units/parser-xs.r/simple-xs.d/input.xs

Lines changed: 159 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,159 @@
1+
/* Derrive from perl5/ext/SDBM_File/SDBM_File.xs */
2+
#define PERL_NO_GET_CONTEXT
3+
#include "EXTERN.h"
4+
#include "perl.h"
5+
#include "XSUB.h"
6+
#include "sdbm.h"
7+
8+
#define fetch_key 0
9+
#define store_key 1
10+
#define fetch_value 2
11+
#define store_value 3
12+
13+
typedef struct {
14+
DBM * dbp ;
15+
SV * filter[4];
16+
int filtering ;
17+
} SDBM_File_type;
18+
19+
typedef SDBM_File_type * SDBM_File ;
20+
typedef datum datum_key ;
21+
typedef datum datum_value ;
22+
23+
#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
24+
#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
25+
#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
26+
#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
27+
#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
28+
#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
29+
30+
31+
MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
32+
33+
PROTOTYPES: DISABLE
34+
35+
SDBM_File
36+
sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
37+
char * dbtype
38+
char * filename
39+
int flags
40+
int mode
41+
char * pagname
42+
CODE:
43+
{
44+
DBM * dbp ;
45+
46+
RETVAL = NULL ;
47+
if (pagname == NULL) {
48+
dbp = sdbm_open(filename, flags, mode);
49+
}
50+
else {
51+
dbp = sdbm_prep(filename, pagname, flags, mode);
52+
}
53+
if (dbp) {
54+
RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
55+
RETVAL->dbp = dbp ;
56+
}
57+
58+
}
59+
OUTPUT:
60+
RETVAL
61+
62+
void
63+
sdbm_DESTROY(db)
64+
SDBM_File db
65+
CODE:
66+
if (db) {
67+
int i = store_value;
68+
sdbm_close(db->dbp);
69+
do {
70+
if (db->filter[i])
71+
SvREFCNT_dec_NN(db->filter[i]);
72+
} while (i-- > 0);
73+
safefree(db) ;
74+
}
75+
76+
datum_value
77+
sdbm_FETCH(db, key)
78+
SDBM_File db
79+
datum_key key
80+
81+
int
82+
sdbm_STORE(db, key, value, flags = DBM_REPLACE)
83+
SDBM_File db
84+
datum_key key
85+
datum_value value
86+
int flags
87+
CLEANUP:
88+
if (RETVAL) {
89+
if (RETVAL < 0 && errno == EPERM)
90+
croak("No write permission to sdbm file");
91+
croak("sdbm store returned %d, errno %d, key \"%s\"",
92+
RETVAL,errno,key.dptr);
93+
sdbm_clearerr(db->dbp);
94+
}
95+
96+
int
97+
sdbm_DELETE(db, key)
98+
SDBM_File db
99+
datum_key key
100+
101+
int
102+
sdbm_EXISTS(db,key)
103+
SDBM_File db
104+
datum_key key
105+
106+
datum_key
107+
sdbm_FIRSTKEY(db)
108+
SDBM_File db
109+
110+
datum_key
111+
sdbm_NEXTKEY(db, key)
112+
SDBM_File db
113+
114+
int
115+
sdbm_error(db)
116+
SDBM_File db
117+
ALIAS:
118+
sdbm_clearerr = 1
119+
CODE:
120+
RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
121+
OUTPUT:
122+
RETVAL
123+
124+
SV *
125+
filter_fetch_key(db, code)
126+
SDBM_File db
127+
SV * code
128+
SV * RETVAL = &PL_sv_undef ;
129+
ALIAS:
130+
SDBM_File::filter_fetch_key = fetch_key
131+
SDBM_File::filter_store_key = store_key
132+
SDBM_File::filter_fetch_value = fetch_value
133+
SDBM_File::filter_store_value = store_value
134+
CODE:
135+
DBM_setFilter(db->filter[ix], code);
136+
137+
BOOT:
138+
{
139+
HV *stash = gv_stashpvs("SDBM_File", 1);
140+
newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
141+
newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
142+
newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
143+
}
144+
145+
MODULE = SDBM_File PACKAGE = SDBM_X PREFIX = sdbm_X_
146+
147+
int
148+
sdbm_X_DELETE0(db, key)
149+
SDBM_File db
150+
datum_key key
151+
152+
#define X "X"
153+
154+
int
155+
sdbm_X_DELETE1(db, key)
156+
SDBM_File db
157+
datum_key key
158+
159+
#define Y "Y"

‎docs/news.rst

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -479,6 +479,7 @@ The following parsers have been added:
479479
* TypeScript
480480
* Varlink *peg/packcc*
481481
* WindRes
482+
* XS *optlib pcre2*
482483
* XSLT v1.0 *libxml*
483484
* Yacc
484485
* Yaml *libyaml*

‎main/parsers_p.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,8 @@
4848

4949
#ifdef HAVE_PCRE2
5050
#define OPTLIB2C_PCRE2_PARSER_LIST \
51-
RDocParser
51+
RDocParser, \
52+
XSParser
5253
#else
5354
#define OPTLIB2C_PCRE2_PARSER_LIST
5455
#endif

‎optlib/xs.ctags

Lines changed: 141 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,141 @@
1+
#
2+
# xs.ctags --- interface description file format used to create an extension interface between Perl and C code
3+
#
4+
# Copyright (c) 2022, Red Hat, Inc.
5+
# Copyright (c) 2022, Masatake YAMATO
6+
#
7+
# Author: Masatake YAMATO <[email protected]>
8+
#
9+
# This program is free software; you can redistribute it and/or
10+
# modify it under the terms of the GNU General Public License
11+
# as published by the Free Software Foundation; either version 2
12+
# of the License, or (at your option) any later version.
13+
#
14+
# This program is distributed in the hope that it will be useful,
15+
# but WITHOUT ANY WARRANTY; without even the implied warranty of
16+
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17+
# GNU General Public License for more details.
18+
#
19+
# You should have received a copy of the GNU General Public License
20+
# along with this program; if not, write to the Free Software
21+
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
22+
# USA.
23+
#
24+
# References:
25+
#
26+
# - https://perldoc.perl.org/perlxs
27+
#
28+
29+
#
30+
# TODO:
31+
#
32+
# - capture aliases
33+
# - capture signatures of functions,
34+
# - make reftag for INCLUDE'ed files
35+
# - separators
36+
#
37+
38+
--langdef=XS
39+
--map-XS=+.xs
40+
41+
#
42+
# Kind definitions
43+
#
44+
45+
--kinddef-XS=m,module,modules
46+
--kinddef-XS=p,package,packages
47+
--kinddef-XS=f,function,functions
48+
49+
#
50+
# Tables declaration
51+
#
52+
53+
--_tabledef-XS=init
54+
--_tabledef-XS=main
55+
--_tabledef-XS=func
56+
--_tabledef-XS=keywords
57+
58+
#
59+
# Prelude
60+
#
61+
62+
--_prelude-XS={{
63+
/scope false def
64+
/xsstart false def
65+
/prefix false def
66+
/prefix-length 0 def
67+
}}
68+
69+
#
70+
# Tables definitions
71+
#
72+
73+
# keywords table
74+
--_mtable-regex-XS=keywords/(?:REQUIRE|BOOT|CASE|PREINIT|INPUT|INIT|CODE|PPCODE|OUTPUT|CLEANUP|ALIAS|ATTRS|PROTOTYPES|PROTOTYPE|VERSIONCHECK|INCLUDE|INCLUDE_COMMAND|SCOPE|INTERFACE|INTERFACE_MACRO|C_ARGS|POSTCALL|OVERLOAD|FALLBACK|EXPORT_XSUB_SYMBOLS)[^\n]*\n//{pcre2}
75+
76+
# init table
77+
--_mtable-regex-XS=init/((?:.*?)[\n])[ \t]*(MODULE[ \t]*=)//{pcre2}{tjump=main}{_guest=C,1start,1end}{_advanceTo=2start}{{
78+
/xsstart 2 /start _matchloc def
79+
}}
80+
81+
# main table
82+
--_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/{{
83+
\3 false ne {
84+
% Make a tag for the package and set it to the scope.
85+
\3 /package 3 /start _matchloc _tag _commit dup . scope:
86+
} {
87+
% Make a tag for the module and set it to the scope.
88+
.
89+
} ifelse
90+
/scope exch def
91+
92+
% Record the prefix.
93+
\5 false ne {
94+
/prefix \5 def
95+
/prefix-length \5 length def
96+
} if
97+
}}
98+
99+
--_mtable-regex-XS=main/[\t ]+[^\n]*\n//
100+
--_mtable-extend-XS=main+keywords
101+
--_mtable-regex-XS=main/([A-Za-z_][^\n]*?)[\t ]*\n//{tenter=func}{pcre2}{{
102+
% return type
103+
\1
104+
}}
105+
106+
--_mtable-regex-XS=main/[^\n]*\n//
107+
--_mtable-regex-XS=main/()//{tquit}{{
108+
xsstart false ne {
109+
(CPreProcessor) xsstart 1 /start _matchloc _makepromise pop
110+
} if
111+
}}
112+
113+
# func table
114+
--_mtable-extend-XS=func+keywords
115+
--_mtable-regex-XS=func/([A-Za-z_][a-zA-Z0-9_]*)[ \t]*\([^\n]*\n/\1/f/{tleave}{{
116+
% function name
117+
count 0 gt {
118+
prefix false ne {
119+
\1 prefix _strstr {
120+
0 eq {
121+
prefix-length \1 length prefix-length sub 0 string _copyinterval
122+
% type name-sans-prefix
123+
/function 1 /start _matchloc _tag _commit dup scope scope:
124+
% type tag
125+
1 index exch
126+
% type type tag
127+
exch typeref:
128+
} if
129+
} {
130+
pop
131+
} ifelse
132+
} if
133+
% Fill the scope: field.
134+
. scope scope:
135+
% if a return type is on the stack, set it to typeref: field.
136+
% Should we consdier "struct", "union", and "enum" here?
137+
. exch typeref:
138+
} if
139+
}}
140+
--_mtable-regex-XS=func/[^\n]*\n//{tleave}
141+
--_mtable-regex-XS=func/.//{tleave}

‎source.mak

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -219,6 +219,7 @@ OPTSCRIPT_OBJS = $(OPTSCRIPT_SRCS:.c=.$(OBJEXT))
219219

220220
OPTLIB2C_PCRE2_INPUT = \
221221
optlib/rdoc.ctags \
222+
optlib/xs.ctags \
222223
\
223224
$(NULL)
224225
OPTLIB2C_PCRE2_SRCS = $(OPTLIB2C_PCRE2_INPUT:.ctags=.c)

0 commit comments

Comments
 (0)