From 1ea7c8604e4c35a4aa27206a41feda83fa5eed27 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Mon, 1 Jan 2001 17:19:55 +0000 Subject: [PATCH] Ported to new FFI. --- scsh/rx/packages.scm | 1 + scsh/rx/re-low.scm | 38 ++++++++++----------- scsh/rx/re1.c | 79 +++++++++++++++++++++++++------------------- scsh/rx/re1.h | 12 +++---- 4 files changed, 70 insertions(+), 60 deletions(-) diff --git a/scsh/rx/packages.scm b/scsh/rx/packages.scm index 9b62a84..86f9a77 100644 --- a/scsh/rx/packages.scm +++ b/scsh/rx/packages.scm @@ -203,6 +203,7 @@ ascii primitives ; JMG add-finalizer! define-record-types ; JMG debugging + external-calls string-lib ; string-fold scheme) diff --git a/scsh/rx/re-low.scm b/scsh/rx/re-low.scm index 6b3e4cd..9b7d0f4 100644 --- a/scsh/rx/re-low.scm +++ b/scsh/rx/re-low.scm @@ -65,6 +65,9 @@ (define-record-discloser :cre (lambda (self) (list "cre" (cre:string self)))) +(define-record-resumer :cre (lambda (cre) + (set-cre:bytes cre #f) + (set-cre:bytes/nm cre #f))) (define (make-cre str max-paren tvec) (really-make-cre str max-paren #f #f tvec #f)) @@ -76,15 +79,15 @@ (vfold (lambda (sm mlpsm) (if sm (max mlpsm sm) mlpsm)) 0 tvec)) (define (compile-posix-re->c-struct re-string sm?) - (receive (errcode c-struct) (%compile-re re-string sm?) - (if (zero? errcode) c-struct - (error errcode (%regerror-msg errcode c-struct) - compile-posix-re->c-struct re-string sm?)))) - -(define-foreign %compile-re (compile_re (string-desc pattern) (bool submatches?)) - integer ; 0 or error code - (C regex_t*)) + (let ((maybe-struct (%compile-re re-string sm?))) + (if (pair? maybe-struct) + (error (car maybe-struct) + (%regerror-msg (car maybe-struct) (cdr maybe-struct)) + compile-posix-re->c-struct re-string sm?) + maybe-struct))) +;;; returns pointer as number or a pair of error number and 0 +(define-stubless-foreign %compile-re (pattern submatches?) "compile_re") ;;; Searching with compiled regexps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -121,25 +124,20 @@ cre-search? cre str start) retcode))))) -(define-foreign %cre-search - (re_search ((C "const regex_t *~a") compiled-regexp) - (string-desc str) - (integer start) - (vector-desc tvec) (integer max-psm) - (vector-desc svec) (vector-desc evec)) - desc) ; 0 success, #f no-match, or non-zero int error code. +; 0 success, #f no-match, or non-zero int error code: +(define-stubless-foreign %cre-search + (compiled-regexp str start tvec max-psm svec evec) "re_search") + ;;; Generate an error msg from an error code. -(define-foreign %regerror-msg (re_errint2str (integer errcode) - ((C "const regex_t *~a") re)) - string) +(define-stubless-foreign %regerror-msg (errcode re) "re_errint2str") ;;; Reclaiming compiled regexp storage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-foreign %free-re (free_re ((C regex_t*) re)) ignore) +(define-stubless-foreign %free-re (re) "free_re") ;;; Whenever we make a new CRE, add the appropriate finalizer, @@ -151,7 +149,7 @@ (warn "free-bytes called on #f"))) (define (free-bytes/nm the-cre) - (if (cre:bytes the-cre) + (if (cre:bytes/nm the-cre) (%free-re (cre:bytes/nm the-cre)) (warn "free-bytes/nm called on #f"))) diff --git a/scsh/rx/re1.c b/scsh/rx/re1.c index b01710a..52d531c 100644 --- a/scsh/rx/re1.c +++ b/scsh/rx/re1.c @@ -8,6 +8,7 @@ ** regex freeing ** regexp-string -> regex_t caching ** make filter_stringvec return an error code. +** TODO: filter_stringvec is used nowhere, why? */ #include @@ -26,24 +27,24 @@ ** and return a non-zero error code. */ -int compile_re(s48_value re_str, int sm_p, regex_t **cr) +s48_value compile_re(s48_value re_str, s48_value sm_p) { - // JMG: char *s = &STRING_REF(re_str, 0); char *s = s48_extract_string(re_str); - int len = S48_STRING_LENGTH(re_str); - int err; - regex_t *re = Alloc(regex_t); - - if( !re ) return -1; - - re->re_endp = s + len; - err = regcomp(re, s, REG_EXTENDED | REG_PEND - | (sm_p ? 0 : REG_NOSUB)); - if( err ) {Free(re); *cr=0;} - else *cr=re; - - return err; - } + int len = S48_STRING_LENGTH(re_str); + int err; + regex_t *re = Alloc(regex_t); + + if( !re ) s48_raise_out_of_memory_error(); + + re->re_endp = s + len; + err = regcomp(re, s, REG_EXTENDED | REG_PEND + | ((sm_p != S48_FALSE) ? 0 : REG_NOSUB)); + if( err ) { + Free(re); + return s48_cons(s48_enter_fixnum (err), s48_enter_fixnum (0)); + } + else return s48_enter_integer((unsigned long) re); +} /* Do a regex search of RE through string STR, beginning at STR[START]. ** - STR is passed as a Scheme value as it is allowed to contain nul bytes. @@ -76,14 +77,15 @@ int compile_re(s48_value re_str, int sm_p, regex_t **cr) ** Return 0 on success; #f if no match; non-zero integer error code otherwise. */ -s48_value re_search(const regex_t *re, s48_value str, int start, - s48_value trans_vec, int max_psm, +s48_value re_search(s48_value _re, s48_value str, s48_value _start, + s48_value trans_vec, s48_value _max_psm, s48_value start_vec, s48_value end_vec) { - // JMG: char *s = &STRING_REF(str,0); /* Passed as a s48_value because */ + const regex_t *re = (const regex_t *) s48_extract_integer (_re); char *s = s48_extract_string(str); - int len = S48_STRING_LENGTH(str); /* it might contain nul bytes. */ - + int len = S48_STRING_LENGTH(str); /* it might contain nul bytes. */ + int start = s48_extract_fixnum (_start); + int max_psm = s48_extract_fixnum (_max_psm); int vlen = S48_VECTOR_LENGTH(start_vec); int retval; @@ -93,7 +95,7 @@ s48_value re_search(const regex_t *re, s48_value str, int start, if( max_psm < 10 ) pm = static_pmatch; else { pm = Malloc(regmatch_t, max_psm+1);/* Add 1 for the whole-match info. */ - if( !pm ) return s48_enter_fixnum(-1); + if( !pm ) s48_raise_out_of_memory_error(); } pm[0].rm_so = start; @@ -105,9 +107,6 @@ s48_value re_search(const regex_t *re, s48_value str, int start, if( !retval && max_psm >= 0 ) { int i; - //JMG: S48_VECTOR_REF(start_vec,0) = s48_enter_fixnum(pm[0].rm_so); /* whole-match */ - //S48_VECTOR_REF(end_vec,0) = s48_enter_fixnum(pm[0].rm_eo); - S48_VECTOR_SET(start_vec,0, s48_enter_fixnum(pm[0].rm_so)); S48_VECTOR_SET(end_vec,0, s48_enter_fixnum(pm[0].rm_eo)); @@ -117,8 +116,6 @@ s48_value re_search(const regex_t *re, s48_value str, int start, int j = s48_extract_fixnum(j_scm); int k = pm[j].rm_so, l = pm[j].rm_eo; - // JMG S48_VECTOR_REF(start_vec,i+1) = (k != -1) ? s48_enter_fixnum(k) : S48_FALSE; - //S48_VECTOR_REF(end_vec, i+1) = (l != -1) ? s48_enter_fixnum(l) : S48_FALSE; S48_VECTOR_SET(start_vec,i+1, (k != -1) ? s48_enter_fixnum(k) : S48_FALSE); S48_VECTOR_SET(end_vec, i+1, (l != -1) ? s48_enter_fixnum(l) : S48_FALSE); } @@ -130,7 +127,7 @@ s48_value re_search(const regex_t *re, s48_value str, int start, if( retval==REG_NOMATCH ) return S48_FALSE; if( ! retval ) return S48_TRUE; return s48_enter_fixnum(retval); - } +} @@ -163,20 +160,34 @@ int filter_stringvec(s48_value re_str, char const **stringvec) regfree(&re); return q-stringvec; - } +} -const char *re_errint2str(int errcode, const regex_t *re) +s48_value re_errint2str(s48_value _errcode, s48_value _re) { + const regex_t *re = (const regex_t *) s48_extract_integer (_re); + int errcode = s48_extract_fixnum (_errcode); int size = regerror(errcode, re, 0, 0); char *s = Malloc(char,size); if(s) regerror(errcode, re, s, size); - return s; - } + return s48_enter_string(s); +} -void free_re(regex_t *re) +s48_value free_re(s48_value _re) { + regex_t *re = (regex_t *) s48_extract_integer(_re); regfree(re); Free(re); - } + return S48_UNSPECIFIC; +} + +s48_value s48_init_re_low(void) +{ + S48_EXPORT_FUNCTION(compile_re); + S48_EXPORT_FUNCTION(re_search); + S48_EXPORT_FUNCTION(re_errint2str); + S48_EXPORT_FUNCTION(free_re); + + return S48_UNSPECIFIC; +} diff --git a/scsh/rx/re1.h b/scsh/rx/re1.h index 49878b2..d3da80d 100644 --- a/scsh/rx/re1.h +++ b/scsh/rx/re1.h @@ -1,15 +1,15 @@ /* Exports from re1.c */ -int compile_re(s48_value sre, int sm_p, regex_t **cr); +s48_value compile_re(s48_value sre, s48_value sm_p); -s48_value re_search(const regex_t *re, s48_value str, int start, - s48_value trans_vec, int max_psm, - s48_value start_vec, s48_value end_vec); +s48_value re_search(s48_value _re, s48_value str, s48_value start, + s48_value trans_vec, s48_value max_psm, + s48_value start_vec, s48_value end_vec); /* Filter a vector of strings by a regexp. */ int filter_stringvec(s48_value re_str, char const **stringvec); /* Error code -> error msg */ -const char *re_errint2str(int errcode, const regex_t *re); +s48_value re_errint2str(s48_value _errcode, s48_value _re); -void free_re(regex_t *re); /* Free the malloc'd regexp. */ +s48_value free_re(s48_value _re); /* Free the malloc'd regexp. */