=============================================================================
20050215:

(listen) does not work when readline is enabled in 2.6.6. Either do (si::readline-off), or apply this patch:
=============================================================================
diff -ru gcl/h/protoize.h gcl-2.6.6/h/protoize.h
--- gcl/h/protoize.h 2005-01-16 00:36:20.000000000 +0000
+++ gcl-2.6.6/h/protoize.h 2005-02-15 16:35:37.000000000 +0000
@@ -547,6 +547,7 @@


/* readline.d */
+extern int readline_on;
void
gcl_init_readline_function(void);

diff -ru gcl/o/file.d gcl-2.6.6/o/file.d
--- gcl/o/file.d 2004-05-07 21:48:58.000000000 +0000
+++ gcl-2.6.6/o/file.d 2005-02-15 17:52:20.000000000 +0000
@@ -39,6 +39,7 @@
#include "include.h"

#ifdef HAVE_READLINE
+#include
#define kclgetc(FP) rl_getc_em(FP)
#define kclungetc(C, FP) rl_ungetc_em(C, FP)
#define kclputc(C, FP) rl_putc_em(C, FP)
@@ -1210,6 +1211,8 @@
case smm_input:
case smm_io:

+ if (readline_on && strm->sm.sm_fp==rl_instream)
+ return *rl_line_buffer ? TRUE : FALSE;

if (strm->sm.sm_fp == NULL)
closed_stream(strm);
diff -ru gcl/o/gcl_readline.d gcl-2.6.6/o/gcl_readline.d
--- gcl/o/gcl_readline.d 2004-03-09 02:15:42.000000000 +0000
+++ gcl-2.6.6/o/gcl_readline.d 2005-02-15 17:51:56.000000000 +0000
@@ -51,7 +51,7 @@
#include
#endif

-static int readline_on = 0; /* On (1) or off (0) */
+int readline_on = 0; /* On (1) or off (0) */
static int rl_ungetc_em_char = -1;
static unsigned char *rl_putc_em_line = NULL;

@@ -283,6 +283,7 @@
free(line);
line = NULL;
linepos = 0;
+ if (rl_line_buffer) *rl_line_buffer=0;
return '\n';
}

