61 |
RETURN1(make_fixnum(-1)); |
RETURN1(make_fixnum(-1)); |
62 |
} |
} |
63 |
|
|
64 |
|
DEFUN_NEW("COMPILE-REGEXP",object,fScompile_regexp,SI,1,1,NONE,OO,OO,OO,OO,(object p), |
65 |
|
"Provide handle to export pre-compiled regexp's to string-match") { |
66 |
|
|
67 |
|
char *tmp; |
68 |
|
object res; |
69 |
|
|
70 |
|
if (type_of(p)!= t_string && type_of(p)!=t_symbol) |
71 |
|
not_a_string_or_symbol(p); |
72 |
|
|
73 |
|
if (!(tmp=alloca(p->st.st_fillp+1))) |
74 |
|
FEerror("out of C stack",0); |
75 |
|
memcpy(tmp,p->st.st_self,p->st.st_fillp); |
76 |
|
tmp[p->st.st_fillp]=0; |
77 |
|
|
78 |
|
res=alloc_object(t_vector); |
79 |
|
res->v.v_displaced=Cnil; |
80 |
|
res->v.v_hasfillp=1; |
81 |
|
res->v.v_elttype=aet_uchar; |
82 |
|
res->v.v_adjustable=0; |
83 |
|
res->v.v_offset=0; |
84 |
|
if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) |
85 |
|
FEerror("regcomp failure",0); |
86 |
|
res->v.v_fillp=res->v.v_dim; |
87 |
|
|
88 |
|
RETURN1(res); |
89 |
|
|
90 |
|
} |
91 |
|
|
92 |
|
|
93 |
DEFUN_NEW("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OI,IO,OO,(object pattern,object string,...), |
DEFUN_NEW("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OI,IO,OO,(object pattern,object string,...), |
94 |
"Match regexp PATTERN in STRING starting in string starting at START \ |
"Match regexp PATTERN in STRING starting in string starting at START \ |
95 |
and ending at END. Return -1 if match not found, otherwise \ |
and ending at END. Return -1 if match not found, otherwise \ |
102 |
|
|
103 |
int i,ans,nargs=VFUN_NARGS,len,start,end; |
int i,ans,nargs=VFUN_NARGS,len,start,end; |
104 |
static char buf[400],case_fold; |
static char buf[400],case_fold; |
105 |
static regexp *compiled_regexp; |
static regexp *saved_compiled_regexp; |
106 |
va_list ap; |
va_list ap; |
107 |
object v = sSAmatch_dataA->s.s_dbind; |
object v = sSAmatch_dataA->s.s_dbind; |
108 |
char **pp,*str,save_c=0; |
char **pp,*str,save_c=0; |
109 |
unsigned np; |
unsigned np; |
110 |
|
|
111 |
if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol) |
if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol && |
112 |
not_a_string_or_symbol(string); |
(type_of(pattern)!=t_vector || pattern->v.v_elttype!=aet_uchar)) |
113 |
|
FEerror("~S is not a regexp pattern", 1 , pattern); |
114 |
if (type_of(string)!= t_string && type_of(string)!=t_symbol) |
if (type_of(string)!= t_string && type_of(string)!=t_symbol) |
115 |
not_a_string_or_symbol(string); |
not_a_string_or_symbol(string); |
116 |
|
|
139 |
} |
} |
140 |
|
|
141 |
{ |
{ |
142 |
|
|
143 |
|
regexp *compiled_regexp=saved_compiled_regexp; |
144 |
|
|
145 |
BEGIN_NO_INTERRUPT; |
BEGIN_NO_INTERRUPT; |
146 |
|
|
147 |
case_fold_search = sSAcase_fold_searchA->s.s_dbind != sLnil ? 1 : 0; |
case_fold_search = sSAcase_fold_searchA->s.s_dbind != sLnil ? 1 : 0; |
148 |
if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) { |
|
149 |
|
if (type_of(pattern)==t_vector) |
|
char *tmp=len+1<sizeof(buf) ? buf : (char *) alloca(len+1); |
|
|
if (!tmp) |
|
|
FEerror("Cannot allocate memory on C stack",0); |
|
|
|
|
|
case_fold = case_fold_search; |
|
|
memcpy(tmp,pattern->st.st_self,len); |
|
|
tmp[len]=0; |
|
|
|
|
|
if (compiled_regexp) { |
|
|
free((void *)compiled_regexp); |
|
|
compiled_regexp = 0; |
|
|
} |
|
150 |
|
|
151 |
if (!(compiled_regexp=regcomp(tmp))) { |
compiled_regexp=(void *)pattern->ust.ust_self; |
152 |
END_NO_INTERRUPT; |
|
153 |
RETURN1(make_fixnum(-1)); |
else if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) |
154 |
} |
|
155 |
|
compiled_regexp=saved_compiled_regexp=(regexp *)fScompile_regexp(pattern)->v.v_self; |
156 |
|
|
|
} |
|
157 |
|
|
158 |
str=string->st.st_self; |
str=string->st.st_self; |
159 |
np=page(str); |
np=page(str); |