picolisp

commit 162767a7ca08aabf52cae1209e5b7f792ce09988
parent 8454cb6bd0c793b829e50586f19408f4e61e722d
Author: Commit-Bot <unknown>
Date:   Fri, 21 May 2010 17:51:07 +0000

Automatic commit from picoLisp.tgz, From: Fri, 21 May 2010 14:51:07 GMT
Diffstat:
M
doc/refS.html
 | 
14
++++++++++++++
M
misc/crc.l
 | 
46
++++++++++++++++++++++++++++++++++++----------
M
test/src/apply.l
 | 
3
++-

3 files changed, 52 insertions(+), 11 deletions(-)
diff --git a/doc/refS.html b/doc/refS.html
@@ -443,6 +443,20 @@ href="refS.html#show">show</a></code>.
 href="refS.html#*Sig1">*Sig[12]</a></code>.
 
 <pre><code>
+# First session
+: (sigio (setq *SigSock (port T 4444))  # Register signal handler at UDP port
+   (while (udp *SigSock)                # Queue all received data
+      (fifo '*SigQueue @) ) )
+-> 3
+
+# Second session
+: (for I 7 (udp "localhost" 4444 I))  # Send numbers to first session
+
+# First session
+: (fifo '*SigQueue)
+-> 1
+: (fifo '*SigQueue)
+-> 2
 </code></pre>
 
 <dt><a name="size"><code>(size 'any) -> cnt</code></a>
diff --git a/misc/crc.l b/misc/crc.l
@@ -1,23 +1,49 @@
-# 04sep06abu
+# 21may10abu
 # (c) Software Lab. Alexander Burger
 
-(load "lib/gcc.l")
+(if (== 64 64) (load "lib/native.l") (from "/**/"))
+
+(gcc "util" NIL
+   (crc (Len Lst) "crc" 'I Len (cons NIL (cons Len) Lst)) )
+
+int crc(int len, char *p) {
+   int res, c, i;
+
+   for (res = 0; --len >=0;) {
+      c = *p++;
+      for (i = 0; i < 8; ++i) {
+         if ((c ^ res) & 1)
+            res ^= 0x14002;  /* Polynom x**16 + x**15 + x**2 + 1 */
+         c >>= 1,  res >>= 1;
+      }
+   }
+   return res;
+}
+
+/**/
+
+
+(ifn (== 64 64) (load "lib/gcc.l") (from "/**/"))
 
 (gcc "crc" NIL 'crc)
 
 any crc(any ex) {
-   any x = EVAL(cadr(ex));
-   int c, crc, i;
+   any x;
+   int len, res, c, i;
 
-   NeedLst(ex,x);
-   for (crc = 0; isCell(x); x = cdr(x)) {
+   len = evCnt(ex, x = cdr(ex));
+   x = cdr(x),  x = EVAL(car(x));
+   for (res = 0; --len >=0; x = cdr(x)) {
       c = (int)xCnt(ex,car(x));
       for (i = 0; i < 8; ++i) {
-         if ((c ^ crc) & 1)
-            crc ^= 0x14002;  /* Polynom x**16 + x**15 + x**2 + 1 */
-         c >>= 1,  crc >>= 1;
+         if ((c ^ res) & 1)
+            res ^= 0x14002;  /* Polynom x**16 + x**15 + x**2 + 1 */
+         c >>= 1,  res >>= 1;
       }
    }
-   return boxCnt(crc);
+   return boxCnt(res);
 }
+
 /**/
+
+# vi:et:ts=3:sw=3
diff --git a/test/src/apply.l b/test/src/apply.l
@@ -1,10 +1,11 @@
-# 12jul08abu
+# 21may10abu
 # (c) Software Lab. Alexander Burger
 
 ### apply ###
 (test 6 (apply + (1 2 3)))
 (test 360 (apply * (5 6) 3 4))
 (test 27 (apply '((X Y Z) (* X (+ Y Z))) (3 4 5)))
+(test (5 7 9) (apply mapcar '((1 2 3) (4 5 6)) +))
 
 
 ### pass ###