=============================================================================
Control-D did not work when readline was on.
=============================================================================
Index: file.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/file.d,v
retrieving revision 1.38
diff -u -r1.38 file.d
--- file.d 8 Mar 2005 03:56:43 -0000 1.38
+++ file.d 31 Mar 2005 01:13:15 -0000
@@ -102,6 +102,10 @@
feof1(fp)
FILE *fp;
{
+
+ if (readline_on && fp==rl_instream && rl_line_buffer && *rl_line_buffer==EOF)
+ return TRUE;
+
if (!feof(fp))
return(FALSE);
if (fp == terminal_io->sm.sm_object0->sm.sm_fp) {
Index: gcl_readline.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/gcl_readline.d,v
retrieving revision 1.9
diff -u -r1.9 gcl_readline.d
--- gcl_readline.d 16 Feb 2005 14:32:45 -0000 1.9
+++ gcl_readline.d 31 Mar 2005 01:13:15 -0000
@@ -272,7 +272,7 @@
putc('\r', stdout);
line = readline(rl_putc_em_line);
rl_putc_em('\r', stdout);
- if (line==NULL) return EOF;
+ if (line==NULL) return *rl_line_buffer=EOF;
if (line[0] != 0) add_history(line);
} else {
return getc(f);
=============================================================================
librealine5 support in Debian
=============================================================================
--- debian/control 25 Nov 2004 00:05:37 -0000 1.44
+++ debian/control 31 Mar 2005 02:15:56 -0000
@@ -2,7 +2,7 @@
Section: interpreters
Priority: optional
Maintainer: Camm Maguire
-Build-Depends: debhelper, emacs21 | emacsen, libreadline4-dev, m4, tk8.4-dev, tetex-bin, texinfo, binutils-dev, libgmp3-dev, autotools-dev
+Build-Depends: debhelper, emacs21 | emacsen, libreadline5-dev | libreadline-dev, m4, tk8.4-dev, tetex-bin, texinfo, binutils-dev, libgmp3-dev, autotools-dev
Standards-Version: 3.6.1

Package: gclcvs
=============================================================================
Support for pre-compiled regexps and new texinfo format
=============================================================================
diff -ru gcl-2.6.6/cmpnew/gcl_cmpeval.lsp gcl-2.6.6.new/cmpnew/gcl_cmpeval.lsp
--- gcl-2.6.6/cmpnew/gcl_cmpeval.lsp 2003-10-31 01:03:29.000000000 +0000
+++ gcl-2.6.6.new/cmpnew/gcl_cmpeval.lsp 2005-04-03 00:00:38.000000000 +0000
@@ -68,10 +68,31 @@
(if (eq form '*cmperr-tag*) (c1nil) form))

(si::putprop 'si:|#,| 'c1sharp-comma 'c1special)
+(si::putprop 'load-time-value 'c1load-time-value 'c1special)

(defun c1sharp-comma (arg)
(c1constant-value (cons 'si:|#,| arg) t))

+(defun wrap-literals (form)
+ (cond ((consp form)
+ (if (eq (car form) 'quote )
+ `(load-time-value (si::nani ,(si::address (cadr form))))
+ (cons (wrap-literals (car form)) (wrap-literals (cdr form)))))
+ ((stringp form)
+ `(load-time-value (si::nani ,(si::address form))))
+ (t form)))
+
+(defun c1load-time-value (arg)
+ (c1constant-value
+ (cons 'si:|#,|
+ (if *compiler-compile*
+ (let ((x (cmp-eval (car arg))))
+ (if (and (cdr arg) (cadr arg))
+ x
+ `(si::nani ,(si::address x))))
+ (car arg)))
+ t))
+
(si::putprop 'si::define-structure 'c1define-structure 't1)

(defun c1define-structure (arg &aux *sharp-commas*)
diff -ru gcl-2.6.6/cmpnew/gcl_cmpmain.lsp gcl-2.6.6.new/cmpnew/gcl_cmpmain.lsp
--- gcl-2.6.6/cmpnew/gcl_cmpmain.lsp 2005-01-15 16:27:15.000000000 +0000
+++ gcl-2.6.6.new/cmpnew/gcl_cmpmain.lsp 2005-04-03 00:00:38.000000000 +0000
@@ -35,6 +35,7 @@


(defvar *compiler-in-use* nil)
+(defvar *compiler-compile* nil)
(defvar *compiler-input*)
(defvar *compiler-output1*)
(defvar *compiler-output2*)
@@ -408,7 +409,6 @@
(wt-data1 form) ;; this binds all the print stuff
))

-
(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #"."))

(cond ((not(symbolp name)) (error "Must be a name"))
@@ -423,10 +423,12 @@
(setf (symbol-function 'cmp-anon) tem)
(compile 'cmp-anon)
(setf (macro-function name) (macro-function name))
- name)
+ ;; FIXME -- support warnings-p and failures-p. CM 20041119
+ (values name nil nil))
((and (setq tem (symbol-function name))
(consp tem))
- (let ((na (if (symbol-package name) name 'cmp-anon)))
+ (let ((na (if (symbol-package name) name 'cmp-anon))
+ (tem (wrap-literals tem)))
(unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon)))
(with-open-file
(st (setq gaz (gazonk-name)) :direction :output)
@@ -434,12 +436,14 @@
(lambda (cdr tem))
(lambda-block (cddr tem))
)) st))
- (let ((fi (compile-file gaz)))
+ (let ((fi (let ((*compiler-compile* t))
+ (compile-file gaz))))
(load fi)
(delete-file fi))
(unless *keep-gaz* (delete-file gaz)))
(or (eq na name) (setf (symbol-function name) (symbol-function na)))
- (symbol-function name)
+ ;; FIXME -- support warnings-p and failures-p. CM 20041119
+ (values (symbol-function name) nil nil)
))
(t (error "can't compile ~a" name))))

diff -ru gcl-2.6.6/lsp/gcl_info.lsp gcl-2.6.6.new/lsp/gcl_info.lsp
--- gcl-2.6.6/lsp/gcl_info.lsp 2004-03-20 01:35:28.000000000 +0000
+++ gcl-2.6.6.new/lsp/gcl_info.lsp 2005-04-02 23:59:54.000000000 +0000
@@ -11,7 +11,8 @@
`(slooP::sloop while ,test do ,@ body))
(defmacro f (op x y)
`(the ,(if (get op 'compiler::predicate) 't 'fixnum)
- (,op (the fixnum ,x) (the fixnum ,y)))))
+ (,op (the fixnum ,x) (the fixnum ,y))))
+(defmacro fcr (x) `(load-time-value (compile-regexp ,x))))

(eval-when (compile eval load)
(defun sharp-u-reader (stream subchar arg)
@@ -31,10 +32,13 @@
(vector-push-extend ch tem)))
tem))

-
(set-dispatch-macro-character #\# #\u 'sharp-u-reader)
+
)

+(defconstant +crlu+ (compile-regexp #u""))
+(defconstant +crnp+ (compile-regexp #u"[]"))
+
(defvar *info-data* nil)
(defvar *current-info-data* nil)

@@ -67,11 +71,11 @@
(declare (fixnum lim))
(let ((s (file-to-string file)) (i 0))
(declare (fixnum i) (string s))
- (cond ((f >= (string-match #u"[\n]+Indirect:" s 0) 0)
+ (cond ((f >= (string-match (fcr #u"[\n]+Indirect:") s 0) 0)
(setq i (match-end 0))
- (setq lim (string-match #u"" s i))
+ (setq lim (string-match +crlu+ s i))
(while
- (f >= (string-match #u"\n([^\n]+): ([0-9]+)" s i lim) 0)
+ (f >= (string-match (fcr #u"\n([^\n]+): ([0-9]+)") s i lim) 0)
(setq i (match-end 0))
(setq files
(cons(cons
@@ -79,39 +83,40 @@
(get-match s 1)
)
files)))))
- (cond ((f >= (si::string-match #u"[\n]+Tag Table:" s i) 0)
+ (cond ((f >= (si::string-match (fcr #u"[\n]+Tag Table:") s i) 0)
(setq i (si::match-end 0))
- (cond ((f >= (si::string-match "" s i) 0)
+ (cond ((f >= (si::string-match +crlu+ s i) 0)
(setq tags (subseq s i (si::match-end 0)))))))
(if files (or tags (info-error "Need tags if have multiple files")))
(list* tags (nreverse files))))

-(defun re-quote-string (x &aux (i 0) (len (length x)) ch
- (extra 0) )
- (declare (fixnum i len extra))
- (declare (string x))
- (let (tem)
- (tagbody
- AGAIN
- (while (< i len)
- (setq ch (aref x i))
- (cond ((position ch "\\()[]+.*|^$?")
- (cond (tem
- (vector-push-extend #\\ tem))
- (t (incf extra)))))
- (if tem
- (vector-push-extend ch tem))
- (setq i (+ i 1)))
- (cond (tem )
- ((> extra 0)
- (setq tem
- (make-array (f + (length x) extra)
- :element-type 'string-char :fill-pointer 0))
- (setq i 0)
- (go AGAIN))
- (t (setq tem x)))
- )
- tem))
+(defun re-quote-string (x &aux (i 0) ch (extra 0))
+ (declare (fixnum i extra))
+ (let ((x (if (stringp x) x (string x))))
+ (declare (string x))
+ (let (tem (len (length x)))
+ (declare (fixnum len))
+ (tagbody
+ AGAIN
+ (while (< i len)
+ (setq ch (aref x i))
+ (cond ((position ch "\\()[]+.*|^$?")
+ (cond (tem
+ (vector-push-extend #\\ tem))
+ (t (incf extra)))))
+ (if tem
+ (vector-push-extend ch tem))
+ (setq i (+ i 1)))
+ (cond (tem )
+ ((> extra 0)
+ (setq tem
+ (make-array (f + (length x) extra)
+ :element-type 'string-char :fill-pointer 0))
+ (setq i 0)
+ (go AGAIN))
+ (t (setq tem x)))
+ )
+ tem)))

(defun get-match (string i)
(subseq string (match-beginning i) (match-end i)))
@@ -292,15 +297,15 @@
(let* ((info-subfile (info-subfile n))
(s (info-get-file (cdr info-subfile)))
(end (- n (car info-subfile))))
- (while (f >= (string-match #u"" s i end) 0)
+ (while (f >= (string-match +crlu+ s i end) 0)
(setq i (match-end 0)))
(setq i (- i 1))
(if (f >= (string-match
- #u"[\n][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n" s i) 0)
+ (fcr #u"[\n][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n") s i) 0)
(let* ((i (match-beginning 0))
(beg (match-end 0))
(name (get-match s 1))
- (end(if (f >= (string-match "[]" s beg) 0)
+ (end(if (f >= (string-match +crnp+ s beg) 0)
(match-beginning 0)
(length s)))
(node (list* s beg end i name info-subfile
@@ -326,7 +331,7 @@
(setq position-pattern (car name) name (cdr name)))))
(or (stringp name) (info-error "bad arg"))
(waiting *info-window*)
- (cond ((f >= (string-match "^\\(([^(]+)\\)([^)]*)" name) 0)
+ (cond ((f >= (string-match (fcr "^\\(([^(]+)\\)([^)]*)") name) 0)
;; (file)node
(setq file (get-match name 1))
(setq name (get-match name 2))
@@ -351,7 +356,7 @@
s start) 0)
(let* ((i (match-beginning 0))
(beg (match-end 0))
- (end(if (f >= (string-match "[]" s beg) 0)
+ (end(if (f >= (string-match +crnp+ s beg) 0)
(match-beginning 0)
(length s)))
(node (list* s beg end i name info-subfile
@@ -366,7 +371,7 @@
(f >= (setq subnode
(string-match
(si::string-concatenate
- #u"\n - [A-Za-z ]+: "
+ #u"\n -+ [A-Za-z ]+: "
position-pattern #u"[ \n]")
s beg end)) 0)
(f >= (string-match position-pattern s beg end) 0))
@@ -381,9 +386,13 @@
(let ((e
(if (and (>= subnode 0)
(f >=
- (string-match #u"\n\n - [A-Z]"
- s (+ beg 1
- initial-offset)
+ (string-match
+ (fcr #u"\n -+ [a-zA-Z]")
+ s
+ (let* ((bg (+ beg 1 initial-offset))
+ (sd (string-match (fcr #u"\n ") s bg end))
+ (nb (if (minusp sd) bg sd)))
+ nb)
end)
0))
(match-beginning 0)
diff -ru gcl-2.6.6/o/regexp.c gcl-2.6.6.new/o/regexp.c
--- gcl-2.6.6/o/regexp.c 2003-02-15 00:38:28.000000000 +0000
+++ gcl-2.6.6.new/o/regexp.c 2005-04-02 23:40:21.000000000 +0000
@@ -230,7 +230,7 @@
* of the structure of the compiled regexp.
*/
static regexp *
-regcomp(char *exp)
+regcomp(char *exp,int *sz)
{
register regexp *r;
register char *scan;
@@ -255,7 +255,8 @@
FAIL("regexp too big");

/* Allocate space. */
- r = (regexp *)malloc(sizeof(regexp) + (unsigned)regsize);
+ *sz=sizeof(regexp) + (unsigned)regsize;
+ r = (regexp *)alloc_relblock(*sz);
if (r == NULL)
FAIL("out of space");

diff -ru gcl-2.6.6/o/regexpr.c gcl-2.6.6.new/o/regexpr.c
--- gcl-2.6.6/o/regexpr.c 2004-08-05 22:21:11.000000000 +0000
+++ gcl-2.6.6.new/o/regexpr.c 2005-04-02 23:40:21.000000000 +0000
@@ -61,6 +61,35 @@
RETURN1(make_fixnum(-1));
}

+DEFUN_NEW("COMPILE-REGEXP",object,fScompile_regexp,SI,1,1,NONE,OO,OO,OO,OO,(object p),
+ "Provide handle to export pre-compiled regexp's to string-match") {
+
+ char *tmp;
+ object res;
+
+ if (type_of(p)!= t_string && type_of(p)!=t_symbol)
+ not_a_string_or_symbol(p);
+
+ if (!(tmp=alloca(p->st.st_fillp+1)))
+ FEerror("out of C stack",0);
+ memcpy(tmp,p->st.st_self,p->st.st_fillp);
+ tmp[p->st.st_fillp]=0;
+
+ res=alloc_object(t_vector);
+ res->v.v_displaced=Cnil;
+ res->v.v_hasfillp=1;
+ res->v.v_elttype=aet_uchar;
+ res->v.v_adjustable=0;
+ res->v.v_offset=0;
+ if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim)))
+ FEerror("regcomp failure",0);
+ res->v.v_fillp=res->v.v_dim;
+
+ RETURN1(res);
+
+}
+
+
DEFUN_NEW("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OI,IO,OO,(object pattern,object string,...),
"Match regexp PATTERN in STRING starting in string starting at START \
and ending at END. Return -1 if match not found, otherwise \
@@ -73,14 +102,15 @@

int i,ans,nargs=VFUN_NARGS,len,start,end;
static char buf[400],case_fold;
- static regexp *compiled_regexp;
+ static regexp *saved_compiled_regexp;
va_list ap;
object v = sSAmatch_dataA->s.s_dbind;
char **pp,*str,save_c=0;
unsigned np;

- if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol)
- not_a_string_or_symbol(string);
+ if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol &&
+ (type_of(pattern)!=t_vector || pattern->v.v_elttype!=aet_uchar))
+ FEerror("~S is not a regexp pattern", 1 , pattern);
if (type_of(string)!= t_string && type_of(string)!=t_symbol)
not_a_string_or_symbol(string);

@@ -109,30 +139,21 @@
}

{
+
+ regexp *compiled_regexp=saved_compiled_regexp;
+
BEGIN_NO_INTERRUPT;

case_fold_search = sSAcase_fold_searchA->s.s_dbind != sLnil ? 1 : 0;
- if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) {
+
+ if (type_of(pattern)==t_vector)
+
+ compiled_regexp=(void *)pattern->ust.ust_self;

- char *tmp=len+1 - if (!tmp)
- FEerror("Cannot allocate memory on C stack",0);
+ else if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len))

- 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;
- }
-
- if (!(compiled_regexp=regcomp(tmp))) {
- END_NO_INTERRUPT;
- RETURN1(make_fixnum(-1));
- }
+ compiled_regexp=saved_compiled_regexp=(regexp *)fScompile_regexp(pattern)->v.v_self;

- }

str=string->st.st_self;
np=page(str);
diff -ru gcl-2.6.6/o/toplevel.c gcl-2.6.6.new/o/toplevel.c
--- gcl-2.6.6/o/toplevel.c 2004-03-20 01:47:38.000000000 +0000
+++ gcl-2.6.6.new/o/toplevel.c 2005-04-02 23:45:46.000000000 +0000
@@ -149,6 +149,19 @@
}

static void
+FFN(Fload_time_value)(object arg)
+{
+
+ if(endp(arg))
+ FEtoo_few_argumentsF(arg);
+ if(!endp(MMcdr(arg)) && !endp(MMcddr(arg)))
+ FEtoo_many_argumentsF(arg);
+ vs_push(MMcar(arg));
+ eval(vs_head);
+
+}
+
+static void
FFN(Fdeclare)(object arg)
{
FEerror("DECLARE appeared in an invalid position.", 0);
@@ -215,6 +228,7 @@
make_si_function("*MAKE-SPECIAL", siLAmake_special);
make_si_function("*MAKE-CONSTANT", siLAmake_constant);
make_special_form("EVAL-WHEN", Feval_when);
+ make_special_form("LOAD-TIME-VALUE", Fload_time_value);
make_special_form("THE", Fthe);
sLdeclare=make_special_form("DECLARE",Fdeclare);
make_special_form("LOCALLY",Flocally);
=============================================================================
This patch reenabled run-process on linux
=============================================================================
--- h/protoize.h 2005-01-16 00:36:20.000000000 +0000
+++ ../gclcvs-2.7.0/h/protoize.h 2005-04-09 13:16:40.000000000 +0000
@@ -604,6 +604,9 @@
gcl_init_symbol_function(void);

void
+gcl_init_socket_function(void);
+
+void
gcl_init_hash(void);

void
--- o/run_process.c 2003-09-14 02:30:45.000000000 +0000
+++ ../gclcvs-2.7.0/o/run_process.c 2005-04-14 21:55:45.000000000 +0000
@@ -16,12 +16,15 @@

*/

-
+#include

#define IN_RUN_PROCESS
#include "include.h"
#ifdef RUN_PROCESS

+void setup_stream_buffer(object);
+object make_two_way_stream(object, object);
+
#ifdef __MINGW32__

#include
@@ -29,7 +32,6 @@
#define PIPE_BUFFER_SIZE 2048

void DisplayError ( char *pszAPI );
-void setup_stream_buffer ( object x );
void PrepAndLaunchRedirectedChild ( HANDLE hChildStdOut,
HANDLE hChildStdIn,
HANDLE hChildStdErr,
@@ -425,7 +427,8 @@
return(stream);
}

-object make_socket_stream(host_l,port)
+object
+make_socket_stream(host_l,port)
object host_l;
object port;
{
@@ -445,7 +448,7 @@
}

void
-siLmake_socket_stream()
+FFN(siLmake_socket_stream)()
{
check_arg(2);
vs_base[0] = make_socket_stream(vs_base[0], vs_base[1]);
@@ -462,7 +465,6 @@
int sockets_in[2];
int sockets_out[2];
FILE *fp1, *fp2;
- int pid;
object stream_in, stream_out, stream;

if (socketpair(AF_UNIX, SOCK_STREAM, 0, sockets_in) < 0)
@@ -473,11 +475,12 @@
fp2 = fdopen(sockets_out[0], "w");

#ifdef OVM_IO
+ {int pid;
pid = getpid();
ioctl(sockets_in[0], SIOCSPGRP, (char *)&pid);
if( fcntl(sockets_in[0], F_SETFL, FASYNC | FNDELAY) == -1)
perror("Couldn't control socket");
-
+ }
#endif


@@ -502,7 +505,7 @@
* with "C" type streams.
*/

-
+void
spawn_process_with_streams(istream, ostream, pname, argv)
object istream;
object ostream;
@@ -531,12 +534,10 @@
}
}

-
-
-
}


+void
run_process(filename, argv)
char *filename;
char **argv;
@@ -550,7 +551,8 @@
vs_top = vs_base + 2;
}

-siLrun_process()
+void
+FFN(siLrun_process)()
{
int i;
object arglist;
@@ -567,7 +569,7 @@
}

void
-siLmake_socket_pair()
+FFN(siLmake_socket_pair)()
{
make_socket_pair();
}
--- h/linux.h 2005-04-27 15:44:19.000000000 +0000
+++ ../gclcvs-2.7.0/h/linux.h 2005-03-07 23:12:07.000000000 +0000
@@ -93,7 +93,7 @@
result = (current_mask & sigmask(m) ? signal_mask(m) : 0) \
| (current_mask & sigmask(n) ? signal_mask(n) : 0);

-#undef RUN_PROCESS
+#define RUN_PROCESS

#define IEEEFLOAT

=============================================================================