From: <cli...@li...> - 2005-11-27 01:19:08
|
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 lispbibl.d,1.693,1.694 ChangeLog,1.5116,1.5117 (Sam Steingold) 2. clisp/unix PLATFORMS,1.36,1.37 (Sam Steingold) 3. clisp/src makemake.in,1.624,1.625 ChangeLog,1.5117,1.5118 (Sam Steingold) 4. clisp/src ChangeLog,1.5118,1.5119 .gdbinit,1.36,1.37 (Sam Steingold) 5. clisp/tests encoding.tst,1.14,1.15 ChangeLog,1.429,1.430 (Sam Steingold) 6. clisp/doc impext.xml,1.423,1.424 Symbol-Table.text,1.8,1.9 (Sam Steingold) 7. clisp/src encoding.d,1.126,1.127 constsym.d,1.314,1.315 clhs.lisp,1.36,1.37 NEWS,1.293,1.294 ChangeLog,1.5119,1.5120 (Sam Steingold) 8. clisp/src ChangeLog,1.5120,1.5121 .gdbinit,1.37,1.38 (Sam Steingold) --__--__-- Message: 1 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src lispbibl.d,1.693,1.694 ChangeLog,1.5116,1.5117 Date: Sat, 26 Nov 2005 22:35:22 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7276/src Modified Files: lispbibl.d ChangeLog Log Message: (Snstring): export to clisp.h to make module i18n build --without-unicode Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.693 retrieving revision 1.694 diff -u -d -r1.693 -r1.694 --- lispbibl.d 29 Oct 2005 20:44:11 -0000 1.693 +++ lispbibl.d 26 Nov 2005 22:35:19 -0000 1.694 @@ -5623,6 +5623,7 @@ %% emit_typedef("s32string_ *","S32string"); %% #endif %% emit_typedef("struct { SSTRING_HEADER chart data[unspecified]; }","snstring_"); +%% emit_typedef("snstring_*","Snstring"); %% export_def(sstring_length(ptr)); %% export_def(Sstring_length(obj)); %% export_def(sstring_eltype(ptr)); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5116 retrieving revision 1.5117 diff -u -d -r1.5116 -r1.5117 --- ChangeLog 25 Nov 2005 16:53:10 -0000 1.5116 +++ ChangeLog 26 Nov 2005 22:35:19 -0000 1.5117 @@ -1,3 +1,8 @@ +2005-11-26 Sam Steingold <sd...@gn...> + + * lispbibl.d (Snstring): export to clisp.h to make module i18n + build --without-unicode + 2005-11-25 Sam Steingold <sd...@gn...> * modules/syscalls/posix.lisp: set documentation sys::process-id --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/unix PLATFORMS,1.36,1.37 Date: Sat, 26 Nov 2005 22:38:10 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/unix In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7781/unix Modified Files: PLATFORMS Log Message: (LN_HARD): set from @LN@, also set a Makefile variable with the same name so that the AFS users can change it at run time Index: PLATFORMS =================================================================== RCS file: /cvsroot/clisp/clisp/unix/PLATFORMS,v retrieving revision 1.36 retrieving revision 1.37 diff -u -d -r1.36 -r1.37 --- PLATFORMS 24 Nov 2005 20:13:56 -0000 1.36 +++ PLATFORMS 26 Nov 2005 22:38:08 -0000 1.37 @@ -627,6 +627,12 @@ to the CFLAGS. +On platforms using AFS: + +You may get an "Invalid cross-device link" error. +If you do, try running make as "make LN_HARD='cp -p' LN='cp -p'". + + Hints for porting to new platforms: ----------------------------------- --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src makemake.in,1.624,1.625 ChangeLog,1.5117,1.5118 Date: Sat, 26 Nov 2005 22:38:10 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7781/src Modified Files: makemake.in ChangeLog Log Message: (LN_HARD): set from @LN@, also set a Makefile variable with the same name so that the AFS users can change it at run time Index: makemake.in =================================================================== RCS file: /cvsroot/clisp/clisp/src/makemake.in,v retrieving revision 1.624 retrieving revision 1.625 diff -u -d -r1.624 -r1.625 --- makemake.in 25 Nov 2005 17:02:58 -0000 1.624 +++ makemake.in 26 Nov 2005 22:38:08 -0000 1.625 @@ -501,6 +501,7 @@ # srcdir='@srcdir@' # either '.' or '../src', see above CP='@CP@' # either 'cp -p' or 'cp' LN_S='@LN_S@' # either 'ln -s' or 'ln' + LN='@LN@' # either 'ln' or ${CP} HLN='@HLN@' # either 'ln' or 'hln' CC="@CC@" # either 'gcc -O' or 'cc' CPP="@CPP@" # either $CC' -E' or '/lib/cpp' @@ -913,12 +914,7 @@ fi # LN_HARD = command for copying files, saving disk space if possible -if [ "$HSYSOS" = beos ] ; then - # The BeOS 5 filesystem has only symbolic links, no hard links. - LN_HARD='cp -p' -else - LN_HARD='ln' -fi +LN_HARD=${LN-ln} # HLN = command for making hard links ($HOS = unix only) if [ "$HLN" = hln ] ; then @@ -2807,11 +2803,12 @@ if [ -n "$USE_GETTEXT" ] ; then + echol "LN_HARD=${LN_HARD}" echol "locale :" if [ $HOS = unix ] ; then echotab "if test -d locale; then rm -rf locale; fi" echotab "mkdir locale" - echotab "(cd po && \$(MAKE) && \$(MAKE) install datadir=.. localedir='\$\$(datadir)/locale' INSTALL_DATA='$LN_HARD') || (rm -rf locale ; exit 1)" + echotab "(cd po && \$(MAKE) && \$(MAKE) install datadir=.. localedir='\$\$(datadir)/locale' INSTALL_DATA='\$(LN_HARD)') || (rm -rf locale ; exit 1)" else echotab "mkdir locale" if test -f src/configure.in; then Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5117 retrieving revision 1.5118 diff -u -d -r1.5117 -r1.5118 --- ChangeLog 26 Nov 2005 22:35:19 -0000 1.5117 +++ ChangeLog 26 Nov 2005 22:38:08 -0000 1.5118 @@ -1,5 +1,10 @@ 2005-11-26 Sam Steingold <sd...@gn...> + * makemake.in (LN_HARD): set from @LN@, also set a Makefile variable + with the same name so that the AFS users can change it at run time + +2005-11-26 Sam Steingold <sd...@gn...> + * lispbibl.d (Snstring): export to clisp.h to make module i18n build --without-unicode --__--__-- Message: 4 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.5118,1.5119 .gdbinit,1.36,1.37 Date: Sat, 26 Nov 2005 22:39:28 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8052/src Modified Files: ChangeLog .gdbinit Log Message: (run_test, run_all_tests): suite --> tests (typo) Index: .gdbinit =================================================================== RCS file: /cvsroot/clisp/clisp/src/.gdbinit,v retrieving revision 1.36 retrieving revision 1.37 diff -u -d -r1.36 -r1.37 --- .gdbinit 6 Nov 2005 22:04:01 -0000 1.36 +++ .gdbinit 26 Nov 2005 22:39:26 -0000 1.37 @@ -56,14 +56,14 @@ end define run_test - run -B . -N locale -M lispinit.mem -q -norc -C -i suite/tests.lisp -x "(run-test \"suite/$arg0.tst\")" + run -B . -N locale -M lispinit.mem -q -norc -i tests/tests -x "(run-test \"tests/$arg0\")" end document run_test run the specified test in the test suite end define run_all_tests - run -B . -N locale -M lispinit.mem -q -norc -C -i suite/tests.lisp -x "(cd \"suite/\") (run-all-tests)" + run -B . -N locale -M lispinit.mem -q -norc -i tests/tests -x "(cd \"tests/\") (run-all-tests)" end document run_all_tests run the whole test suite Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5118 retrieving revision 1.5119 diff -u -d -r1.5118 -r1.5119 --- ChangeLog 26 Nov 2005 22:38:08 -0000 1.5118 +++ ChangeLog 26 Nov 2005 22:39:26 -0000 1.5119 @@ -1,5 +1,9 @@ 2005-11-26 Sam Steingold <sd...@gn...> + * .gdbinit (run_test, run_all_tests): suite --> tests (typo) + +2005-11-26 Sam Steingold <sd...@gn...> + * makemake.in (LN_HARD): set from @LN@, also set a Makefile variable with the same name so that the AFS users can change it at run time --__--__-- Message: 5 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/tests encoding.tst,1.14,1.15 ChangeLog,1.429,1.430 Date: Sat, 26 Nov 2005 22:48:36 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9444/tests Modified Files: encoding.tst ChangeLog Log Message: New charset BASE64 Index: encoding.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/encoding.tst,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- encoding.tst 21 Jul 2005 19:44:36 -0000 1.14 +++ encoding.tst 26 Nov 2005 22:48:34 -0000 1.15 @@ -116,3 +116,30 @@ (setq list (sort list #'< :key #'second)) (format t "~& ~:D encoding~:P:~%~:{~25@A: ~5:D~%~}" (length list) list)) NIL + +;; base64 +(convert-string-from-bytes #(97) charset:base64) "YQ==" +(convert-string-to-bytes "YQ==" charset:base64) #(97) +(convert-string-from-bytes #(97 98) charset:base64) "YWI=" +(convert-string-to-bytes "YWI=" charset:base64) #(97 98) +(convert-string-from-bytes #(97 98 99) charset:base64) "YWJj" +(convert-string-to-bytes "YWJj" charset:base64) #(97 98 99) +(convert-string-from-bytes #(108 105 115 112 32 115 116 114 105 110 103) + charset:base64) "bGlzcCBzdHJpbmc=" +(convert-string-to-bytes "bGlzcCBzdHJpbmc=" charset:base64) +#(108 105 115 112 32 115 116 114 105 110 103) +(convert-string-from-bytes #(108 105 115 112 32 115 116 114 105 110 103 115) + charset:base64) "bGlzcCBzdHJpbmdz" +(convert-string-to-bytes "bGlzcCBzdHJpbmdz" charset:base64) +#(108 105 115 112 32 115 116 114 105 110 103 115) +(convert-string-from-bytes #(99 108 105 115 112 32 115 116 114 105 110 103 115) + charset:base64) "Y2xpc3Agc3RyaW5ncw==" +(convert-string-to-bytes "Y2xpc3Agc3RyaW5ncw==" charset:base64) +#(99 108 105 115 112 32 115 116 114 105 110 103 115) + +(loop :with s :and v2 :repeat 1000 :for v1 = (make-array (random 300)) :do + (loop :for i :from 0 :below (length v1) :do (setf (aref v1 i) (random 256))) + (setq s (convert-string-from-bytes v1 charset:base64) + v2 (convert-string-to-bytes s charset:base64)) + :unless (equalp v1 v2) :collect (list v1 s v2)) +NIL Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.429 retrieving revision 1.430 diff -u -d -r1.429 -r1.430 --- ChangeLog 21 Nov 2005 21:34:41 -0000 1.429 +++ ChangeLog 26 Nov 2005 22:48:34 -0000 1.430 @@ -1,3 +1,7 @@ +2005-11-26 Sam Steingold <sd...@gn...> + + * encoding.tst: test CHARSET:BASE64 + 2005-11-21 Sam Steingold <sd...@gn...> * mop.tst: test user-defined :allocation :hash --__--__-- Message: 6 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/doc impext.xml,1.423,1.424 Symbol-Table.text,1.8,1.9 Date: Sat, 26 Nov 2005 22:48:36 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9444/doc Modified Files: impext.xml Symbol-Table.text Log Message: New charset BASE64 Index: impext.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v retrieving revision 1.423 retrieving revision 1.424 diff -u -d -r1.423 -r1.424 --- impext.xml 25 Nov 2005 16:35:12 -0000 1.423 +++ impext.xml 26 Nov 2005 22:48:34 -0000 1.424 @@ -613,6 +613,16 @@ <listitem id="charset-TCVN"><simpara><constant>TCVN</constant>, &ascii-iso-ext; Vietnamese. &charset-glibc-libiconv;</simpara></listitem> <!-- #endif /* GNU_LIBICONV */ --> +<listitem id="base64"><para><constant>BASE64</constant>, encodes + arbitrary byte sequences with 64 &ascii; characters <literallayout> + ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ + </literallayout> as specifined by &mime;; 3 bytes are encoded with 4 + characters, line breaks are inserted after every 76 characters.</para> + <simpara>While this is not a traditional character set (i.e., it does + not map a set of characters in a natural language into bytes), it + does define a map between arbitrary byte sequences and certain + character sequences, so it falls naturally into the &encoding; class. +</simpara></listitem> </orderedlist> <!-- #ifdef /* HAVE_ICONV */ --> @@ -633,10 +643,10 @@ there is no portable way to get the list of all character sets supported by &iconv;.</simpara> -<simpara>On &gnu; systems (such as &gnu;/&linux; and &gnu;/&hurd;) - and on systems with &libiconv; you get this list by calling the - <emphasis>program</emphasis>: <command role="unix">iconv -l</command>. - </simpara> +<simpara>On standard-compliant &unix; systems (e.g., &gnu; systems, such + as &gnu;/&linux; and &gnu;/&hurd;) and on systems with &libiconv; you + get this list by calling the <emphasis>program</emphasis>: + <command role="unix">iconv -l</command>.</simpara> <simpara>The reason we use only &glibc; 2.2 or &libiconv; is that the other &iconv; implementations are broken in various ways and @@ -1636,18 +1646,6 @@ &pass-r; (or &port-r;) are &nil;.</para> <para>Use function <code>(EXT:HTTP-PROXY &optional-amp; (&string-t; (&getenv; "HTTP_PROXY")))</code> to reset &http-proxy;.</para></section> - -<section id="base64"><title>Functions <function>EXT:BASE64-ENCODE</function> - and <function>EXT:BASE64-DECODE</function></title> - <para>These functions implement the &mime; convertion between &string-t; - and &ubyte-vec; <programlisting language="lisp"> -(EXT:BASE64-ENCODE &string-r; &optional-amp; &vec-r;) -(EXT:BASE64-DECODE &vec-r; &optional-amp; &string-r;) -</programlisting> - The optional second argument is the output buffer: when it is - specified, it will be written to and will be returned.</para> -</section> - </section> <section id="customize"><title>Customizing &clisp; behavior</title> Index: Symbol-Table.text =================================================================== RCS file: /cvsroot/clisp/clisp/doc/Symbol-Table.text,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Symbol-Table.text 23 Nov 2005 17:35:56 -0000 1.8 +++ Symbol-Table.text 26 Nov 2005 22:48:34 -0000 1.9 @@ -712,10 +712,6 @@ http-proxy CUSTOM:*HTTP-PROXY* http-proxy -EXT:BASE64-ENCODE -base64 -EXT:BASE64-DECODE -base64 EXT:EXPAND-FORM code-walk EXT:MODULE-INFO --__--__-- Message: 7 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src encoding.d,1.126,1.127 constsym.d,1.314,1.315 clhs.lisp,1.36,1.37 NEWS,1.293,1.294 ChangeLog,1.5119,1.5120 Date: Sat, 26 Nov 2005 22:48:36 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9444/src Modified Files: encoding.d constsym.d clhs.lisp NEWS ChangeLog Log Message: New charset BASE64 Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.293 retrieving revision 1.294 diff -u -d -r1.293 -r1.294 --- NEWS 21 Nov 2005 22:53:40 -0000 1.293 +++ NEWS 26 Nov 2005 22:48:34 -0000 1.294 @@ -29,6 +29,10 @@ * New FFI macro FFI:DEF-C-CONST. See <http://clisp.cons.org/impnotes/dffi.html#def-c-const> for details. +* New charset BASE64 encodes arbitrary byte sequences with strings of + printable ASCII characters (4 characters per 3 bytes). + See <http://clisp.cons.org/impnotes/encoding.html#base64> for details. + * New module readline offers some advanced readline and history features. It is a BASE module and is available when both FFI and readline are present. Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.314 retrieving revision 1.315 diff -u -d -r1.314 -r1.315 --- constsym.d 19 Nov 2005 23:27:01 -0000 1.314 +++ constsym.d 26 Nov 2005 22:48:34 -0000 1.315 @@ -1808,6 +1808,7 @@ LISPSYM(write_float_decimal,"WRITE-FLOAT-DECIMAL",system) /* function for LISPARIT */ LISPSYM(random_state_stern,"*RANDOM-STATE*",lisp) /* variable in LISPARIT */ #ifdef UNICODE +LISPSYM(base64,"BASE64",charset) LISPSYM(unicode_16,"UNICODE-16",charset) LISPSYM(unicode_16_big_endian,"UNICODE-16-BIG-ENDIAN",charset) LISPSYM(unicode_16_little_endian,"UNICODE-16-LITTLE-ENDIAN",charset) Index: encoding.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/encoding.d,v retrieving revision 1.126 retrieving revision 1.127 diff -u -d -r1.126 -r1.127 --- encoding.d 11 Oct 2005 23:08:59 -0000 1.126 +++ encoding.d 26 Nov 2005 22:48:34 -0000 1.127 @@ -1,7 +1,7 @@ /* * Encodings (character sets and conversions) for CLISP * Bruno Haible 1998-2005 - * Sam Steingold 1998-2004 + * Sam Steingold 1998-2005 */ #include "lispbibl.c" @@ -31,6 +31,228 @@ most one byte in the buffer. stream.d (rd_ch_buffered, rd_ch_array_buffered) heavily depend on this. */ +/* -------------------------------------------------------------------------- + * base64 http://rfc.net/rfc2045.html */ + +global uintL base64_mblen (object encoding, const uintB* src, + const uintB* srcend); +global void base64_mbstowcs (object encoding, object stream, + const uintB* *srcp, const uintB* srcend, + chart* *destp, chart* destend); +global uintL base64_wcslen (object encoding, const chart* src, + const chart* srcend); +global void base64_wcstombs (object encoding, object stream, + const chart* *srcp, const chart* srcend, + uintB* *destp, uintB* destend); +global object base64_range (object encoding, uintL start, uintL end, + uintL maxintervals); + +static const char base64_table[64] = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; +static const char table_base64[128] = { + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* -1- 9 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */ + -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */ + 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */ + -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */ + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */ + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */ + 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */ + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */ + 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */ + 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */ +}; +/* alternatively: + var int pos = 0; + while (pos < sizeof(table_base64)) table_base64[pos++] = -1; + for (pos = 0; pos < sizeof(base64_table); pos++) + table_base64[base64_table[pos]] = pos; +*/ + +#define MIME_LINE_LENGTH 76 + +typedef enum { le_unix, le_mac, le_dos } line_end_t; +local line_end_t enc_eol_to_le (object enc_eol) { + if (eq(enc_eol,S(Kunix))) return le_unix; + if (eq(enc_eol,S(Kdos))) return le_dos; + if (eq(enc_eol,S(Kmac))) return le_mac; + NOTREACHED; +} + +local uintL base64_to_chars (line_end_t le, const uintB* src, + const uintB* srcend, chart *dest) { + var uintL pos = 0; + var uintL counter = 0; + var uintL num_chars = 0; + while (src < srcend) { + int c = *src++; + if (counter < MIME_LINE_LENGTH/4) counter++; + else { /* Wrap line every 76 characters. */ + counter = 1; + switch (le) { + case le_unix: + if (dest) *dest++ = ascii(LF); num_chars++; + break; + case le_dos: + if (dest) { *dest++ = ascii(CR); *dest++ = ascii(LF); } + num_chars += 2; + break; + case le_mac: + if (dest) *dest++ = ascii(CR); num_chars++; + break; + } + } + /* Process first byte of a triplet. */ + if (dest) *dest++ = ascii(base64_table[0x3f & c >> 2]); num_chars++; + var int value = (0x03 & c) << 4; + /* Process second byte of a triplet. */ + if (src == srcend) { + if (dest) { + *dest++ = ascii(base64_table[value]); + *dest++ = ascii('='); + *dest++ = ascii('='); + } + num_chars += 3; + break; + } + c = *src++; + if (dest) *dest++ = ascii(base64_table[value | (0x0f & c >> 4)]); + num_chars++; + value = (0x0f & c) << 2; + /* Process third byte of a triplet. */ + if (src == srcend) { + if (dest) { + *dest++ = ascii(base64_table[value]); + *dest++ = ascii('='); + } + num_chars += 2; + break; + } + c = *src++; + if (dest) { + *dest++ = ascii(base64_table[value | (0x03 & c >> 6)]); + *dest++ = ascii(base64_table[0x3f & c]); + } + num_chars += 2; + } + return num_chars; +} + +global uintL base64_mblen (object encoding, const uintB* src, + const uintB* srcend) { + return base64_to_chars(enc_eol_to_le(TheEncoding(encoding)->enc_eol), + src,srcend,NULL); +} + +/* see emacs/src/fns.c */ +global void base64_mbstowcs (object encoding, object stream, + const uintB* *srcp, const uintB* srcend, + chart* *destp, chart* destend) { + *destp += base64_to_chars(enc_eol_to_le(TheEncoding(encoding)->enc_eol), + *srcp,srcend,*destp); + *srcp = srcend; +} + +#define BASE64_P(c) (c<sizeof(table_base64) && table_base64[c]!=-1) +#define BASE64_IGNORABLE_P(ch) \ + (chareq(ch,ascii(' ')) || chareq(ch,ascii('\t')) || chareq(ch,ascii('\n')) \ + || chareq(ch,ascii('\f')) || chareq(ch,ascii('\r'))) + +/* see emacs/src/fns.c */ +#define READ_QUADRUPLET_BYTE(endform) do { \ + if (src == srcend) { endform; } \ + ch = *src++; \ + } while (BASE64_IGNORABLE_P(ch)); \ + c = as_cint(ch) + +/* convert ascii src to bytes dest - when destp is given + return the number of bytes + the final bad characted position is retutned in error_p */ +local uintL base64_to_bytes (const chart *src, const chart* srcend, + uintB* destp, const chart* *error_p) { + var unsigned char c; + var chart ch; + var unsigned long value; + var uintB *dest = destp; + var uintL num_bytes = 0; + + while (1) { + /* Process first byte of a quadruplet. */ + READ_QUADRUPLET_BYTE(return num_bytes); + if (!BASE64_P(c)) { *error_p = src-1; return num_bytes; } + value = table_base64[c] << 18; + + /* Process second byte of a quadruplet. */ + READ_QUADRUPLET_BYTE(*error_p = src; return num_bytes); + if (!BASE64_P(c)) { *error_p = src-1; return num_bytes; } + value |= table_base64[c] << 12; + + if (dest) *dest++ = (unsigned char) (value >> 16); + num_bytes++; + + /* Process third byte of a quadruplet. */ + READ_QUADRUPLET_BYTE(*error_p = src; return num_bytes); + if (c == '=') { + READ_QUADRUPLET_BYTE(*error_p = src; return num_bytes); + if (c != '=') { *error_p = src-1; return num_bytes; } + continue; + } + + if (!BASE64_P(c)) { *error_p = src-1; return num_bytes; } + value |= table_base64[c] << 6; + + if (dest) *dest++ = (unsigned char) (0xff & value >> 8); + num_bytes++; + + /* Process fourth byte of a quadruplet. */ + READ_QUADRUPLET_BYTE(*error_p = src-1; return num_bytes); + if (c == '=') + continue; + if (!BASE64_P(c)) { *error_p = src-1; return num_bytes; } + value |= table_base64[c]; + + if (dest) *dest++ = (unsigned char) (0xff & value); + num_bytes++; + } +} + +global uintL base64_wcslen (object encoding, const chart* src, + const chart* srcend) { + var const chart *error_p = NULL; + return base64_to_bytes(src,srcend,NULL,&error_p) + + (error_p ? 1 : 0); /* space for errors */ +} + +global void base64_wcstombs (object encoding, object stream, + const chart* *srcp, const chart* srcend, + uintB* *destp, uintB* destend) { + var const chart *error_p = NULL; + *destp += base64_to_bytes(*srcp,srcend,*destp,&error_p); + if (error_p) { + pushSTACK(fixnum(srcend-*srcp)); + pushSTACK(fixnum(error_p-*srcp)); + pushSTACK(code_char(*error_p)); + fehler(charset_type_error,GETTEXT("Invalid base64 encoding at ~S (character ~S of ~S)")); + } + *srcp = srcend; +} + +global object base64_range (object encoding, uintL start, uintL end, + uintL maxintervals) { + var uintL count = 0; /* number of intervals already on the STACK */ + if (end >= sizeof(table_base64)) end = sizeof(table_base64) - 1; + while (start <= end) { + while (table_base64[start] == 0) start++; + pushSTACK(code_char(as_chart(start))); + while (table_base64[start]) start++; + pushSTACK(code_char(as_chart(--start))); + start++; count++; + } + return stringof(count << 1); +} + local char const hex_table[] = "0123456789ABCDEF"; /* Error, when a character cannot be converted to an encoding. @@ -2080,6 +2302,22 @@ ASSERT(sizeof(chart) == sizeof(cint)); #ifdef UNICODE { + var object symbol = S(base64); + var object encoding = allocate_encoding(); + TheEncoding(encoding)->enc_eol = S(Kunix); + TheEncoding(encoding)->enc_towcs_error = S(Kerror); + TheEncoding(encoding)->enc_tombs_error = S(Kerror); + TheEncoding(encoding)->enc_charset = symbol; + TheEncoding(encoding)->enc_mblen = P(base64_mblen); + TheEncoding(encoding)->enc_mbstowcs = P(base64_mbstowcs); + TheEncoding(encoding)->enc_wcslen = P(base64_wcslen); + TheEncoding(encoding)->enc_wcstombs = P(base64_wcstombs); + TheEncoding(encoding)->enc_range = P(base64_range); + TheEncoding(encoding)->min_bytes_per_char = 2; /* ?? */ + TheEncoding(encoding)->max_bytes_per_char = 2; /* ?? */ + define_constant(symbol,encoding); + } + { var object symbol = S(unicode_16_big_endian); var object encoding = allocate_encoding(); TheEncoding(encoding)->enc_eol = S(Kunix); Index: clhs.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clhs.lisp,v retrieving revision 1.36 retrieving revision 1.37 diff -u -d -r1.36 -r1.37 --- clhs.lisp 25 Nov 2005 16:37:29 -0000 1.36 +++ clhs.lisp 26 Nov 2005 22:48:34 -0000 1.37 @@ -5,101 +5,10 @@ (in-package "EXT") (export '(clhs clhs-root read-from-file browse-url open-http with-http-input - http-proxy base64-encode base64-decode)) + http-proxy)) (in-package "SYSTEM") -;; lifted from clocc/cllib/base64.lisp -(defconstant *base64-table* - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") - -(defun base64-encode (vec &optional buffer) - "Encode the vector of bytes as a string in base64." - (let ((vec-len (length vec)) quotient remainder str full-top str-len) - (setf (values quotient remainder) (ceiling vec-len 3) - str-len (* 4 quotient) - str (or buffer (make-string str-len)) - full-top (* 4 (if (zerop remainder) quotient (1- quotient)))) - (loop :with triplet :for vec-pos :from 0 :by 3 :for str-pos :from 0 :by 4 - :while (< str-pos full-top) :do - (setf triplet (+ (ash (aref vec vec-pos) 16) - (ash (aref vec (+ 1 vec-pos)) 8) - (aref vec (+ 2 vec-pos))) - (char str str-pos) - (char *base64-table* (ldb (byte 6 18) triplet)) - (char str (+ 1 str-pos)) - (char *base64-table* (ldb (byte 6 12) triplet)) - (char str (+ 2 str-pos)) - (char *base64-table* (ldb (byte 6 6) triplet)) - (char str (+ 3 str-pos)) - (char *base64-table* (ldb (byte 6 0) triplet)))) - (ecase remainder - (-2 (let ((val (ash (aref vec (- vec-len 1)) 16))) - (setf (char str (- str-len 4)) - (char *base64-table* (ldb (byte 6 18) val)) - (char str (- str-len 3)) - (char *base64-table* (ldb (byte 6 12) val)) - (char str (- str-len 2)) #\= - (char str (- str-len 1)) #\=))) - (-1 (let ((val (+ (ash (aref vec (- vec-len 2)) 16) - (ash (aref vec (- vec-len 1)) 8)))) - (setf (char str (- str-len 4)) - (char *base64-table* (ldb (byte 6 18) val)) - (char str (- str-len 3)) - (char *base64-table* (ldb (byte 6 12) val)) - (char str (- str-len 2)) - (char *base64-table* (ldb (byte 6 6) val)) - (char str (- str-len 1)) #\=))) - (0)) ; golden! - str)) - -(defconstant *table-base64* - (let ((vec (make-array 128))) - (loop :for pos :upfrom 0 :for ch :across *base64-table* - :do (setf (aref vec (char-code ch)) pos)) - vec)) - -(defun base64-decode (str &optional buffer) - "Decode the string into a vector of bytes." - (let* ((str-len (length str)) quotient remainder vec vec-len full-top - (=count - (if (and (> str-len 0) (char= #\= (char str (- str-len 1)))) - (if (and (> str-len 1) (char= #\= (char str (- str-len 2)))) - 2 1) - 0))) - (setf (values quotient remainder) (floor str-len 4)) - (unless (zerop remainder) - (error "~S: invalid base64 data length ~:D: ~S" - 'base64-decode str-len str)) - (setq full-top (* 3 quotient) - vec-len (- full-top =count) - vec (or buffer (make-array vec-len :element-type '(unsigned-byte 8)))) - (unless (zerop =count) (decf full-top 3)) - (macrolet ((get-byte (pos) - `(or (svref *table-base64* (char-code (char str ,pos))) - (error "~S: invalid base64 character ~@C at ~:D in ~S" - 'base64-decode (char str ,pos) ,pos str)))) - (loop :with quad :for vec-pos :from 0 :by 3 :for str-pos :from 0 :by 4 - :while (< vec-pos full-top) :do - (setf quad (+ (ash (get-byte str-pos) 18) - (ash (get-byte (+ 1 str-pos)) 12) - (ash (get-byte (+ 2 str-pos)) 6) - (get-byte (+ 3 str-pos))) - (aref vec vec-pos) (ldb (byte 8 16) quad) - (aref vec (+ 1 vec-pos)) (ldb (byte 8 8) quad) - (aref vec (+ 2 vec-pos)) (ldb (byte 8 0) quad))) - (ecase =count - (2 (let ((val (+ (ash (get-byte (- str-len 4)) 18) - (ash (get-byte (- str-len 3)) 12)))) - (setf (aref vec (- vec-len 1)) (ldb (byte 8 16) val)))) - (1 (let ((val (+ (ash (get-byte (- str-len 4)) 18) - (ash (get-byte (- str-len 3)) 12) - (ash (get-byte (- str-len 2)) 6)))) - (setf (aref vec (- vec-len 2)) (ldb (byte 8 16) val) - (aref vec (- vec-len 1)) (ldb (byte 8 8) val)))) - (0)) ; golden! - vec))) - (defvar *browsers* '((:netscape "netscape" "~a") (:netscape-remote "netscape" "-remote" "openURL(~a,new-window)") @@ -239,10 +148,13 @@ (format t "connected...") (force-output) (format sock "GET ~A HTTP/1.0~%User-agent: ~A~%Host: ~A~%" path (lisp-implementation-type) host) ; request + #+unicode ; base64 requires unicode for some weird infrastructure reasons (when (first *http-proxy*) ; auth: http://www.ietf.org/rfc/rfc1945.txt (format sock "Proxy-Authorization: Basic ~A~%" - (base64-encode (convert-string-to-bytes (first *http-proxy*) - *http-encoding*)))) + (convert-string-from-bytes + (convert-string-to-bytes (first *http-proxy*) + *http-encoding*) + charset:base64))) (format sock "Accept: */*~%Connection: close~2%") ; finish request (write-string (setq status (read-line sock))) (force-output) (let* ((pos1 (position #\Space status)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5119 retrieving revision 1.5120 diff -u -d -r1.5119 -r1.5120 --- ChangeLog 26 Nov 2005 22:39:26 -0000 1.5119 +++ ChangeLog 26 Nov 2005 22:48:34 -0000 1.5120 @@ -1,5 +1,17 @@ 2005-11-26 Sam Steingold <sd...@gn...> + New charset BASE64 + * encoding.d (base64_mblen, base64_mbstowcs, base64_wcslen) + (base64_wcstombs, base64_range, base64_table, table_base64) + (base64_to_bytes, base64_to_chars): added + (init_encodings_1): unit BASE64 + * constsym.d (BASE64): added + * clhs.lisp (*base64-table*, base64-encode, *table-base64*) + (base64-decode): removed + (open-http): use CHARSET:BASE64 instead of BASE64-ENCODE + +2005-11-26 Sam Steingold <sd...@gn...> + * .gdbinit (run_test, run_all_tests): suite --> tests (typo) 2005-11-26 Sam Steingold <sd...@gn...> --__--__-- Message: 8 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.5120,1.5121 .gdbinit,1.37,1.38 Date: Sun, 27 Nov 2005 01:17:10 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9160/src Modified Files: ChangeLog .gdbinit Log Message: use $common to ensure that all invocations get -E 1:1 Index: .gdbinit =================================================================== RCS file: /cvsroot/clisp/clisp/src/.gdbinit,v retrieving revision 1.37 retrieving revision 1.38 diff -u -d -r1.37 -r1.38 --- .gdbinit 26 Nov 2005 22:39:26 -0000 1.37 +++ .gdbinit 27 Nov 2005 01:17:08 -0000 1.38 @@ -1,9 +1,11 @@ # CLISP .gdbinit set language c +set $common = -B . -N locale -E 1:1 -q -norc + define boot file lisp.run - set args -B . -N locale -M lispinit.mem -q -norc + set args $common -M lispinit.mem end document boot debug the boot linking set @@ -11,7 +13,7 @@ define base file base/lisp.run - set args -B . -N locale -M base/lispinit.mem -q -norc + set args $common -M base/lispinit.mem end document base debug the base linking set @@ -19,7 +21,7 @@ define full file full/lisp.run - set args -B . -N locale -M full/lispinit.mem -q -norc + set args $common -M full/lispinit.mem # -i ../tests/tests -x '(run-test "***/test")' # -i clx/new-clx/demos/clx-demos.lisp -x '(clx-demos:qix)' -x '(clx-demos:koch)' -x '(clx-demos:sokoban)' break my_type_error @@ -33,7 +35,7 @@ define interpreted file lisp.run - set args -B . -N locale -M interpreted.mem -q -norc + set args $common -M interpreted.mem end document interpreted debug the boot linking set with the interpreted memory image @@ -56,28 +58,28 @@ end define run_test - run -B . -N locale -M lispinit.mem -q -norc -i tests/tests -x "(run-test \"tests/$arg0\")" + run $common -M lispinit.mem -i tests/tests -x "(run-test \"tests/$arg0\")" end document run_test run the specified test in the test suite end define run_all_tests - run -B . -N locale -M lispinit.mem -q -norc -i tests/tests -x "(cd \"tests/\") (run-all-tests)" + run $common -M lispinit.mem -i tests/tests -x "(cd \"tests/\") (run-all-tests)" end document run_all_tests run the whole test suite end define ansi_tests - run -B . -N locale -M lispinit.mem -q -norc -ansi -x "(cd \"ansi-tests/\") (load \"clispload.lsp\") (in-package \"CL-TEST\") (time (regression-test:do-tests))" + run $common -M lispinit.mem -ansi -x "(cd \"ansi-tests/\") (load \"clispload.lsp\") (in-package \"CL-TEST\") (time (regression-test:do-tests))" end document ansi_tests run the gcl/ansi-test suite end define ansi_tests_compiled - run -B . -N locale -M lispinit.mem -q -norc -ansi -x "(cd \"ansi-tests/\") (load \"clispload.lsp\") (in-package \"CL-TEST\") (setq regression-test::*compile-tests* t) (time (regression-test:do-tests))" + run $common -M lispinit.mem -ansi -x "(cd \"ansi-tests/\") (load \"clispload.lsp\") (in-package \"CL-TEST\") (setq regression-test::*compile-tests* t) (time (regression-test:do-tests))" end document ansi_tests run the gcl/ansi-test suite - compiled Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5120 retrieving revision 1.5121 diff -u -d -r1.5120 -r1.5121 --- ChangeLog 26 Nov 2005 22:48:34 -0000 1.5120 +++ ChangeLog 27 Nov 2005 01:17:07 -0000 1.5121 @@ -1,5 +1,9 @@ 2005-11-26 Sam Steingold <sd...@gn...> + * .gdbinit: use $common to ensure that all invocations get -E 1:1 + +2005-11-26 Sam Steingold <sd...@gn...> + New charset BASE64 * encoding.d (base64_mblen, base64_mbstowcs, base64_wcslen) (base64_wcstombs, base64_range, base64_table, table_base64) --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |