From: <cli...@li...> - 2005-01-30 04:18:46
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src condition.lisp,1.78,1.79 defs2.lisp,1.35,1.36 (Bruno Haible) 2. clisp/src ChangeLog,1.4177,1.4178 (Sam Steingold) 3. clisp/src genclisph.d,1.170,1.171 ChangeLog,1.4178,1.4179 (Sam Steingold) 4. clisp/src ChangeLog,1.4179,1.4180 (Sam Steingold) 5. clisp/modules/berkeley-db bdb.c,1.57,1.58 (Sam Steingold) 6. clisp/doc impent.xml,1.192,1.193 (Sam Steingold) 7. clisp/src eval.d,1.188,1.189 (Sam Steingold) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src condition.lisp,1.78,1.79 defs2.lisp,1.35,1.36 Date: Sat, 29 Jan 2005 15:07:48 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27798/src Modified Files: condition.lisp defs2.lisp Log Message: Comments about declarations. Index: defs2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defs2.lisp,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- defs2.lisp 20 Dec 2004 14:00:46 -0000 1.35 +++ defs2.lisp 29 Jan 2005 15:07:45 -0000 1.36 @@ -86,6 +86,8 @@ (defconstant *common-lisp-user-package* (find-package "COMMON-LISP-USER")) ; ABI (defmacro with-standard-io-syntax (&body body) + ;; ANSI CL does not allow declarations at the beginning of the body, but + ;; we do, as an extension. (multiple-value-bind (body-rest declarations) (SYSTEM::PARSE-BODY body) ;; It would be possible to put all these bindings into a single function, ;; but this would force variables into closures. Index: condition.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/condition.lisp,v retrieving revision 1.78 retrieving revision 1.79 diff -u -d -r1.78 -r1.79 --- condition.lisp 28 Jan 2005 14:09:13 -0000 1.78 +++ condition.lisp 29 Jan 2005 15:07:44 -0000 1.79 @@ -755,6 +755,8 @@ (defmacro with-condition-restarts (condition-form restarts-form &body body) `(LET ((*CONDITION-RESTARTS* *CONDITION-RESTARTS*)) (ADD-CONDITION-RESTARTS ,condition-form ,restarts-form) + ;; ANSI CL does not allow declarations at the beginning of the body, but + ;; we do, as an extension. (LET () ,@body))) ;;; 29.4.8. Finding and Manipulating Restarts --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.4177,1.4178 Date: Sat, 29 Jan 2005 19:55:54 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27977/src Modified Files: ChangeLog Log Message: formatting Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4177 retrieving revision 1.4178 diff -u -d -r1.4177 -r1.4178 --- ChangeLog 29 Jan 2005 15:06:56 -0000 1.4177 +++ ChangeLog 29 Jan 2005 19:55:48 -0000 1.4178 @@ -30,8 +30,8 @@ 2005-01-28 Bruno Haible <br...@cl...> - * socket.d (host_fn_t, with_host, string_to_addr1, string_to_addr, - resolve_host1): Use const where appropriate. + * socket.d (host_fn_t, with_host, string_to_addr1, string_to_addr) + (resolve_host1): Use const where appropriate. * genclisph.d (main): Update. 2005-01-28 Bruno Haible <br...@cl...> @@ -45,21 +45,21 @@ 2005-01-28 Bruno Haible <br...@cl...> * lispbibl.d (FAKE_8BIT_VECTOR): New macro. - (LEbytes_to_UI, LESbvector_to_UI, LEbytes_to_I, LESbvector_to_I, - UI_to_LEbytes, I_to_LEbytes): New declarations. + (LEbytes_to_UI, LESbvector_to_UI, LEbytes_to_I, LESbvector_to_I) + (UI_to_LEbytes, I_to_LEbytes): New declarations. * intserial.d: New file, mostly extracted from stream.d. * lisparit.d: Include intserial.c. * stream.d (bitbuff_iu_I): Use LESbvector_to_UI. (bitbuff_is_I): Use LESbvector_to_I. - (bitbuff_ixu_sub): Remove bytesize argument. Use UI_to_LEbytes. Don't - call ASSERT_wr_int here. + (bitbuff_ixu_sub): Remove bytesize argument. Use UI_to_LEbytes. + Don't call ASSERT_wr_int here. (wr_by_ixu_sub): Call ASSERT_wr_int here. Update. - (bitbuff_ixs_sub): Remove bytesize argument. Use I_to_LEbytes. Don't - call ASSERT_wr_int here. + (bitbuff_ixs_sub): Remove bytesize argument. Use I_to_LEbytes. + Don't call ASSERT_wr_int here. (wr_by_ixs_sub): Call ASSERT_wr_int here. Update. (WRITE-INTEGER): Update. - * genclisph.d (main): Emit declarations for LEbytes_to_UI, LEbytes_to_I, - UI_to_LEbytes, I_to_LEbytes. + * genclisph.d (main): Emit declarations for LEbytes_to_UI, + LEbytes_to_I, UI_to_LEbytes, I_to_LEbytes. * makemake.in (LISPARIT_SUBFILES): Add intserial. * po/Makefile.devel (DSOURCES): Add intserial. --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src genclisph.d,1.170,1.171 ChangeLog,1.4178,1.4179 Date: Sun, 30 Jan 2005 00:50:14 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24897/src Modified Files: genclisph.d ChangeLog Log Message: (I_integer_length): export Index: genclisph.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/genclisph.d,v retrieving revision 1.170 retrieving revision 1.171 diff -u -d -r1.170 -r1.171 --- genclisph.d 29 Jan 2005 14:58:16 -0000 1.170 +++ genclisph.d 30 Jan 2005 00:50:08 -0000 1.171 @@ -2220,6 +2220,7 @@ printf("extern object I_I_plus_I (object x, object y);\n"); printf("extern object I_I_minus_I (object x, object y);\n"); #endif + printf("extern uintL I_integer_length (object x);\n"); printf("extern object LEbytes_to_UI (uintL bytesize, const uintB* bufferptr);\n"); printf("extern object LEbytes_to_I (uintL bytesize, const uintB* bufferptr);\n"); printf("extern bool UI_to_LEbytes (object obj, uintL bitsize, uintB* bufferptr);\n"); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4178 retrieving revision 1.4179 diff -u -d -r1.4178 -r1.4179 --- ChangeLog 29 Jan 2005 19:55:48 -0000 1.4178 +++ ChangeLog 30 Jan 2005 00:50:09 -0000 1.4179 @@ -1,3 +1,7 @@ +2005-01-29 Sam Steingold <sd...@gn...> + + * genclisph.d (I_integer_length): export + 2005-01-23 Bruno Haible <br...@cl...> * foreign1.lisp (with-defining-c-type): Put the declarations from --__--__-- Message: 4 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.4179,1.4180 Date: Sun, 30 Jan 2005 00:55:36 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26189/src Modified Files: ChangeLog Log Message: (fill_dbt): use I_to_LEbytes() (dbt_to_object): use LEbytes_to_I() Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4179 retrieving revision 1.4180 diff -u -d -r1.4179 -r1.4180 --- ChangeLog 30 Jan 2005 00:50:09 -0000 1.4179 +++ ChangeLog 30 Jan 2005 00:55:33 -0000 1.4180 @@ -1,5 +1,10 @@ 2005-01-29 Sam Steingold <sd...@gn...> + * modules/berkeley-db/bdb.c (fill_dbt): use I_to_LEbytes() + (dbt_to_object): use LEbytes_to_I() + +2005-01-29 Sam Steingold <sd...@gn...> + * genclisph.d (I_integer_length): export 2005-01-23 Bruno Haible <br...@cl...> --__--__-- Message: 5 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/modules/berkeley-db bdb.c,1.57,1.58 Date: Sun, 30 Jan 2005 00:55:38 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/berkeley-db In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26189/modules/berkeley-db Modified Files: bdb.c Log Message: (fill_dbt): use I_to_LEbytes() (dbt_to_object): use LEbytes_to_I() Index: bdb.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v retrieving revision 1.57 retrieving revision 1.58 diff -u -d -r1.57 -r1.58 --- bdb.c 25 Jan 2005 14:35:17 -0000 1.57 +++ bdb.c 30 Jan 2005 00:55:34 -0000 1.58 @@ -987,6 +987,7 @@ can trigger GC */ static dbt_o_t fill_dbt (object obj, DBT* key, int re_len) { + restart_fill_dbt: obj = check_dbt_object(obj); init_dbt(key,DB_DBT_MALLOC); if (stringp(obj)) { @@ -1007,21 +1008,21 @@ memcpy(key->data,TheSbvector(obj)->data + idx,key->size); end_system_call(); return DBT_RAW; - } else if (fixnump(obj)) { - key->ulen = key->size = MAX(re_len,sizeof(uintL)); - key->data = my_malloc(key->size); - begin_system_call(); memset(key->data,0,key->size); end_system_call(); - *(uintL*)((char*)key->data + key->size - sizeof(uintL)) - = posfixnum_to_L(obj); - return DBT_INTEGER; - } else if (bignump(obj)) { - int need = sizeof(uintD)*Bignum_length(obj); - key->ulen = key->size = MAX(re_len,need); - key->data = my_malloc(key->size); - begin_system_call(); - memset(key->data,0,key->size); - memcpy((char*)key->data + key->size - need,TheBignum(obj)->data,need); - end_system_call(); + } else if (integerp(obj)) { + unsigned long bitsize = I_integer_length(obj); + unsigned long bytesize = ceiling(bitsize,8); + if (re_len) { + if (bytesize > re_len) { + pushSTACK(fixnum(bytesize)); pushSTACK(fixnum(re_len)); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + check_value(error,GETTEXT("~S: ~S does not fit into ~S bytes (it requires at least ~S bytes)")); + obj = value1; + goto restart_fill_dbt; + } else bytesize = re_len; + } + key->ulen = key->size = bytesize; + key->data = my_malloc(bytesize); + I_to_LEbytes(obj,bitsize,key->data); return DBT_INTEGER; } else NOTREACHED; } @@ -1048,22 +1049,11 @@ free_dbt(p_dbt); return s; } - case DBT_INTEGER: - if (p_dbt->size > sizeof(uintL)) { - object ret = udigits_to_I(p_dbt->data,p_dbt->size); - free_dbt(p_dbt); - return ret; - } else if (p_dbt->size == sizeof(uintL)) { - object ret = UL_to_I(*(uintL*)p_dbt->data); - free_dbt(p_dbt); - return ret; - } else { - uintL res = 0, i; - for (i=0; i < p_dbt->size; i++) - res += ((char*)p_dbt->data)[i] << i; - free_dbt(p_dbt); - return UL_to_I(res); - } + case DBT_INTEGER: { + object ret = LEbytes_to_I(p_dbt->size,p_dbt->data); + free_dbt(p_dbt); + return ret; + } default: NOTREACHED; } } --__--__-- Message: 6 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/doc impent.xml,1.192,1.193 Date: Sun, 30 Jan 2005 01:40:46 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2760 Modified Files: impent.xml Log Message: regexp->regexp-mod Index: impent.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v retrieving revision 1.192 retrieving revision 1.193 diff -u -d -r1.192 -r1.193 --- impent.xml 24 Jan 2005 17:35:54 -0000 1.192 +++ impent.xml 30 Jan 2005 01:40:43 -0000 1.193 @@ -146,7 +146,7 @@ <!ENTITY i18n-pac "<link linkend='i18n'><quote role='package'>I18N</quote></link>"> <!ENTITY ldap-pac "<link linkend='dir-key'><quote role='package'>LDAP</quote></link>"> <!ENTITY posix-pac "<link linkend='syscalls'><quote role='package'>POSIX</quote></link>"> -<!ENTITY regexp-pac "<link linkend='regexp'><quote role='package'>REGEXP</quote></link>"> +<!ENTITY regexp-pac "<link linkend='regexp-mod'><quote role='package'>REGEXP</quote></link>"> <!ENTITY screen-pac "<link linkend='screen'><quote role='package'>SCREEN</quote></link>"> <!ENTITY socket-pac "<link linkend='socket'><quote role='package'>SOCKET</quote></link>"> <!ENTITY sys-pac "<link linkend='sys-pac'><quote role='package'>SYSTEM</quote></link>"> --__--__-- Message: 7 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src eval.d,1.188,1.189 Date: Sun, 30 Jan 2005 03:52:50 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27743/src Modified Files: eval.d Log Message: avoid a dotimes to ease debugging (and kill "elif"!) Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.188 retrieving revision 1.189 diff -u -d -r1.188 -r1.189 --- eval.d 29 Jan 2005 15:02:32 -0000 1.188 +++ eval.d 30 Jan 2005 03:52:46 -0000 1.189 @@ -763,11 +763,11 @@ var uintL count = as_oint(FRAME_(frame_anz)); /* number of bindings */ if (count > 0) { var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* 1st binding */ - dotimespL(count,count, { + do { if (binds_sym_p(bindingsptr)) /* right symbol & active & static? */ return bindingsptr STACKop varframe_binding_value; bindingsptr skipSTACKop varframe_binding_size; /* no: next binding */ - }); + } while (--count); } venv = FRAME_(frame_next_env); goto next_env; @@ -789,7 +789,7 @@ }); venv = *ptr; /* next environment */ continue; - } elif (consp(venv)) { + } else if (consp(venv)) { /* environment is a MACROLET capsule */ ASSERT(eq(Car(venv),S(macrolet))); from_inside_macrolet = true; @@ -962,7 +962,7 @@ }); env = *ptr; # next Environment continue; - } elif (consp(env)) { + } else if (consp(env)) { /* environment is a MACROLET capsule */ ASSERT(eq(Car(env),S(macrolet))); from_inside_macrolet = true; @@ -1420,7 +1420,7 @@ funcall(Symbol_value(S(macroexpand_hook)),3); value2 = T; # expanded Form as 1. value, T as 2. value return; - } elif (symbolp(fdef)) { + } else if (symbolp(fdef)) { # fdef a Symbol # Must be expanded to (FUNCALL fdef ...) : pushSTACK(Cdr(form)); # (cdr form) @@ -1439,7 +1439,7 @@ } } } - } elif (symbolp(form)) { + } else if (symbolp(form)) { var object symbolmacro; var object val = sym_value(form,TheSvector(env)->data[0],&symbolmacro); if (!eq(symbolmacro,nullobj)) { # found Symbol-Macro? --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |