/[gcl]/gcl/o/regexpr.c
ViewVC logotype

Diff of /gcl/o/regexpr.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by camm, Thu Aug 5 22:21:59 2004 UTC revision 1.10 by camm, Sat Apr 2 16:13:52 2005 UTC
# Line 61  DEFUN_NEW("MATCH-END",object,fSmatch_end Line 61  DEFUN_NEW("MATCH-END",object,fSmatch_end
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 \
# Line 73  be over written.   \ Line 102  be over written.   \
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        
# Line 109  be over written.   \ Line 139  be over written.   \
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);

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26