From: <cli...@li...> - 2007-12-30 18:36:05
|
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 subr.d, 1.240, 1.241 predtype.d, 1.142, 1.143 lispbibl.d, 1.752, 1.753 funarg.d, 1.1, 1.2 NEWS, 1.403, 1.404 ChangeLog, 1.5877, 1.5878 (Sam Steingold) 2. clisp/src weak.d, 1.9, 1.10 type.lisp, 1.79, 1.80 subtypep.lisp, 1.16, 1.17 record.d, 1.122, 1.123 list.d, 1.81, 1.82 (Sam Steingold) 3. clisp/src intserial.d,1.6,1.7 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Sun, 30 Dec 2007 15:40:22 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src subr.d, 1.240, 1.241 predtype.d, 1.142, 1.143 lispbibl.d, 1.752, 1.753 funarg.d, 1.1, 1.2 NEWS, 1.403, 1.404 ChangeLog, 1.5877, 1.5878 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv15941/src Modified Files: subr.d predtype.d lispbibl.d funarg.d NEWS ChangeLog Log Message: additional 5% speedup in simple sequence tests: switch instead of if * lispbibl.d (fastcmp_t): new type (subr_t): split uintW seclass into uintB seclass and uintB fastcmp * funarg.d (check_test_args): use fastcmp subr field in switch instead of a sequence of if statements * subr.d (SECFC_BITS, SECFC_MASK, SECFC, SECFC_SEC, SECFC_FC): macros to allow passing both seclass and fastcmp in one LISPFUN macro argument (LISPFUN_D, LISPFUN_F, LISPFUN_G): set fastcmp (eq, eql, equal, equalp): set fastcmp * predtype.d (eq, eql, equal, equalp): ditto Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5877 retrieving revision 1.5878 diff -u -d -r1.5877 -r1.5878 --- ChangeLog 29 Dec 2007 23:11:36 -0000 1.5877 +++ ChangeLog 30 Dec 2007 15:40:16 -0000 1.5878 @@ -1,3 +1,17 @@ +2007-12-30 Sam Steingold <sd...@gn...> + + additional 5% speedup in simple sequence tests: switch instead of if + * lispbibl.d (fastcmp_t): new type + (subr_t): split uintW seclass into uintB seclass and uintB fastcmp + * funarg.d (check_test_args): use fastcmp subr field in switch + instead of a sequence of if statements + * subr.d (SECFC_BITS, SECFC_MASK, SECFC, SECFC_SEC, SECFC_FC): + macros to allow passing both seclass and fastcmp in one LISPFUN + macro argument + (LISPFUN_D, LISPFUN_F, LISPFUN_G): set fastcmp + (eq, eql, equal, equalp): set fastcmp + * predtype.d (eq, eql, equal, equalp): ditto + 2007-12-27 Sam Steingold <sd...@gn...> * funarg.d: new file, extracted from list.d, sequence.d, weak.d Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.240 retrieving revision 1.241 diff -u -d -r1.240 -r1.241 --- subr.d 20 Dec 2007 15:08:09 -0000 1.240 +++ subr.d 30 Dec 2007 15:40:14 -0000 1.241 @@ -45,9 +45,18 @@ #define LISPFUN_C(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ subr_t D_##name; +/* convert combination of side-effect class + fast comparison into + the individual fields. since fastcmp is fastcmp_none virtually always, + there is little reason to have separate argument slots in LISPFUN_* for it */ +#define SECFC_BITS 16 +#define SECFC_MASK ((1 << SECFC_BITS) - 1) +#define SECFC(sec,fc) (sec ^ (fc << SECFC_BITS)) +#define SECFC_SEC(secfc) (secfc & SECFC_MASK) +#define SECFC_FC(secfc) (secfc >> SECFC_BITS) + /* expander for the initialization of the SUBR-table: */ #ifdef TYPECODES -#define LISPFUN_D(name_,sec,req_count_,opt_count_,rest_flag_,key_flag_,key_count_,keywords_) \ +#define LISPFUN_D(name_,secfc,req_count_,opt_count_,rest_flag_,key_flag_,key_count_,keywords_) \ ptr->GCself = subr_tab_ptr_as_object(ptr /* = &subr_tab.D_##name_ */);\ ptr->rectype = Rectype_Subr; \ ptr->recflags = 0; \ @@ -62,10 +71,11 @@ ptr->rest_flag = (uintB)subr_##rest_flag_; \ ptr->key_flag = (uintB)subr_##key_flag_; \ ptr->key_count = key_count_; \ - ptr->seclass = sec; \ + ptr->seclass = SECFC_SEC(secfc); \ + ptr->fastcmp = SECFC_FC(sec_fc); \ ptr++; #else -#define LISPFUN_D(name_,sec,req_count_,opt_count_,rest_flag_,key_flag_,key_count_,keywords_) \ +#define LISPFUN_D(name_,sec_fc,req_count_,opt_count_,rest_flag_,key_flag_,key_count_,keywords_) \ ptr->GCself = subr_tab_ptr_as_object(ptr /* = &subr_tab.D_##name_ */);\ ptr->tfl = xrecord_tfl(Rectype_Subr,0,subr_length,subr_xlength); \ ptr->name = S_help_(S_##name_); \ @@ -77,7 +87,8 @@ ptr->rest_flag = (uintB)subr_##rest_flag_; \ ptr->key_flag = (uintB)subr_##key_flag_; \ ptr->key_count = key_count_; \ - ptr->seclass = sec; \ + ptr->seclass = SECFC_SEC(secfc); \ + ptr->fastcmp = SECFC_FC(sec_fc); \ ptr++; #endif #define LISPFUN_E(name_,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ @@ -85,7 +96,7 @@ ptr++; #ifdef TYPECODES #ifdef DEBUG_GCSAFETY -#define LISPFUN_F(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_F(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { gcv_nullobj, /* preliminary */ \ Rectype_Subr, 0, subr_length, subr_xlength, \ gcv_nullobj, /* preliminary */ \ @@ -97,10 +108,11 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #else -#define LISPFUN_F(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_F(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { { gcv_nullobj }, /* preliminary */ \ Rectype_Subr, 0, subr_length, subr_xlength, \ gcv_nullobj, /* preliminary */ \ @@ -112,11 +124,12 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #endif #else -#define LISPFUN_F(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_F(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { gcv_nullobj, /* preliminary */ \ xrecord_tfl(Rectype_Subr,0,subr_length,subr_xlength), \ gcv_nullobj, /* preliminary */ \ @@ -128,12 +141,13 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #endif #ifdef TYPECODES #ifdef DEBUG_GCSAFETY -#define LISPFUN_G(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_G(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { subr_tab_ptr_as_object(&subr_tab.D_##name), \ Rectype_Subr, 0, subr_length, subr_xlength, \ S_help_(S_##name), \ @@ -145,10 +159,11 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #else -#define LISPFUN_G(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_G(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { { subr_tab_ptr_as_object(&subr_tab.D_##name) }, \ Rectype_Subr, 0, subr_length, subr_xlength, \ S_help_(S_##name), \ @@ -160,11 +175,12 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #endif #else -#define LISPFUN_G(name,sec,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ +#define LISPFUN_G(name,secfc,req_count,opt_count,rest_flag,key_flag,key_count,keywords) \ { subr_tab_ptr_as_object(&subr_tab.D_##name), \ xrecord_tfl(Rectype_Subr,0,subr_length,subr_xlength), \ S_help_(S_##name), \ @@ -176,7 +192,8 @@ (uintB)subr_##rest_flag, \ (uintB)subr_##key_flag, \ key_count, \ - sec, \ + SECFC_SEC(secfc), \ + SECFC_FC(secfc), \ }, #endif @@ -859,10 +876,10 @@ LISPFUNN(lib_directory,0) LISPFUNN(set_lib_directory,1) /* ---------- PREDTYPE ---------- */ -LISPFUNNF(eq,2) -LISPFUNNF(eql,2) -LISPFUNNR(equal,2) -LISPFUNNR(equalp,2) +LISPFUN(eq,SECFC(seclass_foldable,fastcmp_eq),2,0,norest,nokey,0,NIL) +LISPFUN(eql,SECFC(seclass_foldable,fastcmp_eql),2,0,norest,nokey,0,NIL) +LISPFUN(equal,SECFC(seclass_read,fastcmp_equal),2,0,norest,nokey,0,NIL) +LISPFUN(equalp,SECFC(seclass_read,fastcmp_equalp),2,0,norest,nokey,0,NIL) LISPFUNNF(consp,1) LISPFUNNF(atom,1) LISPFUNNF(symbolp,1) Index: funarg.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/funarg.d,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- funarg.d 29 Dec 2007 23:11:36 -0000 1.1 +++ funarg.d 30 Dec 2007 15:40:15 -0000 1.2 @@ -127,17 +127,23 @@ if (nullp(test_not_arg)) { /* :TEST-NOT was not specified */ if (nullp(test_arg)) *(stackptr STACKop 1) = test_arg = L(eql); /* :TEST defaults to #'EQL */ - if (eq(test_arg,L(eq))) return &call_test_eq; - if (eq(test_arg,L(eql))) return &call_test_eql; - if (eq(test_arg,L(equal))) return &call_test_equal; - if (eq(test_arg,L(equalp))) return &call_test_equalp; + if (subrp(test_arg)) + switch (TheSubr(test_arg)->fastcmp) { + case fastcmp_eq: return &call_test_eq; + case fastcmp_eql: return &call_test_eql; + case fastcmp_equal: return &call_test_equal; + case fastcmp_equalp: return &call_test_equalp; + } return &call_test; } if (!nullp(test_arg)) error_both_tests(); - if (eq(test_not_arg,L(eq))) return &call_test_not_eq; - if (eq(test_arg,L(eql))) return &call_test_not_eql; - if (eq(test_arg,L(equal))) return &call_test_not_equal; - if (eq(test_arg,L(equalp))) return &call_test_not_equalp; + if (subrp(test_not_arg)) + switch (TheSubr(test_not_arg)->fastcmp) { + case fastcmp_eq: return &call_test_not_eq; + case fastcmp_eql: return &call_test_not_eql; + case fastcmp_equal: return &call_test_not_equal; + case fastcmp_equalp: return &call_test_not_equalp; + } return &call_test_not; } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.752 retrieving revision 1.753 diff -u -d -r1.752 -r1.753 --- lispbibl.d 29 Dec 2007 23:11:35 -0000 1.752 +++ lispbibl.d 30 Dec 2007 15:40:15 -0000 1.753 @@ -6717,7 +6717,8 @@ uintB rest_flag; /* flag for arbitrary number of arguments */ uintB key_flag; /* flag for keywords */ uintW key_count; /* number of keyword parameter */ - uintW seclass; /* side-effect class */ + uintB seclass; /* side-effect class */ + uintB fastcmp; /* fast comparison method */ /* If necessary, add fillers here to ensure sizeof(subr_t) is a multiple of varobject_alignment. */ } subr_t @@ -6781,7 +6782,7 @@ } subr_argtype_t; /* Conversion: see SPVW: */ /* extern subr_argtype_t subr_argtype (uintW req_count, uintW opt_count, subr_rest_t rest_flag, subr_key_t key_flag); */ -%% sprintf(buf,"struct { XRECORD_HEADER gcv_object_t name%s; gcv_object_t keywords%s; lisp_function_t function; uintW argtype; uintW req_count; uintW opt_count; uintB rest_flag; uintB key_flag; uintW key_count; uintW seclass; } %%s",attribute_aligned_object,attribute_aligned_object); +%% sprintf(buf,"struct { XRECORD_HEADER gcv_object_t name%s; gcv_object_t keywords%s; lisp_function_t function; uintW argtype; uintW req_count; uintW opt_count; uintB rest_flag; uintB key_flag; uintW key_count; uintB seclass; uintB fastcmp; } %%s",attribute_aligned_object,attribute_aligned_object); %% #if defined(HEAPCODES) && (alignment_long < 4) && defined(GNU) %% strcat(buf," __attribute__ ((aligned (4)))"); %% #endif @@ -6807,6 +6808,21 @@ } seclass_t; %% puts("enum { seclass_foldable, seclass_no_se, seclass_read, seclass_write, seclass_default};"); +/* fast comparison method is really fastcmp_t: + when you want to make another comparison function bypass FUNCALL in + :TEST/:TEST-NOT sequence functions, you need to + -- add fastcmp_FOO here and + -- augment funarg.d:check_test_args(), and + -- add call_test_FOO and call_test_not_FOO in funarg.d */ +typedef enum { + fastcmp_none=0, /* no special tricks */ + fastcmp_eq, /* EQ */ + fastcmp_eql, /* EQL */ + fastcmp_equal, /* EQUAL */ + fastcmp_equalp, /* EQUALP */ + fastcmp_for_broken_compilers_that_dont_like_trailing_commas +} fastcmp_t; + # Small-Read-Label #ifdef TYPECODES #define make_small_read_label(n) \ @@ -12615,7 +12631,7 @@ v(kw(keyword1),...,kw(keywordn)) (NIL if nokey) See SUBR.D */ #define LISPFUN LISPFUN_B -/* is used by all modules */ +/* used by all modules */ /* The macro LISPFUNN initiates a simple declaration of a LISP-function. LISPFUNN(name,req_count) @@ -12624,7 +12640,7 @@ LISPFUNNF - ditto, but seclass_foldable instead of seclass_default LISPFUNNR - ditto, but seclass_read instead of seclass_default See SUBR.D - is used by all modules */ + used by all modules */ /* UP: initialize hand-made compiled closures init_cclosures(); Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.403 retrieving revision 1.404 diff -u -d -r1.403 -r1.404 --- NEWS 20 Dec 2007 15:42:43 -0000 1.403 +++ NEWS 30 Dec 2007 15:40:15 -0000 1.404 @@ -13,6 +13,8 @@ * The AFFI (simple ffi, originally for Amiga) code has been removed. +* Speed up list and sequence functions when :TEST is EQ, EQL, EQUAL or EQUALP. + * Bug fixes: + Fix FRESH-LINE at the end of a line containing only TABs. [ 1834193 ] + PPRINT-LOGICAL-BLOCK no longer ignores *PRINT-PPRINT-DISPATCH-TABLE*. Index: predtype.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/predtype.d,v retrieving revision 1.142 retrieving revision 1.143 diff -u -d -r1.142 -r1.143 --- predtype.d 20 Dec 2007 15:08:09 -0000 1.142 +++ predtype.d 30 Dec 2007 15:40:15 -0000 1.143 @@ -1139,22 +1139,22 @@ } } -LISPFUNNF(eq,2) +LISPFUN(eq,SECFC(seclass_foldable,fastcmp_eq),2,0,norest,nokey,0,NIL) { /* (EQ obj1 obj2), CLTL p. 77 */ VALUES_IF(eq(STACK_0,STACK_1)); skipSTACK(2); } -LISPFUNNF(eql,2) +LISPFUN(eql,SECFC(seclass_foldable,fastcmp_eql),2,0,norest,nokey,0,NIL) { /* (EQL obj1 obj2), CLTL p. 78 */ VALUES_IF(eql(STACK_0,STACK_1)); skipSTACK(2); } -LISPFUNNR(equal,2) +LISPFUN(equal,SECFC(seclass_read,fastcmp_equal),2,0,norest,nokey,0,NIL) { /* (EQUAL obj1 obj2), CLTL p. 80 */ VALUES_IF(equal(STACK_0,STACK_1)); skipSTACK(2); } -LISPFUNNR(equalp,2) +LISPFUN(equalp,SECFC(seclass_read,fastcmp_equalp),2,0,norest,nokey,0,NIL) { /* (EQUALP obj1 obj2), CLTL p. 81 */ VALUES_IF(equalp(STACK_0,STACK_1)); skipSTACK(2); } ------------------------------ Message: 2 Date: Sun, 30 Dec 2007 16:19:35 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src weak.d, 1.9, 1.10 type.lisp, 1.79, 1.80 subtypep.lisp, 1.16, 1.17 record.d, 1.122, 1.123 list.d, 1.81, 1.82 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv31990/src Modified Files: weak.d type.lisp subtypep.lisp record.d list.d Log Message: (C)year Index: list.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/list.d,v retrieving revision 1.81 retrieving revision 1.82 diff -u -d -r1.81 -r1.82 --- list.d 29 Dec 2007 23:11:35 -0000 1.81 +++ list.d 30 Dec 2007 16:19:32 -0000 1.82 @@ -2,7 +2,7 @@ * List functions for CLISP * Bruno Haible 1990-2005 * Marcus Daniels 8.4.1994 - * Sam Steingold 1999-2006 + * Sam Steingold 1999-2007 */ #include "lispbibl.c" Index: subtypep.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/subtypep.lisp,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- subtypep.lisp 10 Nov 2006 16:32:10 -0000 1.16 +++ subtypep.lisp 30 Dec 2007 16:19:32 -0000 1.17 @@ -1,5 +1,6 @@ ;;;; SUBTYPEP ;;;; Bruno Haible 2004-03-28, 2004-04-03 +;;;; Sam Steingold 2004-2005 ;; SUBTYPEP is very powerful. It can tell: ;; - whether a type is empty: Index: weak.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/weak.d,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- weak.d 29 Dec 2007 23:11:32 -0000 1.9 +++ weak.d 30 Dec 2007 16:19:32 -0000 1.10 @@ -1,7 +1,7 @@ /* * Functions for weak references in CLISP * Bruno Haible 1999-2005 - * Sam Steingold 2003 + * Sam Steingold 2003, 2007 */ #include "lispbibl.c" Index: record.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/record.d,v retrieving revision 1.122 retrieving revision 1.123 diff -u -d -r1.122 -r1.123 --- record.d 18 Dec 2007 15:46:09 -0000 1.122 +++ record.d 30 Dec 2007 16:19:32 -0000 1.123 @@ -1,7 +1,7 @@ /* * Functions for records and structures in CLISP * Bruno Haible 1990-2005 - * Sam Steingold 1998-2006 + * Sam Steingold 1998-2007 * German comments translated into English: Stefan Kain 2002-04-16 */ #include "lispbibl.c" Index: type.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/type.lisp,v retrieving revision 1.79 retrieving revision 1.80 diff -u -d -r1.79 -r1.80 --- type.lisp 20 Dec 2007 21:40:59 -0000 1.79 +++ type.lisp 30 Dec 2007 16:19:32 -0000 1.80 @@ -1,7 +1,7 @@ ;;;; TYPEP und Verwandtes ;;;; Michael Stoll, 21. 10. 1988 ;;;; Bruno Haible, 10.6.1989 -;;;; Sam Steingold 2000-2005 +;;;; Sam Steingold 2000-2005, 2007 ;;; Datenstrukturen für TYPEP: ;;; - Ein Type-Specifier-Symbol hat auf seiner Propertyliste unter dem ------------------------------ Message: 3 Date: Sun, 30 Dec 2007 18:35:51 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src intserial.d,1.6,1.7 To: cli...@li... Message-ID: <E1J...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv24704/src Modified Files: intserial.d Log Message: convert comments from "# " to "/**/" Index: intserial.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/intserial.d,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- intserial.d 13 Dec 2007 22:27:46 -0000 1.6 +++ intserial.d 30 Dec 2007 18:35:49 -0000 1.7 @@ -1,48 +1,48 @@ -/* Serialization of integers into a little-endian sequence of bytes */ +/* Serialization of integers into a little-endian sequence of bytes -# Converts a little-endian byte sequence to an unsigned integer. -# > bytesize: number of given 8-bit bytes of the integer, -# < intDsize/8*uintWC_max -# > bufferptr: address of bytesize bytes in GC-invariant memory -# < result: an integer >= 0 with I_integer_length(result) <= 8*bytesize -# can trigger GC + Converts a little-endian byte sequence to an unsigned integer. + > bytesize: number of given 8-bit bytes of the integer, + < intDsize/8*uintWC_max + > bufferptr: address of bytesize bytes in GC-invariant memory + < result: an integer >= 0 with I_integer_length(result) <= 8*bytesize + can trigger GC */ global maygc object LEbytes_to_UI (uintL bytesize, const uintB* bufferptr) { var gcv_object_t fake; fake = FAKE_8BIT_VECTOR(bufferptr); return LESbvector_to_UI(bytesize,&fake); } -# Converts a little-endian byte sequence to an unsigned integer. -# > bytesize: number of given 8-bit bytes of the integer, -# < intDsize/8*uintWC_max -# > *buffer_: address of a simple-8bit-vector (or of a fake) -# containing bytesize bytes of memory -# < result: an integer >= 0 with I_integer_length(result) <= 8*bytesize -# can trigger GC +/* Converts a little-endian byte sequence to an unsigned integer. + > bytesize: number of given 8-bit bytes of the integer, + < intDsize/8*uintWC_max + > *buffer_: address of a simple-8bit-vector (or of a fake) + containing bytesize bytes of memory + < result: an integer >= 0 with I_integer_length(result) <= 8*bytesize + can trigger GC */ global maygc object LESbvector_to_UI (uintL bytesize, const gcv_object_t* buffer_) { - # Normalize number in buffer: + /* Normalize number in buffer: */ var uintB* bufferptr = &TheSbvector(*buffer_)->data[bytesize-1]; var uintL count = bytesize; while ((!(count==0)) && (*bufferptr==0)) { count--; bufferptr--; } - # Make number: - if # at most oint_data_len Bits ? + /* Make number: */ + if /* at most oint_data_len Bits ? */ ((count <= floor(oint_data_len,8)) || ((count == floor(oint_data_len,8)+1) && (*bufferptr < bit(oint_data_len%8)))) { - # yes -> build Fixnum >=0 : + /* yes -> build Fixnum >=0 : */ var uintV value = 0; while (count != 0) { value = (value<<8) | *bufferptr--; count--; } return fixnum(value); } - # no -> build Bignum >0 : + /* no -> build Bignum >0 : */ var uintL digitcount = floor(count,(intDsize/8)); if (((count%(intDsize/8)) > 0) || (*bufferptr & bit(7))) digitcount++; - # As bitsize < intDsize*uintWC_max, - # digitcount <= ceiling((bitsize+1)/intDsize) <= uintWC_max . - var object big = allocate_bignum(digitcount,0); # new Bignum >0 - TheBignum(big)->data[0] = 0; # set highest Digit to 0 - # Fill remaining Digits from right to left, - # thereby translate sequence of Bytes into sequence of uintD: + /* As bitsize < intDsize*uintWC_max, + digitcount <= ceiling((bitsize+1)/intDsize) <= uintWC_max . */ + var object big = allocate_bignum(digitcount,0); /* new Bignum >0 */ + TheBignum(big)->data[0] = 0; /* set highest Digit to 0 */ + /* Fill remaining Digits from right to left, + thereby translate sequence of Bytes into sequence of uintD: */ bufferptr = &TheSbvector(*buffer_)->data[0]; #if BIG_ENDIAN_P { @@ -56,7 +56,7 @@ #define GET_NEXT_BYTE(i) digit |= ((uintD)(*bufferptr++) << (8*i)); dotimespL(count2,floor(count,intDsize/8), { var uintD digit = 0; - DOCONSTTIMES(intDsize/8,GET_NEXT_BYTE); # GET_NEXT_BYTE(0..intDsize/8-1) + DOCONSTTIMES(intDsize/8,GET_NEXT_BYTE); /* GET_NEXT_BYTE(0..intDsize/8-1) */ *--bigptr = digit; }); #undef GET_NEXT_BYTE @@ -72,77 +72,77 @@ } } #endif - # Since (intDsize/8)*(digitcount-1) <= count <= (intDsize/8)*digitcount - # everything is filled. + /* Since (intDsize/8)*(digitcount-1) <= count <= (intDsize/8)*digitcount + everything is filled. */ return big; } -# Converts a little-endian byte sequence to an integer. -# > bytesize: number of given 8-bit bytes of the integer, > 0, -# < intDsize/8*uintWC_max -# > bufferptr: address of bytesize bytes in GC-invariant memory -# < result: an integer with I_integer_length(result) < 8*bytesize -# can trigger GC +/* Converts a little-endian byte sequence to an integer. + > bytesize: number of given 8-bit bytes of the integer, > 0, + < intDsize/8*uintWC_max + > bufferptr: address of bytesize bytes in GC-invariant memory + < result: an integer with I_integer_length(result) < 8*bytesize + can trigger GC */ global maygc object LEbytes_to_I (uintL bytesize, const uintB* bufferptr) { var gcv_object_t fake; fake = FAKE_8BIT_VECTOR(bufferptr); return LESbvector_to_I(bytesize,&fake); } -# Converts a little-endian byte sequence to an integer. -# > bytesize: number of given 8-bit bytes of the integer, > 0, -# < intDsize/8*uintWC_max -# > *buffer_: address of a simple-8bit-vector (or of a fake) -# containing bytesize bytes of memory -# < result: an integer with I_integer_length(result) < 8*bytesize -# can trigger GC +/* Converts a little-endian byte sequence to an integer. + > bytesize: number of given 8-bit bytes of the integer, > 0, + < intDsize/8*uintWC_max + > *buffer_: address of a simple-8bit-vector (or of a fake) + containing bytesize bytes of memory + < result: an integer with I_integer_length(result) < 8*bytesize + can trigger GC */ global maygc object LESbvector_to_I (uintL bytesize, const gcv_object_t* buffer_) { - # Normalize number in buffer: + /* Normalize number in buffer: */ var uintB* bufferptr = &TheSbvector(*buffer_)->data[bytesize-1]; var sintD sign; var uintL count = bytesize; if (!(*bufferptr & bit(7))) { sign = 0; - # Normalize, highest Bit must remain 0: + /* Normalize, highest Bit must remain 0: */ while ((count>=2) && (*bufferptr==0) && !(*(bufferptr-1) & bit(7))) { count--; bufferptr--; } - # Make number: - if # at most oint_data_len+1 Bits, count <2^oint_data_len ? + /* Make number: */ + if /* at most oint_data_len+1 Bits, count <2^oint_data_len ? */ ((count <= floor(oint_data_len,8)) || ((count == floor(oint_data_len,8)+1) && (*bufferptr < bit(oint_data_len%8)))) { - # yes -> build Fixnum >=0: + /* yes -> build Fixnum >=0: */ var uintV value = 0; while (count != 0) { value = (value<<8) | *bufferptr--; count--; } return posfixnum(value); } } else { sign = -1; - # Normalize, highest Bit must remain 1: + /* Normalize, highest Bit must remain 1: */ while ((count>=2) && (*bufferptr==(uintB)(-1)) && (*(bufferptr-1) & bit(7))) { count--; bufferptr--; } - # Make number: - if # at most oint_data_len+1 Bits, count >=-2^oint_data_len ? + /* Make number: */ + if /* at most oint_data_len+1 Bits, count >=-2^oint_data_len ? */ ((count <= floor(oint_data_len,8)) || ((count == floor(oint_data_len,8)+1) && (*bufferptr >= (uintB)(-bit(oint_data_len%8))))) { - # yes -> build Fixnum <0: + /* yes -> build Fixnum <0: */ var uintV value = (uintV)(sintV)(-1); while (count != 0) { value = (value<<8) | *bufferptr--; count--; } return negfixnum(-wbitm(intVsize)+(oint)value); } } - # Make bignum: + /* Make bignum: */ var uintL digitcount = ceiling(count,(intDsize/8)); - # As bitsize < intDsize*uintWC_max, - # digitcount <= ceiling(bitsize/intDsize) <= uintWC_max . + /* As bitsize < intDsize*uintWC_max, + digitcount <= ceiling(bitsize/intDsize) <= uintWC_max . */ var object big = allocate_bignum(digitcount,(sintB)sign); - TheBignum(big)->data[0] = sign; # set highest Word to sign - # Fill the remaining Digits from right to left, - # thereby translate sequence of Bytes into sequence of uintD: + TheBignum(big)->data[0] = sign; /* set highest Word to sign */ + /* Fill the remaining Digits from right to left, + thereby translate sequence of Bytes into sequence of uintD: */ bufferptr = &TheSbvector(*buffer_)->data[0]; #if BIG_ENDIAN_P { @@ -156,7 +156,7 @@ #define GET_NEXT_BYTE(i) digit |= ((uintD)(*bufferptr++) << (8*i)); dotimespL(count2,floor(count,intDsize/8), { var uintD digit = 0; - DOCONSTTIMES(intDsize/8,GET_NEXT_BYTE); # GET_NEXT_BYTE(0..intDsize/8-1) + DOCONSTTIMES(intDsize/8,GET_NEXT_BYTE); /* GET_NEXT_BYTE(0..intDsize/8-1) */ *--bigptr = digit; }); #undef GET_NEXT_BYTE @@ -172,38 +172,38 @@ } } #endif - # Since (intDsize/8)*(digitcount-1) < count <= (intDsize/8)*digitcount - # everything is filled. + /* Since (intDsize/8)*(digitcount-1) < count <= (intDsize/8)*digitcount + everything is filled. */ return big; } -# Converts an unsigned integer to a little-endian byte sequence. -# > obj: an integer -# > bitsize: maximum number of bits of the integer -# > bufferptr: pointer to bytesize = ceiling(bitsize,8) bytes of memory -# < false and bufferptr[0..bytesize-1] filled, if obj >= 0 and -# I_integer_length(obj) <= bitsize; -# true, if obj is out of range +/* Converts an unsigned integer to a little-endian byte sequence. + > obj: an integer + > bitsize: maximum number of bits of the integer + > bufferptr: pointer to bytesize = ceiling(bitsize,8) bytes of memory + < false and bufferptr[0..bytesize-1] filled, if obj >= 0 and + I_integer_length(obj) <= bitsize; + true, if obj is out of range */ global bool UI_to_LEbytes (object obj, uintL bitsize, uintB* bufferptr) { if (!positivep(obj)) return true; - # obj is an integer >=0. + /* obj is an integer >=0. */ var uintL bytesize = ceiling(bitsize,8); - # Transfer obj into the buffer: + /* Transfer obj into the buffer: */ { var uintL count = bytesize; - if (posfixnump(obj)) { # obj is a Fixnum >=0 + if (posfixnump(obj)) { /* obj is a Fixnum >=0 */ var uintV value = posfixnum_to_V(obj); - # check value < 2^bitsize: + /* check value < 2^bitsize: */ if (!((bitsize>=oint_data_len) || (value < vbit(bitsize)))) return true; - # store value in Bitbuffer: + /* store value in Bitbuffer: */ while (value != 0) { *bufferptr++ = (uint8)value; value = value>>8; count--; } - } else { # obj is a Bignum >0 + } else { /* obj is a Bignum >0 */ var uintL len = (uintL)Bignum_length(obj); - # check obj < 2^bitsize: + /* check obj < 2^bitsize: */ if (!((floor(bitsize,intDsize) >= len) || ((floor(bitsize,intDsize) == len-1) && (TheBignum(obj)->data[0] < bit(bitsize%intDsize))))) @@ -211,15 +211,15 @@ #if BIG_ENDIAN_P { var uintB* ptr = (uintB*)&TheBignum(obj)->data[len]; - # convert Digit-Length in Byte-Length: + /* convert Digit-Length in Byte-Length: */ len = (intDsize/8)*len; #define CHECK_NEXT_BYTE(i) \ if (((uintB*)(&TheBignum(obj)->data[0]))[i] != 0) goto len_ok; \ len--; - DOCONSTTIMES(intDsize/8,CHECK_NEXT_BYTE); # CHECK_NEXT_BYTE(0..intDsize/8-1) + DOCONSTTIMES(intDsize/8,CHECK_NEXT_BYTE); /* CHECK_NEXT_BYTE(0..intDsize/8-1) */ #undef CHECK_NEXT_BYTE len_ok: - # store obj in Bitbuffer: + /* store obj in Bitbuffer: */ count = count - len; dotimespL(len,len, { *bufferptr++ = *--ptr; } ); } @@ -253,27 +253,26 @@ return false; } -# Converts an integer to a little-endian byte sequence. -# > obj: an integer -# > bitsize: maximum number of bits of the integer, including the sign bit -# > bufferptr: pointer to bytesize = ceiling(bitsize,8) bytes of memory -# < false and bufferptr[0..bytesize-1] filled, if I_integer_length(obj) < bitsize; -# true, if obj is out of range +/* Converts an integer to a little-endian byte sequence. + > obj: an integer + > bitsize: maximum number of bits of the integer, including the sign bit + > bufferptr: pointer to bytesize = ceiling(bitsize,8) bytes of memory + < false and bufferptr[0..bytesize-1] filled, if I_integer_length(obj) < bitsize; + true, if obj is out of range */ global bool I_to_LEbytes (object obj, uintL bitsize, uintB* bufferptr) { - # obj is an integer. + /* obj is an integer. */ var uintL bytesize = ceiling(bitsize,8); - # Transfer obj into the buffer: + /* Transfer obj into the buffer: */ { var uintL count = bytesize; var uintV sign = (sintV)(sintL)R_sign(obj); - if (fixnump(obj)) { - # obj is a Fixnum - var uintV value = fixnum_to_V(obj); # >=0 or <0, according to sign - # check 0 <= value < 2^(bitsize-1) resp. -2^(bitsize-1) <= value < 0: + if (fixnump(obj)) { /* obj is a Fixnum */ + var uintV value = fixnum_to_V(obj); /* >=0 or <0, according to sign */ + /* check 0 <= value < 2^(bitsize-1) resp. -2^(bitsize-1) <= value < 0: */ value = value^sign; if (!((bitsize>oint_data_len) || (value < bit(bitsize-1)))) return true; - # store value^sign in Bitbuffer: + /* store value^sign in Bitbuffer: */ while (value != 0) { *bufferptr++ = (uint8)(value^sign); value = value>>8; count--; } @@ -282,10 +281,9 @@ memset(bufferptr,(uint8)sign,count); end_system_call(); } - } else { - # obj is a Bignum + } else { /* obj is a Bignum */ var uintL len = (uintL)Bignum_length(obj); - # check -2^(bitsize-1) <= obj < 2^(bitsize-1): + /* check -2^(bitsize-1) <= obj < 2^(bitsize-1): */ if (!((floor(bitsize,intDsize) >= len) || ((bitsize > intDsize*(len-1)) && ((TheBignum(obj)->data[0] ^ (uintD)sign) < @@ -294,15 +292,15 @@ #if BIG_ENDIAN_P { var uintB* ptr = (uintB*)&TheBignum(obj)->data[len]; - # convert Digit-Length in Byte-Length: + /* convert Digit-Length in Byte-Length: */ len = (intDsize/8)*len; #define CHECK_NEXT_BYTE(i) \ if (((uintB*)(&TheBignum(obj)->data[0]))[i] != (uintB)sign) goto len_ok; \ len--; - DOCONSTTIMES(intDsize/8,CHECK_NEXT_BYTE); # CHECK_NEXT_BYTE(0..intDsize/8-1) + DOCONSTTIMES(intDsize/8,CHECK_NEXT_BYTE); /* CHECK_NEXT_BYTE(0..intDsize/8-1) */ #undef CHECK_NEXT_BYTE len_ok: - # store obj in Bitbuffer: + /* store obj in Bitbuffer: */ count = count - len; dotimespL(len,len, { *bufferptr++ = *--ptr; } ); } ------------------------------ ------------------------------------------------------------------------- This SF.net email is sponsored by: Microsoft Defy all challenges. Microsoft(R) Visual Studio 2005. http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 20, Issue 48 ***************************************** |